flowmap resets zoom and position when redrawn in shiny

[e-kotov]

In Shiny app, if we use {flowmapblue} to visualise data that is filtered before it is passed to {flowmapblue}, the map position and zoom resets. This makes sense, as the only function we can use is creation of a new map. Hence it redraws. Reproducible example is below.

It would be great if we could get some sort of control like with {leaflet} to update the map contents without full redrawing.

Perhaps there is some quick JavaScript hack that we could use to save the zoom and position from the currently rendered {flowmapblue} and restore it after redrawing.

# Load necessary libraries
library(shiny)
library(dplyr)
library(flowmapblue)
library(lubridate)
library(arrow)
library(here)
library(duckdb)

# Create fake data for flows and locations
set.seed(123)
fake_flows <- data.frame(
  origin = sample(letters[1:5], 100, replace = TRUE),
  dest = sample(letters[1:5], 100, replace = TRUE),
  count = sample(1:10, 100, replace = TRUE),
  date = sample(seq(as.Date('2019-01-01'), as.Date('2019-12-31'), by="day"), 100, replace = TRUE)
)

fake_locations <- data.frame(
  id = letters[1:5],
  name = c("Location A", "Location B", "Location C", "Location D", "Location E"),
  lat = runif(5, 19, 20),
  lon = runif(5, -99, -98)
)

# Save fake data as parquet files
fake_flows_path <- tempfile(fileext = ".parquet")
fake_locations_path <- tempfile(fileext = ".parquet")
arrow::write_parquet(fake_flows, fake_flows_path)
arrow::write_parquet(fake_locations, fake_locations_path)

# Mapbox Access Token
mapboxAccessToken <- "YOUR_MAPBOX_ACCESS_TOKEN"

# Load the data using duckdb
dflows <- dbConnect(duckdb(), dbdir = ":memory:")
dbSendStatement(dflows, paste0("CREATE TABLE flows AS SELECT * FROM read_parquet('", fake_flows_path, "')"))

# Load the locations data
locations <- arrow::read_parquet(fake_locations_path)

# Get min and max dates from the flows data
min_date <- tbl(dflows, "flows") %>% summarise(min_date = min(date)) %>% pull(min_date)
max_date <- tbl(dflows, "flows") %>% summarise(max_date = max(date)) %>% pull(max_date)

# Shiny UI
ui <- fluidPage(
  titlePanel("Flowmapblue Shiny App"),
  fluidRow(
    column(6, 
           flowmapblueOutput("flowmap1", width = "100%", height = "400px"),
           sliderInput("dateRange1", "Date Range for Map 1:",
                       min = as.Date(min_date), max = as.Date(max_date),
                       value = c(as.Date(min_date), as.Date("2019-02-01")),
                       timeFormat = "%Y-%m-%d")
    ),
    column(6, 
           flowmapblueOutput("flowmap2", width = "100%", height = "400px"),
           sliderInput("dateRange2", "Date Range for Map 2:",
                       min = as.Date(min_date), max = as.Date(max_date),
                       value = c(as.Date("2019-09-01"), as.Date(max_date)),
                       timeFormat = "%Y-%m-%d")
    )
  )
)

# Shiny Server
server <- function(input, output, session) {
  
  onStop(function() {
    dbDisconnect(dflows, shutdown = TRUE)
  })
  
  filtered_data1 <- reactive({
    start_date <- as.Date(input$dateRange1[1])
    end_date <- as.Date(input$dateRange1[2])
    
    data <- tbl(dflows, "flows") %>% 
      filter(origin != dest) %>% 
      filter(date >= start_date & date <= end_date) %>%
      group_by(origin, dest) %>%
      summarise(count = median(count, na.rm = TRUE), .groups = "drop") %>%
      collect()
    
    return(data)
  })
  
  filtered_data2 <- reactive({
    start_date <- as.Date(input$dateRange2[1])
    end_date <- as.Date(input$dateRange2[2])
    
    data <- tbl(dflows, "flows") %>% 
      filter(origin != dest) %>% 
      filter(date >= start_date & date <= end_date) %>%
      group_by(origin, dest) %>%
      summarise(count = median(count, na.rm = TRUE), .groups = "drop") %>%
      collect()
    
    return(data)
  })
  
  output$flowmap1 <- renderFlowmapblue({
    flowmapblue(locations, filtered_data1(), mapboxAccessToken = mapboxAccessToken, clustering = TRUE, darkMode = TRUE, animation = FALSE)
  })
  
  output$flowmap2 <- renderFlowmapblue({
    flowmapblue(locations, filtered_data2(), mapboxAccessToken = mapboxAccessToken, clustering = TRUE, darkMode = TRUE, animation = FALSE)
  })
}

# Run the Shiny app
shinyApp(ui = ui, server = server)