时间戳

首页 > 解决方案 > 更新 R 中的 plotly 数据（chloropleth），无需重新渲染整个地图

r - 更新 R 中的 plotly 数据（chloropleth），无需重新渲染整个地图

问题描述

我正在尝试使用闪亮的控件来修改绘图叶绿素图的数据。

每当我更改数据时，整个绘图都会重新渲染，这非常慢。我猜瓶颈是重绘geojson多边形。因为geojson永远不会改变，我想知道是否有办法保持渲染的小部件完好无损，但只修改z值。

看起来使用plotlyProxy和plotlyProxyInvoke可能是正确的方向，但我只能看到被替换的整个跟踪（包括 geojson 数据）的示例。

抱歉，如果我遗漏了一些东西或不清楚 - 我并没有非常多地使用情节，更不用说 js 方面的事情了。

请参阅下面的示例代码：

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)

标签： rshinyplotlygeojsonr-plotly

解决方案

对于以后遇到此帖子的其他人，我找到了解决方案。

事实证明，您可以使用 plotlyProxyInvoke 中的 restyle 方法更改数据，如下所示。

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)

推荐阅读