my purpose is to render a reactive map through Shiny + Leaflet: I want to use two overlapped layers, "confini.comuni.WGS84" and "confini.asl.WGS84", on which to draw a reactive layer.
Based on the value 'inputId = "Year.map"', the server reads a layer 'zone.WGS84' ('layer = paste0 ("zone_", anno.map ())', EX "zone_2015") and colors the polygons based on the value one of the fields in the dataframe ("SIST_NERV", "MESOT", "TUM_RESP") selected via 'inputId = "Pathology.map"'.
The shapefiles "zone_2000.shp" etc.. are stored in "App/shapes/zone", the shapefiles "rt.confini.comunali.shp" and "rt.confini.regionali.shp" are stored in "App/shapes/originali"
The App and the files are here:
The data.frame related to the shapesfile "zone_2016" is:
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
Next, Leaflet must create a reactive label built on the data 'EXASLNOME' and 'pat.map()' of the data.frame.
Finally, a map() map must be generated via renderLeaflet sent to output$Map.ASL.
This generates this error:
Warning: Error in domain: could not find function "domain" Stack trace (innermost first): 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
I can not use all the reactive components to pass as parameters to the Leaflet function, can you tell me something?
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)
There were several mistakes in your code, the missing labels were just a minor problem.
First of all, you can put all non reactive values outside the server function and maybe you should save the confini.* shapefiles to an RDS-file or a DB and load them from there. I guess that would speed up your App.
Your leaflet plot was never showing, because you rendered the object mappa() to the output ID = Mappa.ASL. The reactive mappa doesnt create a map though, its not returning a map or any object, so you should change the reactive to an observer. The LeafletProxy just adds stuff on the original map (in your case mappa.base), which you never used in the UI.
Your error came from calling labels = labels() in addPolygons, as if labels was a reactive object, but you defined it in the same reactive environment so you call it without parenthesis like:
labels = labels
Instead of making a reactive value out of those:
anno.map <- reactive({input$Anno.map})
pat.map <- reactive({input$Patologia.map})
pat.map.p <- reactive({paste0(pat.map(), "p")})
You can just use them as reactives like:
input$Anno.map
input$Patologia.map
paste0(pat.map(), "p")
I also wouldnt use a reactive (map) which always reads a shapefile from disk and reprojects it straight away. Can you maybe merge them together to one shapefile and then filter from it and reproject them beforehand, so you dont have to do it everytime the app is called?
The following app should work. At least a bit, as you will run in errors in the colorQuantile function like this one, as there are NA-values in the datasets (eg. years 2009-2006 for 'SIST_NERV')
Warning: Error in cut.default: 'breaks' are not unique
You could just change the colorQuantile to colorBin and drop the n = 6 argument.
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)