问题
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.
回答1:
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)
来源：https://stackoverflow.com/questions/47716106/filter-reactive-data-with-button-clicked-on-leaflet-map-popup