R Shiny & Leaflet，创建一个闪亮的过滤器，可以遍历数据框列中的列表

Question

我有一个输入数据框，其列值可能包含逗号分隔列表。有没有办法为 shiny 创建一个可以遍历数据帧中的列表的过滤器？

理想情况下，用户应该能够查看所有三个点，并筛选出 PointUse 为 farm、house[=21= 的那些点]，甚至两者兼而有之。

返回并在源数据中创建 'both' 选项不是一个选项。 必须坚持使用两个过滤器选项，farm 或 house。

#############################################
# Needed Libraries & Input Files

library(shiny)
library(shinydashboard)
library(leaflet)
library(dplyr)

##The Data
Point_ID = c("A1", "B1", "C3")
Latitude = c(38.05, 39.08, 40.05)
Longitude = c(-107.00, -107.05, -108.00)
PointUse = I(list("farm", c("farm", "house"), "house"))  # <- the column with the list entries
Map_DF <- data.frame(Point_ID, Latitude, Longitude, PointUse)

choiseList <- c("farm", "house")

#############################################
# UI
ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(checkboxGroupInput(inputId = "PointUseInput", label = "Select Point Use", choices = choiseList, selected = choiseList)),
    dashboardBody(fluidRow(leafletOutput(outputId = 'mapA')))
)

#############################################
# SERVER
server <- function(input, output, session) {

    ## The Filter
    filter_df <- reactive({
      Map_DF %>% filter(for(p in PointUse){p} %in% input$PointUseInput)   # <- the filter
    })

    ## Base Map Creation
    output$mapA <- renderLeaflet({
        leaflet() %>%
            addProviderTiles(
                providers$Esri.DeLorme,
                options = providerTileOptions(
                    updateWhenZooming = FALSE,
                    updateWhenIdle = TRUE)
            ) %>%
            setView(lng = -107.50, lat = 39.00, zoom = 7)
    })

    ## Update Map with Filter Selection
    observe({
        leafletProxy("mapA", session) %>%
            clearMarkers() %>%
            addCircleMarkers(
                data = filter_df(),
                radius = 10,
                color = "red",
                lat = ~Latitude,
                lng = ~Longitude,
                popupOptions(autoPan = FALSE),
                popup = ~paste("PointUse: ", filter_df()$PointUse))
    })
}

############################################
shinyApp(ui = ui, server = server)

Answer 1

使用逻辑向量作为索引而不是 filter 怎么样？请参阅下面的代码，其中 sapply 用于创建与 input$PointUseInput 值匹配的行的逻辑向量。

library(shiny)
library(shinydashboard)
library(leaflet)

##The Data
Point_ID = c("A1", "B1", "C3")
Latitude = c(38.05, 39.08, 40.05)
Longitude = c(-107.00, -107.05, -108.00)
PointUse = I(list("farm", c("farm", "house"), "house"))  # <- the column with the list entries
Map_DF <- data.frame(Point_ID, Latitude, Longitude, PointUse)

choiseList <- c("farm", "house")

#############################################
# UI
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(checkboxGroupInput(inputId = "PointUseInput", label = "Select Point Use", choices = choiseList, selected = choiseList)),
  dashboardBody(fluidRow(leafletOutput(outputId = 'mapA')))
)

#############################################
# SERVER
server <- function(input, output, session) {
  
  ## The Filter
  filter_df <- reactive({
    Map_DF[sapply(Map_DF$PointUse, function(p) {any(input$PointUseInput %in% p)}), ]
  })
  
  ## Base Map Creation
  output$mapA <- renderLeaflet({
    leaflet() %>%
      addProviderTiles(
        providers$Esri.DeLorme,
        options = providerTileOptions(
          updateWhenZooming = FALSE,
          updateWhenIdle = TRUE)
      ) %>%
      setView(lng = -107.50, lat = 39.00, zoom = 7)
  })
  
  ## Update Map with Filter Selection
  observe({
    leafletProxy("mapA", session) %>%
      clearMarkers() %>%
      addCircleMarkers(
        data = filter_df(),
        radius = 10,
        color = "red",
        lat = ~Latitude,
        lng = ~Longitude,
        popupOptions(autoPan = FALSE),
        popup = ~paste("PointUse: ", filter_df()$PointUse))
  })
}

############################################
shinyApp(ui = ui, server = server)

Answer 2

filter 函数需要一个逻辑向量作为输入。我们可以使用 map_lgl 来映射列表列，并使用 any 来显示每一行中是否至少有一个值等于输入值。

Map_DF %>% filter(map_lgl(PointUse, ~any(. %in% input$PointUseInput)))