Skip to content

App with ggplot2 doesn't render without loading the munsell package #537

Open
@durraniu

Description

@durraniu

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

No one assigned

    Labels

    No labels
    No labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions