显示模拟的闪亮应用程序：如何使用 plotly 重写

Question

我有一个简单的原型 Shiny 应用程序，它显示一维布朗运动。目前我使用基本图形来获得我正在寻找的最少功能。当我将其扩展到我感兴趣的实际任务时，模拟中的每一步都将更加计算密集（在这个原型中它是沿着 x <- x + rnorm(1) 的路线）。

所以我想知道 plotly 是否可以帮助提高渲染效率，如果可以的话该怎么做。从我的最小搜索来看，这些累积动画似乎需要掌握整个时间序列并按帧复制它：https://plot.ly/r/cumulative-animations/。当模拟的每一步成本都很高时，这将意味着用户要等待应用程序呈现很长时间。相反，我想在每次模拟迭代后渲染累积结果 "in real time"，正如下面使用基础图形实现的那样。关于如何将其转换为 plotly 的任何想法都会非常有帮助！作为最后一个挑战，我想保留侧边栏中的 "Go"、"Stop"、"Reset" 按钮，而不使用 plotly 的动画按钮。

谢谢！（感谢@danyaalmohamed 为我提供了这个 MWE 的示例）

library(shiny)

ui<-fluidPage(
    titlePanel('1D Brownian Motion'),
    sidebarLayout(
        # panel with all inputs
        sidebarPanel(
            # param set-up
            numericInput('mean', 'mean', 0, step = 1),
            numericInput('sd', 'sd', 1, step = 0.5, min = 0.0001),

            # buttons to start, stop, reset 
            fluidRow(
                column(3, actionButton('go', 'Go')),
                column(3, actionButton('stop', 'Stop')),
                column(3, actionButton('reset',label='Reset'))
            )
        ),

        # plot panel
        mainPanel(
            plotOutput('bmtrack', height = '250px'), 
            plotOutput('bmmax', height = '250px')
        )
    )
)

server<-function(input,output){
    waits <- reactiveValues() # reactive to store all reactive variables
    waits$x <- 0
    waits$xmax <- 0
    waits$tt <- 0

    # function to move simulation forward
    forward <- function() {
        waits$x <- c(waits$x, 
                            tail(waits$x, 1) + rnorm(1, input$mean, input$sd))
        waits$xmax <- c(waits$xmax, max(waits$x))
        waits$tt <- c(waits$tt, max(waits$tt) + 1)
    }

    # setup
    session <- reactiveValues()
    session$timer <- reactiveTimer(Inf)

    # when go button is pressed
    observeEvent(input$go,{
        session$timer<-reactiveTimer(30)
        observeEvent(session$timer(),{
            forward()
        })
    })


    # when stop button is pressed
    observeEvent(input$stop,{
        session$timer<-reactiveTimer(Inf)
    })


    # when reset button is pressed
    observeEvent(input$reset,{
        waits$x <- 0
        waits$xmax <- 0
        waits$tt <- 0
    })

    output$bmtrack<-renderPlot({
        ylim <- c(-1, 1)
        if(ylim[1] > min(waits$x)) ylim[1] <- min(waits$x)
        if(ylim[2] < max(waits$x)) ylim[2] <- max(waits$x)

        par(mar = c(3, 3, 2, 0) + 0.5, cex = 1.4, mgp = c(1.75, 0.5, 0), tcl = -0.25)
        plot(waits$tt, waits$x, 
             type = 'l', lwd = 2,
             ylab = 'X', xlab = '', main = 'BM track',
             xlim = c(0, ifelse(max(waits$tt) < 50, 50, max(waits$tt))),
             ylim = ylim)
    })

    output$bmmax<-renderPlot({
        ylim <- c(-1, 1)
        if(ylim[1] > min(waits$xmax)) ylim[1] <- min(waits$xmax)
        if(ylim[2] < max(waits$xmax)) ylim[2] <- max(waits$xmax)

        par(mar = c(3, 3, 2, 0) + 0.5, cex = 1.4, mgp = c(1.75, 0.5, 0), tcl = -0.25)
        plot(waits$tt, waits$xmax, 
             type = 'l', lwd = 2,
             ylab = 'max of X', xlab = 'Time', main = 'BM max',
             xlim = c(0, ifelse(max(waits$tt) < 50, 50, max(waits$tt))),
             ylim = ylim)
    })

}

runApp(shinyApp(ui, server), launch.browser = TRUE)

Answer 1

要有效更改绘图对象，您应该查看 plotlyProxy, which avoids re-rendering the entire plot. Here are some streaming examples。

这就是我认为您想要的 - 顺便说一句。你应该避免调用 reactiveValues "session"，因为 session 是 server 函数的可选参数（plotlyProxy 需要它）。

library(shiny)
library(plotly)

ui <- fluidPage(titlePanel('1D Brownian Motion'),
                sidebarLayout(
                  # panel with all inputs
                  sidebarPanel(
                    # param set-up
                    numericInput('mean', 'mean', 0, step = 1),
                    numericInput('sd', 'sd', 1, step = 0.5, min = 0.0001),

                    # buttons to start, stop, reset
                    fluidRow(
                      column(3, actionButton('go', 'Go')),
                      column(3, actionButton('stop', 'Stop')),
                      column(3, actionButton('reset', label = 'Reset'))
                    )
                  ),

                  # plot panel
                  mainPanel(
                    plotlyOutput('bmtrack', height = '250px'),
                    plotlyOutput('bmmax', height = '250px')
                  )
                ))

server <- function(input, output, session) {
  # reactive to store all reactive variables
  waits <- reactiveValues(x = 0, xmax = 0, tt = 0, timer = reactiveTimer(Inf))

  # function to move simulation forward
  forward <- function() {
    waits$x <- waits$x + rnorm(1, input$mean, input$sd)
    waits$xmax <- max(waits$xmax, waits$x)
    waits$tt <- waits$tt + 1
  }

  # when go button is pressed
  observeEvent(input$go, {
    waits$timer <- reactiveTimer(100)
    observeEvent(waits$timer(), {
      forward()
    })
  })

  # when stop button is pressed
  observeEvent(input$stop, {
    waits$timer <- reactiveTimer(Inf)
  })

  # when reset button is pressed
  observeEvent(input$reset,{
      waits$x <- 0
      waits$xmax <- 0
      waits$tt <- 0
  })

  # generate initial "empty" plot
  initial_plot <- plot_ly(
    x = 0,
    y = 0,
    type = 'scatter',
    mode = 'lines',
    line = list(color = '#000000',
                width = 3)
  )

  # render initial plot and assign to both outputs
  output$bmmax <- output$bmtrack <- renderPlotly({
    input$reset # rerender when reset is pressed
    initial_plot
  })

  # create plotlyProxy objects for both plotly outputs
  bmtrack_proxy <- plotlyProxy("bmtrack", session)
  bmmax_proxy <- plotlyProxy("bmmax", session)

  # manipulate plots via plotlyProxy objects (without rerendering)
  observe({
      plotlyProxyInvoke(bmtrack_proxy, "extendTraces", list(x = list(list(waits$tt)), y = list(list(waits$x))), list(0))
  })

  observe({
      plotlyProxyInvoke(bmmax_proxy, "extendTraces", list(x = list(list(waits$tt)), y = list(list(waits$xmax))), list(0))
  })

}

shinyApp(ui, server)

显示模拟的闪亮应用程序：如何使用 plotly 重写

Shiny app to show simulation: how to re-write using plotly

r

shiny

r-plotly