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)
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)