Search code examples
rshinyqgisshinyappsr-leaflet

R Shiny/R Leaflet/ R : Dynamically render choropleth map with sliderInput in R shiny 2


I am trying to use the slider function to select and only display selected polygons using Shiny on a Leaflet map.

The code below gets the slider to react, but I want the colour scale to represent the depth, and the slider to select and display the energy polygons (removing non-relevant polygons) but with the depth colour scale. The polygon files contain both the depth and energy data.

The following question points me in the right direction. But I cannot get this to work with my data.

Dynamically render choropleth map with sliderInput in R shiny

Shapefile wave-shp (wave.shp) on the following page: https://www.renewables-atlas.info/downloads/.

Here is my code:

library(shiny)
library(leaflet)
library(rgdal)
library(sf)
library(dplyr)
library(RColorBrewer)

wave_data <- read_sf("~/path/Wave.shp")

wave_data <- st_transform(wave_data, crs = '+proj=longlat 
+datum=WGS84')

wave_data2 <- wave_data %>% 
mutate_at(vars(An_mn_P_OD), ~ as.integer(round(.x))) 

## Load map

wave_data_map <- leaflet() %>% 
   addProviderTiles(providers$Esri.WorldTopoMap) %>% 
   setView(lng = -4.2026458, lat = 56.4906712, zoom = 5)
wave_data_map

bins <- c(0, 25, 50, 100, 150, 200, 300, 400, 500, 1000, 3100)
pal <- colorBin("RdYlBu", domain = wave_data2$Ave_Depth, bins = 
bins)

## Add polygons

wave_data_map <- leaflet() %>% 
   addProviderTiles(providers$Esri.WorldTopoMap) %>% 
   setView(lng = -4.2026458, lat = 56.4906712, zoom = 5) %>% 
   addPolygons(data = wave_data2, 
           weight = 1,
           smoothFactor = 0.5,
           color = "white", 
           fillOpacity = 0.5, 
           fillColor = pal(wave_data2$Ave_Depth), 
           
)
wave_data_map

## Add legend

wave_data_map <- leaflet() %>% 
   addProviderTiles(providers$Esri.WorldTopoMap) %>% 
   setView(lng = -4.2026458, lat = 56.4906712, zoom = 5) %>% 
   addPolygons(data = wave_data2, 
           weight = 1,
           smoothFactor = 0.5,
           color = "white", 
           fillOpacity = 0.3, 
           fillColor = pal(wave_data2$Ave_Depth)) %>% 
   addLegend(pal = pal, 
         values = wave_data2$Ave_Depth, 
         title = "Average depth",
         labFormat = labelFormat (suffix = "m"),
         opacity = 0.7, 
         position = "bottomright")
wave_data_map


# Define UI for application

ui <- bootstrapPage(
   tags$style(type = "text/css", "html, body 
                {width:100%;height:100%}"),
   leafletOutput("wave_data_map", width = "100%", height = 
                  "100%"),
   sliderInput("wave_data_slider", "Wave energy", 
                         min = 0, max = 75, 
                         value = c(min(wave_data2$An_mn_P_OD), 
                         max(wave_data2$An_mn_P_OD)), 
                         step = 5, 
                         round = 0.5,
                         dragRange = TRUE)
))


# Define server logic

server <- function(input, output, session) {
 wave_energy_output <- reactive ({
    wave_data2 %>% 
    filter(An_mn_P_OD >= input$wave_data_range[1]) %>% 
    filter(An_mn_P_OD <= input$wave_data_range[2]) %>% 
     group_by(Lat)
 })
output$wave_data_map <- renderLeaflet(
  leaflet() %>% 
     addProviderTiles(providers$Esri.WorldTopoMap) %>% 
     setView(lng = -4.2026458, lat = 56.4906712, zoom = 5) %>% 
     addPolygons(data = wave_data2, 
                 weight = 1,
                 smoothFactor = 0.5,
                 color = "white", 
                 fillOpacity = 0.3, 
                 fillColor = pal(wave_data2$Ave_Depth)) %>% 
     addLegend(pal = pal, 
               values = wave_data2$Ave_Depth, 
               title = "Average depth",
               labFormat = labelFormat (suffix = "m"),
               opacity = 0.7, 
               position = "bottomright")
)

observeEvent({input$wave_data_slider}, {
    data = wave_energy_output()[wave_data2$An_mn_P_OD]
  leafletProxy("wave_data_map", data = wave_data2) %>% 
     clearShapes() %>% 
     addPolygons(data = wave_energy_output,
        fillColor = pal, 
        weight = 0.0, 
        opacity = 1, 
        color = "white", 
        dashArray = 3, 
        fillOpacity = 0.7, 
     ) %>% clearControls() %>% 
     addLegend(pal = pal, 
               values = wave_data2$Ave_Depth, 
               title = "Average depth",
               labFormat = labelFormat (suffix = "m"),
               opacity = 0.7, 
               position = "bottomright")
  
}
)}

# Run the application 

shinyApp(ui = ui, server = server)

NEW ERROR:

Warning: Error in [: Can't subset columns past the end. ℹ Locations 43, 57, 57, …, 48, and 46 don't exist. ℹ There are only 42 columns.

Any help would really be appreciated.


Solution

  • Working code:

    library(shiny)
    library(leaflet)
    library(rgdal)
    library(sf)
    library(dplyr)
    library(RColorBrewer)
    
    wave_data <- read_sf("~/path/Wave.shp")
    
    wave_data <- st_transform(wave_data, crs = '+proj=longlat 
    +datum=WGS84')
    
    wave_data2 <- wave_data %>% 
       mutate_at(vars(An_mn_P_OD), ~ as.integer(round(.x))) 
    
    ## Load map
    
    wave_data_map <- leaflet() %>% 
       addProviderTiles(providers$Esri.WorldTopoMap) %>% 
       setView(lng = -4.2026458, lat = 56.4906712, zoom = 5)
    wave_data_map
    
    bins <- c(0, 25, 50, 100, 150, 200, 300, 400, 500, 1000, 3100)
    pal <- colorBin("RdYlBu", domain = wave_data2$Ave_Depth, bins = bins)
    
    # Define UI for application
    
    ui <- bootstrapPage(
       tags$style(type = "text/css", "html, body 
                 {width:100%;height:100%}"),
       leafletOutput("wave_data_map", width = "100%", height = 
                    "100%"),
       absolutePanel(top = 10, right = 10, 
       sliderInput("wave_data_range", "Wave energy", 
               min = 0, max = 75, 
               value = c(min(wave_data2$An_mn_P_OD), 
                         max(wave_data2$An_mn_P_OD)), 
               step = 5, 
               round = 0.5,
               dragRange = TRUE)
    ))
    
    # Define server logic
    
    server <- function(input, output, session) {
       wave_energy_output <- reactive({
          data <- wave_data2 %>% 
             filter(An_mn_P_OD >= input$wave_data_range[1],
                An_mn_P_OD <= input$wave_data_range[2])
          data %>% group_by(Lat)
       })
    
      output$wave_data_map <- renderLeaflet({
       leaflet() %>% 
         addProviderTiles(providers$Esri.WorldTopoMap) %>% 
         setView(lng = -4.2026458, lat = 56.4906712, zoom = 5) %>% 
         addPolygons(data = wave_data2, 
                     weight = 1,
                     smoothFactor = 0.5,
                     color = "white", 
                     fillOpacity = 0.3, 
                     fillColor = pal(wave_data2$Ave_Depth)) %>% 
         addLegend(pal = pal, 
                   values = wave_data2$Ave_Depth, 
                   title = "Average depth",
                   labFormat = labelFormat (suffix = "m"),
                   opacity = 0.7, 
                   position = "bottomright")
     })
    
     observeEvent(input$wave_data_range, {
        data <- wave_energy_output()
        leafletProxy("wave_data_map", data = data) %>% 
         clearShapes() %>% 
         addPolygons(data = data,
                     fillColor = pal(wave_energy_output()$Ave_Depth), 
                     weight = 1,
                     smoothFactor = 0.5,
                     color = "white", 
                     fillOpacity = 0.3)
       })
    
    }
    
    # Run the application 
    
    shinyApp(ui = ui, server = server)