У меня есть простое приложение-прототип Shiny, которое показывает броуновское движение в 1D. В настоящее время я использую базовую графику, чтобы получить минимальную функциональность, которую я ищу. Когда я масштабирую это до фактической задачи, которая меня интересует, каждый шаг в симуляции будет более сложным в вычислительном отношении (в этом прототипе он имеет вид x <- x + rnorm(1)
).
Так что мне интересноЕсли заговор может помочь с эффективностью рендеринга, и если да, то как это сделать. Из моего минимального поиска кажется, что эти виды кумулятивных анимаций в сюжете требуют наличия всей временной серии под рукой и репликации ее по кадрам: https://plot.ly/r/cumulative-animations/. Когда каждый шаг моделирования дорогостоящий, это будет означать, что пользователь ждет долговремя для приложения, чтобы сделать вообще. Вместо этого я хотел бы отображать кумулятивные результаты «в режиме реального времени» после каждой итерации симуляции, как в настоящее время реализуется ниже с использованием базовой графики. Любые мысли о том, как преобразовать это в заговор, были бы очень полезны! В качестве последнего вызова я хочу оставить кнопки «Перейти», «Стоп», «Сброс» на боковой панели и не использовать кнопки анимации сюжета.
Спасибо! (и спасибо @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)