Open
Description
I use ggplot2
in the following shinylive app in a quarto document. But it does not show up on the page after the honeycomb loader goes away. As suggested in this thread, the issue is that webR installation of ggplot2
is missing the munsell
dependency. This app works when I add the library(munsell)
line.
Here is my qmd file:
---
title: "Post With Code"
author: "Harlow Malloc"
date: "2025-04-17"
format:
html:
resources:
- shinylive-sw.js
filters:
- shinylive
---
```{shinylive-r}
#| standalone: true
library(shiny)
ui <- fluidPage(
titlePanel("Hello Shiny!")
)
server <- function(input, output, session) {
# code
}
shinyApp(ui, server)
```
```{shinylive-r}
#| standalone: true
#| viewerHeight: 1000
library(shiny)
library(ggplot2)
library(bslib)
library(dplyr)
# Define the diffusion simulation functions
r_diffusion_em <- function(alpha, tau, beta, delta, dt = 0.001, max_steps = 1e4) {
sigma <- 1 # Standard diffusion coefficient
X <- beta * alpha # Start at initial bias
trajectory <- data.frame(time = 0, evidence = X)
for (step in 1:max_steps) {
noise <- rnorm(1, 0, 1)
dX <- delta * dt + sigma * sqrt(dt) * noise
X <- X + dX
# Record the step
current_time <- step * dt
trajectory <- rbind(trajectory, data.frame(time = current_time, evidence = X))
# Check boundaries
if (X >= alpha) {
rt <- current_time + tau
response <- "upper"
break
} else if (X <= 0) {
rt <- (current_time + tau) # Negative for lower boundary
response <- "lower"
break
}
}
# Handle non-termination (rare, but possible if max_steps is too small)
if (!exists("rt")) {
warning("Process did not hit boundary within max_steps. Increase max_steps or dt.")
rt <- NA
response <- NA
}
list(
rt = rt,
response = response,
trajectory = trajectory
)
}
rwiener <- function(n = 1,
alpha,
tau,
beta,
delta,
dt = 0.001,
max_steps = 1e4) {
# Validate inputs
if (alpha <= 0 || tau < 0 || beta < 0 || beta > 1) {
stop("Invalid parameters: alpha > 0, tau >= 0, 0 <= beta <= 1")
}
# Initialize results data frame
results <- data.frame(q = numeric(n),
resp = factor(rep(NA, n), levels = c("upper", "lower")))
# Initialize trajectory collector
all_trajectories <- data.frame(n = integer(),
time = numeric(),
evidence = numeric())
# Simulate n trials
for (i in 1:n) {
trial <- r_diffusion_em(alpha, tau, beta, delta, dt, max_steps)
# Store results
results$q[i] <- trial$rt
results$resp[i] <- trial$response
# Store trajectory with trial number
if (!is.null(trial$trajectory)) {
trial_traj <- data.frame(n = i,
time = trial$trajectory$time,
evidence = trial$trajectory$evidence)
all_trajectories <- rbind(all_trajectories, trial_traj)
}
}
# Prepare output
output <- list(
responses = structure(results, class = c("data.wiener", "data.frame")),
trajectories = all_trajectories
)
return(output)
}
# Create the Shiny app
ui <- page_sidebar(
title = "Diffusion Process Simulator",
sidebar = sidebar(
# Parameter sliders
sliderInput("n", "Number of Trials (n):",
min = 1, max = 50, value = 5, step = 1),
sliderInput("alpha", "Boundary Separation (alpha):",
min = 0.1, max = 2.0, value = 1.0, step = 0.1),
sliderInput("tau", "Non-decision Time (tau):",
min = 0, max = 1, value = 0.2, step = 0.05),
sliderInput("beta", "Initial Bias (beta):",
min = 0, max = 1, value = 0.5, step = 0.05),
sliderInput("delta", "Drift Rate (delta):",
min = -2, max = 2, value = 0, step = 0.1),
actionButton("simulate", "Run Simulation", class = "btn-primary")
),
# Main panel with simulation results
card(
card_header("Diffusion Process Trajectories"),
plotOutput("trajectoryPlot", height = "400px")
),
card(
card_header("Simulation Results"),
fluidRow(
column(6, tableOutput("resultsTable")),
column(6, plotOutput("responsePie", height = "250px"))
)
)
)
server <- function(input, output, session) {
# Reactive value to store simulation results
sim_data <- reactiveVal(NULL)
# Run simulation when the button is clicked
observeEvent(input$simulate, {
set.seed(as.numeric(Sys.time()))
withProgress(message = 'Running simulation...', {
results <- rwiener(
n = input$n,
alpha = input$alpha,
tau = input$tau,
beta = input$beta,
delta = input$delta
)
sim_data(results)
})
})
# Plot the trajectories
output$trajectoryPlot <- renderPlot({
req(sim_data())
ggplot(sim_data()$trajectories, aes(x = time, y = evidence, group = n, color = factor(n))) +
geom_line(alpha = 0.7) +
geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
geom_hline(yintercept = input$alpha, linetype = "dashed", color = "red") +
labs(x = "Time (s)", y = "Evidence", color = "Trial") +
theme_minimal() +
theme(legend.position = "none")
})
# Show results table
output$resultsTable <- renderTable({
req(sim_data())
sim_data()$responses %>%
mutate(Trial = row_number(),
RT = round(q, 3),
Response = resp) %>%
select(Trial, Response, RT)
})
# Show pie chart of responses
output$responsePie <- renderPlot({
req(sim_data())
response_counts <- sim_data()$responses %>%
count(resp) %>%
rename(Response = resp, Count = n)
ggplot(response_counts, aes(x = "", y = Count, fill = Response)) +
geom_bar(stat = "identity", width = 1) +
coord_polar("y", start = 0) +
labs(title = "Response Distribution") +
theme_minimal() +
theme(axis.title = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
panel.grid = element_blank())
})
# Initialize with a simulation on startup
# observe({
# set.seed(123)
# results <- rwiener(
# n = input$n,
# alpha = input$alpha,
# tau = input$tau,
# beta = input$beta,
# delta = input$delta
# )
# sim_data(results)
# })
}
shinyApp(ui, server)
```
```{r}
sessionInfo()
```
Metadata
Metadata
Assignees
Labels
No labels