Reactive reading and rendering a shapefile

Question

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)

Answer 1

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)

Answer 2

Thanks, I tried to follow your advice: I created a data.frame from the shape using

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())})

Note thant both "map" and "map.df" are reactive.

"pat.map" is the name of a column of the data.frame "map.df" taken as input value (input $ Pathology.map) and "pat.map.p" is the name of another column of the same data.frame. I used the numeric field map.df () [, 2] as the "domain" parameter of the "pal" function

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

I've also created a reactive label with

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)

This is the new script

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)

launching the app, there seems to be a problem with "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

Answer 3

The error msg should be quite clear. You are using a function domain() which you never assigned.

ColorQuantile needs numeric values for the domain, so you have to provide a column with numeric values in it. Based on them leaflet will produce the colors.

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

and change this line in the second addPolygon function:

fillColor = pal(dataframe$numericVariable),

You have to adapt dataframe$numericVariable to the column of your data.frame which you want to use for coloring.

See the following example:

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)