Фильтрация реактивных данных нажатием кнопки на всплывающей карте
У меня есть блестящее приложение, которое отображает информацию для пользователей. Каждая строка представляет собой место, поэтому вы можете использовать два selectInputs фильтровать данные, используя конкретные названия городов и районов. я использую reactive() фильтровать данные. Полученные данные отображаются ниже с информационными полями и картой, показывающей местоположение каждого места.
Информационные блоки имеют кнопку действия, которая после нажатия отображает только маркер, соответствующий этому блоку. Я обновляю свою карту с leafletProxy,
Кроме того, на моей карте есть создатели с всплывающими окнами, содержащими кнопку действия, поэтому я хочу нажать на эту кнопку и показать только информационное окно, соответствующее месту на карте, но не отображать остальные. Я думал, что смогу сделать эту фильтрацию данных снова eventReactive когда пользователь нажимает на кнопку на карте, но я не могу этого сделать. Идентификатор кнопок генерируется динамически 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)
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)
Спасибо за любую помощь и извините, если я написал что-то не так, впервые используя stackru.
1 ответ
Хорошо, я не уверен на 100%, что это желаемое поведение, но я думаю, что этого достаточно для работы, чтобы вы могли достичь того, чего хотите.
Я добавил идентификатор в div, который вы создали, а затем использовал lapply создать отдельный observeEvent для каждой кнопки. Это наблюдать событие потом срабатывает show или же hide от shinyjs пакет на соответствующие дивы.
я добавил #added by Florian или же modified by Florian выше строк, которые я добавил или изменил, так как код довольно длинный. Надеюсь, это поможет! Дайте мне знать, если возникнут какие-либо другие вопросы.
# 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)