使用 R Shiny 中的 sliderInput 动态渲染等值线图

Posted 2023-03-24

【中文标题】使用 R Shiny 中的 sliderInput 动态渲染等值线图

【英文标题】：Dynamically render choropleth map with sliderInput in R shiny

【发布时间】：2019-04-28 02:05:20

【问题描述】：

我有 shapefile，我正在使用 readOGR 将其读入 R 以将其转换为 SpatialPolygonDataframe。属性表如下图所示。

每一行都是一个区域（邮政编码区域），一天中的每个小时都有一个值，例如：h_0、h_1、...h_23 针对每个区域测量。在我闪亮的应用程序中，我想显示一个随着用户使用滑块输入小部件选择特定时间而变化的地图。闪亮的应用如下所示：

产生上述结果的代码在这里：

 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)

因此，目前 choropleth 地图填充了静态选择的列 h_7 的值。但我不知道如何以及是否可以根据滑块输入选择动态传递列名（例如，如果滑块输入值为 8，则相应的列是 h_8）。然后根据从响应函数传递给observe 和leafletProxy 函数的选定列渲染地图。

样本数据：sample data

【参考方案1】：

可以将列名作为字符串传递。在leafletProxy 中，您可以使用dataset[[column_name]] 链接到您的列值。使用单个方括号，您不仅可以选择值，还可以选择相应的多边形。

要使您的应用程序正常工作，您需要在 leafletProxy 函数之外调用 layer()。此外，使用clearControls() 删除重复的图例。

最后，我不确定您为什么将 shapefile 放在 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")
  )