Question

我的目的是通过Shiny + Leaflet呈现一个反应性地图：我想使用两个重叠的层，＆＃34; confini.comuni.WGS84＆＃34; 和＆＃34 ; confini.asl.WGS84＆＃34; ，用于绘制反应层。

根据值'inputId = "Year.map"'，服务器会读取图层＆＃39; zone.WGS84＆＃39; ('layer = paste0 ("zone_", anno.map ())', EX "zone_2015")并根据以下值之一为多边形着色数据框中的字段（＆＃34; SIST_NERV＆＃34;，＆＃34; MESOT＆＃34;，＆＃34; TUM_RESP＆＃34;）通过'inputId = "Pathology.map"'选择。

shapefile ＆＃34; zone_2000.shp＆＃34; 等..存储在＆＃34; App / shapes / zone＆＃34; 中，shapefile ＆＃34; rt.confini.comunali.shp＆＃34; 和＆＃34; rt.confini.regionali.shp＆＃34; 存储在＆＃34;应用/形状/ originali＆＃34;

应用和文件为here：

与shapesfile＆＃34; zone_2016＆＃34;相关的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的＆＃39; EXASLNOME＆＃39; 和'pat.map()'数据的反应性标签。最后，必须通过发送至map()的{{1}}生成renderLeaflet地图。这会产生此错误：

警告：域中出错：无法找到功能＆＃34;域＆＃34;堆栈跟踪（最里面的第一个）：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：输出$ Mappa.ASL 1：runApp

我无法使用所有反应组件作为参数传递给Leaflet函数，你能告诉我什么吗？

output$Map.ASL

Answer 1

错误消息应该非常清楚。您正在使用您从未分配过的函数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)

Answer 2

谢谢，我试着听从你的建议：我使用

从形状创建了一个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())})

请注意＆＃34; map＆＃34;和＆＃34; map.df＆＃34;是反应性的。

＆＃34; pat.map＆＃34;是data.frame＆＃34; map.df＆＃34;的列的名称。作为输入值（输入$ Pathology.map）和＆＃34; pat.map.p＆＃34;是同一data.frame的另一列的名称。我使用数字字段map.df（）[，2]作为＆＃34;域＆＃34; ＆＃34; pal＆＃34;的参数功能

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)

启动应用程序，＆＃34;标签＆＃34;似乎存在问题。

> 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

Answer 3

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

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

您的传单图从未显示过，因为您将对象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并立即重新投影。你可以将它们合并到一个shapefile中，然后从中过滤并预先重新投影它们，这样你每次调用应用程序时都不必这样做吗？

以下应用应该有效。至少有一点，因为你会在像这样的colorQuantile函数中运行错误，因为数据集中有NA值（例如，2009-2006年为＆＃39; SIST_NERV＆＃39;）

警告：cut.default出错：＆＃39;中断＆＃39;不是唯一的

您可以将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)

反应性读取和渲染shapefile

3 个答案: