Quarto Document with Interactive Shiny App

Interactive Quarto Demo

# app.R
library(shiny)
library(ggplot2)
library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

# Generate a population dataset
set.seed(42) # for reproducibility
population <- data.frame(
  x = rnorm(10000, mean = 5, sd = 1.5), 
  y = rnorm(10000, mean = 5, sd = 1.5)
)

# Initialize a data frame to store time series of totals
time_series_data <- data.frame(
  SampleNumber = integer(),
  UnweightedTotal = numeric(),
  WeightedTotal = numeric(),
  WeightedTotal_CI_Lower = numeric(),
  WeightedTotal_CI_Upper = numeric()
)

# Function to calculate weighted totals and CIs
calculate_totals <- function(sample_data, sample_number) {
  unweighted_total <- sum(sample_data$y)
  weighted_total <- sum(sample_data$y * sample_data$weight)
  
  # Approximate standard error for weighted total
  weighted_se <- sd(sample_data$y * sample_data$weight) / sqrt(nrow(sample_data))
  
  data.frame(
    SampleNumber = sample_number,
    UnweightedTotal = unweighted_total,
    WeightedTotal = weighted_total,
    WeightedTotal_CI_Lower = weighted_total - 1.96 * weighted_se,
    WeightedTotal_CI_Upper = weighted_total + 1.96 * weighted_se
  )
}

# Initialize with 5 samples
initial_samples <- bind_rows(lapply(1:5, function(i) {
  sample_data <- population %>%
    sample_n(200, replace = TRUE) %>%
    mutate(weight = nrow(population) / 200)
  calculate_totals(sample_data, i)
}))

ui <- fluidPage(
  titlePanel("Time Series of Weighted and Unweighted Totals"),
  
  sidebarLayout(
    sidebarPanel(
      # Control for sample size
      sliderInput("sample_size", "Sample Size:", min = 100, max = 1000, value = 200, step = 50),
      actionButton("resample", "Redraw Sample") # Button to redraw sample
    ),
    
    mainPanel(
      plotOutput("violinPlot"),
      plotOutput("weightedTimeSeriesPlot")
    )
  )
)

server <- function(input, output, session) {
  
  # Reactive values to store time series data with an initial baseline
  totals <- reactiveValues(data = initial_samples)
  
  # Reactive event to generate a new sample when the button is clicked
  generateSample <- eventReactive(input$resample, {
    sample_data <- population %>%
      sample_n(input$sample_size, replace = TRUE) %>%
      mutate(weight = nrow(population) / input$sample_size)
    sample_data
  }, ignoreNULL = FALSE) # Generate initial sample on app load
  
  # Update totals with each new sample
  observeEvent(input$resample, {
    sample_data <- generateSample()
    new_entry <- calculate_totals(sample_data, nrow(totals$data) + 1)
    totals$data <- rbind(totals$data, new_entry)
  })
  
  # Violin plot of sampled y values
  output$violinPlot <- renderPlot({
    sample_data <- generateSample()
    ggplot(sample_data, aes(x = factor(1), y = y)) +
      geom_violin(fill = "skyblue", alpha = 0.6) +
      labs(x = "Sample", y = "Y", title = "Violin Plot of Sampled Y Values") +
      theme_minimal()
  })
  

  
  # Weighted Total Time Series Plot with Error Bars for CI
  output$weightedTimeSeriesPlot <- renderPlot({
    ggplot(totals$data, aes(x = SampleNumber, y = WeightedTotal)) +
      geom_line(color = "red") +
      geom_point(color = "red") +
      geom_errorbar(aes(ymin = WeightedTotal_CI_Lower, ymax = WeightedTotal_CI_Upper), width = 0.2, color = "red") +
      labs(x = "Sample Number", y = "Weighted Total (Y)", title = "Time Series of Weighted Totals with 95% CI") +
      theme_minimal()
  })
}

shinyApp(ui = ui, server = server)

`google-chrome` and `chromium-browser` were not found. Try setting the `CHROMOTE_CHROME` environment variable to the executable of a Chromium-based browser, such as Google Chrome, Chromium or Brave or adding one of these executables to your PATH.

PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.

Shiny applications not supported in static R Markdown documents