Сервер блестящих листовок R не изменяет вывод карты - PullRequest
Новая
       11

Сервер блестящих листовок R не изменяет вывод карты

0 голосов
/ 20 июня 2020

Я новичок в создании карт с помощью Shiny, но моя цель - создать интерактивную карту, которая изменяется при выборе различных входов. Например: при выборе месяца будут отображаться только маркеры этого месяца. Когда вы выбираете год, он будет отображать наблюдения за этот год И месяц (и так далее).

Прямо сейчас я могу получить свою карту для визуализации, но точки, которые появляются на карте, не соответствуют тому, что пользователь выбирает в раскрывающемся списке.

Вот код, который я пробовал: 

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

SampleData <- data.frame(year = c('2017', '2018', '2019', '2020'),
                         lon = c(38.62893, 38.62681, 38.62797, 38.62972),
                         lat = c(-90.26233, -90.25272, -90.26232, -90.25703),
                         month = c('January', 'February', 'March', 'April', 'May'),
                         new_use = c('Industrial', 'Institutional', 'Commercial', 'Residential')

use <- sort(unique(SampleData$new_use))
years <- sort(unique(SampleData$year))
months <- sort(unique(SampleData$month))

ui <- bootstrapPage(
    tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
    leafletOutput("map", width = "100%", height = "100%"),
    absolutePanel(top = 10, right = 10,
                  selectInput("month", "Month",
                              choices = sort(unique(SampleData$month))),
                  selectInput("year", "Year",
                              choices = sort(unique(SampleData$year))),
                  selectInput("new_use", "Permit Use",
                              choices = sort(unique(SampleData$new_use))),
    )
)

server <- function(input, output, session) {
    
    output$map <- renderLeaflet({
        leaflet() %>% 
            setView(lng = -90.1994, lat = 38.6270, zoom = 10)%>%
            addProviderTiles(providers$CartoDB.Positron)
    })
    
    # Reactive expression for the data subsetted to what the user selected
    filteredData <- reactive({
        dplyr::filter(SampleData, years %in% input$year & use %in% input$new_use & months %in% input$month)
    })
  
observe({
        leafletProxy("map") %>%
            clearShapes() %>%
            addMarkers(data = filteredData(), 
             ~lat, ~lon, popup = paste("<b>Year:</b> ", filteredData()$year, "<br>",
                  "<b>Permit Type:</b> ", filteredData()$new_use, "<br>")) 
    })
}    
    


shinyApp(ui, server)

Есть ли у кого-нибудь предложения? Что мне не хватает?

1 Ответ

0 голосов
/ 23 июня 2020

Фильтрация в реактивном операторе должна выполняться по именам столбцов во фрейме данных. Например, вам нужно «год», а не «годы».

Таким образом, реактивная инструкция должна читать: 

filteredData <- reactive({
        dplyr::filter(SampleData, year %in% input$year & new_use %in% input$new_use & month %in% input$month)
    })

И чтобы очистить предыдущие маркеры, вы хотите использовать clearMarkers() not clearShapes().

Однако с предоставленным образцом кадра данных маркер будет отображаться только тогда, когда выбраны указанные c комбинированный год, месяц и использование (это после удаления 'May', чтобы сделать все столбцы одинаковыми длина). Например, первый маркер будет отображаться только тогда, когда пользователем выбраны «2017», «Январь» и «Промышленный», поскольку это соответствующие значения, связанные с первой парой координат (и так далее).

...