时间戳

首页 > 解决方案 > 响应式读取和渲染 shapefile

r - 响应式读取和渲染 shapefile

问题描述

我的目的是通过 Shiny + Leaflet 渲染反应式地图：我想使用两个重叠的图层"confini.comuni.WGS84"和"confini.asl.WGS84"，在其上绘制反应式图层。

基于该值'inputId = "Year.map"'，服务器读取图层“zone.WGS84”并根据通过选择的数据帧 （“SIST_NERV”、“MESOT”、“TUM_RESP”）中('layer = paste0 ("zone_", anno.map ())', EX "zone_2015")的字段之一的值对多边形进行着色。'inputId = "Pathology.map"'

形状文件“zone_2000.shp”等存储在“App/shapes/zone”中，形状文件“rt.confini.comunali.shp”和“rt.confini.regionali.shp”存储在“App/shapes/原创”

应用程序和文件在这里：

与shapesfile“zone_2016”相关的data.frame是：

 EXASLNOME                     Anno SIST_NERV SIST_NERVp MESOT MESOTp TUM_RESP TUM_RESPp
 Az. USL 1 di Massa Carrara    2016        43         41     1      1        4         4     
 Az. USL 2 di Lucca            2016        45         45    11     10        3         3
 Az. USL 3 di Pistoia          2016        26         21    13     13        5         5
 Az. USL 4 di Prato            2016         6          6     8      8       NA        NA
 Az. USL 5 di Pisa             2016       155        146     3      3        2         2
 Az. USL 6 di Livorno          2016       137        136    17     17       20        18
 Az. USL 7 di Siena            2016        29         24     1      1       NA        NA
 Az. USL 8 di Arezzo           2016        31         29     3      3        2         2
 Az. USL 9 di Grosseto         2016        35         34     2      2        1         1
 Az. USL 10 di Firenze         2016        34         33    24     13       11         4
 Az. USL 11 di Empoli          2016        30         29     2      2       20        20
 Az. USL 12 di Viareggio       2016       130        129     7      7        3         3

接下来，Leaflet 必须创建一个基于数据“EXASLNOME”和data.frame 的反应式标签'pat.map()'。最后，map()必须通过renderLeaflet发送到生成地图output$Map.ASL。这会产生此错误：

