响应式读取和渲染 shapefile
Reactive reading and rendering a shapefile
我的目的是通过 Shiny + Leaflet 渲染反应图：我想使用两个重叠层，"confini.comuni.WGS84" 和 "confini.asl.WGS84"，在其上绘制反应层。
基于值'inputId = "Year.map"'，服务器读取层'zone.WGS84'('layer = paste0 ("zone_", anno.map ())', EX "zone_2015")并根据值之一为多边形着色通过 'inputId = "Pathology.map"'.
选择的数据帧 ("SIST_NERV", "MESOT", "TUM_RESP") 中的字段
shapefiles "zone_2000.shp"等存储在"App/shapes/zone"，shapefiles "rt.confini.comunali.shp"和"rt.confini.regionali.shp"存储在"App/shapes/originali"
应用程序和文件是here：
与形状文件"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()' 数据的反应式标签。
最后，必须通过 renderLeaflet 发送到 output$Map.ASL 生成 map() 地图。
这会生成此错误：
Warning: Error in domain: could not find function "domain" Stack trace
(innermost first): 91: colorQuantile 90:
[C:/Users/User/Downloads/Prova_mappe/App_per_Whosebug.r#63] 79:
mappa 78: func
[C:/Users/User/Downloads/Prova_mappe/App_per_Whosebug.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)
错误消息应该很清楚。您正在使用从未分配过的函数 domain()。
ColorQuantile 需要 numeric values 作为域，因此您必须提供一个包含数值的列。基于它们，传单将产生颜色。
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)
谢谢，我试着听从你的建议：我使用
从形状创建了一个 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"是作为输入值（输入$Pathology.map）的data.frame"map.df"的列名，"pat.map.p"是名称相同 data.frame 的另一列。
我使用数值字段 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)
正在启动应用程序，"labels"似乎有问题
> 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.* shapefiles 保存到 RDS 文件或数据库中并加载他们从那里。我想这会加速您的应用程序。
您的传单图从未显示，因为您将对象 mappa() 渲染到输出 ID = Mappa.ASL。反应式 mappa 不会创建地图，它不会返回地图或任何对象，因此您应该将 reactive 更改为 observer。 LeafletProxy 只是在原始地图上添加东西（在你的情况下 mappa.base），你从未在 UI 中使用过。
你的错误来自于在 addPolygons 中调用 labels = labels()，好像标签是一个反应对象，但你在相同的反应环境中定义它，所以你调用它时没有括号，如：
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 年 'SIST_NERV'）
Warning: Error in cut.default: 'breaks' are not unique
您可以将 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)
我的目的是通过 Shiny + Leaflet 渲染反应图：我想使用两个重叠层，"confini.comuni.WGS84" 和 "confini.asl.WGS84"，在其上绘制反应层。
基于值'inputId = "Year.map"'，服务器读取层'zone.WGS84'('layer = paste0 ("zone_", anno.map ())', EX "zone_2015")并根据值之一为多边形着色通过 'inputId = "Pathology.map"'.
shapefiles "zone_2000.shp"等存储在"App/shapes/zone"，shapefiles "rt.confini.comunali.shp"和"rt.confini.regionali.shp"存储在"App/shapes/originali"
应用程序和文件是here：
与形状文件"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()' 数据的反应式标签。
最后，必须通过 renderLeaflet 发送到 output$Map.ASL 生成 map() 地图。
这会生成此错误：
Warning: Error in domain: could not find function "domain" Stack trace (innermost first): 91: colorQuantile 90: [C:/Users/User/Downloads/Prova_mappe/App_per_Whosebug.r#63] 79: mappa 78: func [C:/Users/User/Downloads/Prova_mappe/App_per_Whosebug.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)
错误消息应该很清楚。您正在使用从未分配过的函数 domain()。
ColorQuantile 需要 numeric values 作为域，因此您必须提供一个包含数值的列。基于它们，传单将产生颜色。
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)
谢谢，我试着听从你的建议：我使用
从形状创建了一个 data.framemap <- 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"是作为输入值（输入$Pathology.map）的data.frame"map.df"的列名，"pat.map.p"是名称相同 data.frame 的另一列。 我使用数值字段 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)
正在启动应用程序，"labels"似乎有问题
> 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.* shapefiles 保存到 RDS 文件或数据库中并加载他们从那里。我想这会加速您的应用程序。
您的传单图从未显示，因为您将对象 mappa() 渲染到输出 ID = Mappa.ASL。反应式 mappa 不会创建地图，它不会返回地图或任何对象，因此您应该将 reactive 更改为 observer。 LeafletProxy 只是在原始地图上添加东西（在你的情况下 mappa.base），你从未在 UI 中使用过。
你的错误来自于在 addPolygons 中调用 labels = labels()，好像标签是一个反应对象，但你在相同的反应环境中定义它，所以你调用它时没有括号，如：
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 年 'SIST_NERV'）
Warning: Error in cut.default: 'breaks' are not unique
您可以将 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)