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的二项分布模拟,那么将生成所有输出。然后我选择一个不同的分布(例如,正态分布),在我将值渲染到参数并单击动作按钮之前,直方图绘图变为灰色大约一秒钟。似乎服务器功能正在运行,尽管在那一秒之后根本没有变化
我希望的是,当做出分配选择时,应该推迟反应。因此,除非单击操作按钮,否则不应运行服务器功能
我该如何解决这个问题?