Random Walks Dashboard
Interactive dashboard with walker paths, step distributions, and fractal visualizations
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 1800
# ============================================================================
# Package Loading + Inline Fallbacks for WebR
# ============================================================================
cat("\n=== DASHBOARD SETUP ===\n")
# Load shiny (pre-installed in Shinylive)
library(shiny)
cat("✅ shiny\n")
# Install and load ggplot2
tryCatch({
library(ggplot2)
cat("✅ ggplot2\n")
}, error = function(e) {
cat("⚠️ ggplot2 not found, installing...\n")
webr::install("munsell", repos = "https://repo.r-wasm.org")
webr::install("ggplot2", repos = "https://repo.r-wasm.org")
library(ggplot2)
cat("✅ ggplot2 installed\n")
})
# Try to load randomwalk package (may fail if WebR binaries not available)
has_randomwalk <- tryCatch({
webr::install("randomwalk", repos = c(
"https://johngavin.github.io/randomwalk",
"https://repo.r-wasm.org"
))
library(randomwalk)
cat("✅ randomwalk (v", as.character(packageVersion("randomwalk")), ")\n", sep = "")
TRUE
}, error = function(e) {
cat("⚠️ randomwalk not available — using inline simulation engine\n")
FALSE
})
# ============================================================================
# Inline simulation functions (used when package unavailable in WebR)
# These are minimal versions of initialize_grid() and generate_walker_positions()
# ============================================================================
if (!has_randomwalk) {
initialize_grid <- function(n, center_black = TRUE) {
grid <- matrix(0L, nrow = n, ncol = n)
if (center_black) { ctr <- ceiling(n / 2); grid[ctr, ctr] <- 1L }
grid
}
generate_walker_positions <- function(n_walkers, grid, avoid_black = TRUE) {
n <- nrow(grid); ctr <- ceiling(n / 2)
lapply(seq_len(n_walkers), function(i) {
for (attempt in 1:1000) {
pos <- c(sample.int(n, 1L), sample.int(n, 1L))
if (!all(pos == c(ctr, ctr)) && !(avoid_black && grid[pos[1], pos[2]] == 1L))
return(pos)
}
pos
})
}
# Minimal plot fallback
plot_grid_enhanced <- function(result, quantiles = 5, color_scheme = "viridis") {
g <- result$grid; n <- nrow(g)
df <- expand.grid(x = 1:n, y = 1:n)
df$black <- as.vector(g)
p <- ggplot2::ggplot(df, ggplot2::aes(x = .data$x, y = .data$y)) +
ggplot2::geom_tile(ggplot2::aes(fill = factor(.data$black)),
color = NA, linewidth = 0) +
ggplot2::scale_fill_manual(values = c("0" = "gray60", "1" = "black"),
guide = "none") +
ggplot2::coord_fixed() +
ggplot2::labs(title = sprintf("DLA Pattern: %d black pixels (%d%% of %dx%d)",
sum(g == 1L), round(100 * sum(g == 1L) / (n*n)), n, n)) +
ggplot2::theme_minimal() +
ggplot2::theme(panel.background = ggplot2::element_rect(fill = "gray60", color = NA),
plot.background = ggplot2::element_rect(fill = "gray60", color = NA))
attr(p, "caption") <- ""
p
}
cat("✅ Inline simulation engine ready\n")
}
cat("\n⚠️ WebR Mode: Synchronous only (workers=0)\n")
cat(" Simulation is fully vectorized for speed\n")
cat("\n=== SETUP COMPLETE ===\n\n")
# ============================================================================
# Helper Functions
# ============================================================================
is_webr <- function() {
exists(".webr_env", envir = .GlobalEnv) ||
identical(Sys.getenv("WEBR"), "1")
}
format_duration <- function(seconds) {
if (is.null(seconds) || is.na(seconds)) return("00:00")
seconds <- round(seconds)
if (seconds < 60) {
sprintf("00:%02d", seconds)
} else if (seconds < 3600) {
sprintf("%02d:%02d", floor(seconds / 60), seconds %% 60)
} else {
sprintf("%02d:%02d:%02d", floor(seconds / 3600),
floor((seconds %% 3600) / 60), seconds %% 60)
}
}
# ============================================================================
# Shiny UI
# ============================================================================
ui <- fluidPage(
# CSS for light/dark themes + collapsible panels + progress
tags$head(
tags$style(HTML("
/* ── Dark mode ────────────────────────────────────── */
body.dark-mode, body.dark-mode * {
color: #e0e0e0;
}
body.dark-mode {
background-color: #1e1e1e !important;
}
body.dark-mode .well {
background-color: #2b2b2b;
border-color: #444;
color: #e0e0e0;
}
body.dark-mode .btn { color: #fff; }
body.dark-mode .btn-primary { background-color: #2a6cb6; border-color: #2a6cb6; }
body.dark-mode .btn-success { background-color: #1a7a3a; border-color: #1a7a3a; }
body.dark-mode .btn-warning { background-color: #8a6d2b; border-color: #8a6d2b; color: #fff; }
body.dark-mode label, body.dark-mode .control-label {
color: #e0e0e0 !important;
}
body.dark-mode .irs--shiny .irs-single,
body.dark-mode .irs--shiny .irs-min,
body.dark-mode .irs--shiny .irs-max {
color: #e0e0e0;
}
body.dark-mode .form-control,
body.dark-mode .selectize-input,
body.dark-mode .selectize-dropdown {
background-color: #333;
color: #e0e0e0;
border-color: #555;
}
body.dark-mode details {
background: #2b2b2b;
border-color: #444;
}
body.dark-mode details[open] {
background: #333;
}
body.dark-mode summary {
color: #ccc;
}
body.dark-mode summary:hover {
color: #6cb4ee;
}
body.dark-mode .nav-tabs > li > a {
color: #aaa;
}
body.dark-mode .nav-tabs > li.active > a,
body.dark-mode .nav-tabs > li > a:hover {
color: #fff;
background-color: #333;
border-color: #555;
}
body.dark-mode pre,
body.dark-mode .shiny-text-output {
background-color: #2b2b2b;
color: #e0e0e0;
border-color: #444;
}
body.dark-mode h4, body.dark-mode h5 {
color: #e0e0e0;
}
body.dark-mode .help-block {
color: #999;
}
body.dark-mode table {
color: #e0e0e0;
}
body.dark-mode table th {
background-color: #333 !important;
}
body.dark-mode table td {
border-color: #444 !important;
}
body.dark-mode hr {
border-color: #444;
}
/* Dark mode toggle button */
#dark_mode_btn {
position: fixed;
top: 8px;
right: 12px;
z-index: 10000;
font-size: 20px;
background: none;
border: 1px solid #888;
border-radius: 50%;
width: 36px;
height: 36px;
cursor: pointer;
padding: 0;
line-height: 34px;
text-align: center;
}
body:not(.dark-mode) #dark_mode_btn { color: #333; }
body.dark-mode #dark_mode_btn { color: #eee; border-color: #666; }
/* ── Light mode defaults ──────────────────────────── */
.timer-display {
font-size: 24px;
font-weight: bold;
color: #007bff;
text-align: center;
padding: 10px;
background: #f0f8ff;
border-radius: 5px;
margin: 10px 0;
}
#run_sim:disabled {
opacity: 0.6;
cursor: not-allowed;
}
details {
margin-bottom: 15px;
border: 1px solid #ddd;
border-radius: 4px;
padding: 10px;
background: #f8f9fa;
}
details[open] {
background: white;
}
summary {
font-weight: bold;
cursor: pointer;
padding: 5px;
color: #333;
user-select: none;
}
summary:hover {
color: #007bff;
}
details > *:not(summary) {
margin-top: 10px;
}
.progress-popup {
position: fixed;
top: 50%;
left: 50%;
transform: translate(-50%, -50%);
background: rgba(0, 0, 0, 0.8);
color: white;
padding: 20px;
border-radius: 10px;
z-index: 9999;
font-size: 18px;
min-width: 300px;
text-align: center;
}
")),
# Dark mode toggle script
tags$script(HTML("
document.addEventListener('DOMContentLoaded', function() {
// Respect OS preference on first load
if (window.matchMedia && window.matchMedia('(prefers-color-scheme: dark)').matches) {
document.body.classList.add('dark-mode');
}
// Restore saved preference
if (localStorage.getItem('rw-dark-mode') === 'true') {
document.body.classList.add('dark-mode');
} else if (localStorage.getItem('rw-dark-mode') === 'false') {
document.body.classList.remove('dark-mode');
}
});
function toggleDarkMode() {
document.body.classList.toggle('dark-mode');
var isDark = document.body.classList.contains('dark-mode');
localStorage.setItem('rw-dark-mode', isDark);
var btn = document.getElementById('dark_mode_btn');
if (btn) btn.textContent = isDark ? '\\u2600' : '\\u263E';
}
// JS-driven batch trigger: R sends 'batch_done' after each batch,
// JS waits 50ms (browser renders, handles clicks), then triggers
// next batch in R. This guarantees a true yield to the browser
// event loop between batches — invalidateLater() alone doesn't
// yield the WebR Worker thread.
$(document).on('shiny:connected', function() {
Shiny.addCustomMessageHandler('batch_done', function(msg) {
setTimeout(function() {
Shiny.setInputValue('next_batch', Math.random());
}, 50);
});
});
"))
),
# TOP SECTION: Run Button (always visible)
fluidRow(
column(12,
wellPanel(
style = "background-color: #f0f8ff;",
fluidRow(
column(6,
h5("Estimated Runtime:"),
uiOutput("runtime_estimate")
),
column(6,
uiOutput("run_button_ui")
)
)
)
)
),
hr(),
# MAIN SECTION: FULL-WIDTH TABSET
fluidRow(
column(12,
tabsetPanel(
id = "tabs",
# PAGE 1: Fractal Graph (Black Pixels)
tabPanel("Fractal Graph",
h4("Grid Visualization - Black Pixels"),
plotOutput("fractal_plot", height = "600px"),
tags$p(style = "margin-top: 10px; margin-bottom: 10px; color: #666; font-style: italic; text-align: center;",
textOutput("fractal_caption", inline = TRUE)),
tags$p(style = "margin-top: 10px; font-size: 12px; color: #666;",
"Right-click the plot image above to save it."),
hr(),
verbatimTextOutput("fractal_stats"),
hr(),
h5("Simulation Status:"),
verbatimTextOutput("status", placeholder = TRUE),
tags$div(
style = "background: #f0f0f0; padding: 10px; margin-top: 10px; font-family: monospace; font-size: 14px; border: 1px solid #ccc;",
h5("Live Progress:"),
verbatimTextOutput("progress_timer")
)),
# PAGE 2: Distributions (Path Lengths by Termination Reason)
tabPanel("Distributions",
h4("Path Length Distributions"),
plotOutput("dist_overall", height = "300px"),
h5("Overall Distribution"),
hr(),
plotOutput("dist_by_reason", height = "300px"),
h5("By Termination Reason")),
# PAGE 4: Statistics - Quintile Analysis
tabPanel("Statistics",
h4("Quintile-Based Statistics"),
radioButtons("stats_group_by", "Group walkers by:",
choices = c("Termination order" = "termination",
"Launch order" = "launch"),
selected = "termination", inline = TRUE),
helpText(textOutput("stats_group_desc", inline = TRUE)),
hr(),
h5("Path Length by Termination Quintile"),
plotOutput("stats_quintile_boxplot", height = "350px"),
hr(),
h5("Histogram Panels by Quintile"),
plotOutput("stats_quintile_histograms", height = "400px"),
hr(),
h5("Distribution Shape Comparison"),
fluidRow(
column(6, plotOutput("stats_violin", height = "300px")),
column(6, plotOutput("stats_trend", height = "300px"))
),
hr(),
h5("Summary Statistics by Quintile"),
verbatimTextOutput("stats_quintile_summary")),
# PAGE 5: Survival Curve
tabPanel("Survival Curve",
h4("Walker Survival Analysis"),
# Interactive slider for step threshold
sliderInput("survival_step", "Show survival at step:",
min = 0, max = 1000, value = 500, step = 50),
helpText("Drag to see what proportion of walkers survived to this step"),
# Main survival curve plot
plotOutput("survival_curve", height = "400px"),
hr(),
# Competing risks breakdown
h5("Termination by Reason"),
plotOutput("termination_breakdown", height = "250px"),
hr(),
# Summary statistics
verbatimTextOutput("survival_stats"),
hr(),
# Hypothesis Testing Section
h4("Hypothesis Test: Survival Decay"),
tags$p("Tests whether later walkers terminate faster as black pixels accumulate."),
# Hypothesis plot
plotOutput("hypothesis_plot", height = "350px"),
# Hypothesis statistics
verbatimTextOutput("hypothesis_stats")),
# PAGE 6: Debug Info (renumbered from PAGE 5)
tabPanel("Debug",
h4("Debug Information"),
h5("Package Versions"),
verbatimTextOutput("debug_versions"),
hr(),
h5("Current Inputs"),
verbatimTextOutput("debug_inputs"),
hr(),
h5("Backend Information"),
verbatimTextOutput("debug_backend"),
hr(),
h5("Walker Paths QA"),
verbatimTextOutput("debug_walker_qa"),
hr(),
h5("Periodic Updates"),
verbatimTextOutput("debug_periodic"),
hr(),
h5("Simulation Status:"),
verbatimTextOutput("status_debug", placeholder = TRUE),
tags$div(
style = "background: #f0f0f0; padding: 10px; margin-top: 10px; font-family: monospace; font-size: 14px; border: 1px solid #ccc;",
h5("Live Progress:"),
verbatimTextOutput("progress_timer_debug")
)),
# PAGE 7: Notes
tabPanel("Notes",
h4("About This Dashboard"),
tags$p("Interactive random walk fractal simulation running entirely in your browser via WebR/Shinylive. ",
"No server required — all computation happens in WebAssembly."),
hr(),
h4("Tips"),
tags$ul(
tags$li(tags$strong("Larger grid"), " (200-400): More exploration space, slower"),
tags$li(tags$strong("Fewer walkers"), " (100-500): Faster simulation"),
tags$li(tags$strong("8-hood"), ": Diagonal movement creates different fractal patterns"),
tags$li(tags$strong("Wrap boundary"), ": Toroidal grid (no edge termination)")
),
hr(),
h4("Browser Limitations"),
tags$ul(
tags$li("Single-threaded WebAssembly execution"),
tags$li("First load: 15-30s (WebR + package downloads)"),
tags$li("Default params (100×100, 200 walkers): ~30s"),
tags$li("Large sims (300×300, 10k walkers): several minutes"),
tags$li("For very large simulations, use native R with crew workers")
),
hr(),
h5("Vectorized Engine"),
tags$p("The simulation moves ALL active walkers simultaneously using matrix operations ",
"(10-50x faster than per-walker loops). Walker paths are not stored in this mode. ",
"Use native R for path visualization."),
hr(),
tags$a(href="https://johngavin.github.io/randomwalk/", "Documentation"),
tags$span(" | "),
tags$a(href="https://github.com/JohnGavin/randomwalk", "GitHub"))
) # End of tabs
) # End of column
), # End of fluidRow
hr(),
# BOTTOM SECTION: COLLAPSIBLE PARAMETER GROUPS
fluidRow(
column(12,
# Use Shiny's wellPanel with conditional rendering for collapsible sections
wellPanel(
actionButton("toggle_sim_params", "▶ Simulation Parameters",
style = "background: none; border: none; font-weight: bold; font-size: 16px; padding: 0; margin-bottom: 10px;"),
conditionalPanel(
condition = "output.show_sim_params",
fluidRow(
column(4,
h5("Grid Settings"),
sliderInput("grid_size", "Grid Size:",
min = 20, max = 400, value = 100, step = 20),
helpText("Size of the square grid (pixels per side)")
),
column(8,
h5("Walker Settings"),
sliderInput("n_walkers", "Number of Walkers:",
min = 1, max = 1000, value = 200, step = 50),
helpText(HTML("Number of walkers to simulate<br><em>Max: 70% of grid pixels (updates automatically)</em>")),
sliderInput("max_steps", "Max Steps per Walker:",
min = 100, max = 10000, value = 5000, step = 100),
helpText("Maximum steps before walker terminates")
)
)
)
),
wellPanel(
actionButton("toggle_move_params", "▶ Movement Settings",
style = "background: none; border: none; font-weight: bold; font-size: 16px; padding: 0; margin-bottom: 10px;"),
conditionalPanel(
condition = "output.show_move_params",
fluidRow(
column(6,
selectInput("neighborhood", "Neighborhood:",
choices = c("4-hood", "8-hood"),
selected = "4-hood"),
helpText("4-hood: up/down/left/right, 8-hood: includes diagonals")
),
column(6,
selectInput("boundary", "Boundary Behavior:",
choices = c("terminate", "wrap"),
selected = "terminate"),
helpText("terminate: stop at edges, wrap: toroidal topology")
)
)
)
),
wellPanel(
actionButton("toggle_validation_params", "▶ Advanced Settings",
style = "background: none; border: none; font-weight: bold; font-size: 16px; padding: 0; margin-bottom: 10px;"),
conditionalPanel(
condition = "output.show_validation_params",
fluidRow(
column(4,
selectInput("sync_mode", "Sync Mode:",
choices = c("static", "chunked"),
selected = "static"),
helpText("static: Frozen snapshots (~5% collision). chunked: Batched updates (~15% collision)")
),
column(4,
checkboxInput("validate_strict", "Strict Validation",
value = FALSE),
helpText("ON: Stop on isolated pixel. OFF: Warn and continue")
),
column(4,
sliderInput("validate_percent", "Validation %:",
min = 0, max = 20, value = 5, step = 1),
helpText("Check every N% of walkers (0 = off)")
)
)
)
)
)
) # End of parameter fluidRow
)
# ============================================================================
# Shiny Server
# ============================================================================
server <- function(input, output, session) {
# Dynamic walker constraint: Limit to 70% of grid pixels
observe({
max_walkers <- floor(0.7 * input$grid_size^2)
updateSliderInput(
session,
"n_walkers",
max = max_walkers,
value = min(input$n_walkers, max_walkers)
)
})
# Reactive values for simulation state and history
sim_result <- reactiveVal(NULL)
sim_count <- reactiveVal(0) # Count total simulations run
sim_state <- reactiveVal("idle") # States: idle, running, complete, error
sim_error_msg <- reactiveVal("") # Store actual error message for debugging
sim_start_time <- reactiveVal(NULL)
sim_end_time <- reactiveVal(NULL)
sim_current_step <- reactiveVal(0) # Track current simulation step
sim_completed_walkers <- reactiveVal(0) # Track completed walkers
sim_black_pixels <- reactiveVal(0) # Track black pixels
# Reactive values for BATCHED simulation state (non-blocking execution)
batch_grid <- reactiveVal(NULL)
batch_walkers <- reactiveVal(NULL)
batch_active <- reactiveVal(NULL)
batch_step_count <- reactiveVal(0L)
batch_term_counter <- reactiveVal(0L)
# Reactive values for collapsible panels
show_sim_params <- reactiveVal(FALSE)
show_move_params <- reactiveVal(FALSE)
show_validation_params <- reactiveVal(FALSE)
# Toggle simulation parameters panel
observeEvent(input$toggle_sim_params, {
current <- show_sim_params()
show_sim_params(!current)
# Update button text
updateActionButton(session, "toggle_sim_params",
label = ifelse(!current, "▼ Simulation Parameters", "▶ Simulation Parameters"))
})
# Toggle movement settings panel
observeEvent(input$toggle_move_params, {
current <- show_move_params()
show_move_params(!current)
# Update button text
updateActionButton(session, "toggle_move_params",
label = ifelse(!current, "▼ Movement Settings", "▶ Movement Settings"))
})
# Toggle validation settings panel
observeEvent(input$toggle_validation_params, {
current <- show_validation_params()
show_validation_params(!current)
# Update button text
updateActionButton(session, "toggle_validation_params",
label = ifelse(!current, "▼ Validation Settings", "▶ Validation Settings"))
})
# Output for conditional panels
output$show_sim_params <- reactive({ show_sim_params() })
output$show_move_params <- reactive({ show_move_params() })
output$show_validation_params <- reactive({ show_validation_params() })
outputOptions(output, "show_sim_params", suspendWhenHidden = FALSE)
outputOptions(output, "show_move_params", suspendWhenHidden = FALSE)
outputOptions(output, "show_validation_params", suspendWhenHidden = FALSE)
# Runtime estimate (WebR performance varies: ~50-500 steps/sec depending on grid size & walker count)
output$runtime_estimate <- renderUI({
# Runtime calculation considers BOTH factors:
# 1. Simulation steps = max_steps (all walkers move simultaneously each step)
# 2. Per-step cost increases with more walkers due to collision checks & neighbor lookups
#
# Total cost = max_steps × (base_per_step_cost + walker_scaling × n_walkers)
# Rearranged: effective_steps_per_sec = base_steps_per_sec / (1 + walker_scaling × n_walkers)
grid_area <- input$grid_size^2
# Empirical base performance model (1 walker) based on grid size:
# Small grids (≤100x100): ~300 steps/sec
# Medium grids (100-200): ~150 steps/sec
# Large grids (>200): ~75 steps/sec
if (grid_area <= 10000) {
base_steps_per_sec <- 300
} else if (grid_area <= 40000) {
base_steps_per_sec <- 150
} else {
base_steps_per_sec <- 75
}
# Walker scaling factor: each walker adds ~0.2% overhead per step
# (collision checks, neighbor lookups, state updates scale with active walkers)
walker_scaling <- 0.002
# Effective throughput accounting for both factors
effective_steps_per_sec <- base_steps_per_sec / (1 + walker_scaling * input$n_walkers)
# Total simulation time
total_steps <- input$max_steps
est_seconds <- total_steps / effective_steps_per_sec
if (est_seconds < 60) {
est_text <- paste0("~", format_duration(est_seconds))
color <- "green"
} else if (est_seconds < 300) {
est_text <- paste0("~", format_duration(est_seconds))
color <- "orange"
} else {
est_text <- paste0("~", format_duration(est_seconds), " (consider smaller params)")
color <- "red"
}
# Calculate total walker steps for reference
total_walker_steps <- input$n_walkers * input$max_steps
tags$div(
style = paste0("color: ", color, "; font-weight: bold;"),
est_text,
tags$br(),
tags$small(style = "color: gray;",
sprintf("Max steps: %s | Walkers: %s\n(%sK total walker-steps, ~%.0f steps/sec effective)",
format(input$max_steps, big.mark=","),
format(input$n_walkers, big.mark=","),
format(round(total_walker_steps/1000), big.mark=","),
effective_steps_per_sec))
)
})
# Reactive timer for periodic UI refresh (progress display, debug tab)
autoInvalidate <- reactiveTimer(500) # Update displays every 500ms
# Status output — updates reactively as batch_* values change
output$status <- renderText({
if (sim_state() == "running" && !is.null(sim_start_time())) {
elapsed <- as.numeric(difftime(Sys.time(), sim_start_time(), units = "secs"))
n_active <- length(batch_active())
progress <- if (input$n_walkers > 0) {
round(100 * sim_completed_walkers() / input$n_walkers)
} else 0
paste0(
"SIMULATION RUNNING...\n",
"Run #", sim_count(), "\n",
"━━━━━━━━━━━━━━━━━━━━━━\n",
"Started: ", format(sim_start_time(), "%H:%M:%S"), "\n",
"Elapsed: ", format_duration(elapsed), "\n",
"Progress: ", progress, "%\n",
"━━━━━━━━━━━━━━━━━━━━━━\n",
"Grid: ", input$grid_size, "×", input$grid_size, "\n",
"Walkers: ", sim_completed_walkers(), "/", input$n_walkers,
" (", n_active, " active)\n",
"Black Pixels: ", sim_black_pixels(), "\n",
"Step: ", sim_current_step(), "\n",
"Workers: 0 (batched sequential)"
)
} else if (sim_state() == "complete" && !is.null(sim_result())) {
result <- sim_result()
elapsed <- as.numeric(difftime(sim_end_time(), sim_start_time(), units = "secs"))
paste0(
"SIMULATION COMPLETE\n",
"Run #", sim_count(), "\n",
"━━━━━━━━━━━━━━━━━━━━━━\n",
"Started: ", format(sim_start_time(), "%H:%M:%S"), "\n",
"Finished: ", format(sim_end_time(), "%H:%M:%S"), "\n",
"Elapsed: ", format_duration(elapsed), "\n",
"━━━━━━━━━━━━━━━━━━━━━━\n",
"Backend: batched sequential (WebR browser)\n",
"Black Pixels: ", result$statistics$black_pixels, "\n",
"Walkers: ", result$statistics$completed_walkers, " completed"
)
} else if (sim_state() == "error") {
paste0("SIMULATION ERROR\n━━━━━━━━━━━━━━━━━━━━━━\n", sim_error_msg(),
"\n━━━━━━━━━━━━━━━━━━━━━━\nPlease try again with different parameters.")
} else {
"Ready to run simulation..."
}
})
# Real-time progress timer — now updates accurately because simulation
# yields to the event loop between batches (non-blocking execution)
output$progress_timer <- renderText({
autoInvalidate()
if (sim_state() == "running") {
elapsed <- if (!is.null(sim_start_time())) {
round(as.numeric(difftime(Sys.time(), sim_start_time(), units = "secs")), 1)
} else { 0 }
sprintf("⏱ Time: %s | Walkers: %d/%d | Black: %d | Step: %d",
format_duration(elapsed),
sim_completed_walkers(), input$n_walkers,
sim_black_pixels(), sim_current_step())
} else if (sim_state() == "complete" && !is.null(sim_result())) {
result <- sim_result()
sprintf("Done | Black: %d | Grid: %d%%",
result$statistics$black_pixels,
round(result$statistics$black_percentage))
} else {
sprintf("Ready | %s", format(Sys.time(), "%H:%M:%S"))
}
})
# Duplicate outputs for Debug tab (Shiny requires unique output IDs)
output$status_debug <- renderText({
autoInvalidate() # Refresh periodically for elapsed time
if (sim_state() == "running") {
elapsed <- if (!is.null(sim_start_time())) {
as.numeric(difftime(Sys.time(), sim_start_time(), units = "secs"))
} else { 0 }
paste0(
"SIMULATION RUNNING...\n",
"Run #", sim_count(), "\n",
"Started: ", format(sim_start_time(), "%H:%M:%S"), "\n",
"Elapsed: ", format_duration(elapsed), "\n",
"Walkers: ", sim_completed_walkers(), "/", input$n_walkers, "\n",
"Black: ", sim_black_pixels(), " | Step: ", sim_current_step()
)
} else if (sim_state() == "complete" && !is.null(sim_result())) {
result <- sim_result()
paste0(
"SIMULATION COMPLETE\n",
"Run #", sim_count(), "\n",
"Black pixels: ", result$statistics$black_pixels, "\n",
"Elapsed: ", format_duration(result$statistics$elapsed_time_secs)
)
} else if (sim_state() == "error") {
"SIMULATION ERROR"
} else {
"Ready to run simulation..."
}
})
output$progress_timer_debug <- renderText({
autoInvalidate() # Use the reactive timer
if (sim_state() == "running") {
elapsed <- if (!is.null(sim_start_time())) {
round(as.numeric(difftime(Sys.time(), sim_start_time(), units = "secs")), 1)
} else { 0 }
sprintf("⏱️ Time: %s | Walkers: %d/%d | Black: %d",
format_duration(elapsed),
sim_completed_walkers(), input$n_walkers,
sim_black_pixels())
} else if (sim_state() == "complete" && !is.null(sim_result())) {
result <- sim_result()
sprintf("✓ Complete | Black: %d | Grid: %d%%",
result$statistics$black_pixels,
round(result$statistics$black_percentage))
} else {
sprintf("Ready | %s", format(Sys.time(), "%H:%M:%S"))
}
})
# Render button with walker/pixel counts
output$run_button_ui <- renderUI({
if (sim_state() == "running") {
# Reactive values update automatically between batches — no polling needed
actionButton("run_sim_disabled",
sprintf("Running... W: %d/%d | B: %d",
sim_completed_walkers(), input$n_walkers,
sim_black_pixels()),
class = "btn-warning btn-lg",
style = "width: 100%; font-size: 14px;",
disabled = TRUE)
} else if (sim_state() == "complete" && !is.null(sim_result())) {
# Show walker count and black pixel count when complete
result <- sim_result()
total_secs <- as.numeric(difftime(sim_end_time(), sim_start_time(), units = "secs"))
mins <- floor(total_secs / 60)
secs <- floor(total_secs %% 60)
# Get walker and black pixel counts
walker_count <- result$statistics$completed_walkers
black_count <- result$statistics$black_pixels
actionButton("run_sim", sprintf("Run Simulation (Walkers: %d. Black: %d. Time: %02d:%02d)",
walker_count, black_count, mins, secs),
class = "btn-success btn-lg",
style = "width: 100%;")
} else if (sim_state() == "error") {
actionButton("run_sim", "Run Simulation (Error - Try Again)",
class = "btn-danger btn-lg",
style = "width: 100%;")
} else {
actionButton("run_sim", "Run Simulation",
class = "btn-primary btn-lg",
style = "width: 100%;")
}
})
# Run simulation when button clicked — INITIALIZE only (non-blocking)
# Uses VECTORIZED state: matrices instead of walker lists for 10-50x speed.
observeEvent(input$run_sim, {
max_allowed <- floor(0.7 * input$grid_size^2)
if (input$n_walkers > max_allowed) { sim_state("error"); return() }
sim_state("running")
sim_start_time(Sys.time())
sim_count(sim_count() + 1)
sim_current_step(0); sim_completed_walkers(0); sim_black_pixels(0)
tryCatch({
gs <- input$grid_size
nw <- input$n_walkers
grid <- initialize_grid(gs)
# Vectorized state: N×2 position matrix + vectors
positions <- generate_walker_positions(nw, grid)
pos_mat <- do.call(rbind, positions) # N×2 integer matrix
steps_vec <- integer(nw)
active_vec <- rep(TRUE, nw)
reason_vec <- character(nw)
order_vec <- integer(nw)
# Padded grid for boundary-free neighbor lookups
padded <- matrix(0L, nrow = gs + 2L, ncol = gs + 2L)
padded[2:(gs+1), 2:(gs+1)] <- grid
batch_grid(grid)
batch_walkers(list( # store as vectorized structure
pos_mat = pos_mat, steps_vec = steps_vec,
active_vec = active_vec, reason_vec = reason_vec,
order_vec = order_vec, padded = padded
))
batch_active(which(active_vec))
batch_step_count(0L)
batch_term_counter(0L)
}, error = function(e) {
sim_error_msg(paste("Init error:", conditionMessage(e)))
message(paste("INIT ERROR:", conditionMessage(e)))
sim_state("error")
})
})
# === VECTORIZED BATCHED SIMULATION (non-blocking via JS round-trip) ===
# Moves ALL active walkers simultaneously using matrix ops.
# ~10-50x faster than per-walker R loops.
observe({
req(sim_state() == "running")
req(!is.null(batch_grid()))
invalidateLater(200)
isolate({
if (batch_step_count() == 0L)
session$sendCustomMessage("batch_done", list(kick = TRUE))
})
})
observeEvent(input$next_batch, {
req(sim_state() == "running")
req(!is.null(batch_grid()))
grid <- batch_grid()
st <- batch_walkers() # vectorized state
pos_mat <- st$pos_mat; steps_vec <- st$steps_vec
active_vec <- st$active_vec; reason_vec <- st$reason_vec
order_vec <- st$order_vec; padded <- st$padded
step_count <- batch_step_count()
term_counter <- batch_term_counter()
gs <- input$grid_size
max_steps <- input$max_steps
is_4hood <- (input$neighborhood == "4-hood")
is_wrap <- (input$boundary == "wrap")
# Direction deltas (pre-computed)
if (is_4hood) {
DR <- c(-1L, 1L, 0L, 0L); DC <- c(0L, 0L, 1L, -1L); nd <- 4L
} else {
DR <- c(-1L,1L,0L,0L,-1L,-1L,1L,1L); DC <- c(0L,0L,1L,-1L,-1L,1L,-1L,1L); nd <- 8L
}
# Adaptive batch: ~200k walker-steps per batch for large sims
n_active <- sum(active_vec)
STEPS <- max(10L, as.integer(200000 / max(1L, n_active)))
tryCatch({
for (b in seq_len(STEPS)) {
idx <- which(active_vec)
na <- length(idx)
if (na == 0L) break
step_count <- step_count + 1L
# 1. Random directions for ALL active walkers (one C call)
dirs <- sample.int(nd, na, replace = TRUE)
new_r <- pos_mat[idx, 1] + DR[dirs]
new_c <- pos_mat[idx, 2] + DC[dirs]
# 2. Boundary handling (vectorized)
if (is_wrap) {
new_r <- ((new_r - 1L) %% gs) + 1L
new_c <- ((new_c - 1L) %% gs) + 1L
} else {
oob <- new_r < 1L | new_r > gs | new_c < 1L | new_c > gs
if (any(oob)) {
oob_idx <- idx[oob]
active_vec[oob_idx] <- FALSE
reason_vec[oob_idx] <- "hit_boundary"
steps_vec[oob_idx] <- steps_vec[oob_idx] + 1L
}
# Continue with in-bounds walkers
inb <- !oob
idx <- idx[inb]; new_r <- new_r[inb]; new_c <- new_c[inb]
}
if (length(idx) == 0L) next
# 3. Update positions + step counts
pos_mat[idx, 1] <- new_r
pos_mat[idx, 2] <- new_c
steps_vec[idx] <- steps_vec[idx] + 1L
# 4. Check ON black pixel (vectorized grid lookup)
on_black <- grid[cbind(new_r, new_c)] == 1L
if (any(on_black)) {
tb_idx <- idx[on_black]
active_vec[tb_idx] <- FALSE
reason_vec[tb_idx] <- "touched_black"
}
# 5. Check black NEIGHBOR using padded grid (no bounds checks)
still <- idx[!on_black & active_vec[idx]]
if (length(still) > 0L) {
pr <- pos_mat[still, 1] + 1L # offset for padding
pc <- pos_mat[still, 2] + 1L
if (is_4hood) {
has_bn <- padded[cbind(pr-1L,pc)] == 1L | padded[cbind(pr+1L,pc)] == 1L |
padded[cbind(pr,pc-1L)] == 1L | padded[cbind(pr,pc+1L)] == 1L
} else {
has_bn <- padded[cbind(pr-1L,pc)] == 1L | padded[cbind(pr+1L,pc)] == 1L |
padded[cbind(pr,pc-1L)] == 1L | padded[cbind(pr,pc+1L)] == 1L |
padded[cbind(pr-1L,pc-1L)] == 1L | padded[cbind(pr-1L,pc+1L)] == 1L |
padded[cbind(pr+1L,pc-1L)] == 1L | padded[cbind(pr+1L,pc+1L)] == 1L
}
if (any(has_bn)) {
bn_idx <- still[has_bn]
active_vec[bn_idx] <- FALSE
reason_vec[bn_idx] <- "black_neighbor"
# Paint pixels + update padded grid
br <- pos_mat[bn_idx, 1]; bc <- pos_mat[bn_idx, 2]
grid[cbind(br, bc)] <- 1L
padded[cbind(br + 1L, bc + 1L)] <- 1L # offset for padding
}
}
# 6. Max steps check
ms_hit <- active_vec[idx] & steps_vec[idx] >= max_steps
if (any(ms_hit)) {
ms_idx <- idx[ms_hit]
active_vec[ms_idx] <- FALSE
reason_vec[ms_idx] <- "max_steps"
}
# 7. Assign termination order to newly terminated walkers
newly_dead <- idx[!active_vec[idx] & order_vec[idx] == 0L]
if (length(newly_dead) > 0L) {
new_orders <- seq(term_counter + 1L, term_counter + length(newly_dead))
order_vec[newly_dead] <- new_orders
term_counter <- term_counter + length(newly_dead)
}
}
# Update batch state
batch_grid(grid)
batch_walkers(list(
pos_mat = pos_mat, steps_vec = steps_vec,
active_vec = active_vec, reason_vec = reason_vec,
order_vec = order_vec, padded = padded
))
batch_active(which(active_vec))
batch_step_count(step_count)
batch_term_counter(term_counter)
n_done <- sum(!active_vec)
sim_completed_walkers(n_done)
sim_black_pixels(sum(grid == 1L))
sim_current_step(step_count)
# Complete or request next batch via JS round-trip
if (all(!active_vec)) {
sim_end_time(Sys.time())
elapsed <- as.numeric(difftime(sim_end_time(), sim_start_time(), units = "secs"))
nw <- input$n_walkers
# Build walker list from vectorized state (for downstream plots)
walkers <- lapply(seq_len(nw), function(i) {
list(id = i, pos = pos_mat[i, ], steps = steps_vec[i],
active = FALSE, termination_reason = reason_vec[i],
termination_order = order_vec[i],
path = NULL, store_path = FALSE)
})
result <- list(
grid = grid,
walkers = walkers,
statistics = list(
black_pixels = sum(grid == 1L),
black_percentage = round(100 * sum(grid == 1L) / (gs^2), 2),
grid_size = gs,
total_walkers = nw,
completed_walkers = nw,
total_steps = sum(steps_vec),
min_steps = min(steps_vec),
max_steps = max(steps_vec),
mean_steps = mean(steps_vec),
median_steps = median(steps_vec),
percentile_25 = quantile(steps_vec, 0.25),
percentile_75 = quantile(steps_vec, 0.75),
elapsed_time_secs = elapsed,
termination_reasons = table(reason_vec)
),
parameters = list(
grid_size = gs, n_walkers = nw,
neighborhood = input$neighborhood,
boundary = input$boundary,
workers = 0L, max_steps = max_steps
)
)
sim_result(result)
sim_state("complete")
message(sprintf("=== SIMULATION COMPLETE === Black: %d, Steps: %d, Time: %s",
sum(grid == 1L), step_count, format_duration(elapsed)))
} else {
# Tell JS we're done with this batch — JS will setTimeout(50)
# then send next_batch back, guaranteeing a browser yield.
session$sendCustomMessage("batch_done", list(step = step_count))
}
}, error = function(e) {
sim_error_msg(paste("Batch error:", conditionMessage(e)))
message(sprintf("Simulation error: %s", conditionMessage(e)))
sim_state("error")
sim_end_time(Sys.time())
})
}, ignoreInit = TRUE)
# PAGE 1: Fractal Graph with arrival time coloring
output$fractal_plot <- renderPlot({
# If simulation is running, show live progress in plot area
if (sim_state() == "running") {
autoInvalidate() # Refresh with timer
par(bg = "gray70", mar = c(2, 2, 3, 2))
plot(1, type = "n", xlim = c(0, 1), ylim = c(0, 1),
xlab = "", ylab = "", axes = FALSE,
main = "Simulation Running...")
progress_pct <- if (input$n_walkers > 0) {
round(100 * sim_completed_walkers() / input$n_walkers)
} else 0
text(0.5, 0.7, sprintf("Walkers: %d / %d (%d%%)",
sim_completed_walkers(), input$n_walkers, progress_pct),
cex = 2, font = 2)
text(0.5, 0.5, sprintf("Black pixels: %d", sim_black_pixels()),
cex = 2, font = 2)
elapsed <- if (!is.null(sim_start_time())) {
as.numeric(difftime(Sys.time(), sim_start_time(), units = "secs"))
} else { 0 }
text(0.5, 0.3, sprintf("Time: %s | Step: %d",
format_duration(elapsed), sim_current_step()),
cex = 1.5)
return()
}
req(sim_result())
result <- sim_result()
# Defensive checks for WebR environment (Issue #157)
req(!is.null(result$grid))
req(nrow(result$grid) > 0)
req(sum(result$grid == 1) > 0) # Ensure has black pixels
# Use enhanced plot with color-coded arrival times (with device error handling)
tryCatch({
p <- plot_grid_enhanced(result,
quantiles = 5,
color_scheme = "viridis")
p
}, error = function(e) {
# Fallback for WebR device issues
par(bg = "gray70", mar = c(2, 2, 3, 2))
image(result$grid, col = c("gray60", "black"),
main = sprintf("DLA Fractal: %d black pixels", sum(result$grid == 1)),
axes = FALSE)
})
})
# Display the caption separately
output$fractal_caption <- renderText({
req(sim_result())
result <- sim_result()
# Generate the plot to get the caption
p <- plot_grid_enhanced(result,
quantiles = 5,
color_scheme = "viridis")
# Extract and return the caption
caption <- attr(p, "caption")
if (!is.null(caption) && caption != "") {
caption
} else {
""
}
})
output$fractal_stats <- renderText({
req(sim_result())
stats <- sim_result()$statistics
paste0(
"Black Pixels: ", stats$black_pixels,
" (", sprintf("%d%%", round(stats$black_percentage)), " of grid)\n",
"Grid Size: ", stats$grid_size, "×", stats$grid_size,
" (", stats$grid_size^2, " total cells)"
)
})
# Note: downloadHandler doesn't work in Shinylive/WebR (no filesystem).
# Users can right-click the rendered plot to save it.
# PAGE 2: Walker Paths
output$paths_plot_first25 <- renderPlot({
req(sim_result())
result <- sim_result()
n_walkers <- length(result$walkers)
if (n_walkers >= 1) {
first_n <- min(input$first_n_paths, n_walkers)
last_n <- min(input$last_n_paths, n_walkers)
# CRITICAL FIX: Only select from walkers that HAVE paths stored
# Paths are only stored for BLACK_NEIGHBOR terminators (walkers that found the fractal)
# Boundary walkers terminate quickly but don't have paths - skip them
# Filter to walkers with paths first
walkers_with_paths <- Filter(function(w) {
!is.null(w$path) && length(w$path) > 0
}, result$walkers)
n_with_paths <- length(walkers_with_paths)
if (n_with_paths == 0) {
plot.new()
text(0.5, 0.5, paste0(
"Walker paths not available in vectorized mode.\n",
"The simulation uses matrix operations for speed\n",
"(10-50x faster) which don't store individual paths.\n\n",
"Walkers: ", n_walkers, " | With paths: 0\n",
"Use native R (not WebR) for path visualization."
), cex = 1.0, col = "gray30")
return()
}
# Sort by termination order (among walkers with paths)
walkers_ordered <- walkers_with_paths[order(sapply(walkers_with_paths, function(w) {
if (!is.null(w$termination_order)) w$termination_order else w$id
}))]
# Select first N and last N from walkers WITH PATHS
first_n <- min(first_n, n_with_paths)
last_n <- min(last_n, n_with_paths)
walker_indices <- unique(c(
if(first_n > 0) 1:first_n else NULL,
if(last_n > 0) (n_with_paths - last_n + 1):n_with_paths else NULL
))
if (length(walker_indices) > 0) {
# Plot only selected walkers' paths
filtered_walkers <- walkers_ordered[walker_indices]
# Create custom plot with better visibility
grid_size <- result$parameters$grid_size
# Create plot with gray background for contrast
par(bg = "gray70")
plot(1, type = "n", xlim = c(1, grid_size), ylim = c(1, grid_size),
xlab = "", ylab = "",
main = paste(length(walker_indices), "of", n_with_paths, "Fractal-Finding Walkers (by termination order)"),
asp = 1, col.main = "black", col.lab = "black", col.axis = "black")
# Add subtle grid for visibility
grid(nx = grid_size, ny = grid_size, col = "gray70", lty = 1, lwd = 0.3)
# Create STABLE color mapping based on termination order (not position)
distinct_colors <- c("red", "blue", "darkgreen", "purple", "orange",
"brown", "deeppink", "darkcyan", "darkmagenta", "darkblue",
"darkred", "forestgreen", "black", "goldenrod", "darkviolet")
# Map each walker to a consistent color based on their termination order
# This ensures walker #20 always gets the same color regardless of selection
color_map <- list()
for (i in seq_along(walkers_ordered)) {
term_order <- walkers_ordered[[i]]$termination_order
# Use modulo to cycle through colors if more walkers than colors
color_index <- ((term_order - 1) %% length(distinct_colors)) + 1
color_map[[as.character(term_order)]] <- distinct_colors[color_index]
}
# Collect all paths with STABLE colors
all_paths <- list()
all_starts <- list()
all_ends <- list()
for (i in seq_along(filtered_walkers)) {
walker <- filtered_walkers[[i]]
# Get stable color for this walker based on termination order
walker_color <- color_map[[as.character(walker$termination_order)]]
# Check if path exists and is not empty
if (!is.null(walker$path) && length(walker$path) > 0) {
path_matrix <- do.call(rbind, walker$path)
# Use walker termination order as key to ensure uniqueness
key <- paste0("walker_", walker$termination_order)
all_paths[[key]] <- list(
x = path_matrix[, 2],
y = path_matrix[, 1],
col = walker_color
)
all_starts[[key]] <- list(
x = path_matrix[1, 2],
y = path_matrix[1, 1],
col = walker_color
)
}
# Always mark end position
if (!is.null(walker$pos)) {
key <- paste0("walker_", walker$termination_order)
all_ends[[key]] <- list(
x = walker$pos[2],
y = walker$pos[1],
col = walker_color
)
}
}
# Draw all paths
for (path_data in all_paths) {
if (!is.null(path_data)) {
points(path_data$x, path_data$y,
pch = 16, col = path_data$col, cex = 0.8)
}
}
# Draw all start positions
for (start_data in all_starts) {
if (!is.null(start_data)) {
points(start_data$x, start_data$y,
pch = 21, bg = start_data$col, col = "black", cex = 2, lwd = 2)
}
}
# Draw all end positions
for (end_data in all_ends) {
if (!is.null(end_data)) {
points(end_data$x, end_data$y,
pch = 22, bg = end_data$col, col = "black", cex = 2.5, lwd = 2)
}
}
# Caption moved to separate textOutput below plot
} else {
plot.new()
text(0.5, 0.5, "No walkers selected")
}
} else {
plot.new()
text(0.5, 0.5, "No walkers available")
}
})
# Caption for Walker Paths plot
output$paths_caption <- renderText({
"Symbols: Circle = Start | Square = End | Dots = Path. Colors by termination order."
})
# PAGE 3: Distributions
output$dist_overall <- renderPlot({
req(sim_result())
result <- sim_result()
# Set gray background
par(bg = "gray70")
# Defensive check for walkers
if (is.null(result$walkers) || length(result$walkers) == 0) {
plot.new()
text(0.5, 0.5, "Run a simulation first", cex = 1.5, col = "gray")
return()
}
# Extract path lengths safely
# NOTE: walker$path is a LIST of positions, not a matrix
# Use walker$steps for accurate step count
path_lengths <- tryCatch({
sapply(result$walkers, function(w) {
if (!is.null(w$steps)) {
w$steps
} else {
NA
}
})
}, error = function(e) {
numeric(0)
})
# Remove NAs and ensure numeric type
path_lengths <- as.numeric(path_lengths[!is.na(path_lengths)])
if (length(path_lengths) == 0 || !is.numeric(path_lengths)) {
plot.new()
text(0.5, 0.5, "No valid path data available", cex = 1.5, col = "gray")
return()
}
# Need at least 2 values for meaningful distribution
if (length(path_lengths) < 2) {
plot.new()
text(0.5, 0.5, paste0("Only ", length(path_lengths), " path - need at least 2"),
cex = 1.2, col = "gray")
return()
}
# Plot histogram with error handling
tryCatch({
hist(path_lengths,
breaks = min(30, max(5, length(unique(path_lengths)))),
col = "steelblue",
border = "white",
main = "Overall Path Length Distribution",
xlab = "Path Length (steps)",
ylab = "Frequency")
abline(v = median(path_lengths), col = "red", lwd = 2, lty = 2)
legend("topright",
legend = c(paste("Median:", median(path_lengths)),
paste("Mean:", sprintf("%.1f", mean(path_lengths)))),
col = c("red", "black"),
lty = c(2, 1),
lwd = 2)
}, error = function(e) {
plot.new()
text(0.5, 0.5, paste0("Error creating plot:\n", e$message), cex = 1, col = "red")
})
})
output$dist_by_reason <- renderPlot({
req(sim_result())
result <- sim_result()
# Defensive check for walkers
if (is.null(result$walkers) || length(result$walkers) == 0) {
plot.new()
text(0.5, 0.5, "Run a simulation first", cex = 1.5, col = "gray")
return()
}
# Extract termination reasons and path lengths safely
# NOTE: walker$path is a LIST, not a matrix - use walker$steps
path_lengths <- tryCatch({
sapply(result$walkers, function(w) {
if (!is.null(w$steps)) w$steps else NA
})
}, error = function(e) numeric(0))
reasons <- tryCatch({
sapply(result$walkers, function(w) {
if (!is.null(w$termination_reason)) w$termination_reason else "unknown"
})
}, error = function(e) character(0))
# Remove NAs and ensure same length
valid_idx <- !is.na(path_lengths)
path_lengths <- as.numeric(path_lengths[valid_idx])
reasons <- as.character(reasons[valid_idx])
# Defensive check: ensure vectors are same length
min_len <- min(length(path_lengths), length(reasons))
if (min_len < length(path_lengths) || min_len < length(reasons)) {
path_lengths <- path_lengths[1:min_len]
reasons <- reasons[1:min_len]
}
# Check if we have valid data
if (length(path_lengths) == 0 || length(reasons) == 0 ||
!is.numeric(path_lengths) || !is.character(reasons)) {
plot.new()
text(0.5, 0.5, "No valid termination data available", cex = 1.5, col = "gray")
return()
}
# Need at least 2 data points
if (length(path_lengths) < 2) {
plot.new()
text(0.5, 0.5, "Need at least 2 walkers for distribution", cex = 1.2, col = "gray")
return()
}
# Create data frame with error handling
walkers_data <- tryCatch({
data.frame(
path_length = path_lengths,
reason = reasons,
stringsAsFactors = FALSE
)
}, error = function(e) {
NULL
})
if (is.null(walkers_data)) {
plot.new()
text(0.5, 0.5, "Error creating data frame", cex = 1.2, col = "red")
return()
}
# Plot boxplot by termination reason with error handling
tryCatch({
print(
ggplot(walkers_data, aes(x = reason, y = path_length, fill = reason)) +
geom_boxplot(alpha = 0.7) +
geom_jitter(width = 0.2, alpha = 0.3) +
labs(title = "Path Lengths by Termination Reason",
x = "Termination Reason",
y = "Path Length (steps)") +
theme_minimal() +
theme(legend.position = "none",
panel.background = element_rect(fill = "gray70"),
plot.background = element_rect(fill = "gray70"))
)
}, error = function(e) {
plot.new()
text(0.5, 0.5, paste0("Error creating plot:\n", e$message), cex = 1, col = "red")
})
})
# PAGE 4: Statistics - Quintile-based Analysis
# Returns data with both termination and launch quintiles
get_quintile_data <- reactive({
req(sim_result())
result <- sim_result()
steps <- sapply(result$walkers, function(w) w$steps)
term_order <- sapply(result$walkers, function(w) w$termination_order)
reasons <- sapply(result$walkers, function(w) w$termination_reason)
launch_order <- sapply(result$walkers, function(w) w$id)
df <- data.frame(steps = steps, termination_order = term_order,
launch_order = launch_order,
reason = reasons, stringsAsFactors = FALSE)
n <- nrow(df)
# Termination quintiles
df <- df[order(df$termination_order), ]
df$term_quintile <- factor(paste0("Q", ceiling(seq_len(n) / n * 5)),
levels = paste0("Q", 1:5))
# Launch quintiles (walker index IS launch order)
df <- df[order(df$launch_order), ]
df$launch_quintile <- factor(paste0("Q", ceiling(seq_len(n) / n * 5)),
levels = paste0("Q", 1:5))
# Active column based on toggle
grp <- input$stats_group_by
df$quintile <- if (identical(grp, "launch")) df$launch_quintile else df$term_quintile
df
})
# Dynamic description based on toggle
output$stats_group_desc <- renderText({
if (identical(input$stats_group_by, "launch")) {
"Q1 = first 20% launched (fewer black pixels on grid), Q5 = last 20% launched (more black pixels)."
} else {
"Q1 = first 20% to terminate (found black quickly), Q5 = last 20% to terminate (wandered longest)."
}
})
# Boxplot by quintile
output$stats_quintile_boxplot <- renderPlot({
req(sim_result())
df <- get_quintile_data()
if (is.null(df) || nrow(df) < 4) {
plot.new()
text(0.5, 0.5, "Need at least 4 walkers for quintile analysis", cex = 1.2, col = "gray")
return()
}
tryCatch({
print(
ggplot(df, aes(x = quintile, y = steps)) +
geom_boxplot(fill = "steelblue", alpha = 0.7, outlier.shape = 21) +
geom_jitter(width = 0.15, alpha = 0.3, size = 1) +
labs(
title = "Path Length Distribution by Termination Quintile",
subtitle = "Q1 = earliest terminators, Q4 = latest terminators",
x = "Termination Quintile",
y = "Path Length (steps)"
) +
theme_minimal(base_size = 12) +
theme(legend.position = "none",
axis.text.x = element_text(angle = 15, hjust = 1),
panel.background = element_rect(fill = "gray70"),
plot.background = element_rect(fill = "gray70"))
)
}, error = function(e) {
plot.new()
text(0.5, 0.5, paste0("Error: ", e$message), cex = 1, col = "red")
})
})
# Histogram panels by quintile
output$stats_quintile_histograms <- renderPlot({
req(sim_result())
df <- get_quintile_data()
if (is.null(df) || nrow(df) < 4) {
plot.new()
text(0.5, 0.5, "Need at least 4 walkers for quintile analysis", cex = 1.2, col = "gray")
return()
}
tryCatch({
print(
ggplot(df, aes(x = steps)) +
geom_histogram(bins = 20, fill = "steelblue", alpha = 0.8, color = "white") +
facet_wrap(~ quintile, scales = "free_y", ncol = 2) +
labs(
title = "Path Length Histograms by Termination Quintile",
x = "Path Length (steps)",
y = "Count"
) +
theme_minimal(base_size = 11) +
theme(legend.position = "none",
strip.text = element_text(face = "bold"),
panel.background = element_rect(fill = "gray70"),
plot.background = element_rect(fill = "gray70"))
)
}, error = function(e) {
plot.new()
text(0.5, 0.5, paste0("Error: ", e$message), cex = 1, col = "red")
})
})
# Violin plot for distribution shape comparison
output$stats_violin <- renderPlot({
req(sim_result())
df <- get_quintile_data()
if (is.null(df) || nrow(df) < 4) {
plot.new()
text(0.5, 0.5, "Need at least 4 walkers", cex = 1.2, col = "gray")
return()
}
tryCatch({
print(
ggplot(df, aes(x = quintile, y = steps)) +
geom_violin(fill = "steelblue", alpha = 0.6, trim = FALSE) +
geom_boxplot(width = 0.15, fill = "white", alpha = 0.8) +
labs(
title = "Distribution Shape by Quintile",
x = "Termination Quintile",
y = "Path Length (steps)"
) +
theme_minimal(base_size = 11) +
theme(axis.text.x = element_text(angle = 15, hjust = 1),
panel.background = element_rect(fill = "gray70"),
plot.background = element_rect(fill = "gray70"))
)
}, error = function(e) {
plot.new()
text(0.5, 0.5, paste0("Error: ", e$message), cex = 1, col = "red")
})
})
# Trend plot showing mean/median across quintiles
output$stats_trend <- renderPlot({
req(sim_result())
df <- get_quintile_data()
if (is.null(df) || nrow(df) < 4) {
plot.new()
text(0.5, 0.5, "Need at least 4 walkers", cex = 1.2, col = "gray")
return()
}
tryCatch({
# Calculate summary statistics by quintile
summary_df <- do.call(rbind, lapply(levels(df$quintile), function(q) {
q_data <- df[df$quintile == q, ]
data.frame(
quintile = q,
mean_steps = mean(q_data$steps),
median_steps = median(q_data$steps),
q_num = match(q, levels(df$quintile))
)
}))
print(
ggplot(summary_df, aes(x = q_num)) +
geom_line(aes(y = mean_steps, color = "Mean"), linewidth = 1.2) +
geom_point(aes(y = mean_steps, color = "Mean"), size = 3) +
geom_line(aes(y = median_steps, color = "Median"), linewidth = 1.2, linetype = "dashed") +
geom_point(aes(y = median_steps, color = "Median"), size = 3) +
scale_x_continuous(breaks = 1:5, labels = paste0("Q", 1:5)) +
scale_color_manual(values = c("Mean" = "steelblue", "Median" = "darkred")) +
labs(
title = "Path Length Trend Across Quintiles",
x = "Termination Quintile",
y = "Path Length (steps)",
color = "Statistic"
) +
theme_minimal(base_size = 11) +
theme(legend.position = "bottom",
panel.background = element_rect(fill = "gray70"),
plot.background = element_rect(fill = "gray70"))
)
}, error = function(e) {
plot.new()
text(0.5, 0.5, paste0("Error: ", e$message), cex = 1, col = "red")
})
})
# Summary statistics by quintile
output$stats_quintile_summary <- renderPrint({
req(sim_result())
df <- get_quintile_data()
if (is.null(df) || nrow(df) < 4) {
cat("Need at least 4 walkers for quintile analysis\n")
return()
}
cat("=== QUARTILE SUMMARY STATISTICS ===\n\n")
for (q in levels(df$quintile)) {
q_data <- df[df$quintile == q, ]
cat(sprintf("%s (n=%d):\n", q, nrow(q_data)))
cat(sprintf(" Min: %d steps\n", min(q_data$steps)))
cat(sprintf(" Q1: %d steps\n", as.integer(quantile(q_data$steps, 0.25))))
cat(sprintf(" Median: %d steps\n", as.integer(median(q_data$steps))))
cat(sprintf(" Q3: %d steps\n", as.integer(quantile(q_data$steps, 0.75))))
cat(sprintf(" Max: %d steps\n", max(q_data$steps)))
cat(sprintf(" Mean: %.1f steps\n", mean(q_data$steps)))
cat(sprintf(" SD: %.1f steps\n", sd(q_data$steps)))
cat("\n")
}
# Overall comparison
cat("=== QUARTILE COMPARISON ===\n\n")
means <- tapply(df$steps, df$quintile, mean)
cat("Mean steps by quintile:\n")
for (i in seq_along(means)) {
cat(sprintf(" %s: %.1f\n", names(means)[i], means[i]))
}
# Trend indicator
# Q1 = earliest terminators (found black quickly), Q5 = latest (wandered longest)
# Expected: Q5 mean > Q1 mean (later terminators took more steps by definition)
cat("\n=== TREND ===\n")
cat(sprintf("Q1 (earliest 20%%): mean %.0f steps\n", means[1]))
cat(sprintf("Q5 (latest 20%%): mean %.0f steps\n", means[5]))
cat(sprintf("Ratio Q5/Q1: %.1fx\n", means[5] / means[1]))
})
# ============================================================================
# PAGE 5: Survival Curve - Server Logic
# ============================================================================
# Dynamic slider: max = max steps, default = median (50% survival)
observe({
req(sim_result())
result <- sim_result()
steps <- sapply(result$walkers, function(w) w$steps)
max_step <- max(steps)
median_step <- as.integer(median(steps))
updateSliderInput(session, "survival_step",
max = max_step,
value = median_step)
})
# Survival curve plot (Kaplan-Meier style)
output$survival_curve <- renderPlot({
req(sim_result())
result <- sim_result()
# Build survival data
steps <- sapply(result$walkers, function(w) w$steps)
n_total <- length(steps)
# Calculate survival proportion at each unique step value
unique_steps <- sort(unique(steps))
survival_at_step <- sapply(unique_steps, function(s) {
sum(steps > s) / n_total
})
# Current slider position
current_step <- input$survival_step
current_survival <- sum(steps > current_step) / n_total
# Plot using ggplot2
df <- data.frame(step = unique_steps, survival = survival_at_step)
ggplot(df, aes(x = step, y = survival)) +
geom_step(color = "steelblue", linewidth = 1.2) +
geom_vline(xintercept = current_step, linetype = "dashed", color = "red") +
geom_point(aes(x = current_step, y = current_survival),
color = "red", size = 3) +
annotate("text", x = current_step, y = min(current_survival + 0.08, 1),
label = sprintf("%.1f%% alive", current_survival * 100),
color = "red", hjust = 0, size = 4) +
labs(
title = "Walker Survival Curve",
subtitle = sprintf("Red line: step %d (%.1f%% still walking)",
current_step, current_survival * 100),
x = "Steps",
y = "Proportion Surviving"
) +
scale_y_continuous(labels = scales::percent_format(), limits = c(0, 1)) +
theme_minimal(base_size = 14) +
theme(
plot.title = element_text(hjust = 0.5, face = "bold"),
plot.subtitle = element_text(hjust = 0.5, color = "gray40"),
panel.background = element_rect(fill = "gray70"),
plot.background = element_rect(fill = "gray70")
)
})
# Termination breakdown by reason
output$termination_breakdown <- renderPlot({
req(sim_result())
result <- sim_result()
reasons <- sapply(result$walkers, function(w) w$termination_reason)
reason_counts <- table(reasons)
df <- data.frame(
reason = names(reason_counts),
count = as.integer(reason_counts)
)
df$pct <- df$count / sum(df$count) * 100
# Color mapping for different termination reasons
color_map <- c(
"black_neighbor" = "steelblue",
"hit_boundary" = "orange",
"max_steps" = "gray50",
"touched_black" = "darkblue"
)
# Create fill colors vector matching data
df$fill_color <- ifelse(df$reason %in% names(color_map),
color_map[df$reason],
"gray70")
ggplot(df, aes(x = reorder(reason, -count), y = count, fill = reason)) +
geom_col() +
geom_text(aes(label = sprintf("%.1f%%", pct)), vjust = -0.5, size = 3.5) +
scale_fill_manual(values = color_map, na.value = "gray70") +
labs(
title = "How Walkers Terminated",
x = "Termination Reason",
y = "Count"
) +
theme_minimal(base_size = 12) +
theme(
legend.position = "none",
axis.text.x = element_text(angle = 30, hjust = 1),
plot.title = element_text(hjust = 0.5, face = "bold"),
panel.background = element_rect(fill = "gray70"),
plot.background = element_rect(fill = "gray70")
)
})
# Survival statistics text
output$survival_stats <- renderPrint({
req(sim_result())
result <- sim_result()
steps <- sapply(result$walkers, function(w) w$steps)
cat("=== SURVIVAL STATISTICS ===\n\n")
cat(sprintf("Total walkers: %d\n", length(steps)))
cat(sprintf("Median survival: %d steps\n", median(steps)))
cat(sprintf("Mean survival: %.1f steps\n", mean(steps)))
cat(sprintf("25th percentile: %d steps\n", as.integer(quantile(steps, 0.25))))
cat(sprintf("75th percentile: %d steps\n", as.integer(quantile(steps, 0.75))))
cat("\n")
cat("At current slider position:\n")
current_survival <- sum(steps > input$survival_step)
cat(sprintf(" %d walkers (%.1f%%) survived past step %d\n",
current_survival,
current_survival / length(steps) * 100,
input$survival_step))
})
# Hypothesis test: Geometric vs Exponential decay models
output$hypothesis_plot <- renderPlot({
req(sim_result())
result <- sim_result()
# Build survival data with termination order
survdat <- data.frame(
order = sapply(result$walkers, function(w) {
if (!is.null(w$termination_order)) w$termination_order else NA
}),
steps = sapply(result$walkers, function(w) w$steps)
)
# Remove NA orders (if termination_order not available)
survdat <- survdat[!is.na(survdat$order), ]
if (nrow(survdat) < 10) {
# Not enough data for hypothesis testing
plot.new()
text(0.5, 0.5, "Need at least 10 walkers with termination order for hypothesis test",
cex = 1.2, col = "gray")
return()
}
survdat <- survdat[order(survdat$order), ]
# H0: Geometric decay model
# Geometric: P(survive n steps) = (1-p)^n, E[steps] = (1-p)/p
# Fit p via method of moments: p_hat = 1 / (1 + mean(steps))
geom_p <- 1 / (1 + mean(survdat$steps))
# Predicted mean at each order position (linear decay in expected value)
survdat$geom_pred <- (1 / geom_p) * (1 - survdat$order / max(survdat$order) * 0.5)
# H1: Exponential decay model
# E[steps | order] = a * exp(-lambda * order)
survdat$log_steps <- log(survdat$steps + 1)
exp_model <- lm(log_steps ~ order, data = survdat)
survdat$exp_pred <- exp(fitted(exp_model))
# Non-parametric: Kolmogorov-Smirnov tests
geom_ks <- tryCatch({
ks.test(survdat$steps, function(x) pgeom(x, prob = geom_p))
}, error = function(e) list(p.value = 0, statistic = 1))
exp_rate <- 1 / mean(survdat$steps)
exp_ks <- tryCatch({
ks.test(survdat$steps, function(x) pexp(x, rate = exp_rate))
}, error = function(e) list(p.value = 0, statistic = 1))
# Determine which model fits better (higher p-value = better fit)
geom_better <- geom_ks$p.value > exp_ks$p.value
# Plot
ggplot(survdat, aes(x = order, y = steps)) +
geom_point(alpha = 0.4, size = 1.5, color = "gray40") +
geom_line(aes(y = geom_pred), color = "blue", linewidth = 1.2, linetype = "dashed") +
geom_line(aes(y = exp_pred), color = "red", linewidth = 1.2) +
annotate("text", x = max(survdat$order) * 0.6, y = max(survdat$steps) * 0.9,
label = sprintf("H0 Geometric: KS p=%.3f\nH1 Exponential: KS p=%.3f\nBetter fit: %s",
geom_ks$p.value, exp_ks$p.value,
ifelse(geom_better, "Geometric", "Exponential")),
hjust = 0, size = 3.5,
color = ifelse(geom_better, "blue", "red")) +
labs(
title = "Survival Decay: Geometric vs Exponential",
subtitle = sprintf("Best fit: %s model (higher KS p-value = better fit)",
ifelse(geom_better, "Geometric (H0)", "Exponential (H1)")),
x = "Walker Termination Order",
y = "Steps Survived",
caption = "Blue dashed: Geometric (H0) | Red solid: Exponential (H1)"
) +
theme_minimal(base_size = 12) +
theme(
panel.background = element_rect(fill = "gray70"),
plot.background = element_rect(fill = "gray70"),
plot.title = element_text(hjust = 0.5, face = "bold"),
plot.subtitle = element_text(hjust = 0.5,
color = ifelse(geom_better, "blue", "red"))
)
})
# Hypothesis test summary text
output$hypothesis_stats <- renderPrint({
req(sim_result())
result <- sim_result()
# Build survival data with termination order
survdat <- data.frame(
order = sapply(result$walkers, function(w) {
if (!is.null(w$termination_order)) w$termination_order else NA
}),
steps = sapply(result$walkers, function(w) w$steps)
)
survdat <- survdat[!is.na(survdat$order), ]
if (nrow(survdat) < 10) {
cat("Insufficient data for hypothesis testing.\n")
cat("Need at least 10 walkers with termination_order field.\n")
return()
}
cat("=== HYPOTHESIS TEST: GEOMETRIC vs EXPONENTIAL DECAY ===\n\n")
cat("H0 (Geometric): Step counts follow a geometric distribution\n")
cat("H1 (Exponential): Step counts follow an exponential distribution\n\n")
# Geometric model
geom_p <- 1 / (1 + mean(survdat$steps))
cat("--- Geometric Model (H0) ---\n")
cat(sprintf("Estimated p: %.4f\n", geom_p))
cat(sprintf("Expected mean: %.1f steps\n", (1 - geom_p) / geom_p))
# Exponential model
exp_rate <- 1 / mean(survdat$steps)
survdat$log_steps <- log(survdat$steps + 1)
exp_model <- lm(log_steps ~ order, data = survdat)
cat("\n--- Exponential Model (H1) ---\n")
cat(sprintf("Rate parameter (lambda): %.6f\n", exp_rate))
cat(sprintf("Expected mean: %.1f steps\n", 1 / exp_rate))
cat(sprintf("Decay coefficient: %.6f\n", coef(exp_model)[2]))
# KS tests
geom_ks <- tryCatch({
ks.test(survdat$steps, function(x) pgeom(x, prob = geom_p))
}, error = function(e) list(p.value = 0, statistic = 1))
exp_ks <- tryCatch({
ks.test(survdat$steps, function(x) pexp(x, rate = exp_rate))
}, error = function(e) list(p.value = 0, statistic = 1))
cat("\n--- Kolmogorov-Smirnov Tests ---\n")
cat(sprintf("Geometric KS statistic: %.4f, p-value: %.4f\n",
geom_ks$statistic, geom_ks$p.value))
cat(sprintf("Exponential KS statistic: %.4f, p-value: %.4f\n",
exp_ks$statistic, exp_ks$p.value))
# Significance threshold
alpha <- 0.05
cat("\n=== CONCLUSION ===\n")
# Check if BOTH models are rejected (p < alpha)
geom_rejected <- geom_ks$p.value < alpha
exp_rejected <- exp_ks$p.value < alpha
if (geom_rejected && exp_rejected) {
cat("NEITHER model fits well (both p-values < 0.05)\n")
cat("The step distribution may be more complex than geometric or exponential.\n")
cat("Consider: mixture models, heavy-tailed distributions, or spatial effects.\n")
} else if (!geom_rejected && !exp_rejected) {
# Both acceptable - compare which is better
if (geom_ks$p.value > exp_ks$p.value) {
cat("GEOMETRIC model fits better (p=", round(geom_ks$p.value, 4), ")\n")
cat("Step counts suggest discrete process with constant termination probability.\n")
} else {
cat("EXPONENTIAL model fits better (p=", round(exp_ks$p.value, 4), ")\n")
cat("Step counts suggest continuous decay process.\n")
}
} else if (!geom_rejected) {
cat("GEOMETRIC model fits (p=", round(geom_ks$p.value, 4), ")\n")
cat("Exponential model rejected (p=", round(exp_ks$p.value, 4), ")\n")
} else {
cat("EXPONENTIAL model fits (p=", round(exp_ks$p.value, 4), ")\n")
cat("Geometric model rejected (p=", round(geom_ks$p.value, 4), ")\n")
}
})
# PAGE 6: Debug - Versions
output$debug_versions <- renderText({
paste0(
"=== PACKAGE VERSIONS ===\n",
"randomwalk: ", tryCatch(as.character(packageVersion("randomwalk")), error = function(e) "inline engine"), "\n",
"shiny: ", packageVersion("shiny"), "\n",
"ggplot2: ", packageVersion("ggplot2"), "\n",
if (requireNamespace("mirai", quietly = TRUE)) {
paste0("mirai: ", packageVersion("mirai"), "\n")
} else "",
if (requireNamespace("nanonext", quietly = TRUE)) {
paste0("nanonext: ", packageVersion("nanonext"), "\n")
} else "",
if (requireNamespace("crew", quietly = TRUE)) {
paste0("crew: ", packageVersion("crew"), "\n")
} else ""
)
})
# PAGE 5: Debug - Inputs
output$debug_inputs <- renderText({
paste0(
"=== CURRENT INPUTS ===\n",
"Grid Size: ", input$grid_size, "\n",
"Number of Walkers: ", input$n_walkers, "\n",
"Mode: sync sequential (workers=0)\n",
"Neighborhood: ", input$neighborhood, "\n",
"Boundary: ", input$boundary, "\n",
"Max Steps: ", input$max_steps
)
})
# PAGE 5: Debug - Backend
output$debug_backend <- renderText({
env_is_webr <- is_webr()
paste0(
"=== BACKEND INFORMATION ===\n",
"Environment: WebR/Browser\n",
"R Version: ", R.version.string, "\n",
"Backend: synchronous (no parallelization)\n",
"Sync Mode: static (grid snapshots)\n",
"\n=== ENVIRONMENT DETECTION ===\n",
".webr_env exists: ", exists(".webr_env", envir = .GlobalEnv), "\n",
"WEBR env var: ", Sys.getenv("WEBR"), "\n",
"is_webr() result: ", env_is_webr
)
})
# Walker Paths QA
output$debug_walker_qa <- renderText({
if (is.null(sim_result())) return("No simulation run yet.")
result <- sim_result()
walkers <- result$walkers
n <- length(walkers)
has_path <- sum(sapply(walkers, function(w) !is.null(w$path) && length(w$path) > 0))
reasons <- table(sapply(walkers, function(w) w$termination_reason))
steps <- sapply(walkers, function(w) w$steps)
orders <- sapply(walkers, function(w) w$termination_order)
paste0(
"=== WALKER PATHS QA ===\n",
"Total walkers: ", n, "\n",
"With stored paths: ", has_path, " (vectorized mode stores none)\n",
"Termination orders assigned: ", sum(orders > 0), "/", n, "\n",
"Steps range: ", min(steps), " - ", max(steps), "\n",
"Median steps: ", median(steps), "\n",
"\n=== TERMINATION REASONS ===\n",
paste(sprintf(" %s: %d (%.1f%%)", names(reasons), as.integer(reasons),
100 * as.integer(reasons) / n), collapse = "\n"),
"\n\n=== SIMULATION MODE ===\n",
"Engine: ", if (has_path > 0) "per-walker (with paths)" else "vectorized (no paths, 10-50x faster)", "\n",
"Batch target: 200k walker-ops/batch\n",
"JS round-trip delay: 50ms"
)
})
# PAGE 5: Debug - Periodic Updates
output$debug_periodic <- renderText({
# Depend on timer to update every 100ms
autoInvalidate()
# Enhanced debug info during execution
state_info <- switch(sim_state(),
"idle" = "💤 Idle - waiting for user to click 'Run Simulation'",
"running" = {
elapsed <- if (!is.null(sim_start_time())) {
as.numeric(difftime(Sys.time(), sim_start_time(), units = "secs"))
} else {
0
}
paste0("Running - ", format_duration(elapsed), " elapsed")
},
"complete" = {
elapsed <- if (!is.null(sim_end_time()) && !is.null(sim_start_time())) {
as.numeric(difftime(sim_end_time(), sim_start_time(), units = "secs"))
} else {
0
}
paste0("Complete - took ", format_duration(elapsed))
},
"error" = "❌ Error - see status tab for details",
"Unknown state"
)
paste0(
"=== PERIODIC UPDATES ===\n",
"Current Time: ", format(Sys.time(), "%Y-%m-%d %H:%M:%S"), "\n",
"Simulation State: ", state_info, "\n",
"Simulation Count: ", sim_count(), "\n",
"Result Available: ", if (is.null(sim_result())) "No" else "Yes", "\n",
"Active Tab: ", input$tabs, "\n",
if (sim_state() == "running" && !is.null(sim_start_time())) {
n_active <- length(batch_active())
paste0(
"\n=== EXECUTION INFO ===\n",
"Grid Size: ", input$grid_size, "×", input$grid_size, "\n",
"Walkers: ", sim_completed_walkers(), "/", input$n_walkers,
" (", n_active, " active)\n",
"Black Pixels: ", sim_black_pixels(), "\n",
"Step: ", sim_current_step(), "\n",
"Backend: batched sequential (non-blocking)"
)
} else {
""
}
)
})
}
# ============================================================================
# Run Shiny App
# ============================================================================
shinyApp(ui = ui, server = server)Build Info
randomwalk 2.1.1 | Git 507cc3f | R 4.5.2 | Built 2026-05-06 13:34:18