In my Shiny app, why does my sample generator result in the same exact sample without any randomizat-CodePudding

Although I am able to generate the correct amount of samples, and these samples are each of the right size, each one is exactly the same.

Currently, I am trying to create a Shiny app that demonstrates the Central Limit Theorem, specifically for the case regarding the distribution of the sample mean. I expected the app to generate a proper sampling distribution when I realized that the histogram had the same exact value on the x-axis, indicating that the mean was exactly the same for each sample.

Based on my own testing, I think that the issue lies with the sample_i() reactive expression, given that the latter reactive expressions work well.

Would I have to implement another reactive expression in order to fix the issue?

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)

Note that the console generates the output below (which was done through the length component of the output) when the number of samples is set to 12.

           [,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

CodePudding user response：

It looks like you are using the replicate function to generate samples for your Shiny app. The replicate function generates multiple copies of the same object, so it is not suitable for generating a set of independent samples. Instead, you should use a loop to generate the samples, so that each iteration creates a new, independent sample.

Here is an example of how you could modify your code to generate a set of independent samples using a loop:

# Sample the specified distribution input$size times
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))
})

# Generate a set of independent samples
sample_dist <- reactive({
  # Create an empty list to store the samples
  samples <- list()
  
  # Generate input$n_samples samples
  for (i in 1:input$n_samples) {
    # Generate a sample and append it to the list
    samples[[i]] <- sample_i()
  }
  
  # Return the list of samples
  return(samples)
})

# Compute the mean of each sample
sample_dist_mean <- reactive({
  # Use the apply function to compute the mean of each sample
  means <- apply(sample_dist(), MARGIN = 2, mean)
  
  # Return the means as a numeric vector
  return(as.numeric(unlist(means)))
})

By using a loop to generate the samples, you can ensure that each sample is independent and will not be exactly the same as the others. This should fix the issue you are experiencing with your Shiny app.

CodePudding user response：

EDIT: Found a new solution.

server <- function(input, output, session) {
  observeEvent(input$dist, {
    updateTabsetPanel(inputId = "params", selected = input$dist)
  })
  
  samples <- reactive({
    switch(input$dist, 
      Normal = replicate(n = input$n_sample, rnorm(input$size, input$mean, input$sd)),
      Uniform = replicate(n = input$n_sample, runif(input$size, input$min, input$max)), 
      Poisson = replicate(n = input$n_sample, rpois(input$size, input$r)), 
      Binomial = replicate(n = input$n_sample, rbinom(input$size, input$n, input$p)))
  })

  sample_dist_mean <- reactive({
      apply(samples(), MARGIN = 2, mean) |>
        unlist() |> 
        as.numeric()
  })
  
  output$hist <- renderPlot(hist(sample_dist_mean()))
}