Блестящее приложение для демонстрации симуляции: как переписать с помощью сюжета - PullRequest
1 голос
/ 12 ноября 2019

У меня есть простое приложение-прототип 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)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...