反应式读取和渲染形状文件

问题描述 投票：0回答：3

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

基于值 

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

shapefiles “zone_2000.shp”等存储在“App/shapes/zone”，shapefiles “rt.confini.comunali.shp”和“rt.confini.regionali.shp” 存储在 “App/shapes/originali”

应用程序和文件位于此处：

与shapes文件“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 必须创建一个基于 data.frame 的数据 'EXASLNOME' 和 

'pat.map()'
的反应式标签。 最后，必须通过发送到
map()
的
renderLeaflet
生成
output$Map.ASL
地图。 这会产生此错误：

警告：域中的错误：找不到函数“domain”堆栈跟踪 （最里面的第一个）： 91： colorQuantile 90： [C：/Users/User/Downloads/Prova_mappe/App_per_Stackoverflow.r#63] 79： 地图78：功能 [C:/Users/User/Downloads/Prova_mappe/App_per_Stackoverflow.r#95] 77： origRenderFunc 76：输出$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)
r shiny r-leaflet shiny-reactivity rgdal
3个回答
0
投票

您的代码中有几个错误，缺少标签只是一个小问题。

首先，您可以将所有非反应值放在服务器功能之外，也许您应该将 confini.* shapefiles 保存到 RDS 文件或数据库并从那里加载它们。我想这会加速你的应用程序。

您的传单图从未显示，因为您将对象 mappa() 渲染到输出 ID = Mappa.ASL。不过，反应式 mappa 不会创建地图，它不会返回地图或任何对象，因此您应该将 

reactive
更改为 
observer
。 LeafletProxy 只是在原始地图上添加内容（在您的例子中为mappa.base），而您从未在 UI 中使用过这些内容。

您的错误来自于在 

labels = labels()
中调用 
addPolygons
，就好像标签是反应式对象一样，但您在相同的反应式环境中定义了它，因此您可以在不带括号的情况下调用它，例如：

labels = labels

而不是从中产生无功价值：

anno.map <- reactive({input$Anno.map})
pat.map <- reactive({input$Patologia.map})
pat.map.p <- reactive({paste0(pat.map(), "p")})

您可以将它们用作反应式，例如：

input$Anno.map
input$Patologia.map
paste0(pat.map(), "p")

我也不会使用反应式（

map
），它总是从磁盘读取形状文件并立即重新投影它。您是否可以将它们合并到一个 shapefile 中，然后从中过滤并预先重新投影它们，这样您就不必每次调用应用程序时都执行此操作？

以下应用程序应该可以运行。至少有一点，因为您将在像这样的 colorQuantile 函数中运行错误，因为数据集中存在 NA 值（例如“SIST_NERV”的 2009-2006 年）

警告：cut.default 中的错误：“中断”不是唯一的

您可以将 

colorQuantile
更改为 
colorBin
并删除 
n = 6
参数。 

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


# 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.zone <- readOGR(dsn = "shapes/originali", layer = "rt.confini.exasl", stringsAsFactors = FALSE)
confini.zone.WGS84 <- spTransform(confini.zone, 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"))


#### 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.base", height = "600px", width = "100%")
                             ))
    )
  )
)}


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

  # REACTIVE 
  map <- reactive({
    req(input$Anno.map)
    spTransform(readOGR(dsn = "shapes/zone", layer = paste0("zone_", input$Anno.map), stringsAsFactors = FALSE),
                CRS("+proj=longlat +datum=WGS84 +no_defs"))
  })

  output$mappa.base <- renderLeaflet({
    leaflet(options = leafletOptions(zoomControl = FALSE, dragging = FALSE, 
                                     minZoom = 7.5, maxZoom = 7.5)) %>%   
      addTiles() %>% 
      addPolygons(data = confini.comuni.WGS84,
                  weight = 1, opacity = 1, color = "black") %>%
      addPolygons(data = confini.zone.WGS84,
                  weight = 2, opacity = 1, color = "black")
  })


  map.df <- reactive({
    req(input$Anno.map)
    map() %>%
      as.data.frame() %>%
      dplyr::select(EXASLNOME, input$Patologia.map, paste0(input$Patologia.map, "p"))
  })

  mappa <- observe({
    pal <- colorQuantile(palette = "YlOrRd",  domain = map.df()[,2],
                         n = 6,  na.color = "808080",
                         alpha = FALSE, reverse = FALSE,
                         right = FALSE)

    labels <- sprintf("<strong>%s</strong> <br/> %d Segnalazioni <br/> %d con nesso positivo",
                      map.df()[,1], map.df()[,2], map.df()[,3]) %>% lapply(htmltools::HTML)

    leafletProxy(mapId = "mappa.base", data = map()) %>%
      addPolygons(fillColor = ~pal(map.df()[,2]),
                  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
      )
  })
}

