Shiny应用样本生成无随机性问题排查求助

我正在开发一个演示**中心极限定理（样本均值分布场景）**的Shiny应用。目前能生成数量和尺寸符合要求的样本，但所有样本完全相同——直方图显示所有样本的均值完全一致。

自测后怀疑问题出在sample_i()响应式表达式，后续响应式表达式运行正常。请问是否需要新增响应式表达式来修复该问题？

原应用代码如下：

library(shiny)

ui <- fluidPage(
  titlePanel("Demonstration of the Central Limit Theorem"),
  fluidRow(
    column(4, selectInput("dist", "Distribution",
                          c("Normal", "Uniform", "Poisson", "Binomial"))),
    column(4, numericInput("n_sample", "Number of samples", value = 50)),
    column(4, numericInput("size", "Sample size", value = 100))
  ), 
  tabsetPanel(
    id = "params",
    type = "hidden",
    tabPanel("Normal",
             numericInput("mean", "Mean", value = 0),
             numericInput("sd", "SD", value = 1)
    ),
    tabPanel("Uniform",
             numericInput("min", "Min", value = 0),
             numericInput("max", "Max", value = 1)
    ),
    tabPanel("Poisson",
             numericInput("r", "Rate", value = 1)
    ),
    tabPanel("Binomial",
             numericInput("p", "Probability of success", value = 0.5),
             numericInput("n", "Number of trials", value = 10)
    )
  ),
  plotOutput("hist"),
  verbatimTextOutput("length")
)

server <- function(input, output, session) {
  observeEvent(input$dist, {
    updateTabsetPanel(inputId = "params", selected = input$dist)
  })
  
  sample_i <- reactive({
    switch(input$dist, 
      Normal = rnorm(input$size, input$mean, input$sd),
      Uniform = runif(input$size, input$min, input$max), 
      Poisson = rpois(input$size, input$r), 
      Binomial = rbinom(input$size, input$n, input$p))
  })
  sample_dist <- reactive({
    replicate(n = input$n_sample, sample_i())
  })
  sample_dist_mean <- reactive({
      apply(sample_dist(), MARGIN = 2, mean) |>
        unlist() |> 
        as.numeric()
  })
  
  output$hist <- renderPlot(hist(sample_dist_mean()))
  output$length <- renderPrint(head(sample_dist(), n = 5))
}

shinyApp(ui, server)

注：当样本数量设为12时，控制台通过length组件输出如下内容：

[,1]       [,2]       [,3]       [,4]       [,5]       [,6]
[1,]  0.5953571  0.5953571  0.5953571  0.5953571  0.5953571  0.5953571
[2,]  0.8323953  0.8323953  0.8323953  0.8323953  0.8323953  0.8323953
[3,] -1.0366900 -1.0366900 -1.0366900 -1.0366900 -1.0366900 -1.0366900
[4,]  2.1517537  2.1517537  2.1517537  2.1517537  2.1517537  2.1517537
[5,] -1.2565259 -1.2565259 -1.2565259 -1.2565259 -1.2565259 -1.2565259
           [,7]       [,8]       [,9]      [,10]      [,11]      [,12]
[1,]  0.5953571  0.5953571  0.5953571  0.5953571  0.5953571  0.5953571
[2,]  0.8323953  0.8323953  0.8323953  0.8323953  0.8323953  0.8323953
[3,] -1.0366900 -1.0366900 -1.0366900 -1.0366900 -1.0366900 -1.0366900
[4,]  2.1517537  2.1517537  2.1517537  2.1517537  2.1517537  2.1517537
[5,] -1.2565259 -1.2565259 -1.2565259 -1.2565259 -1.2565259 -1.2565259

问题原因 #

sample_i()作为响应式表达式，在replicate调用时只会被求值一次，返回的是同一个样本向量，replicate只是把这个向量重复了input$n_sample次，导致所有列（样本）完全相同。不需要新增响应式表达式，只需调整sample_dist的实现逻辑即可。

修复方案 #

方案1：将sample_i改为普通函数 #

把响应式表达式改成普通函数，让replicate每次迭代都调用函数生成新样本：

server <- function(input, output, session) {
  observeEvent(input$dist, {
    updateTabsetPanel(inputId = "params", selected = input$dist)
  })
  
  # 改为普通函数而非响应式表达式
  sample_i <- function() {
    switch(input$dist, 
      Normal = rnorm(input$size, input$mean, input$sd),
      Uniform = runif(input$size, input$min, input$max), 
      Poisson = rpois(input$size, input$r), 
      Binomial = rbinom(input$size, input$n, input$p))
  }
  
  sample_dist <- reactive({
    replicate(n = input$n_sample, sample_i())
  })
  
  sample_dist_mean <- reactive({
      apply(sample_dist(), MARGIN = 2, mean) |>
        unlist() |> 
        as.numeric()
  })
  
  output$hist <- renderPlot(hist(sample_dist_mean()))
  output$length <- renderPrint(head(sample_dist(), n = 5))
}

方案2：直接在replicate中写生成逻辑 #

去掉单独的sample_i，直接把生成逻辑放到replicate的迭代体里：

server <- function(input, output, session) {
  observeEvent(input$dist, {
    updateTabsetPanel(inputId = "params", selected = input$dist)
  })
  
  sample_dist <- reactive({
    replicate(n = input$n_sample, {
      switch(input$dist, 
        Normal = rnorm(input$size, input$mean, input$sd),
        Uniform = runif(input$size, input$min, input$max), 
        Poisson = rpois(input$size, input$r), 
        Binomial = rbinom(input$size, input$n, input$p))
    })
  })
  
  sample_dist_mean <- reactive({
      apply(sample_dist(), MARGIN = 2, mean) |>
        unlist() |> 
        as.numeric()
  })
  
  output$hist <- renderPlot(hist(sample_dist_mean()))
  output$length <- renderPrint(head(sample_dist(), n = 5))
}

原理说明 #

响应式表达式会缓存结果，只要依赖（如input$dist、input$size等）没有变化，就不会重新计算。改成普通函数或直接写入replicate后，每次迭代都会执行随机生成逻辑，得到不同的样本集合，均值也会呈现符合中心极限定理的正态分布。

内容的提问来源于stack exchange，提问作者rq03