LithosAnanake/experiments/bare_metal/analysis/analyse_stadium_relaunch_fixed.R

#!/usr/bin/env Rscript
# analyse_stadium_relaunch_fixed.R
# StarForth LithosAnanke -- EXEC-DOE 3x3 Latin square campaign, re-run on
# the post-item-4.6 Stadium substrate AND against the fixed SWAP-MTX
# shuffle (2026-08-20). Supersedes analyse_stadium_relaunch.R's dataset
# (acl-rwt-20260820/, buggy shuffle) with acl-rwt-20260820-fixed/.
#
# Two layers, per Captain Bob's own framing:
#   1. Aggregate -- all 9 cells as a conglomerate Latin square.
#   2. Per-cell / per-ISA -- each cell's own internal pattern, and how
#      each ISA's three seeds hold up against each other (subtle
#      within-ISA interactions), including 2-way factor interactions and
#      quadratic (factor^2) terms.

suppressPackageStartupMessages({
  library(ggplot2)
  library(svglite)
  library(dplyr)
  library(tidyr)
  library(scales)
  library(patchwork)
})

SCRIPT_DIR <- tryCatch(
  dirname(normalizePath(sys.frames()[[1]]$ofile)),
  error = function(e) getwd()
)
BASE_DIR   <- normalizePath(file.path(SCRIPT_DIR, ".."))
RUNS_DIR   <- file.path(BASE_DIR, "runs", "acl-rwt-20260820-fixed")
OUT_CHARTS <- file.path(SCRIPT_DIR, "charts")
OUT_TABLES <- file.path(SCRIPT_DIR, "tables")
dir.create(OUT_CHARTS, showWarnings = FALSE, recursive = TRUE)
dir.create(OUT_TABLES, showWarnings = FALSE, recursive = TRUE)

cat("══════════════════════════════════════════════════════════════════\n")
cat("  StarForth LithosAnanke -- Stadium relaunch, FIXED shuffle\n")
cat("  Item 5.1 / F.3 -- campaign-mechanism + factor analysis, 2026-08-20\n")
cat("══════════════════════════════════════════════════════════════════\n\n")

arch_colours <- c(amd64 = "#E07B39", aarch64 = "#4A90D9", riscv64 = "#50C878")

theme_light_sf <- function(base = 11) {
  theme_minimal(base_size = base) %+replace% theme(
    panel.grid.minor = element_blank(),
    panel.grid.major = element_line(colour = "grey90"),
    strip.text        = element_text(face = "bold"),
    plot.title        = element_text(face = "bold", size = base + 1),
    plot.subtitle     = element_text(colour = "grey40", size = base - 2),
    legend.position   = "bottom",
    legend.key.size   = unit(0.5, "cm")
  )
}
theme_dark_sf <- function(base = 11) {
  theme_minimal(base_size = base) %+replace% theme(
    panel.background  = element_rect(fill = "#0d0d0d", colour = NA),
    plot.background   = element_rect(fill = "#0d0d0d", colour = NA),
    panel.grid.major  = element_line(colour = "#1e1e1e"),
    panel.grid.minor  = element_blank(),
    axis.text         = element_text(colour = "#aaaaaa"),
    axis.title        = element_text(colour = "#cccccc"),
    strip.text        = element_text(colour = "white", face = "bold"),
    plot.title        = element_text(colour = "white", face = "bold", size = base + 1),
    plot.subtitle     = element_text(colour = "#666666", size = base - 2),
    legend.text       = element_text(colour = "#aaaaaa"),
    legend.title      = element_text(colour = "#cccccc"),
    legend.background = element_rect(fill = "#0d0d0d", colour = NA),
    legend.position   = "bottom",
    legend.key.size   = unit(0.5, "cm")
  )
}
save_svg <- function(plot, name, w = 12, h = 7) {
  path <- file.path(OUT_CHARTS, paste0(name, ".svg"))
  svglite(path, width = w, height = h); print(plot); dev.off()
  cat(sprintf("  Saved: %s.svg\n", name))
  invisible(path)
}

col_names <- c("run_id", "cfg", "rep", "ent_in", "cv_in", "tmp_in", "stb_in",
               "l8_mode", "win_div", "infer_win", "infer_dec_q", "infer_var_q",
               "early_exit", "bc_mean_q", "bb_mean_q", "fit_q")
archs <- c("amd64", "aarch64", "riscv64")
seeds <- c("12345", "67890", "13579")

load_cell <- function(arch, seed) {
  f <- file.path(RUNS_DIR, sprintf("%s-seed%s.csv", arch, seed))
  df <- read.csv(f, header = TRUE)
  names(df) <- col_names
  df$arch <- arch; df$seed <- seed
  df$ent_f <- factor(ifelse(df$ent_in > 0, "hi", "lo"))
  df$cv_f  <- factor(ifelse(df$cv_in  > 0, "hi", "lo"))
  df$tmp_f <- factor(ifelse(df$tmp_in > 0, "hi", "lo"))
  df$stb_f <- factor(ifelse(df$stb_in > 0, "hi", "lo"))
  df
}

