R Shiny : create non-reactive background in plotOutput

Question

我正在尝试构建一个 Shiny 的应用程序，我可以在其中以交互方式更改情节。我希望情节在几毫秒内发生变化，因为变化仅包括添加一些点，这实际上是可能的。

可重现的例子包含了这个想法的抽象。第一个示例绘制了一个散点图，我可以交互式地更改点数。这基本上立即发生。我将绘图的这一部分称为“ react 层”。

library(shiny)

ui <- fluidPage(
  
  sliderInput(inputId = "slider_input", label = "Reactive values:", min = 1, max = 100, value = 10),
  plotOutput(outputId = "plotx")
  
)

quick_server <- function(input, output, session){
    
  output$plotx <- renderPlot({
    
    # reactive layer
    plot(
      x = sample(x = -4:4, size = input$slider_input, replace = T), 
      y = sample(x = -4:4, size = input$slider_input, replace = T)
      )
    
  })
  
}

shinyApp(ui = ui, server = quick_server)

问题是，我想以交互方式更改的图总是包含一个“慢速非 react 层”，其中包含许多不 react 且从不改变的数据点。由于此数据集的大小和 renderPlot()总是重新绘制它以交互方式更改“ react 层”的速度急剧下降。

library(shiny)

ui <- fluidPage(
  
  sliderInput(inputId = "slider_input", label = "Reactive values:", min = 1, max = 100, value = 10),
  plotOutput(outputId = "plotx")
  
)

slow_server <- function(input, output, session){
  
  base_data <- reactiveVal(value = data.frame(x = rnorm(n = 200000), y = rnorm(n = 200000)))
  
  output$plotx <- renderPlot({
    
    # slow non reactive layer
    plot(x = base_data()$x, y = base_data()$y)
    
    # reactive layer
    points(
      x = sample(x = -4:4, size = input$slider_input, replace = T),
      y = sample(x = -4:4, size = input$slider_input, replace = T), 
      col = "red", 
      cex = 5, 
      pch = 19
      )
    
  })
  
}

shinyApp(ui = ui, server = slow_server)

由于基础数据和生成的图(这里是点云)永远不会改变，所以很烦人 renderPlot()总是重新绘制所有内容(两个“图层”)。有没有办法“隔离”从非 react 性数据集创建的图？这样就不会重新绘制非 react 性层？

我已经尝试使用 ggplot2 并创建一个稳定层

big_data_frame <- data.frame(x = rnorm(n = 200000), y = rnorm(n = 200000))

steady_layer <- reactiveVal(value = geom_point(data = big_data_frame, mapping = aes(x = x, y = y))

然后像这样创建情节

output$plotx <- renderPlot({

  small_df <- 
   data.frame(
      x = sample(x = -4:4, size = input$slider_input, replace = T),
      y = sample(x = -4:4, size = input$slider_input, replace = T)
    )
  
   ggplot() + 
    steady_layer() +
    geom_point(data = small_df, mapping = aes(x = x, y = y) 
    
})

但这无济于事，因为重新绘制过程需要时间而不是创建 ggplot 图层本身。

尽管我可以想象解决方案可能是创建大图的 .png 并将其用作 output$plotx 的 HTML 和 CSS 的背景。通过将其设为响应式(Reactive) UI，我未能成功操作 HTML 和 CSS。

感谢任何帮助。提前致谢!

Answer 1

您需要了解 renderPlot 的工作原理。它首先使用 R png 函数创建一个 png，然后将其发送到客户端浏览器。当绘图的数据发生变化时，将重新创建此 png。因此，不可能重新绘制 png 的一部分。所以给一个已经存在的plot加点总是会用到slow points + new points的时间，所以在目前的shiny机制下，不可能不重新计算这些slow points。一个可能的选择是将 plotly 与 proxy 一起使用.它由 HTML 和 Javascript 组成，所以是的，您可以通过部分更新来完成。详见链接，此处不再赘述。就我个人的经验而言，它的速度并没有你想要的那么快。

所以在这里我有一个聪明的技巧给你:为什么我们要在同一个地 block 上更新？我们可以用一个图作为背景，它很慢，但我们只渲染一次，我们再也不会碰它了。然后我们更新另一个只有几个点的图，并将这个图堆叠在慢速图之上。

方法如下:

1. 添加一些 CSS 技巧来进行堆叠
2. 渲染缓慢的情节
3. 以透明方式渲染快速绘图

library(shiny)
library(ggplot2)
ui <- fluidPage(
    
    sliderInput(inputId = "slider_input", label = "Reactive values:", min = 1, max = 100, value = 10),
    div(
        class = "large-plot",
        plotOutput(outputId = "plot_bg"),
        plotOutput(outputId = "plotx")
    ),
    tags$style(
        "
        .large-plot {
            position: relative;
        }
        #plot_bg {
            position: absolute;
        }        
        #plotx {
            position: absolute;
        }
        "
    )
    
    
)

slow_server <- function(input, output, session){
    
    base_data <- reactiveVal(value = data.frame(x = rnorm(n = 200000), y = rnorm(n = 200000)))
    
    output$plot_bg <- renderPlot({
        ggplot(base_data()) +
            geom_point(aes(x,y)) +
            scale_x_continuous(breaks = -4:4) +
            scale_y_continuous(breaks = -4:4) +
            xlim(-5, 5) +
            ylim(-5, 5)
    })
    output$plotx <- renderPlot({
        data.frame(
            x = sample(x = -4:4, size = input$slider_input, replace = T),
            y = sample(x = -4:4, size = input$slider_input, replace = T)
        ) %>% 
            ggplot() +
                geom_point(aes(x,y), color = "red", size = 3) + 
                scale_x_continuous(breaks = -4:4) +
                scale_y_continuous(breaks = -4:4) +
            theme(
                panel.background = element_rect(fill = "transparent"),
                plot.background = element_rect(fill = "transparent", color = NA), 
                panel.grid.major = element_blank(), 
                panel.grid.minor = element_blank(), 
                legend.background = element_rect(fill = "transparent"), 
                legend.box.background = element_rect(fill = "transparent")
            )+
            xlim(-5, 5) +
            ylim(-5, 5)
    }, bg="transparent")
    
}

shinyApp(ui = ui, server = slow_server)