如何在leafletProxy() 中绘制数据框的全部数据？

Question

我在 RStudio 中使用 R 并创建了一个闪亮的仪表板。在仪表板中，我使用 Leaflet() 函数来绘制地图。现在我正试图在显示芝加哥犯罪的地图上放置标记。我正在使用 selectInput() 和 sliderInput() 函数来选择不同的犯罪类型、地点和年份。如果我在输入字段中选择某些内容，标记会显示在芝加哥地图上，并且效果很好。但我希望当我启动闪亮的应用程序时，所有标记都显示而不基于 selectInput() 过滤。这是我的 ui.R 代码：

  tabItem(tabName = "map",
    div(class="outer",
    tags$head(
    tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"))),

    leafletOutput("map", width = "100%", height = "100%"),

    absolutePanel(id = "mapControls", fixed = TRUE, draggable = TRUE, top = 150, left = "auto", right = 15, bottom = "auto", width = 200, height = "auto",

    selectInput("mapCrimeType", label= "Select Crime Type", choices = unique(cc$Primary.Type), multiple = TRUE),

    selectInput("mapLocation", label= "Select Location", choices = unique(cc$Location.Description), multiple = TRUE),

    sliderInput("mapYear", label = "Select Year", min = 2001, max = 2016, step = 1, sep = '', value = c(2001,2016))

          )
  ),

这是我的 server.R 代码：

server <- function(input, output) {

  ### Draw Map ###
  output$map = renderLeaflet({
      leaflet() %>% 
      addProviderTiles(providers$Esri.WorldStreetMap) %>% 
      setView(lng = -87.6105, lat = 41.8947, zoom=11)
  }) 

  reactMap = reactive({
    cc %>% 
    filter(Primary.Type %in% input$mapCrimeType &
             Location.Description %in% input$mapLocation &
             Year %in% cbind(input$mapYear[1],input$mapYear[2]))
  })

  observe({
    proxy = leafletProxy("map", data = reactMap()) %>%
      clearMarkers() %>%
      clearMarkerClusters() %>%
      addCircleMarkers(clusterOptions = markerClusterOptions(),
                       lng =~ Longitude, lat =~ Latitude, radius = 5, group = 'Cluster', 
                       popup =~ paste('<b><font color="Black">', 'Crime Information', 
                      '</font></b><br/>', 'Crime Type:', Primary.Type,'<br/>',
                      'Date:', Date,'<br/>', #'Time:', Time,'<br/>',
                      'Location:', Location.Description,'<br/>', 'Block:', Block, '<br/>', 'Arrest:', Arrest, '<br/>'))
  })

我想我必须更改 server.R 文件中的响应函数中的某些内容。我希望有人能帮助我。

更新：使用此数据集：https://www.kaggle.com/currie32/crimes-in-chicago

Answer 1

如果没有示例数据很难进行测试，但您可以尝试 2 个选项中的 1 个，我能想到：

第一个选项是通过分别添加selected = unique(cc$Primary.Type) 和selected = unique(cc$Location.Description) 来预选mapCrimeType 和mapLocation 的所有选项。我在下面添加了 mapYear，但无需更改任何内容，因为您已经使用 value = c(2001,2016) 选择了整个范围。

    selectInput("mapCrimeType", label= "Select Crime Type", choices = unique(cc$Primary.Type), multiple = TRUE, selected = unique(cc$Primary.Type)),

    selectInput("mapLocation", label= "Select Location", choices = unique(cc$Location.Description), multiple = TRUE, selected = unique(cc$Location.Description)),

    sliderInput("mapYear", label = "Select Year", min = 2001, max = 2016, step = 1, sep = '', value = c(2001,2016))

如果太乱（我不确定他们有多少选择），您可以尝试以下方法：

  reactMap = reactive({
    if (is.null(input$mapCrimeType)) {
      mapCrimeType = unique(cc$Primary.Type)
    } else {
      mapCrimeType = input$mapCrimeType
    }
    if (is.null(input$mapLocation)) {
      mapLocation = unique(cc$Location.Description)
    } else {
      mapLocation = input$mapLocation
    }
    cc %>% 
    filter(Primary.Type %in% mapCrimeType &
             Location.Description %in% mapLocation &
             Year %in% cbind(input$mapYear[1],input$mapYear[2]))
  })

基本上，只要其中一个 selectInputs 为 NULL，我们就会包含该 selectInput 的所有选项（或两者都为 NULL 时）。 让我知道这是否有帮助。

更新

请尝试下面的完整答案。我上面有一个错误。

if (is.null(input$mapLocation)) {
      mapLocation = unique(cc$Location.Description)
    } else {
      mapLocation = input$mapLocation
    }

有 is.null(input$mapCrimeType) 从上一个 if 语句复制而来。

在这里测试答案：

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

ui <- tabItem(tabName = "map",
                          div(class="outer",
                              tags$head(
                                  tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"))),

                          leafletOutput("map", width = "100%", height = "100%"),

                          absolutePanel(id = "mapControls", fixed = TRUE, draggable = TRUE, top = 150, left = "auto", right = 15, bottom = "auto", width = 200, height = "auto",

                                        selectInput("mapCrimeType", label= "Select Crime Type", choices = unique(cc$Primary.Type), multiple = TRUE),

                                        selectInput("mapLocation", label= "Select Location", choices = unique(cc$Location.Description), multiple = TRUE),

                                        sliderInput("mapYear", label = "Select Year", min = 2001, max = 2016, step = 1, sep = '', value = c(2001,2016))

                          )
    )

server <- function(input, output) {

    ### Draw Map ###
    output$map = renderLeaflet({
        leaflet() %>% 
            addProviderTiles(providers$Esri.WorldStreetMap) %>% 
            setView(lng = -87.6105, lat = 41.8947, zoom=11)
    }) 

    reactMap = reactive({
        if (is.null(input$mapCrimeType)) {
            mapCrimeType = unique(cc$Primary.Type)
        } else {
            mapCrimeType = input$mapCrimeType
        }
        if (is.null(input$mapLocation)) {
            mapLocation = unique(cc$Location.Description)
        } else {
            mapLocation = input$mapLocation
        }
        cc %>% 
            filter(Primary.Type %in% mapCrimeType &
                       Location.Description %in% mapLocation &
                       between(Year, input$mapYear[1], input$mapYear[2]))
    })

    observe({
        proxy = leafletProxy("map", data = reactMap()) %>%
            clearMarkers() %>%
            clearMarkerClusters() %>%
            addCircleMarkers(clusterOptions = markerClusterOptions(),
                             lng =~ Longitude, lat =~ Latitude, radius = 5, group = 'Cluster', 
                             popup =~ paste('<b><font color="Black">', 'Crime Information', 
                                            '</font></b><br/>', 'Crime Type:', Primary.Type,'<br/>',
                                            'Date:', Date,'<br/>', #'Time:', Time,'<br/>',
                                            'Location:', Location.Description,'<br/>', 'Block:', Block, '<br/>', 'Arrest:', Arrest, '<br/>'))
    })
}

shinyApp(ui = ui, server = server)

我添加了 lbusett 的观点，即您的 Year 过滤器仅显示最小和最大年份的数据，而不是两者之间的年份，这是我使用 dplyr 的 between 函数完成的。

您可以合并 lbusett 的答案，如下所示：

reactMap <- reactive({

  out_cc <- cc %>% 
    dplyr::filter(., Year >= input$mapYear[1] & 
                  Year <= input$mapYear[2])

  if (!is.null(input$mapCrimeType)) {
    out_cc <- out_cc %>% 
      dplyr::filter(., Primary.Type %in% input$mapCrimeType)
  }

  if (!is.null(input$mapLocation)) {
    out_cc <- out_cc %>% 
      dplyr::filter(., Location.Description %in% input$mapLocation)
  }

  out_cc

})

Answer 2

未经测试，但这应该可以。只需将响应式更改为：

reactMap <- reactive({

  out_cc <- cc %>% 
    dplyr::filter(., Year %in% cbind(input$mapYear[1],input$mapYear[2]))

  if (!is.null(input$mapCrimeType)) {
    out_cc <- out_cc %>% 
      dplyr::filter(., Primary.Type %in% input$mapCrimeType)
  }

  if (!is.null(input$mapLocation)) {
    out_cc <- out_cc %>% 
      dplyr::filter(., Location.Description %in% input$mapLocation)
  }

  out_cc

})

当在没有“选定”值的情况下调用并使用multiple = TRUE 时，选择器在开头或取消选择所有内容时具有NULL 值。因此，当对应输入为NULL 时，您只需跳过对给定变量的过滤即可。

顺便说一句：我可能错了，但我认为您可能必须将“年份”过滤器更改为：

dplyr::filter(., Year >= input$mapYear[1] & 
                  Year <= input$mapYear[2])

，否则你只会得到最小和最大选定年份的值，而不是中间年份的值。