cat("Loading 9 cells (fixed-shuffle dataset)...\n")
all_data <- bind_rows(lapply(archs, function(a) bind_rows(lapply(seeds, function(s) load_cell(a, s)))))
cat(sprintf("  Total rows: %d (expect 4320)\n", nrow(all_data)))
all_data$arch <- factor(all_data$arch, levels = archs)
all_data$seed <- factor(all_data$seed, levels = seeds)

# ══════════════════════════════════════════════════════════════════════
# LAYER 1 -- AGGREGATE: all 9 cells as a conglomerate Latin square
# ══════════════════════════════════════════════════════════════════════

cell_summary <- all_data %>%
  group_by(arch, seed) %>%
  summarise(
    n_rows = n(), n_cfg = n_distinct(cfg), n_run_id = n_distinct(run_id),
    mean_infer_dec_q = mean(infer_dec_q), sd_infer_dec_q = sd(infer_dec_q),
    early_exit_rate  = mean(early_exit),
    l8_mode_const = length(unique(l8_mode)) == 1,
    win_div_const = length(unique(win_div)) == 1,
    fit_q_const   = length(unique(fit_q)) == 1,
    .groups = "drop"
  )
write.csv(cell_summary, file.path(OUT_TABLES, "stadium_fixed_cell_summary.csv"), row.names = FALSE)
cat("\nPer-cell summary (Layer 1 -- aggregate view):\n"); print(as.data.frame(cell_summary))

# Confirms the invariant metrics: l8_mode/win_div/infer_win/infer_var_q/
# bc_mean_q/bb_mean_q/fit_q are all zero-variance across all 9 cells --
# same extreme-determinism result survives the shuffle fix (expected:
# the shuffle bug affected WHICH (cfg,rep) pairs got visited, not the
# underlying physics/inference computation).
invariant_check <- all_data %>%
  summarise(across(c(l8_mode, win_div, infer_win, infer_var_q, bc_mean_q, bb_mean_q, fit_q),
                    n_distinct))
cat("\nInvariant-metric check across ALL 4320 rows (expect all = 1):\n")
print(as.data.frame(invariant_check))

# ══════════════════════════════════════════════════════════════════════
# FIGURE 1: Latin-square heatmap -- mean infer_dec_q per (arch, seed) cell
# ══════════════════════════════════════════════════════════════════════
cat("\n[F1] Aggregate Latin-square heatmap (light + dark)...\n")

make_heatmap <- function(dark = FALSE) {
  thm <- if (dark) theme_dark_sf() else theme_light_sf()
  txt <- if (dark) "white" else "grey10"
  ggplot(cell_summary, aes(x = seed, y = arch, fill = mean_infer_dec_q)) +
    geom_tile(colour = if (dark) "#0d0d0d" else "white", linewidth = 1.5) +
    geom_text(aes(label = sprintf("%.1f\n(sd=%.1f)", mean_infer_dec_q, sd_infer_dec_q)),
               colour = txt, fontface = "bold", size = 3.6, lineheight = 0.9) +
    scale_fill_gradient(low = "#4A90D9", high = "#E07B39", name = "mean infer_dec_q") +
    labs(title = "Aggregate Latin Square -- mean infer_dec_q per cell",
         subtitle = "9 cells, 480 runs each, fixed Fisher-Yates shuffle, Stadium substrate",
         x = "Seed", y = "Architecture") +
    thm
}
save_svg(make_heatmap(FALSE), "stadium_fixed_latin_square_light", w = 9, h = 6)
save_svg(make_heatmap(TRUE),  "stadium_fixed_latin_square_dark",  w = 9, h = 6)

# ══════════════════════════════════════════════════════════════════════
# LAYER 2a -- PER-ISA: how each ISA's three seeds hold up against each
# other (within-ISA consistency, the "subtle interactions ... within the
# ISA itself" Captain Bob asked for)
# ══════════════════════════════════════════════════════════════════════
cat("\n[F2] Per-ISA seed comparison, infer_dec_q distribution (light + dark)...\n")

make_isa_panel <- function(dark = FALSE) {
  thm <- if (dark) theme_dark_sf() else theme_light_sf()
  ggplot(all_data, aes(x = seed, y = infer_dec_q, fill = arch)) +
    geom_boxplot(alpha = 0.85, outlier.size = 0.5, outlier.alpha = 0.4) +
    scale_fill_manual(values = arch_colours, guide = "none") +
    facet_wrap(~arch, nrow = 1) +
    labs(title = "Within-ISA Seed Consistency -- infer_dec_q by Seed, Faceted by ISA",
         subtitle = "Each panel: one ISA's 3 seeds side by side (480 runs/seed)",
         x = "Seed", y = "infer_dec_q") +
    thm
}
save_svg(make_isa_panel(FALSE), "stadium_fixed_isa_seed_panel_light", w = 12, h = 6)
save_svg(make_isa_panel(TRUE),  "stadium_fixed_isa_seed_panel_dark",  w = 12, h = 6)

