0

I'm working a dashboard in R using Shiny and leaflet. It is basically a map that changes when you select a date. What I want to do is to keep the "groups" selected in the same map position after changing the date.

This is a simplified version of my code:

library(leaflet)
library(tidyverse)
library(shiny)

data <- readRDS("data.RDS")
pal_01 <- colorNumeric("YlGnBu", domain = log1p(data$px100m))
pal_02 <- colorNumeric("YlOrBr", domain = log1p(data$fx100m))

ui <- fluidPage(
    titlePanel("TITLE"),
    sidebarLayout(
        sidebarPanel(
            selectInput("PERIODO_ID", "Select PERIODO_ID:",
                        choices=sort(unique(data$PERIODO_ID), decreasing=TRUE),
            ),
        ),
        mainPanel(tabPanel("MAP", leafletOutput("MAP")))
    )
)
 
server <- function(input, output, session) {

    data_f <- reactive({
        x <- data %>% filter(PERIODO_ID==input$PERIODO_ID)
        return(x)
    })

    output$MAP <- renderLeaflet({
        leaflet() %>%
            addTiles(group="OSM") %>%
            addProviderTiles("CartoDB", group="CartoDB") %>%
            addProviderTiles("Esri", group="Esri") %>%
            addPolygons(data=data_f(), weight = 1, color = ~pal_01(log1p(px100m)),group="A") %>%
            addPolygons(data=data_f(), weight = 1, color = ~pal_02(log1p(fx100m)),group="B") %>%
            addLayersControl(baseGroups = c("CartoDB","OSM","Esri"),
                             overlayGroups = c("A","B")) %>%
            hideGroup("A") %>%
            hideGroup("B")
    })
}

shinyApp(ui = ui, server = server)

As you can see, I'm filtering my dataset using PERIODO_ID. I'm using 3 Tiles (OSM, CartoDB, Esri) and plotting 2 layers of polygons (A,B) I want to start my map with no polygons selected, mantaining both baseGroups and overlayGroups according to the user's selection after changing the date. If I could additionally mantain the map position would be awesome.

From what I have read, I tried using leafletProxy and observeEvent but still doesn't work.

1

If I understand correctly, you want to:

  • have the map set to fixed extent rather than panning and zooming to each selected polygon
  • not having the selected group disappear when the user selects a different choice

Please next time time provide a fully reproducible example (including data, e.g. the nc dataset that comes with the sf package); I'll assume your data is an sf object.

To solve your map extent issue, calculate the bounding box of your data before filtering: we'll use it later to set the bounds of your leaflet.

bbox <- st_bbox(data)

Currently your leaflet code re-executes completely every time your reactive data_fchanges, which means that you are hiding the groups A and B every time a new selection is made. Instead we'll start with a blank map that just has the structure you need, and then use leafletProxy to update just the polygons.

 output$MAP <- renderLeaflet({
        leaflet() %>%

    # set the view 
            fitBounds(bbox[[1]], bbox[[2]], bbox[[3]], bbox[[4]]) %>%  

            addTiles(group="OSM") %>%
            addProviderTiles("CartoDB", group="CartoDB") %>%
            addProviderTiles("Esri", group="Esri") %>%

    # we don't need the polygons just now, you can delete this
            #addPolygons(data=data_f(), weight = 1, color = ~pal_01(log1p(px100m)),group="A") %>%
            #addPolygons(data=data_f(), weight = 1, color = ~pal_02(log1p(fx100m)),group="B") %>%

            addLayersControl(baseGroups = c("CartoDB","OSM","Esri"),
                             overlayGroups = c("A","B")) %>%
            hideGroup("A") %>%
            hideGroup("B")
    })

# Then you can monitor changes to data_f with an observer, and make the map update accordingly

observeEvent(data_f(), {
      
      leafletProxy("MAP") %>% 
         
         clearShapes() %>% # remove existing selection
         
         # add polygons according to selection
         addPolygons(data=data_f(), weight = 1,color = ~pal_01(log1p(px100m)),group="A") %>%
         addPolygons(data=data_f(), weight = 1, color = ~pal_02(log1p(fx100m)),group="B")
         
   })

Shiny wizards might have even more efficient solutions but I think this should do what you need.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.