Динамический рендеринг картограммы с помощью sliderInput в R блестящий - PullRequest
Новая
       9

Динамический рендеринг картограммы с помощью sliderInput в R блестящий

0 голосов
/ 26 ноября 2018

У меня есть шейп-файл, который я читаю в R, используя readOGR, чтобы преобразовать его в SpatialPolygonDataframe.Таблица атрибутов выглядит так, как показано на рисунке ниже.

enter image description here

Каждая строка представляет собой зону (область почтового индекса), и для каждого часа дня существуют значения, например: h_0, h_1, ...h_23 измерено для каждой зоны.В моем блестящем приложении я хочу показать карту, которая меняется, когда пользователь выбирает определенный час, используя виджет sliderInput.Блестящее приложение выглядит следующим образом:

enter image description here

Код, который дает приведенный выше результат, находится здесь: 

 library(shiny)
 library(leaflet)
 library(reshape2)
 library(maps)
 library(mapproj)
 library(rgdal)
 library(RColorBrewer)
 library(sp)
 library(rgeos)



ui <- fluidPage(

 titlePanel("Title"),

 sidebarLayout(

 sidebarPanel(
   tabsetPanel(id= "tabs",

              tabPanel("Map", id = "Map", 
                       br(), 

                       p("Choose options below to interact with the Map"), 

                       sliderInput("hour", "Select the hours", min = 0 , max = 23, 
                                   value = 7, step = 1, dragRange= TRUE)
                       )
  )
),

mainPanel(

  tabsetPanel(type= "tabs",


              tabPanel("Map", leafletOutput(outputId = "map"))
          )
  )
 )
 )



 server <- function(input, output) {


  layer <- reactive( {

      shp = readOGR("shp",layer = "attractiveness_day3")
      shp_p <- spTransform(shp, CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))

  })

 output$map <- renderLeaflet({
     bins<- c(0, 2000, 4000, 8000, 16000, Inf)
    pal <- colorBin("YlOrRd", domain = layer()$h_7, bins = bins)

    leaflet(layer()) %>% 
    setView(13.4, 52.5, 9) %>% 
    addTiles()%>%
      addPolygons( 
        fillColor = ~pal(h_7),
        weight = 0.0,
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7 
      )  %>% 
      addLegend(pal = pal, values = ~h_7, opacity = 0.7, title = NULL, position = "bottomright")


  })
  #until here it works but onwards not. 
 observe(leafletProxy("map", layer())%>%
           clearShapes()%>%
           addPolygons( 
             fillColor = ~pal(h_7),  # is it possible here to pass column name dynamically
             weight = 0.0,
             opacity = 1,
             color = "white",
             dashArray = "3",
             fillOpacity = 0.7 
           )  %>% 
           addLegend(pal = pal, values = ~h_7, opacity = 0.7, title = NULL, position = "bottomright")
 )

}


shinyApp(ui, server)

Так что в настоящее времякартографическая карта заполняется значениями столбца h_7, выбранными статически.Но я не знаю, как и могу ли я динамически передавать имя столбца на основе выбора sliderInput (например, если значение sliderInput равно 8, соответствующий столбец равен h_8).Затем выполните рендеринг карты на основе выбранного столбца, переданного из реактивной функции в функции observe и leafletProxy.

пример данных: пример данных

1 Ответ

0 голосов
/ 26 ноября 2018

Можно передать имена столбцов в виде строки.В leafletProxy вы можете связать значения столбца с dataset[[column_name]].Используя одну квадратную скобку, вы выбираете не только значения, но и соответствующие многоугольники.

Чтобы ваше приложение работало, вам нужно вызвать layer() вне функции leafletProxy.Кроме того, используйте clearControls() для удаления дублирующих легенд.

Наконец, я не уверен, почему вы поместили свой шейп-файл в выражение reactive.Это также сработает, если вы просто добавите его в качестве переменной в server. 

 observeEvent({input$hour},{
    hour_column <- paste0('h_',input$hour)
    data = layer()[hour_column]
    pal <- colorBin("YlOrRd", domain = as.numeric(data[[hour_column]]), bins = bins)
    leafletProxy("map", data=data)%>%
      clearShapes()%>%
      addPolygons( 
        fillColor = pal(as.numeric(data[[hour_column]])),  
        weight = 0.0,
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7 
      )  %>% clearControls() %>%
      addLegend(pal = pal, values =as.numeric(data[[hour_column]]), opacity = 0.7, title = NULL, position = "bottomright")
  })
...