# Run the application 
shinyApp(ui = ui, server = server)
0
投票

错误消息应该很清楚。您正在使用一个从未分配过的函数 

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)
0
投票

谢谢，我尝试遵循你的建议：我使用形状创建了一个 data.frame 

map <- reactive({readOGR(dsn = "shapes/zone", 
                         layer = paste0("zone_", anno.map()), stringsAsFactors = FALSE)})

map.df <- reactive({map() %>% 
                    as.data.frame() %>% 
                    select(EXASLNOME, pat.map(), pat.map.p())})

注意“map”和“map.df”都是反应性的。

“pat.map”是数据框“map.df”的一列名称，作为输入值（输入$ Pathology.map），“pat.map.p”是同一列的另一列名称数据框。 我使用数字字段map.df()[,2]作为“pal”函数的“domain”参数

pal <- colorQuantile(palette = "YlOrRd",  
                            domain = map.df()[,2], 
                            n = 6,  
                            na.color = "808080", 
                            alpha = FALSE, 
                            reverse = FALSE, 
                            right = FALSE)

我还创建了一个反应性标签

labels <- sprintf("<strong>%s</strong> <br/> %d Segnalazioni <br/> %d con nesso positivo",
                            map.df()[,1], map.df()[,2], map.df()[,3]) %>% 
                            lapply(htmltools::HTML)

这是新脚本

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.zone <- readOGR(dsn = "shapes/originali", layer = "rt.confini.exasl", stringsAsFactors = FALSE)
confini.zone.WGS84 <- spTransform(confini.zone, 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"))

mappa.base <- 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.zone.WGS84,
            weight = 2,
            opacity = 1,
            color = "black")

# REACTIVE 
anno.map <- reactive({input$Anno.map})
pat.map <- reactive({input$Patologia.map})
pat.map.p <- reactive({paste0(pat.map(), "p")})

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

map.df <- reactive({map() %>% 
                    as.data.frame() %>% 
                    select(EXASLNOME, pat.map(), pat.map.p())})

mappa <- reactive({             
        pal <- colorQuantile(palette = "YlOrRd",  
                            domain = map.df()[,2], 
                            n = 6,  
                            na.color = "808080", 
                            alpha = FALSE, 
                            reverse = FALSE, 
                            right = FALSE)

        labels <- sprintf("<strong>%s</strong> <br/> %d Segnalazioni <br/> %d con nesso positivo",
                            map.df()[,1], map.df()[,2], map.df()[,3]) %>% 
                            lapply(htmltools::HTML)

        leafletProxy(mapId = "mappa.base", data = map()) %>%
        addPolygons(fillColor = ~pal(map.df()[,2]),
                    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)

启动应用程序，“标签”似乎有问题

> runApp('App')

Listening on http://127.0.0.1:3307
OGR data source with driver: ESRI Shapefile 
Source: "shapes/originali", layer: "rt.confini.comunali"
with 274 features
It has 11 fields
OGR data source with driver: ESRI Shapefile 
Source: "shapes/originali", layer: "rt.confini.exasl"
with 12 features
It has 2 fields
OGR data source with driver: ESRI Shapefile 
Source: "shapes/originali", layer: "rt.confini.asl"
with 3 features
It has 1 fields
OGR data source with driver: ESRI Shapefile 
Source: "shapes/zone", layer: "zone_2016"
with 12 features
It has 40 fields
Warning: Error in labels.default: argument "object" is missing, with no default
Stack trace (innermost first):
    108: labels.default
    107: labels
    106: safeLabel
    105: evalAll
    104: evalFormula
    103: invokeMethod
    102: eval
    101: eval
    100: %>%
    99: addPolygons
    98: function_list[[k]]
    97: withVisible
    96: freduce
    95: _fseq
    94: eval
    93: eval
    92: withVisible
    91: %>%
    90: <reactive:mappa> [S:\ProgettiR\ReportMalprof_ShinyApp\App/app.R#86]
    79: mappa
    78: func [S:\ProgettiR\ReportMalprof_ShinyApp\App/app.R#103]
    77: origRenderFunc
    76: output$Mappa.ASL
    1: runApp
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.