rshinysliderr-leaflet

Drawing Polygons with leaflet in shiny?


I have a geospatial dataset of monthly average temperatures in the US. I want to display this as a leaflet map in a Shiny app. With a time-slider, users should be able to select a visualisation of each month.

When I try to run my data with codes I found online I run into a number of problems and unfortunately I don't understand exactly where which data is needed.

On Wetransfer I uploaded my dataset Data.

Relevant info about the dataset: I want the slider to run by either the "Valid_Seas" column (monthly values by parts of the US) or "values". The polygons (column: Geometry) should be colored by the column "Prob", this is the monthly average temperature.

Regarding the R.skript: Starting at line 215 is my attempt to create the ShinyApp map, just a you can see here:

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "100%"),
  absolutePanel(top = 10, right = 10,
                style="z-index:500;", # legend over my map (map z = 400)
                tags$h3("Average Temperature"), 
                sliderInput("periode", "Months 2021",
                            min(tempyear21$values),
                            max(tempyear21$values),
                            value = range(tempyear21$values),
                            step = 1,
                            sep = ""
                )
  )
)

#bis hier hin stimmt es 

server <- function(input, output, session) {
  
  # reactive filtering data from UI
  
  reactive_data_chrono <- reactive({
    tempyear21 %>%
      filter(Valid_Seas >= input$periode[1] & Valid_Seas <= input$periode[2])
  })
  
  
  # static backround map
  output$map <- renderLeaflet({
    leaflet(tempyear21) %>%
      addTiles() %>%
      fitBounds(-49.57,24.91,-166.99,68.00)
  })  
  
  # reactive circles map
  observe({
    leafletProxy("map", data = reactive_data_chrono()) %>%
      clearShapes() %>%
      addMarkers(lng=~lng,
                 lat=~lat,
                 layerId = ~id) # Assigning df id to layerid
  })
}

shinyApp(ui, server)

Solution

  • I spotted three problems with your code. First, your input slider returns number(s), while your data set column Valid_Seas is character ("Jan 2021", etc.). Hence, after you apply filter the dataset is reduced to zero rows. Better use the values column instead.

    Second, if you wanted to display month by month, you should pass only one single number as value argument to sliderInput, like

    ui <- bootstrapPage(
        tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
        leafletOutput("map", width = "100%", height = "100%"),
        absolutePanel(top = 10, right = 10,
                    style="z-index:500;", # legend over my map (map z = 400)
                    tags$h3("Average Temperature"), 
                    sliderInput("periode", "Months 2021",
                                min(tempyear21$values),
                                max(tempyear21$values),
                                value = min(tempyear21$values), # !
                                step = 1,
                                animate=TRUE, # add play button
                                sep = ""
                    )
        )
    )
    

    Otherwise, you get an overlay of several months.

    Third problem: your dataset has polygons, in your server function you use addMarkers. You need to use addPolygons instead. In order to fill the polygons, you need to determine a color for each number. The classInt and RColorBrewer packages can help you with that:

    library(classInt)
    library(RColorBrewer)
    n <- 3 # number of categories
    pal <- RColorBrewer::brewer.pal(n, "Reds")
    ivar <- classInt::classIntervals(
        tempyear21$Prob, n=n, style="quantile"
    ) 
    tempyear21$colcode <- classInt::findColours(ivar, pal)
    legend_names <- names(attr(tempyear21$colcode, "table"))
    

    As for the server function, I think you are on the right track with leafletProxy.

    server <- function(input, output, session) {        
        # static map elements
        output$map <- renderLeaflet({
            leaflet() |> addTiles() |> 
            fitBounds(-49.57,24.91,-166.99,68.00) |>
            addLegend(position="topleft", colors=pal, labels=legend_names)
        })
        
        # map handler
        map_proxy <- leafletProxy("map", session)
        
        # react on slider changes
        observeEvent(input$periode, {
            dat <- subset(tempyear21, values == input$periode)
            map_proxy |> leaflet::clearShapes() |>
            leaflet::addPolygons(
                data=dat,
                weight=1,
                color=dat$colcode, # border
                opacity=1,
                fillColor=dat$colcode 
            ) 
        })  
    }