R 反应式读取和呈现形状文件

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

根据值'inputId=Year.map'，服务器读取层'zone.WGS84''layer=paste0 zone，anno.map'，EX zone_2015，并根据通过'inputId=Physical.map'选择的数据框SIST_NERV、MESOT、TUM_RESP中的一个字段的值为多边形着色

shapefiles zone_2000.shp等。。存储在App/shapes/zone中，shapefile文件rt.confini.comunali.shp和rt.confini.regionali.shp存储在App/shapes/originali中

应用程序和文件为：

与ShapeFile 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 

接下来，传单必须在data.frame的数据“EXASLNOME”和“pat.map”上创建一个反应性标签。 最后，必须通过发送到输出$map.ASL的RenderLablet生成地图。 这将生成以下错误：

警告：域中出现错误：找不到函数域堆栈跟踪 最里面的第一个：91:colorQuantile 90: [C:/Users/User/Downloads/Prova_mappe/App_per_Stackoverflow.r63]79： mappa 78:func [C:/Users/User/Downloads/Prova_mappe/App_per_Stackoverflow.r95]77： origRenderFunc 76:输出$Mappa.ASL 1:runApp

我不能使用所有的反应性成分作为参数传递给传单功能，你能告诉我一些事情吗

  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)

---

错误消息应该非常清楚。您正在使用从未分配的函数域

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

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

您必须使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)

---

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

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是data.frame map.df的一列的名称，作为输入值input$physical.map，pat.map.p是同一data.frame的另一列的名称。 我使用数值字段map.df[，2]作为pal函数的域参数

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

---

代码中有几个错误，丢失的标签只是一个小问题

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

传单打印从未显示，因为您将对象mappa渲染为输出ID=mappa.ASL。不过，被动贴图PA不会创建贴图，它不会返回贴图或任何对象，因此您应该将被动贴图更改为观察者。Proxy只是在您的案例mappa.base中的原始地图上添加了一些内容，而您从未在UI中使用过这些内容

您的错误来自在addPolygons中调用labels=labels，就好像labels是一个反应对象一样，但您在相同的反应环境中定义了它，因此您在没有括号的情况下调用它，如：

标签=标签

而不是从以下各项中生成无功值：

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

我也不会使用反应式映射，它总是从磁盘读取一个shapefile并立即重新投影它。你能不能把它们合并到一个shapefile中，然后从中过滤并预先重新投影它们，这样你就不必每次调用应用程序时都这样做

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

警告：剪切中出错。默认值：“断开”不是唯一的

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

域的错误是否已解决？如果是，你应该检查答案并问一个新问题，因为你现在有了新的错误。您的被动流程似乎不正常，而且您应该将所有不被动的全局变量放在服务器函数之外。您希望的不是labels=labels，而是labels=labels。它不是你所说的反应对象。

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

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)