Search code examples
rshinyplotlygeojsonr-plotly

Update plotly data (chloropleth) in R shiny without re-rendering entire map


I am trying to use shiny controls to modify the data underlying a plotly chloropleth map.

Whenever I change the data the entire plot re-renders, which is quite slow. I'm guessing the bottleneck is redrawing the geojson polygons. Because the geojson never changes, I'm wondering if there is a way to keep the rendered widget intact but modify the z values only.

It looks like using plotlyProxy and plotlyProxyInvoke might be the right direction, but I can only see examples of an entire trace (which includes the geojson data) being replaced.

Sorry if I'm missing something or have been unclear - I have not used plotly very much, and even less so the js side of things.

See below for example code:

library(shiny)
library(dplyr)
library(plotly)
library(readr)
library(rjson)

zip_geojson <- fromJSON(file="https://raw.githubusercontent.com/hms1/testData/main/zip3_2.json")
plot_data <- read_csv(file="https://raw.githubusercontent.com/hms1/testData/main/plot_data.csv")
mapboxToken <- "pk.eyJ1IjoiaG1vcmdhbnN0ZXdhcnQiLCJhIjoiY2tmaTg5NDljMDBwbDMwcDd2OHV6cnd5dCJ9.8eLR4FtlO079Gq0NeSNoeg"  #burner token

ui <- fluidPage(
    
    sidebarLayout(
        sidebarPanel(
            sliderInput("multip",
                        "n:",
                        min = 1,
                        max = 10,
                        value = 1)
        ),

        mainPanel(
           plotlyOutput("cPlot")
        )
    )
)

server <- function(input, output) {

    output$cPlot <- renderPlotly({

        plot_data_i <- plot_data%>%
            mutate(log_count = case_when(log_count <= input$multip ~ log_count * input$multip,
                                         TRUE ~ log_count))
        
        plot_ly() %>% 
            add_trace(
                type = "choroplethmapbox",
                geojson = zip_geojson,
                locations = plot_data_i$zip,
                z = plot_data_i$log_count
            ) %>% 
            layout(
                mapbox = list(
                    style = "light",
                    zoom = 3,
                    center = list(lon = -95.7129, lat = 37.0902)
                    )
            ) %>% 
            config(mapboxAccessToken = mapboxToken)
        
    })
}

shinyApp(ui = ui, server = server)

Solution

  • For anyone else who comes across this post later, I found a solution.

    It turns out that you can change data using the restyle method in plotlyProxyInvoke, as shown below.

    library(shiny)
    library(dplyr)
    library(plotly)
    library(readr)
    library(rjson)
    
    zip_geojson <- fromJSON(file="https://raw.githubusercontent.com/hms1/testData/main/zip3_2.json")
    plot_data <- read_csv(file="https://raw.githubusercontent.com/hms1/testData/main/plot_data.csv")
    mapboxToken <- "pk.eyJ1IjoiaG1vcmdhbnN0ZXdhcnQiLCJhIjoiY2tmaTg5NDljMDBwbDMwcDd2OHV6cnd5dCJ9.8eLR4FtlO079Gq0NeSNoeg"  
    
    ui <- fluidPage(
        
        sidebarLayout(
            sidebarPanel(
                sliderInput("multip",
                            "n:",
                            min = 1,
                            max = 10,
                            value = 1),
                actionButton("Remove", "Remove Trace")
            ),
    
            mainPanel(
               plotlyOutput("cPlot")
            )
        )
    )
    
    server <- function(input, output, session) {
    
        output$cPlot <- renderPlotly({
            
            plot_ly(type = "choroplethmapbox", geojson = zip_geojson) %>% 
                layout(
                    mapbox = list(
                        style = "light",
                        zoom = 3,
                        center = list(lon = -95.7129, lat = 37.0902)
                        )
                ) %>% 
                config(mapboxAccessToken = mapboxToken) 
            
        })
        
        plotproxy <- plotlyProxy("cPlot", session, deferUntilFlush = FALSE)
        
        observeEvent(input$multip, {
            
            plot_data_i <- plot_data %>%
                mutate(log_count = case_when(log_count <= input$multip ~ log_count * input$multip,
                                             TRUE ~ log_count))
    
            plotproxy %>%
                plotlyProxyInvoke("restyle", list(z = list(plot_data_i$log_count), 
                                                  locations = list(plot_data_i$zip)))
        })
    }
    
    shinyApp(ui = ui, server = server)