{"spec_id":"violin-split","library":"ggplot2","language":"r","code":"#' anyplot.ai\n#' violin-split: Split Violin Plot\n#' Library: ggplot2 3.5.1 | R 4.4.1\n#' Quality: 85/100 | Created: 2026-09-09\n\nlibrary(ggplot2)\nlibrary(dplyr)\nlibrary(ragg)\n\nset.seed(42)\n\n# --- Theme tokens -------------------------------------------------------------\nTHEME       <- Sys.getenv(\"ANYPLOT_THEME\", \"light\")\nPAGE_BG     <- if (THEME == \"light\") \"#FAF8F1\" else \"#1A1A17\"\nINK         <- if (THEME == \"light\") \"#1A1A17\" else \"#F0EFE8\"\nINK_SOFT    <- if (THEME == \"light\") \"#4A4A44\" else \"#B8B7B0\"\nIMPRINT_PALETTE <- c(\"#009E73\", \"#C475FD\", \"#4467A3\", \"#BD8233\",\n                     \"#AE3030\", \"#2ABCCD\", \"#954477\", \"#99B314\")\n\n# --- Data -----------------------------------------------------------------\n# Exam scores across subjects, comparing a control cohort against a cohort\n# that used a new tutoring program.\nsubjects <- c(\"Math\", \"Science\", \"English\", \"History\")\ngroups   <- c(\"Control\", \"Tutoring\")\nn_per_group <- 180\n\nscore_params <- list(\n  Math    = list(Control = c(mean = 68, sd = 9),  Tutoring = c(mean = 74, sd = 8)),\n  Science = list(Control = c(mean = 71, sd = 8),  Tutoring = c(mean = 75, sd = 7)),\n  English = list(Control = c(mean = 64, sd = 11), Tutoring = c(mean = 70, sd = 9)),\n  History = list(Control = c(mean = 78, sd = 7),  Tutoring = c(mean = 79, sd = 7))\n)\n\n# Outer lapply walks the 4 subjects, inner lapply walks the 2 cohorts within\n# each subject; each leaf draws n_per_group scores from that cohort's\n# mean/sd and clamps them to a valid 0-100 exam range. do.call(rbind, ...)\n# flattens each level's list-of-data-frames back into a single data frame.\nscores <- do.call(rbind, lapply(subjects, function(subj) {\n  do.call(rbind, lapply(groups, function(grp) {\n    params <- score_params[[subj]][[grp]]\n    data.frame(\n      subject = subj,\n      group   = grp,\n      score   = pmin(pmax(rnorm(n_per_group, params[\"mean\"], params[\"sd\"]), 0), 100)\n    )\n  }))\n}))\n\n# --- Split-violin geometry --------------------------------------------------\n# ggplot2 has no native split-violin geom; build each half as a closed\n# polygon from a kernel density estimate — the outer edge traces the\n# density curve, the inner edge runs straight down the category center so\n# both halves meet exactly on the shared axis.\nsubject_positions <- setNames(seq_along(subjects), subjects)\nhalf_width <- 0.42\n\n# Same subject/cohort nesting as above, but each leaf builds one polygon:\n# the outer ring follows the KDE curve (scaled to half_width and mirrored\n# left/right by `side`), the inner ring is a straight vertical line back\n# down the category center — closing the ring exactly on the shared axis.\nviolin_polygons <- do.call(rbind, lapply(subjects, function(subj) {\n  do.call(rbind, lapply(groups, function(grp) {\n    values <- scores$score[scores$subject == subj & scores$group == grp]\n    dens   <- density(values, n = 256)\n    scaled <- dens$y / max(dens$y) * half_width\n    center <- subject_positions[[subj]]\n    side   <- if (grp == groups[1]) -1 else 1\n    outer  <- data.frame(x = center + side * scaled, y = dens$x)\n    inner  <- data.frame(x = rep(center, length(dens$x)), y = rev(dens$x))\n    data.frame(rbind(outer, inner),\n               subject = subj, group = grp,\n               poly_id = paste(subj, grp, sep = \"_\"))\n  }))\n}))\n\nmedians <- scores %>%\n  group_by(subject, group) %>%\n  summarise(median_score = median(score), .groups = \"drop\") %>%\n  mutate(\n    center  = subject_positions[subject],\n    side    = ifelse(group == groups[1], -1, 1),\n    x_start = center,\n    x_end   = center + side * half_width * 0.85\n  )\n\n# --- Storytelling callout ---------------------------------------------------\n# Identify the subject with the largest Tutoring-vs-Control median gap and\n# call it out directly on the chart, so the strongest program effect is\n# immediately visible rather than left for the reader to eyeball.\ngap_by_subject <- sapply(subjects, function(subj) {\n  ctrl <- medians$median_score[medians$subject == subj & medians$group == \"Control\"]\n  tut  <- medians$median_score[medians$subject == subj & medians$group == \"Tutoring\"]\n  tut - ctrl\n})\nfocus_subject <- names(which.max(abs(gap_by_subject)))\nfocus_gap     <- gap_by_subject[[focus_subject]]\nfocus_center  <- subject_positions[[focus_subject]]\nfocus_top     <- max(violin_polygons$y[violin_polygons$subject == focus_subject]) + 5\n\ncallout_bracket <- data.frame(\n  x    = focus_center - half_width * 0.85,\n  xend = focus_center + half_width * 0.85,\n  y    = focus_top,\n  yend = focus_top\n)\ncallout_label <- data.frame(\n  x     = focus_center,\n  y     = focus_top + 4,\n  label = sprintf(\"Largest gain: %s %+.1f pts\", focus_subject, focus_gap)\n)\n\n# --- Plot --------------------------------------------------------------------\np <- ggplot() +\n  geom_polygon(data = violin_polygons,\n               aes(x = x, y = y, group = poly_id, fill = group),\n               color = INK, linewidth = 0.25, alpha = 0.88) +\n  geom_segment(data = medians,\n               aes(x = x_start, xend = x_end, y = median_score, yend = median_score),\n               color = INK, linewidth = 0.7) +\n  geom_segment(data = callout_bracket,\n               aes(x = x, xend = xend, y = y, yend = yend),\n               color = INK_SOFT, linewidth = 0.4) +\n  geom_text(data = callout_label,\n            aes(x = x, y = y, label = label),\n            color = INK, size = 3.1, fontface = \"bold\") +\n  scale_fill_manual(values = c(IMPRINT_PALETTE[1], IMPRINT_PALETTE[2]), name = \"Cohort\") +\n  scale_x_continuous(breaks = subject_positions, labels = names(subject_positions)) +\n  scale_y_continuous(expand = expansion(mult = c(0.05, 0.15))) +\n  labs(\n    title = \"violin-split · r · ggplot2 · anyplot.ai\",\n    x = \"Subject\",\n    y = \"Exam Score\"\n  ) +\n  theme_minimal(base_size = 8) +\n  theme(\n    plot.background    = element_rect(fill = PAGE_BG, color = PAGE_BG),\n    panel.background   = element_rect(fill = PAGE_BG, color = NA),\n    panel.grid.major.x = element_blank(),\n    panel.grid.minor   = element_blank(),\n    panel.grid.major.y = element_line(color = INK, linewidth = 0.25),\n    axis.title         = element_text(color = INK, size = 10),\n    axis.text          = element_text(color = INK_SOFT, size = 8),\n    axis.ticks         = element_blank(),\n    plot.title         = element_text(color = INK, size = 14, face = \"bold\"),\n    legend.position    = \"top\",\n    legend.background  = element_rect(fill = PAGE_BG, color = NA),\n    legend.text        = element_text(color = INK_SOFT, size = 8),\n    legend.title       = element_text(color = INK, size = 10)\n  )\n\n# --- Save --------------------------------------------------------------------\nggsave(\n  filename = sprintf(\"plot-%s.png\", THEME),\n  plot     = p,\n  device   = ragg::agg_png,\n  width    = 8,\n  height   = 4.5,\n  units    = \"in\",\n  dpi      = 400\n)\n"}