Drawing Polygons with leaflet in shiny? - r

Question

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)
I am very much looking forward to any advice. Kind regards
Pernilla

Answer 1

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