在传单地图弹出窗口上单击按钮来过滤反应数据 [英] Filter reactive data with button clicked on leaflet map popup
本文介绍了在传单地图弹出窗口上单击按钮来过滤反应数据的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我有一个闪亮的应用程序，可以向用户显示信息.每行代表一个地方，因此您可以使用两个 selectInputs 来过滤使用特定城市名称和区域的数据.我正在使用 reactive()过滤数据.结果数据显示在下面，带有信息框和显示每个位置的地图.
信息框具有一个操作按钮，一旦单击该按钮，将仅显示与该框相对应的标记.我正在使用 leafletProxy 更新地图.
此外，在我的地图中，我的制造商的弹出窗口包含一个操作按钮，因此我想单击该按钮，仅显示与地图上的位置相对应的信息框，而不显示其他位置.我以为我可以在用户单击地图上的按钮时使用 eventReactive 再次过滤数据，但我似乎无法做到这一点.按钮的ID是用 lapply 动态生成的，所以我不知道如何在 observeEvent 或 eventReactive 中声明它.有什么建议么?
下面的代码示例:
name< -sample(c('a'，'b'，'c')，replace = T，5)area1< -sample(c(0,1)，replace = T，5)area2< -sample(c(0,1)，replace = T，5)area3< -sample(c(0,1)，replace = T，5)LAT< -runif(5，min = -26，max = -22)长< -runif(5，min = -54，max = -48)数据< -data.frame(名称，区域1，区域2，区域3，LAT，长)ui<-ShinyUI(fluidPage(selectInput('muni'，label ='选择城市'，choices = c('显示全部'，sort(levels(data(name))，selected = NULL))，selectInput('area'，label ='选择区域'，choices = c('显示全部'，'area1'，'area2'，'area3'，selected = NULL))，HTML('< table border ="0">< tr>< td style ="padding:8px">< a id ="reset" href =#" style ="text-indent:0px;"class ="action-button shine-bound-input">重置</a</td</tr</table")，htmlOutput('box')，leafletOutput('map')))服务器<-功能(输入，输出，会话){data1< -reactive({如果(input $ muni！='Show all'){data< -data [which(data $ name == input $ muni)，]}如果(input $ area！='Show all'){data< -data [data [input $ area]！= 0，]}返回(数据)})watchEvent(input $ reset，{updateSelectInput(session，'muni'，selected ='显示全部')updateSelectInput(session，'area'，selected ='显示全部')})output $ box<-renderUI({数据< -data1()num< -as.integer(nrow(data))func_areas<-函数(区域)sub(，\\ s +([^，] +)$"，和\\ 1"，toString(区域))lapply(1:num，function(i){bt<-paste0('go_btn'，i)fluidRow(HTML(paste0('< div style ="border:1px solid#00000026;border-radius:10px;padding:10px;>< span style ="font-size:14px font-weight:bold;">'，data $ name [i]，'-区域:'，func_areas(colnames(data [i，names(data)[2:4]])[which(data [i，names(data)[2:4]]！= 0)])，'</span></br>'，actionButton(bt，'See map'，icon = icon('map-marker'，lib ='font-awesome'))，HTML('</div></br>'))))})})output $ map< -renderLeaflet({数据< -data1()行名(数据)< -seq(1:nrow(数据))pop< -paste0('< strong>'，data $ name，'</strong></br>'，'< a id ="info'，rownames(data)，'" href =#" style ="text-indent:0px;"class ="action-button shine-bound-input"onclick ="{Shiny.onInputChange(\'info'，rownames(data)，'\'，(Math.random()* 1000)+ 1);}>< i class ="fa fa-info-circle"></i>显示信息</a>')传单(数据)％&％addProviderTiles("Esri.WorldTopoMap")％>％setView(-51.5，-24.8，zoom = 7)％&％;％addMarkers(lng =〜data $ LONG，lat =〜data $ LAT，popup = pop)})lapply(1:nrow(data)，function(i){bt<-paste0('go_btn'，i)watchEvent(input [[bt]]，{数据< -data1()行名(数据)< -seq(1:nrow(数据))pop< -paste0('< strong>'，data $ name [i]，'</strong></br>'，'< a id ="info'，rownames(data)，'" href =#" style ="text-indent:0px;"class ="action-button shine-bound-input"onclick ="{Shiny.onInputChange(\'info'，rownames(data)，'\'，(Math.random()* 1000)+ 1);}>< i class ="fa fa-info-circle"></i>显示信息</a>')leafletProxy('map'，data = data，session = session)％&％;％clearMarkers()％&％;％setView(data $ LONG [i]，data $ LAT [i]，zoom = 15)％&％;％addMarkers(lng = data $ LONG [i]，lat = data $ LAT [i]，popup = pop)})})}ShinyApp(用户界面，服务器) 首次使用stackoverflow时，感谢您的帮助，如果我写错了任何内容，则表示抱歉.
解决方案
好的，我不是100％肯定这是理想的行为，但是我认为这可以为您提供足够的帮助，以便您可以实现想要的目标./p>
我在创建的div上添加了一个id，然后使用 lapply 为每个按钮创建一个单独的 observeEvent .然后，此watchEvent从相应div上的 shinyjs 包中触发 show 或 hide .
由于代码很长，因此在我添加或修改的行上方添加了由Florian所添加的#或由Florian所修改的#.我希望这有帮助！让我知道是否还有其他问题.
#由Florian添加图书馆(shinyjs)名称< -sample(c('a'，'b'，'c')，replace = T，5)area1< -sample(c(0,1)，replace = T，5)area2< -sample(c(0,1)，replace = T，5)area3< -sample(c(0,1)，replace = T，5)LAT< -runif(5，min = -26，max = -22)长< -runif(5，min = -54，max = -48)数据< -data.frame(名称，区域1，区域2，区域3，LAT，长)ui<-ShinyUI(fluidPage(#由弗洛里安(Florian)添加useShinyjs()，selectInput('muni'，label ='选择城市'，choices = c('显示全部'，sort(levels(data(name))，selected = NULL))，selectInput('area'，label ='选择区域'，choices = c('显示全部'，'area1'，'area2'，'area3'，selected = NULL))，HTML('< table border ="0">< tr>< td style ="padding:8px">< a id ="reset" href =#" style ="text-indent:0px;"class ="action-button shine-bound-input">重置</a</td>/tr</table")，htmlOutput('box')，leafletOutput('map')))服务器<-功能(输入，输出，会话){data1< -reactive({如果(input $ muni！='Show all'){data< -data [which(data $ name == input $ muni)，]}如果(input $ area！='Show all'){data< -data [data [input $ area]！= 0，]}返回(数据)})watchEvent(input $ reset，{updateSelectInput(session，'muni'，selected ='显示全部')updateSelectInput(session，'area'，selected ='显示全部')#由弗洛里安(Florian)添加对于(i in 1:as.integer(nrow(data))){Shinyjs :: show(paste0('mydiv _'，i))}})output $ box<-renderUI({数据< -data1()num< -as.integer(nrow(data))func_areas<-函数(区域)sub(，\\ s +([^，] +)$"，和\\ 1"，toString(区域))#由弗洛里安(Florian)修改:添加了div IDlapply(1:num，function(i){bt<-paste0('go_btn'，i)fluidRow(HTML(paste0('< div id ="mydiv _'，i，'"; style ="border:1px solid#00000026;border-radius:10px;padding:10px;>< span style ="font-size:14px font-weight:bold;">'，data $ name [i]，'-区域:'，func_areas(colnames(data [i，names(data)[2:4]])[which(data [i，names(data)[2:4]]！= 0)])，'</span></br>'，actionButton(bt，'See map'，icon = icon('map-marker'，lib ='font-awesome'))，HTML('</div></br>'))))})})#由弗洛里安(Florian)添加lapply(1:as.integer(nrow(data))，function(x){watchEvent(input [[paste0('go_btn'，x)]]，{logjs('点击！')Shinyjs :: show(paste0('mydiv _'，x))对于(i in 1:as.integer(nrow(data))){如果(i！= x){Shinyjs :: hide(paste0('mydiv _'，i))}}})})output $ map< -renderLeaflet({数据< -data1()pop< -paste0('< strong>'，data $ name，'</strong></br>'，'< a id ="info" href =#" style ="text-indent:0px;"class ="action-button shine-bound-input"onclick ="{Shiny.onInputChange(\'info \'，(Math.random()* 1000)+ 1);}">< i class ="fa fa-info-circle"></i>显示信息</a>')传单(数据)％&％addProviderTiles("Esri.WorldTopoMap")％>％setView(-51.5，-24.8，zoom = 7)％&％;％addMarkers(lng =〜data $ LONG，lat =〜data $ LAT，popup = pop)})lapply(1:nrow(data)，function(i){bt<-paste0('go_btn'，i)watchEvent(input [[bt]]，{数据< -data1()pop< -paste0('< strong>'，data $ name [i]，'</strong></br>'，'< a id ="info" href =#" style ="text-indent:0px;"class ="action-button shine-bound-input"onclick ="{Shiny.onInputChange(\'info \'，(Math.random()* 1000)+ 1);}">< i class ="fa fa-info-circle"></i>显示信息</a>')leafletProxy('map'，data = data，session = session)％&％;％clearMarkers()％&％;％setView(data $ LONG [i]，data $ LAT [i]，zoom = 15)％&％;％addMarkers(lng = data $ LONG [i]，lat = data $ LAT [i]，popup = pop)})})}ShinyApp(用户界面，服务器) I have a shiny app that displays information to users. Each line represents a place, so you can use two selectInputs to filter data using specific city names and areas. I'm using reactive() to filter the data. The resulting data is displayed below with info boxes and a map showing the location of each place.
The info boxes have an action button that, once clicked, displays only the marker corresponding to the box. I'm updating my map with leafletProxy.
Also, in my map, I have makers with popups containing an action button, so I want to click in that button and show only the info box corresponding to the place on the map, and not displaying the others. I thought I could do that filtering again the data wih eventReactive when the user click on the button on the map, but I can't seem to do that. The ID of the buttons are dinamically generated with lapply, so I don't know how to declare that in an observeEvent or eventReactive. Any suggestions?
Code example below:
name<-sample(c('a','b','c'),replace=T,5)
area1<-sample(c(0,1),replace=T,5)
area2<-sample(c(0,1),replace=T,5)
area3<-sample(c(0,1),replace=T,5)
LAT<-runif(5,min=-26, max=-22)
LONG<-runif(5,min=-54, max=-48)
data<-data.frame(name,area1,area2,area3,LAT,LONG)
ui <- shinyUI(fluidPage(
selectInput('muni',label='Select city',
choices=c('Show all',sort(levels(data$name)),selected=NULL)),
selectInput('area',label='Select area',
choices=c('Show all','area1','area2','area3',selected=NULL)),
HTML('<table border="0"><tr><td style="padding: 8px">
<a id="reset" href="#" style="text-indent: 0px;"
class="action-button shiny-bound-input">
Reset</a></td></tr></table>'),
htmlOutput('box'),
leafletOutput('map')
))
server <- function (input, output, session) {
data1<-reactive({
if (input$muni!='Show all') {
data<-data[which(data$name==input$muni),]
}
if (input$area!='Show all') {
data<-data[data[input$area]!=0,]
}
return(data)
})
observeEvent(input$reset, {
updateSelectInput(session,'muni',selected='Show all')
updateSelectInput(session,'area',selected='Show all')
})
output$box <- renderUI({
data<-data1()
num<-as.integer(nrow(data))
func_areas <- function(areas) sub(",\\s+([^,]+)$", " and \\1",
toString(areas))
lapply(1:num, function(i) {
bt <- paste0('go_btn',i)
fluidRow(
HTML(paste0('<div style="border: 1px solid #00000026;
border-radius: 10px; padding: 10px;">
<span style="font-size:14px font-weight:bold;">',
data$name[i],' - areas: ',
func_areas(colnames(data[i,names(data)[2:4]])
[which(data[i,names(data)[2:4]]!=0)]),'</span></br>',
actionButton(bt,'See map',icon=icon('map-marker',lib='font-awesome')),
HTML('</div></br>')
)))
})
})
output$map<-renderLeaflet({
data<-data1()
rownames(data)<-seq(1:nrow(data))
pop<-paste0('<strong>',data$name,'</strong></br>',
'<a id="info',rownames(data),'" href="#" style="text-indent: 0px;"
class="action-button shiny-bound-input"
onclick="{Shiny.onInputChange(\'info',rownames(data),'\',
(Math.random() * 1000) + 1);}">
<i class="fa fa-info-circle"></i>Show info</a>')
leaflet(data) %>%
addProviderTiles("Esri.WorldTopoMap") %>%
setView(-51.5,-24.8,zoom=7) %>%
addMarkers(lng=~data$LONG,lat=~data$LAT,popup=pop)
})
lapply(1:nrow(data), function(i) {
bt <- paste0('go_btn',i)
observeEvent(input[[bt]], {
data<-data1()
rownames(data)<-seq(1:nrow(data))
pop<-paste0('<strong>',data$name[i],'</strong></br>',
'<a id="info',rownames(data),'" href="#" style="text-indent: 0px;"
class="action-button shiny-bound-input"
onclick="{Shiny.onInputChange(\'info',rownames(data),'\',
(Math.random() * 1000) + 1);}">
<i class="fa fa-info-circle"></i>Show info</a>')
leafletProxy('map',data=data,session=session) %>%
clearMarkers() %>%
setView(data$LONG[i],data$LAT[i],zoom=15) %>%
addMarkers(lng=data$LONG[i],lat=data$LAT[i],popup=pop)
})
})
}
shinyApp(ui, server)
Thank you for any help and sorry if I wrote something wrong, first time using stackoverflow.
解决方案
Okay, I am not 100% sure this is the desired behavior, but I think this gives you enough to work with so you can achieve what you want.
I added an id to the div's you created, and then used lapply to create a separate observeEvent for each button. This observeEvent then triggers show or hide from the shinyjs package on the appropriate divs.
I added #added by Florian or modified by Florian above the lines I added or modifed, since the code is quite long. I hope this helps! Let me know if any other questions arise.
# Added by Florian
library(shinyjs)
name<-sample(c('a','b','c'),replace=T,5)
area1<-sample(c(0,1),replace=T,5)
area2<-sample(c(0,1),replace=T,5)
area3<-sample(c(0,1),replace=T,5)
LAT<-runif(5,min=-26, max=-22)
LONG<-runif(5,min=-54, max=-48)
data<-data.frame(name,area1,area2,area3,LAT,LONG)
ui <- shinyUI(fluidPage(
# Added by Florian
useShinyjs(),
selectInput('muni',label='Select city',
choices=c('Show all',sort(levels(data$name)),selected=NULL)),
selectInput('area',label='Select area',
choices=c('Show all','area1','area2','area3',selected=NULL)),
HTML('<table border="0"><tr><td style="padding: 8px">
<a id="reset" href="#" style="text-indent: 0px;"
class="action-button shiny-bound-input">
Reset</a></td></tr></table>'),
htmlOutput('box'),
leafletOutput('map')
))
server <- function (input, output, session) {
data1<-reactive({
if (input$muni!='Show all') {
data<-data[which(data$name==input$muni),]
}
if (input$area!='Show all') {
data<-data[data[input$area]!=0,]
}
return(data)
})
observeEvent(input$reset, {
updateSelectInput(session,'muni',selected='Show all')
updateSelectInput(session,'area',selected='Show all')
# Added by Florian
for (i in 1:as.integer(nrow(data)))
{
shinyjs::show(paste0('mydiv_',i))
}
})
output$box <- renderUI({
data<-data1()
num<-as.integer(nrow(data))
func_areas <- function(areas) sub(",\\s+([^,]+)$", " and \\1",
toString(areas))
#modified by Florian: added div id
lapply(1:num, function(i) {
bt <- paste0('go_btn',i)
fluidRow(
HTML(paste0('<div id="mydiv_',i,'"; style="border: 1px solid #00000026;
border-radius: 10px; padding: 10px;">
<span style="font-size:14px font-weight:bold;">',
data$name[i],' - areas: ',
func_areas(colnames(data[i,names(data)[2:4]])
[which(data[i,names(data)[2:4]]!=0)]),'</span></br>',
actionButton(bt,'See map',icon=icon('map-marker',lib='font-awesome')),
HTML('</div></br>')
)))
})
})
# Added by Florian
lapply(1:as.integer(nrow(data)),function(x)
{
observeEvent(input[[paste0('go_btn',x)]], {
logjs('Click!')
shinyjs::show(paste0('mydiv_',x))
for (i in 1:as.integer(nrow(data)))
{
if(i!=x)
{
shinyjs::hide(paste0('mydiv_',i))
}
}
} )
})
output$map<-renderLeaflet({
data<-data1()
pop<-paste0('<strong>',data$name,'</strong></br>',
'<a id="info" href="#" style="text-indent: 0px;"
class="action-button shiny-bound-input"
onclick="{Shiny.onInputChange(\'info\', (Math.random() * 1000) + 1);}">
<i class="fa fa-info-circle"></i>Show info</a>')
leaflet(data) %>%
addProviderTiles("Esri.WorldTopoMap") %>%
setView(-51.5,-24.8,zoom=7) %>%
addMarkers(lng=~data$LONG,lat=~data$LAT,popup=pop)
})
lapply(1:nrow(data), function(i) {
bt <- paste0('go_btn',i)
observeEvent(input[[bt]], {
data<-data1()
pop<-paste0('<strong>',data$name[i],'</strong></br>',
'<a id="info" href="#" style="text-indent: 0px;"
class="action-button shiny-bound-input"
onclick="{Shiny.onInputChange(\'info\', (Math.random() * 1000) + 1);}">
<i class="fa fa-info-circle"></i>Show info</a>')
leafletProxy('map',data=data,session=session) %>%
clearMarkers() %>%
setView(data$LONG[i],data$LAT[i],zoom=15) %>%
addMarkers(lng=data$LONG[i],lat=data$LAT[i],popup=pop)
})
})
}
shinyApp(ui, server)
这篇关于在传单地图弹出窗口上单击按钮来过滤反应数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
