Question

我第一次与R Shiny合作制作交互式的Leaflet地图。该地图在很大程度上没有任何问题，但是有一个我无法弄清楚的错误。我希望有人能够帮助我。

我正在尝试绘制来自英国每个国家（英格兰，苏格兰，威尔士和北爱尔兰）的数据，并包括一个过滤器，以便用户可以选择要显示标记的国家。我已经使用了ShinyWidgets包pickerInput来做到这一点。如果用户选择一个国家或全选，则显示的地图不会出现问题。如果他们选择多个国家/地区的某些组合，则标记会停止按原样显示。

我的数据采用（DataMap.csv）格式：

Country, Topic, Lat, Long, X1, X2, X3,
England, Topic 1, 51.5074, -0.1278, 1, a, TRUE
Scotland, Topic 1, 55.9533, -3.1883, 2, a, TRUE
Wales, Topic 1, 51.4816, -3.1791, 1, b, FALSE
Northern Ireland, Topic 1, 54.5973, -5.9301, 2, b, TRUE

我正在处理三个R文件，并且在下面提供了一个最小可行版本：

global.R

library(shiny)
library(shinythemes)
library(leaflet)
library(rgdal)
library(shinyWidgets)
library(shinydashboard)
library(dplyr)

# Read in the data
mapdata <- as.data.frame(read.csv("DataMap.csv", header = TRUE))

ui.R

ui <- dashboardPage(

      dashboardHeader(title = "Map"),

      dashboardSidebar(

      pickerInput("countryInput","Country", choices=c("England", "Wales", "Scotland", "Northern Ireland"), options = list(`actions-box` = TRUE),multiple = TRUE),

      pickerInput("topicInput","Topic", choices=c("Select topic...", "Topic 1", "Topic 2", ), selected = "Select topic...", options = list(`actions-box` = F),multiple = F)),

      dashboardBody(leafletOutput(outputId = 'map', height = 930)

       ))

server.R

      shinyServer(function(input, output) {
      output$map <- renderLeaflet({

      #Set basemap
      leaflet(mapdata) %>% 
      addProviderTiles(providers$Wikimedia) %>%
      setView(lat = 54.093409, lng = -2.89479,  zoom = 6) %>%
      addMarkers(~long, ~lat, clusterOptions = markerClusterOptions())
      })

      #Select country
      selectedCountry <- reactive({
      mapdata[mapdata$Country == input$countryInput, ] 
      })

      observe({
      state_popup <- paste0("<strong>Country: </strong>", 
                      selectedCountry()$Country,
                      "<br><strong> Topic: </strong>",
                      selectedCountry()$Topic)

      leafletProxy("map", data = selectedCountry()) %>%
      clearMarkerClusters() %>%
      clearMarkers() %>%
      addMarkers(~long, ~lat, clusterOptions = markerClusterOptions()) 
      })

      #Select topic
      selectedTopic <- reactive({
      tmp <- mapdata[!is.na(mapdata$Topic), ] 
      tmp[tmp$Topic == input$topicInput, ]
      })

      observe({
      state_popup <- paste0("<strong>Country: </strong>",
                      selectedTopic()$Country,
                      "<br><strong> Topic: </strong>",
                      selectedTopic()$Topic)

      leafletProxy("map", data = selectedTopic()) %>%
      clearMarkers() %>%
      clearMarkerClusters() %>%
      addMarkers(~long, ~lat, clusterOptions = markerClusterOptions())
      })
      })

问题示例

Here I have selected all of the countries, and all 6 of the markers are showing for each nation

Here I have selected 3 countries, and only 2 markers are showing per nation

非常感谢Valter Beakovic在此主题中对他的回答，这有助于我走得更远。

很抱歉，如果这篇文章太长，我不确定要包含什么内容。

Answer 1

下次应该考虑的一些事项。

在您的数据框上使用dput()，以便我们快速使用您的数据并在发布之前检查其是否真正运行，然后在新的r会话中运行代码。您在“主题2”之后有一个逗号，这引发了错误。

pickerInput("topicInput","Topic", choices=c("Select topic...", "Topic 1", "Topic 2", )...

如果您运行代码，则应该得到类似

mapdata $ Country中的警告== input $ countryInput：更长的对象长度不是较短的对象长度的倍数

要解决该问题，只需尝试以下操作

server <- function(input, output) {
  output$map <- renderLeaflet({

    #Set basemap
    leaflet(mapdata) %>% 
      addProviderTiles(providers$Wikimedia) %>%
      setView(lat = 54.093409, lng = -2.89479,  zoom = 6)
  })

  #Select country
  selectedCountry <- reactive({
    mapdata[mapdata$Country %in% input$countryInput, ] # here you want to change to %in% as == does a element wise checking for equality
  })

  observe({
    state_popup <- paste0("<strong>Country: </strong>", 
                          selectedCountry()$Country,
                          "<br><strong> Topic: </strong>",
                          selectedCountry()$Topic)

    leafletProxy("map", data = selectedCountry()) %>%
      clearMarkerClusters() %>%
      clearMarkers() %>%
      addMarkers(~long, ~lat, clusterOptions = markerClusterOptions()) 
  })

  #Select topic
  selectedTopic <- reactive({
    tmp <- mapdata[!is.na(mapdata$Topic), ] 
    tmp[tmp$Topic == input$topicInput, ]
  })

  observe({
    state_popup <- paste0("<strong>Country: </strong>",
                          selectedTopic()$Country,
                          "<br><strong> Topic: </strong>",
                          selectedTopic()$Topic)

    leafletProxy("map", data = selectedTopic()) %>%
      clearMarkers() %>%
      clearMarkerClusters() %>%
      addMarkers(~long, ~lat, clusterOptions = markerClusterOptions())
  })
}
shinyApp(ui, server)

您还可以选中Why do I get “warning longer object length is not a multiple of shorter object length”?

希望有帮助。

在带有小叶的R Shiny中选择多个过滤器选项的问题

1 个答案: