单击传单地图弹出窗口上的按钮过滤反应数据

Question

我有一个闪亮的应用程序可以向用户显示信息。每行代表一个地方，因此您可以使用两个 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)
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)

感谢您的帮助，如果我写错了，第一次使用 Whosebug，我深表歉意。

Answer 1

好吧，我不是 100% 确定这是所需的行为，但我认为这足以让您使用，因此您可以实现您想要的。

我为您创建的 div 添加了一个 ID，然后使用 lapply 为每个按钮创建了一个单独的 observeEvent。然后，此 observeEvent 在适当的 div 上从 shinyjs 包触发 show 或 hide。

我在添加或修改的行上方添加了#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)

单击传单地图弹出窗口上的按钮过滤反应数据

Filter reactive data with button clicked on leaflet map popup

r

filter

leaflet

shiny

reactive