Сияющая Реактивная Карта Сбой - Карта Листовки - PullRequest
Новая
       23

Сияющая Реактивная Карта Сбой - Карта Листовки

0 голосов
/ 20 мая 2018

У меня есть фрейм данных следующим образом 

d <- data.frame(number = 1:4, 
                date = c(1600, 1700, 1800, 1900),
                T_name = c("name1", "name2", "name3", "name4"))

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

Может кто-нибудь увидеть, где я могу ошибаться?

код пользовательского интерфейса 

library(shiny)
library(leaflet)
ui <- fluidPage("name_of_map", 
sidebarLayout(
  sidebarPanel(
    selectInput(inputId = "input1", label = "Name of Filter" ,choices = 
unique(d$T_name)),
    selectizeInput(inputId = "year", label = "Year of Event", 
choices = unique(d$date))
  ),

  mainPanel(
    leafletOutput("mymap"))
)
)

код сервера 

 server <- function(input, output) {

  output$mymap <- renderLeaflet({ 
  leaflet(data = d[1:25,]) %>% addTiles() %>%
  addProviderTiles(providers$Esri.NatGeoWorldMap) %>%  
  addMarkers(lng=~longitude, lat=~latitude,
             popup = ~paste(mname, "<br>", "Date:", date, 
                            "<br>", "Number of casualties:", 
                           casualties,"<a href=",d$web,">",d$web, main=input$input1) 
  )
  })
}

reactive <- reactive({d})

shinyApp(ui, server)

1 Ответ

0 голосов
/ 20 мая 2018

В вашем примере отсутствуют некоторые входные переменные, особенно координаты (long / lat), mname, web, случайности.А с вашей конструкцией приложение никогда не изменится, так как реактивное значение всегда выбирает фрейм данных d, но оно никогда не фильтрует данные по имени или году.Таким образом, вы должны немного адаптировать свою реактивную функцию.Здесь я фильтрую либо по имени, либо по году.Любое из условий должно быть верным.

Я немного изменил ваш код, так что, по крайней мере, он воспроизводим для других, и я переместил ваш реактив в функцию сервера. 

d <- data.frame(number = 1:4, 
                date = c(1600, 1700, 1800, 1900),
                longitude = runif(4, 13,18),
                latitude = runif(4, 40, 55),
                web= rep("www.whatever.com", 4),
                T_name = c("name1", "name2", "name3", "name4"))


library(shiny)
library(leaflet)
ui <- {fluidPage("name_of_map", 
                sidebarLayout(
                  sidebarPanel(
                    selectInput(inputId = "input1", label = "Name of Filter" ,choices = 
                                  unique(d$T_name)),
                    selectizeInput(inputId = "year", label = "Year of Event", 
                                   choices = unique(d$date))
                  ),

                  mainPanel(
                    leafletOutput("mymap"))
                )
)}

server <- function(input, output) {
  react <- reactive({
    req(input$input1)
    req(input$year)
    df <- d[d$T_name == input$input1 | d$date == input$year,]
    df
  })

  output$mymap <- renderLeaflet({ 
    req(input$input1)

    leaflet() %>% addTiles() %>%
      addProviderTiles(providers$Esri.NatGeoWorldMap) %>%
      addMarkers(lng=react()$longitude, lat=react()$latitude,
                 popup = paste("mname", "<br>", "Date:", react()$date,
                                "<br>", "Number of casualties:",
                                "casualties", "<a href=", react()$web, ">", main=input$input1)
                 )
  })
}

shinyApp(ui, server)
...