警告：域中的错误：找不到函数“域”堆栈跟踪（最里面的第一个）：91：colorQuantile 90：[C：/Users/User/Downloads/Prova_mappe/App_per_Stackoverflow.r#63] 79：mappa 78：func [ C:/Users/User/Downloads/Prova_mappe/App_per_Stackoverflow.r#95] 77: origRenderFunc 76: output$Mappa.ASL 1: runApp

我不能使用所有的反应组件作为参数传递给 Leaflet 函数，你能告诉我一些事情吗？

  require(shiny)
  require(stringr)
  require(shinythemes)
  require(leaflet)
  require(RColorBrewer)
  require(rgdal)
  require(rgeos)

  #### UI ####
  ui <- fluidPage(
    theme = shinytheme("spacelab"),
    titlePanel("Indice"),
    navlistPanel( 
      tabPanel(title = "Mappe",
         fluidRow(column(6, sliderInput(inputId = "Anno.map",
                                        label = "Anno di manifestazione",
                                        min = 2000,
                                        max = 2016, 
                                        value = 2016,
                                        step = 1,
                                        ticks = FALSE,
                                        sep = "")),
                  column(6, selectInput(inputId = "Patologia.map",
                                        label = "Patologia",
                                        choices = list("SIST_NERV", "MESOT","TUM_RESP"),
                                        selected = "SIST_NERV",
                                        multiple = FALSE))),
         fluidRow(column(6, leafletOutput(outputId = "Mappa.ASL", height = "600px", width = "100%")))
    )
   )
  )

 #### SERVER ####
 server <- function(input, output) {

    # NOT REACTIVE 
    confini.comuni <- readOGR(dsn = "shapes/originali", layer = "rt.confini.comunali", stringsAsFactors = FALSE)
    confini.comuni.WGS84 <- spTransform(confini.comuni, CRS("+proj=longlat +datum=WGS84 +no_defs")) 

    confini.asl <- readOGR(dsn = "shapes/originali", layer = "rt.confini.asl", stringsAsFactors = FALSE)
    confini.asl.WGS84 <- spTransform(confini.asl, CRS("+proj=longlat +datum=WGS84 +no_defs"))

    # REACTIVE 
    anno.map <- reactive({input$Anno.map})

    pat.map <- reactive({input$Patologia.map})

    mappa <- reactive({                                                         
        zone.WGS84 <- spTransform(readOGR(dsn = "shapes/zone", 
                                  layer = paste0("zone_", anno.map()), stringsAsFactors = FALSE), 
                                  CRS("+proj=longlat +datum=WGS84 +no_defs"))           

        domain <- paste0("zone_", anno.map(), "@data$", pat.map())
        labels.1 <- paste0("zone_", anno.map(), "@data$EXASLNOME")
        labels.2 <- paste0("zone_", anno.map(), "@data$", pat.map())
        labels.3 <- paste0("zone_", anno.map(), "@data$", pat.map(), "p")

        pal <- colorQuantile(palette = "YlOrRd",  
                             domain = domain(), n = 6,
                             na.color = "808080", alpha = FALSE, reverse = FALSE, right = FALSE)
        labels <- sprintf("<strong>%s</strong><br/>%g Segnalazioni<br/> %g con nesso positivo",
                   labels.1(), labels.2(), labels.3()) %>% 
                   lapply(htmltools::HTML)    

    leaflet(options = leafletOptions(zoomControl = FALSE, dragging = FALSE, minZoom = 7.5, maxZoom = 7.5)) %>%   
            addPolygons(data = confini.comuni.WGS84,
            weight = 1,
            opacity = 1,
            color = "black") %>%
    addPolygons(data = confini.asl.WGS84,
                weight = 2,
                opacity = 1,
                color = "red")  %>%      
    addPolygons(data = zone.WGS84(), 
                fillColor = ~pal(domain()),
                weight = 2,
                opacity = 1,
                color = "white",
                dashArray = "3",
                fillOpacity = 0.7,
                highlight = highlightOptions(weight = 5,
                                             color = "666",
                                             dashArray = "",
                                             fillOpacity = 0.7,
                                             bringToFront = TRUE),
                label = labels())
    })


   output$Mappa.ASL <- renderLeaflet({mappa()})

  }

  # Run the application 
  shinyApp(ui = ui, server = server)

标签： rshinyleafletreactive-programmingrgdal

解决方案

错误消息应该很清楚。您正在使用domain()从未分配过的功能。

ColorQuantile需要域的数值，因此您必须提供一个包含数值的列。基于它们，传单将产生颜色。

 pal <- colorQuantile(palette = "YlOrRd",  
                             domain =  dataframe$numericVariable, 
                             n = 6,
                             na.color = "808080", 
                             alpha = FALSE, reverse = FALSE, 
                             right = FALSE)

并在第二个addPolygon函数中更改此行：

fillColor = pal(dataframe$numericVariable),

您必须适应dataframe$numericVariable要用于着色的 data.frame 列。

请参见以下示例：

library(shiny)
library(leaflet)

dataframe <- data.frame(
  x = runif(n = 40, 15, 18),
  y = runif(n = 40, 50, 55),
  numericVariable = runif(n = 40, 1, 100)
)

ui <- fluidPage(
  leafletOutput("map")
)

server <- function(input, output){

  output$map <- renderLeaflet({
    pal <- colorQuantile(palette = "YlOrRd",  
                         domain =  dataframe$numericVariable, 
                         n = 6,
                         na.color = "808080", 
                         alpha = FALSE, reverse = FALSE, 
                         right = FALSE)

    leaflet() %>% 
      addTiles() %>% 
      addCircleMarkers(lng = ~x, lat = ~y, data=dataframe, 
                       fillColor = pal(dataframe$numericVariabl), fillOpacity = 1)
  })
}
shinyApp(ui, server)

推荐阅读