# Kruskal-Wallis: does seed matter WITHIN each ISA?
kw_within_isa <- lapply(archs, function(a) {
  sub <- filter(all_data, arch == a)
  kw <- kruskal.test(infer_dec_q ~ seed, data = sub)
  data.frame(arch = a, H = unname(kw$statistic), df = unname(kw$parameter), p = kw$p.value)
})
kw_within_isa_df <- bind_rows(kw_within_isa)
write.csv(kw_within_isa_df, file.path(OUT_TABLES, "stadium_fixed_kw_within_isa.csv"), row.names = FALSE)
cat("\nWithin-ISA seed effect (Kruskal-Wallis, infer_dec_q ~ seed, per ISA):\n")
print(kw_within_isa_df)

# ══════════════════════════════════════════════════════════════════════
# LAYER 2b -- CROSS-ISA interaction + quadratic terms on infer_dec_q
# ══════════════════════════════════════════════════════════════════════
cat("\n[F3] Factor model: infer_dec_q ~ factors * arch (2-way interactions + quadratic)...\n")

all_data$ent_q <- (all_data$ent_in / 49152)^2
all_data$cv_q  <- (all_data$cv_in  / 9830)^2
all_data$tmp_q <- (all_data$tmp_in / 32768)^2
all_data$stb_q <- (all_data$stb_in / 32768)^2

fit_full <- lm(infer_dec_q ~ (ent_f + cv_f + tmp_f + stb_f) * arch +
                  ent_q + cv_q + tmp_q + stb_q, data = all_data)
anova_full <- anova(fit_full)
capture.output(print(anova_full), file = file.path(OUT_TABLES, "stadium_fixed_anova_full.txt"))
cat("\nANOVA -- infer_dec_q ~ (4 factors) * arch + quadratic terms:\n")
print(anova_full)

# Logistic regression: early_exit ~ factors * arch
fit_logit <- glm(early_exit ~ (ent_f + cv_f + tmp_f + stb_f) * arch,
                  data = all_data, family = binomial())
capture.output(print(summary(fit_logit)), file = file.path(OUT_TABLES, "stadium_fixed_logit_early_exit.txt"))
cat("\nLogistic regression -- early_exit ~ (4 factors) * arch (summary saved to tables/).\n")

# ══════════════════════════════════════════════════════════════════════
# FIGURE 2: interaction plot -- ent_f x tmp_f, faceted by arch
# ══════════════════════════════════════════════════════════════════════
cat("\n[F4] Interaction plot: ent_in x tmp_in on infer_dec_q, by ISA (light + dark)...\n")

interaction_df <- all_data %>%
  group_by(arch, ent_f, tmp_f) %>%
  summarise(mean_dec = mean(infer_dec_q), se = sd(infer_dec_q)/sqrt(n()), .groups = "drop")

make_interaction <- function(dark = FALSE) {
  thm <- if (dark) theme_dark_sf() else theme_light_sf()
  ggplot(interaction_df, aes(x = tmp_f, y = mean_dec, colour = ent_f, group = ent_f)) +
    geom_line(linewidth = 1) +
    geom_point(size = 2.5) +
    geom_errorbar(aes(ymin = mean_dec - se, ymax = mean_dec + se), width = 0.1) +
    facet_wrap(~arch, nrow = 1) +
    scale_colour_manual(values = c(hi = "#D62728", lo = "#4A90D9"), name = "entropy factor") +
    labs(title = "ent_in x tmp_in Interaction on infer_dec_q, by ISA",
         subtitle = "Non-parallel lines = interaction effect; divergence across panels = ISA-dependent interaction",
         x = "temporal-decay factor", y = "mean infer_dec_q") +
    thm
}
save_svg(make_interaction(FALSE), "stadium_fixed_interaction_light", w = 12, h = 6)
save_svg(make_interaction(TRUE),  "stadium_fixed_interaction_dark",  w = 12, h = 6)

# ══════════════════════════════════════════════════════════════════════
# LAYER 2c -- PER-CELL breakdown: each cell's own infer_dec_q histogram
# ══════════════════════════════════════════════════════════════════════
cat("\n[F5] Per-cell infer_dec_q histograms, 3x3 grid (light + dark)...\n")

make_percell_grid <- function(dark = FALSE) {
  thm <- if (dark) theme_dark_sf() else theme_light_sf()
  fillc <- if (dark) "#4A90D9" else "#E07B39"
  ggplot(all_data, aes(x = infer_dec_q)) +
    geom_histogram(bins = 20, fill = fillc, alpha = 0.85, colour = NA) +
    facet_grid(arch ~ seed) +
    labs(title = "Per-Cell infer_dec_q Distribution -- 3x3 Latin Square Grid",
         subtitle = "Rows: ISA. Columns: seed. Each panel: one cell's own 480 runs.",
         x = "infer_dec_q", y = "count") +
    thm
}
save_svg(make_percell_grid(FALSE), "stadium_fixed_percell_grid_light", w = 11, h = 9)
save_svg(make_percell_grid(TRUE),  "stadium_fixed_percell_grid_dark",  w = 11, h = 9)

cat("\nDone. Tables in analysis/tables/, charts in analysis/charts/.\n")