R闪亮的延迟反应

时间:2017-04-24 03:06:59

标签: r shiny

library(shiny)
library(ggplot2)

ui <- shinyUI(fluidPage(
    titlePanel("Central Limit Theorem Simulation"),
    sidebarLayout(
        sidebarPanel(
            numericInput("sample_size", "Size of each random sample\n(max: 100)", 
                         value = 30, min = 1, max = 100, step = 1),
            sliderInput("simulation", "The number of simulation",
                        value = 100, min = 100, max = 1000, step = 1),
            numericInput("bins", "Number of bins in the histogram\n(max: 50)", 
                         value = 20, min = 1, max = 50, step = 1),
            selectInput("sample_dist", "Population Distribution where each sample is from",
                        choices = c("Bernoulli","Poisson", "Normal", "Uniform") ),
            conditionalPanel(condition = 'input.sample_dist == "Bernoulli"', 
                             textInput("prob", "Parameter (p)") ),
            conditionalPanel(condition = 'input.sample_dist == "Poisson"', 
                             textInput("lambda", "Parameter (lambda)") ),
            conditionalPanel(condition = 'input.sample_dist == "Normal"', 
                             textInput("mu", "Parameter (mu)"),
                             textInput("sigma", "Parameter (sigma)") ),
            conditionalPanel(condition = 'input.sample_dist == "Uniform"', 
                             textInput("min_a", "Parameter (a)"),
                             textInput("max_b", "parameter (b)") ),
            actionButton("update", "Update Simulation")
        ),

        mainPanel(
            tabsetPanel(type = "pills", 
                        tabPanel("mean of random sample mean", br(), 
                                 textOutput(outputId = "output_mean")), 
                        tabPanel("variance of random sample mean", br(), 
                                 textOutput(outputId = "output_var")), 
                        tabPanel("summary table", br(), 
                                 tableOutput(outputId = "output_table")),
                        tabPanel("sample matrix", br(), 
                                 verbatimTextOutput(outputId = "output_sample")),
                        tabPanel("histogram of random normal sample", br(), 
                                 plotOutput(outputId = "output_hist"))
            )
        )
  )


))


server <- shinyServer(function(input, output) {

    # Return the random sample
    rsample <- eventReactive(input$update, {

        if (isolate(input$sample_dist == "Bernoulli") ) {
            rsample <- isolate(rbinom(n = input$sample_size * input$simulation,
                                      size = 1, as.numeric(input$prob) ) )
            } else if (isolate(input$sample_dist == "Poisson") )  {
                rsample <- isolate(rpois(n = input$sample_size * input$simulation, 
                                         as.numeric(input$lambda) ) )
            } else if (isolate(input$sample_dist == "Normal") ) {
                rsample <- isolate(rnorm(n = input$sample_size * input$simulation, 
                                         mean = as.numeric(input$mu), sd = as.numeric(input$sigma) ) ) 
            } else  {
                rsample <- isolate(runif(n = input$sample_size * input$simulation, 
                                         min = as.numeric(input$min_a), max = as.numeric(input$max_b) ) )
            }

        rsample 

    })


        # Return the random sample matrix
    rsamplematrix <- reactive({
        matrix(rsample(), nrow = isolate(input$simulation) )
    })

    # output mean of sample mean
    output$output_mean <- renderText({
        sample_mean <- rowMeans(rsamplematrix())
        mean(sample_mean)
    })

    # output variance of sample mean
    output$output_var <- renderText({
        sample_mean <- rowMeans(rsamplematrix())
        var(sample_mean)
    })

    # output summary table of sample mean
    output$output_table <- renderTable({
        sample_mean <- rowMeans(rsamplematrix())
        data.frame(mean(sample_mean), var(sample_mean))
    })

    # output the first 5 rows and 5 columns of the sample matrix
    output$output_sample <- renderPrint({
        k = rsamplematrix()
        k[1:5, 1:5]
    })

    # output histogram of sample mean
    output$output_hist <- renderPlot({
        sample_mean <- rowMeans(rsamplematrix())
        ggplot(data.frame(sample_mean), aes(x = sample_mean, y = ..density..)) +
            geom_histogram(bins = isolate(input$bins), fill = "steelblue", col = "white") 
    })

})


shinyApp(ui = ui, server = server)

代码运行良好,但延迟反应存在一些问题

假设我运行参数= 0.5的二项分布模拟,那么将生成所有输出。然后我选择一个不同的分布(例如,正态分布),在我将值渲染到参数并单击动作按钮之前,直方图绘图变为灰色大约一秒钟。似乎服务器功能正在运行,尽管在那一秒之后根本没有变化

我希望的是,当做出分配选择时,应该推迟反应。因此,除非单击操作按钮,否则不应运行服务器功能

我该如何解决这个问题?

0 个答案:

没有答案