shiny::downloadHandler with rdeck or rdeck_proxy doesn't give the updated map

[MikeLydeamore]

I have a shiny app that users can upload data into, which then displays on the map. I have added a download handler using:

    filename = function() {
      paste("map", Sys.Date(), ".html", sep = "")
    },
    content = function(con) {
      htmlwidgets::saveWidget(
        widget = map,
        file = con
      )
    }
  )

but I get the original map rather than the one with all the changes caused by updating with rdeck_proxy. If I change the widget to rdeck_proxy("map") then a silent error on download and a "failed" download file.

I've also tried making the map object reactive but that hasn't helped either.

Is there a way to access the up to date rdeck object to pass into downloadHandler?

[anthonynorth]

I haven't seen a downloadHandler before. This is possible with how I've implemented the rdeck_proxy() with a workaround. rdeck_proxy() |> update_x_layer() sends updated map and layers to the client, but the original map object in R is untouched.

A workaround

There's probably a much nicer approach than this!

You can manually synchronise the proxy updates and the original map instance by repeating the modifications on the map object in R -- but I admit that feels pretty dirty. If the update logic is encapsulated in functions, the repeated code might not be super horrible though, example (taken from the shiny example in rdeck docs:

library(rdeck)
library(shiny)
library(dplyr)
library(h3jsr)
library(viridis)

ui <- fillPage(
  rdeckOutput("map", height = "100%"),
  absolutePanel(
    top = 10, left = 10,
    sliderInput("range", "value", 0, 1, c(0, 1), step = 0.1),
    downloadButton("download", "Download")
  )
)

h3_data <- tibble(
  hexagon = get_res0() %>%
    get_children(res = 3) %>%
    unlist() %>%
    unique(),
  value = runif(length(hexagon))
)

# writable semantics needed, I think?
env <- environment()
env$map <- rdeck() %>%
  add_h3_hexagon_layer(
    id = "h3_hexagon",
    name = "hexagons",
    data = h3_data,
    get_fill_color = scale_color_quantize(
      col = value,
      palette = viridis(6, 0.3)
    ),
    pickable = TRUE,
    auto_highlight = TRUE,
    tooltip = c(hexagon, value)
  )

update_hexagon_layer <- function(map, data, ...) {
  update_h3_hexagon_layer(
    map,
    id = "h3_hexagon",
    data = data,
    get_fill_color = scale_color_quantize(
      col = value,
      palette = cividis(6, 0.3)
    ),
    pickable = TRUE,
    auto_highlight = TRUE,
    tooltip = c(hexagon, value)
  )
}

server <- function(input, output, session) {
  output$map <- renderRdeck(env$map)

  filtered_data <- reactive({
    h3_data %>%
      filter(value >= input$range[1] & value <= input$range[2])
  })

  observe({
    rdeck_proxy("map") %>%
      update_hexagon_layer(filtered_data())

    # aaaand we do that again
    env$map <- update_hexagon_layer(env$map, filtered_data())
  })

  output$download <- downloadHandler(
    filename = function() {
      paste("map", Sys.Date(), ".html", sep = "")
    },
    content = function(con) {
      htmlwidgets::saveWidget(
        widget = env$map,
        file = con
      )
    }
  )
}

shinyApp(ui, server)

[MikeLydeamore]

Thanks, this is indeed a clunky but functional workaround. I'll close this as completed, it's good enough for me.