I am trying to create a leaflet map that adds and removes a polygon layer (SpatialDataFrame) based on changing user inputs into a flexdashboard Shiny App. The geometry of the polygons (4201 polygons) remains constant, but as user makes changes to inputs, the data set (2100500 records total) that merges with each polygon changes (to =4201 to merge with polygons).
I've been following the Leaflet R docs here https://rstudio.github.io/leaflet/shiny.html
And my sample code below seems to mimic the observe() event recommend to wrap around the addPolygons(). I've also looked at the source code from a number of similar Shiny apps from the shiny gallery page (particularly this one: https://walkerke.shinyapps.io/neighborhood_diversity/) but it doesn't seem to work
Here is a sample of the app, note the data are too large to load but see the comments. When I create the addPolygons() in the first leaflet() call, it works fine. The downside of this approach is that it causes the entire map to redraw when user input changes. Following leaflet documentation suggestion I then want to move this addPolygon into a separate observer. This is where it fails.
---
title: "Model Result Viewer"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(...)
df <- fread("./data/rca_do_salt_1day.csv")
# get the unique parameters & layers
model_params <- unique(df$Parameter)
model_layers <- unique(df$Cell_K)
# read in the grid
grid <- spTransform(readOGR(dsn="./PVSC06_Grid", layer="PVSC06_WGS84"),
CRS("+proj=longlat +datum=WGS84 +no_defs"))
# Data Controls --------------------------------
<USER INPUTS SIMILAR TO:
# parameter selection
selectInput("param", "Parameter", model_params, selected = model_params[1])
#layer selection
selectInput("lyr", "Layer", model_layers, selected = model_layers[1])
# make the grid dataframe
df_subset <- reactive({
filter(df, Cell_K == input$lyr, Parameter == input$param, Time == input$timeslider)
})
# THIS MAKES THE POLYGONS FOR MAPPING
sp.grid <- reactive({
merge(grid, df_subset(), by.x = "Id", by.y = "Id")
})
# helpers for leaflet
pal <- reactive({
colorNumeric(
palette = input$colors, #"YlOrRd",
domain = df_parameter()$Value
)
})
#Set labels for grid hover
labels <- reactive({
sp.grid()$Value %>% lapply(htmltools::HTML)
})
output$map <- renderLeaflet({
leaflet() %>%
# Base Setup
addTiles(group = "Open Street Map") %>%
addProviderTiles('Esri.WorldImagery', group = "Satellite Imagery") %>%
addDrawToolbar(
targetGroup='Draw',
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())
) %>%
clearShapes() %>%
fitBounds(grid@bbox[1], grid@bbox[2], grid@bbox[3], grid@bbox[4]) %>%
# ================ THIS WORKS HERE, BUT NOT IN AN OBSERVER?!!! =================
# addPolygons(data = sp.grid(),
# layerId = ~Id,
# group= "Grid",
# weight = 0.1,
# opacity = 0,
# fillOpacity = 1,
# stroke = FALSE,
# fillColor = ~pal()(Value),
# highlightOptions = highlightOptions(color = "white",
# weight = 2,
# bringToFront = TRUE),
# label = labels(),
# labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
# textsize = "15px",
# direction = "auto")) %>%
# # Legend
# addLegend(position = 'bottomright',
# pal = pal(), opacity = 1,
# values = sp.grid()$Value,
# title = input$param) %>%
#==================================================================================
# TOC Box
addLayersControl(
baseGroups = c("Satellite Imagery", "Open Street Map"),
overlayGroups = c("Grid", "Loads", "Draw"),
options = layersControlOptions(collapsed=TRUE)
)
})
# =============== THIS DOESN"T WORK ======================
observe({
req(sp.grid()) # this alone will cause the error
# why doesn't this work?
leafletProxy('map', data = sp.grid()) %>%
removeShape(~Id) %>%
addPolygons(
layerId = ~Id,
group= "Grid",
weight = 0.1,
opacity = 0,
fillOpacity = 1,
fill = TRUE,
stroke = FALSE,
fillColor = ~pal()(Value),
highlightOptions = highlightOptions(color = "white",
weight = 2,
bringToFront = TRUE),
label = labels(),
labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")
)
})
# === THIS IS JUST EXAMPLE OF Observer that DOES work?!
# Click event for the map (will use to generate chart)
click_element <- eventReactive(input$map_shape_click, {
input$map_shape_click$id
})
# highlight the clicked element
observe({
req(click_element()) # do this if click_element() is not null
# Add the clicked element to the map in aqua, and remove when a new one is clicked
map <- leafletProxy('map') %>%
removeShape('element') %>%
addPolygons(data = sp.grid()[sp.grid()$Id == click_element(), ],
fill = TRUE,
color = '#00ffff', opacity = 1, layerId = 'element')
})
leafletOutput('map')
When I run this code, the Rmarkdown console gives error of something like and immediately crashes:
Error in : Result must have length 2100500, not 0
90 <Anonymous>
Note the actual number (90) varies but it is usually always >85 and it is the only line output in the Rmarkdown console.
Noteworthy: The 2100500 is the number of records in my non-spatial dataframe (that is filtered by user inputs and merged with spatial polygon (4201 polygons).
Therefore, it looks like the filtering isn't applying correctly, but then how come this works when i simply move it into the leaflet() call?
