Mapdeck inside golem shinyapp does not update!

[shevelp]

Hi, im asking this as a question and not reporting as a bug because I don't know if the problem is with the mapdeck library itself or with the implementation on Shiny, by the way, I'm using also golem pkg to develop the shiny.

Im trying to update a map previously defined in shiny ui module with:

mapdeck::mapdeckOutput(ns("map_exp"))

On the server side I've this inside my module:

       mb_token <- ''

      output$map_exp <- mapdeck::renderMapdeck({
        mapdeck::mapdeck(token = mb_token,
                         style = mapdeck::mapdeck_style("light"),
                         location = c(3.5, 43.45),
                         zoom = 3)
      })

      # Create a reactive observer.
      observe({

        # Here, we establish a dependency on filtered_data()
        data <- filtered_data() 
        print(data)

        mapdeck::mapdeck_update(map_id = "map_exp") %>%
          mapdeck::add_polygon(
            data = data,
            fill_colour = data[[input$fill_variable_select]], #var selected
            fill_opacity = 200,
            legend = TRUE,
            update_view = FALSE)
      })

There is no problem with my data because the observer retrieves perfectly the data after filtering. The problem is that the map does not include the polygons that are in the data.

Any advice with this?

[dcooley]

the argument to fill_colour should be the name of the variable of data. It should be the column name of a data.frame, not the column of data itself. so you may need fill_colour = input$fill_variable_select

[shevelp]

Hi, changing the fill_colour argument does not work. The only "solution" I've found is to render de map again inside de observer, but I think its not a good aproach.

output$map_exp <- mapdeck::renderMapdeck({
          mapdeck::mapdeck(token = mb_token,
                           style = mapdeck::mapdeck_style("light"),
                           location = c(3.5, 43.45),
                           zoom = 3) %>%
            mapdeck::clear_polygon() %>%
            mapdeck::add_polygon(data = filtered_data,
                                 fill_colour = input$fill_variable_select,
                                 fill_opacity = 200,
                                 legend = TRUE,
                                 update_view = FALSE)
        })

[dcooley]

If you can make a small reproducible example I may be able to add a better solution?

[shevelp]

Hi, I think that the issue its something related with the modular approach. I've created two app.R files, one of them a simple, not modular, shinyapp (app,R) and another one using modules (app_modular.R).

Both use a database that can download from here (test.gpkg): https://we.tl/t-bRof80Ji9T

app.R:

library(shiny)
library(shinycssloaders)
library(shinyWidgets)
library(mapdeck)
library(sf)
library(dplyr)

mb_token <- ' ' #your token

ui <- fluidPage(

  #filter
  shinyWidgets::pickerInput("country", "Country", choices = NULL, selected = NULL, multiple = TRUE, options = list(`actions-box` = TRUE)),

  div(
    shinycssloaders::withSpinner(mapdeck::mapdeckOutput("map"), type = 3, color.background = "blue")
  ),
)

server <- function(input, output, session) {

  output$map <- mapdeck::renderMapdeck({
    mapdeck::mapdeck(token = mb_token,
                     style = mapdeck::mapdeck_style("light"),
                     location = c(3.5, 43.45),
                     zoom = 3)
  })

  EW_db_NUTS3 <- reactiveVal()
  EW_db <- sf::read_sf("~/Desktop/test.gpkg") #load the dataset (care with path)
  EW_db <- sf::st_transform(EW_db, crs = "+proj=longlat +datum=WGS84")
  EW_db_NUTS3(EW_db)  # Set the value of reactive variable

  shinyWidgets::updatePickerInput(session, "country", choices = unique(EW_db$CNTR_CODE))

  filtered_data <- reactive({

    EW_db <- EW_db_NUTS3()  # Get the value of reactive variable

    #filter by country
    if (!is.null(input$country)) {
      EW_db %>% dplyr::filter(CNTR_CODE %in% input$country)
    } else {
      EW_db
    }

  })

  observe({

        # Here, we establish a dependency on filtered_data()
        data <- filtered_data()
        print(data)

        mapdeck::mapdeck_update(map_id = "map") %>%
          mapdeck::add_polygon(
            data = data,
            fill_colour = input$fill_variable_select,
            fill_opacity = 200,
            legend = TRUE,
            update_view = FALSE)
      })

}

shinyApp(ui, server)

and now app_modular.R:

library(shiny)
library(shinycssloaders)
library(shinyWidgets)
library(mapdeck)
library(sf)
library(dplyr)

#read data
EW_db <- sf::read_sf("~/Desktop/test.gpkg")
EW_db <- sf::st_transform(EW_db, crs = "+proj=longlat +datum=WGS84")

mb_token <- ' ' #your mapdeck token

mod_ui <- function(id) {
  ns <- NS(id)
  tagList(
    # Filter
    pickerInput(ns("country"), "Country", choices = NULL, selected = NULL, multiple = TRUE, options = list(`actions-box` = TRUE)),

    div(
      withSpinner(mapdeckOutput(ns("map")), type = 3, color.background = "blue")
    )
  )
}

mod_server <- function(id, EW_db) {
  moduleServer(
    id,
    function(input, output, session) {
      output$map <- renderMapdeck({
        mapdeck::mapdeck(token = mb_token,
                         style = mapdeck::mapdeck_style("light"),
                         location = c(3.5, 43.45),
                         zoom = 3)
      })

      EW_db_NUTS3 <- reactiveVal(EW_db)

      observe({
        shinyWidgets::updatePickerInput(session, "country", choices = unique(EW_db$CNTR_CODE))
      })

      filtered_data <- reactive({
        EW_db <- EW_db_NUTS3()

        if (!is.null(input$country)) {
          EW_db %>% dplyr::filter(CNTR_CODE %in% input$country)
        } else {
          EW_db
        }
      })

      observeEvent(filtered_data(), {
        data <- filtered_data()
         print(data)

        mapdeck::mapdeck_update(map_id = "map") %>%
          mapdeck::add_polygon(
            data = data,
            fill_colour = input$fill_variable_select,
            fill_opacity = 200,
            legend = TRUE,
            update_view = FALSE
          )
      })
    }
  )
}

ui <- fluidPage(
  mod_ui("module"),
)

server <- function(input, output, session) {
  mod_server("module", EW_db)
}

shinyApp(ui, server)

As I said, I think the problem is related to the map_id argument on map_update. If you need anything else just let me know!

[shevelp]

Hi again @dcooley,

I hope you're doing well. Over the weekend, I've been working on the issue and I made an interesting discovery regarding the mapdeck_update function. Unlike other outputs in shiny, it seems that for mapdeck_update, you need to explicitly specify the session in the map_id argument.

To address the issue when the shinyapp is modular, you can simply write the mapdeck update like this:

 mapdeck::mapdeck_update(map_id = session$ns("map"))

[dcooley]

excellent, glad you figured it out, and thanks for updating this post with the solution