Проблема с выбором нескольких параметров фильтра в R Shiny с Leaflet - PullRequest
0 голосов
/ 22 февраля 2019

Я впервые работаю с R Shiny над созданием интерактивной карты Leaflet.Карта в основном работает без каких-либо проблем, однако есть одна ошибка, которую я не могу выяснить.Я надеялся, что кто-то сможет мне помочь.

Я пытаюсь нанести данные из каждой страны в Великобритании (Англия, Шотландия, Уэльс и Северная Ирландия) и включить фильтр, чтобы пользователи могли выбиратьдля каких стран они хотели бы показать маркеры.Я использовал для этого пакет 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())
      })
      })

Пример проблемы

ЗдесьЯ выбрал все страны, и все 6 маркеров показаны для каждой нации

Здесь я выбрал 3 страны, и только 2 маркера отображаются на страну

Большое спасибо, однако, Вальтеру Беаковичу за его ответ в этой теме, который помог мне продвинуться так далеко.

Извините, если этот пост слишком длинный, я не былне уверен, что было бы полезно включить.

1 Ответ

0 голосов
/ 22 февраля 2019

Несколько вещей, которые вы должны рассмотреть в следующий раз.

Используйте 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)

Вы также можете проверить Почему я получаю предупреждение «длинная длина объекта не кратна короткой длине объекта»?

Надеюсь, это поможет.

...