R Shiny Leaflet - как сделать CheckboxGroup для двоичных данных - PullRequest
0 голосов
/ 31 марта 2020

Я разместил похожий вопрос здесь: Как мне создать прокси Leaflet в наблюдаемом событии () для checkboxGroup в R Shiny . Но я немного отчаянно нуждаюсь в ответах, поэтому я решил перефразировать свой вопрос и опубликовать его снова. Я искал inte rnet для ответов и не могу найти то, что я ищу. Извиняюсь за двойной пост.

Вот мой вопрос. У меня есть набор данных здесь: https://github.com/mallen011/Leaflet_and_Shiny/blob/master/Shiny%20Leaflet%20Map/csv/RE.csv

Это центры переработки в Кентукки. Он настроен таким образом, чтобы каждый перерабатываемый материал представлял собой столбец, и каждый ряд, т. Е. Центр переработки, указан как да / нет относительно того, действительно ли каждый центр перерабатывает указанный материал. Вот пример того, как выглядят данные, если вы не можете получить доступ к CSV. Верхняя строка является заголовком столбца. Извините за форматирование:

  • Имя ___________________ GL ______ AL _____ PL
  • Утилизация сообщества бани ___ Да _____ Нет ____ Да
  • Склад Теда и Сыновья ______ Нет ______ Нет ____ Да
* 1019 в блестящем приложении R, например, здесь, используя Leaflet: https://github.com/mallen011/Leaflet_and_Shiny/blob/master/Shiny%20Leaflet%20Map/re_map.png Но я хочу добавить элемент управления, в котором пользователи могут фильтровать, где они могут перерабатывать свои товары, а именно, я хочу использовать checkboxGroupInput () в R блестящий, так что пользователи могут проверить материалы и иметь центры переработки заполнить карту. Например, если человек хочет знать, где переработать его стекло, он может отметить «стекло» в группе флажков, и все центры переработки, которые позволяют переработку стекла, всплывают.

Так в R Shiny, я я прочитал мои данные по переработке csv (RE.csv):

RE <- read.csv("C:/Users/username/Desktop/GIS/Shiny Leaflet Map/csv/RE.csv")

RE$y <- as.numeric(RE$y)
RE$x <- as.numeric(RE$x)

RE.SP <- SpatialPointsDataFrame(RE[,c(7,8)], RE[,-c(7,8)])

Вот мой пользовательский интерфейс, который помещает checkboxGroupInput () в боковую панель ():

ui <- dashboardPage(
  skin = "blue",
  dashboardHeader(titleWidth = 400, title = "Controls"),
  dashboardSidebar(width = 400
                  #here's the checkboxgroup, it calls the columns for glass, aluminum and plastic from the RE.csv, all of which have binary values of yes/no
                  checkboxGroupInput(inputId = "RE_check", 
                                     label = h3("Recycleables"), 
                                      choices = list("Glass" = RE$GL, "Aluminum" = RE$AL, "Plastic" = RE$PL),
                                      selected = 0)
                   ),
  dashboardBody(
    fluidRow(box(width = 12, leafletOutput(outputId = "map"))),
    tags$style(type = "text/css", "#map {height: calc(100vh - 80px) !important;}"),
    leafletOutput("map")
  )
)

А теперь о неприятностях У меня есть: Что я помещаю в свой сервер, чтобы он наблюдал за каждым из этих событий? Это то, что у меня есть для события, в котором пользователь проверяет «стекло», и я понятия не имею, насколько он неправ или насколько он прав. Я просто знаю, что это не работает. Я пытаюсь использовать операторы «если», поэтому только значения, равные «да», заполняют карту. Но в настоящее время карта на приборной панели пуста, независимо от того, что я делаю, хотя ввод группы флажков, кажется, работает.

server <- function(session, input, output) {
 observeEvent({
    RE_click <- input$map_marker_click
    if (is.null(RE_click))
      return()

    if(input$RE$GL == "Yes"){
      leafletProxy("map") %>% 
        clearMarkers() %>% 
        addMarkers(data = RE_click,
                   lat = RE$y,
                   lng = RE$x)
      return("map")
    }
  })

Вот и моя выходная карта листовок, на случай, если это имеет значение:

 output$map <- renderLeaflet({
    leaflet() %>% 
      setView(lng = -83.5, lat = 37.6, zoom = 8.5)  %>% 
      addProviderTiles("Esri.WorldImagery") %>% 
      addProviderTiles(providers$Stamen.Toner, group = "Toner") %>% 
      addPolygons(data = counties,
                  color = "green",
                  weight = 1,
                  fillOpacity = .1,
                  highlight = highlightOptions(
                    weight = 3,
                    color = "green",
                    fillOpacity = .3)) %>% 
      addMarkers(data = RE,
                 lng = ~x, lat = ~y, 
                 label = lapply(RE$popup, HTML),
                 group = "recycle",
                 clusterOptions = markerClusterOptions(showCoverageOnHover = FALSE)) %>% 
    addLayersControl(baseGroups = c("Esri.WorldImagery", "Toner"),
                     overlayGroups = c("recycle"),
                     options = layersControlOptions(collapsed = FALSE))
  })
}

Я новичок в R Shiny, если это не очевидно. Я бы очень признателен за любую помощь. Весь мой код общедоступен на моем GitHub для скачивания: https://github.com/mallen011/Leaflet_and_Shiny

Спасибо и будьте в безопасности!

1 Ответ

0 голосов
/ 31 марта 2020

Может быть, это сработает ... Вы можете добавить различные типы рециркуляции в качестве слоев, а затем добавить флажки на карту листовки, не беспокоясь о блестящей интеграции. Очевидно, вам нужно добавить остальные типы корзины здесь ...

library(leaflet)
library(htmlTable)
RE <- read.csv("https://raw.githubusercontent.com/mallen011/Leaflet_and_Shiny/master/Shiny%20Leaflet%20Map/csv/RE.csv")
leaflet() %>% 
  setView(lng = -83.5, lat = 37.6, zoom = 8.5)  %>% 
  addProviderTiles("Esri.WorldImagery") %>% 
  addProviderTiles(providers$Stamen.Toner, group = "Toner") %>% 
  # addPolygons(data = counties,
  #             color = "green",
  #             weight = 1,
  #             fillOpacity = .1,
  #             highlight = highlightOptions(
  #               weight = 3,
  #               color = "green",
  #               fillOpacity = .3)) %>% 
  addMarkers(data = RE[RE$AL=="Yes", ],
             lng = ~x, lat = ~y, 
             #label = lapply(RE$popup, HTML),
             group = "AL",
             clusterOptions = markerClusterOptions(showCoverageOnHover = FALSE)) %>% 
  addMarkers(data = RE[RE$FE=="Yes", ],
             lng = ~x, lat = ~y, 
             #label = lapply(RE$popup, HTML),
             group = "FE",
             clusterOptions = markerClusterOptions(showCoverageOnHover = FALSE)) %>% 
  addMarkers(data = RE[RE$NONFE=="Yes", ],
             lng = ~x, lat = ~y, 
             #label = lapply(RE$popup, HTML),
             group = "NONFE",
             clusterOptions = markerClusterOptions(showCoverageOnHover = FALSE)) %>% 
  addLayersControl(baseGroups = c("Esri.WorldImagery", "Toner"),
                   overlayGroups = c("AL", "FE", "NONFE"),
                   options = layersControlOptions(collapsed = FALSE))
...