{"spec_id":"parallel-categories-basic","library":"ggplot2","language":"r","code":"#' anyplot.ai\n#' parallel-categories-basic: Basic Parallel Categories Plot\n#' Library: ggplot2 3.5.1 | R 4.4.1\n#' Quality: 81/100 | Created: 2026-09-05\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\"\nELEVATED_BG <- if (THEME == \"light\") \"#FFFDF6\" else \"#242420\"\nINK         <- if (THEME == \"light\") \"#1A1A17\" else \"#F0EFE8\"\nINK_SOFT    <- if (THEME == \"light\") \"#4A4A44\" else \"#B8B7B0\"\n\n# Imprint palette (see prompts/default-style-guide.md \"Categorical Palette\")\nIMPRINT_PALETTE <- c(\"#009E73\", \"#C475FD\", \"#4467A3\", \"#BD8233\",\n                     \"#AE3030\", \"#2ABCCD\", \"#954477\", \"#99B314\")\n\nNODE_WIDTH <- 0.055\n\n# --- Data: customer journey across 4 categorical dimensions -------------\n# ggplot2 has no native parallel-categories geom (ggalluvial is not installed\n# in this environment) — bands below are built from first principles with\n# stacked node ranges and a smoothstep interpolation, using only geom_ribbon\n# and geom_rect, both native ggplot2 geoms. Colored by the first dimension\n# (acquisition channel), so a customer's ribbon keeps its origin hue as it\n# flows through every subsequent stage.\nchannel_levels <- c(\"Organic\", \"Paid Search\", \"Social\", \"Referral\")\ndevice_levels  <- c(\"Desktop\", \"Mobile\")\nproduct_levels <- c(\"Electronics\", \"Apparel\", \"Home & Garden\")\noutcome_levels <- c(\"Purchased\", \"Abandoned\")\n\nchannel_probs <- c(Organic = 0.32, \"Paid Search\" = 0.28, Social = 0.24, Referral = 0.16)\n\ndevice_probs_by_channel <- list(\n  Organic       = c(Desktop = 0.55, Mobile = 0.45),\n  \"Paid Search\" = c(Desktop = 0.42, Mobile = 0.58),\n  Social        = c(Desktop = 0.22, Mobile = 0.78),\n  Referral      = c(Desktop = 0.60, Mobile = 0.40)\n)\n\nproduct_probs_by_device <- list(\n  Desktop = c(Electronics = 0.45, Apparel = 0.25, \"Home & Garden\" = 0.30),\n  Mobile  = c(Electronics = 0.30, Apparel = 0.45, \"Home & Garden\" = 0.25)\n)\n\noutcome_probs_by_product <- list(\n  Electronics     = c(Purchased = 0.38, Abandoned = 0.62),\n  Apparel         = c(Purchased = 0.30, Abandoned = 0.70),\n  \"Home & Garden\" = c(Purchased = 0.35, Abandoned = 0.65)\n)\n\nn_customers <- 2000\nchannel <- sample(names(channel_probs), n_customers, replace = TRUE, prob = channel_probs)\ndevice  <- vapply(channel, function(ch) {\n  probs <- device_probs_by_channel[[ch]]\n  sample(names(probs), 1, prob = probs)\n}, character(1))\nproduct <- vapply(device, function(d) {\n  probs <- product_probs_by_device[[d]]\n  sample(names(probs), 1, prob = probs)\n}, character(1))\noutcome <- vapply(product, function(p) {\n  probs <- outcome_probs_by_product[[p]]\n  sample(names(probs), 1, prob = probs)\n}, character(1))\n\n# --- Crossing-minimization: order each downstream stage by the weighted\n# barycenter of its predecessor's node positions (forward Sugiyama sweep),\n# instead of fixed definition order, so fewer ribbons cross between hops.\nbarycenter_order <- function(from_vec, to_vec, prev_order) {\n  prev_pos <- setNames(seq_along(prev_order), prev_order)\n  agg <- as.data.frame(table(from = from_vec, to = to_vec), stringsAsFactors = FALSE)\n  categories <- unique(agg$to)\n  bary <- vapply(categories, function(cat) {\n    rows <- agg[agg$to == cat, ]\n    sum(prev_pos[rows$from] * rows$Freq) / sum(rows$Freq)\n  }, numeric(1))\n  categories[order(bary)]\n}\n\ndevice_order  <- barycenter_order(channel, device, channel_levels)\nproduct_order <- barycenter_order(device, product, device_order)\noutcome_order <- barycenter_order(product, outcome, product_order)\n\ndf <- tibble::tibble(\n  channel = factor(channel, levels = channel_levels),\n  device  = factor(device,  levels = device_order),\n  product = factor(product, levels = product_order),\n  outcome = factor(outcome, levels = outcome_order)\n)\n\n# --- Node totals & stacked y-ranges per stage (crossing-minimized order) ----\n# GAP is deliberately generous (5% of n, vs. a typical 2-3%) to open up\n# breathing room between stacked nodes at each stage, since the Device->Product\n# and Product->Outcome hops carry many crossing ribbons.\nGAP <- n_customers * 0.05\n\nnode_totals_for <- function(values, stage_x) {\n  tibble::tibble(category = values) %>%\n    count(category, name = \"total\") %>%\n    mutate(category = factor(category, levels = levels(values))) %>%\n    arrange(category) %>%\n    mutate(\n      ymax     = cumsum(total) + GAP * (row_number() - 1),\n      ymin     = ymax - total,\n      stage    = stage_x,\n      category = as.character(category)\n    )\n}\n\nnode_channel <- node_totals_for(df$channel, 1)\nnode_device  <- node_totals_for(df$device,  2)\nnode_product <- node_totals_for(df$product, 3)\nnode_outcome <- node_totals_for(df$outcome, 4)\nnode_all <- bind_rows(node_channel, node_device, node_product, node_outcome)\n\n# --- Aggregated flows between adjacent stages, origin = channel ---------\nedges_channel_device  <- df %>%\n  count(channel, device, name = \"value\") %>%\n  transmute(origin = as.character(channel), from_cat = as.character(channel),\n            to_cat = as.character(device), value)\n\nedges_device_product <- df %>%\n  count(channel, device, product, name = \"value\") %>%\n  transmute(origin = as.character(channel), from_cat = as.character(device),\n            to_cat = as.character(product), value)\n\nedges_product_outcome <- df %>%\n  count(channel, product, outcome, name = \"value\") %>%\n  transmute(origin = as.character(channel), from_cat = as.character(product),\n            to_cat = as.character(outcome), value)\n\n# --- Smooth bands via smoothstep interpolation ---------------------------\nbuild_hop_bands <- function(edges, stage_from, stage_to, node_from, node_to, n_smooth = 40) {\n  edges <- edges %>%\n    group_by(from_cat) %>%\n    arrange(to_cat, origin, .by_group = TRUE) %>%\n    mutate(y1_out = cumsum(value), y0_out = y1_out - value) %>%\n    ungroup() %>%\n    left_join(node_from %>% transmute(from_cat = category, node_ymin_from = ymin), by = \"from_cat\") %>%\n    mutate(y0_from = node_ymin_from + y0_out, y1_from = node_ymin_from + y1_out)\n\n  edges <- edges %>%\n    group_by(to_cat) %>%\n    arrange(origin, from_cat, .by_group = TRUE) %>%\n    mutate(y1_in = cumsum(value), y0_in = y1_in - value) %>%\n    ungroup() %>%\n    left_join(node_to %>% transmute(to_cat = category, node_ymin_to = ymin), by = \"to_cat\") %>%\n    mutate(y0_to = node_ymin_to + y0_in, y1_to = node_ymin_to + y1_in) %>%\n    mutate(edge_id = row_number())\n\n  t <- seq(0, 1, length.out = n_smooth)\n  w <- t ^ 2 * (3 - 2 * t)  # smoothstep S-curve\n\n  edges %>%\n    rowwise() %>%\n    reframe(\n      edge_id = edge_id,\n      origin  = origin,\n      value   = value,\n      x       = stage_from + t * (stage_to - stage_from),\n      ymin    = y0_from + w * (y0_to - y0_from),\n      ymax    = y1_from + w * (y1_to - y1_from)\n    )\n}\n\n# Largest flows are drawn first (so they sit behind), thinner flows drawn last\n# (on top) -- this keeps small paths from getting visually buried under the\n# bulk of the crossing traffic in the dense middle hops.\nbands <- bind_rows(\n  build_hop_bands(edges_channel_device,  1, 2, node_channel, node_device)  %>% mutate(hop = \"h1\"),\n  build_hop_bands(edges_device_product,  2, 3, node_device,  node_product) %>% mutate(hop = \"h2\"),\n  build_hop_bands(edges_product_outcome, 3, 4, node_product, node_outcome) %>% mutate(hop = \"h3\")\n) %>%\n  mutate(\n    group_id = paste(hop, edge_id, sep = \"_\"),\n    origin   = factor(origin, levels = channel_levels)\n  ) %>%\n  arrange(desc(value))\n\n# --- Plot ------------------------------------------------------------------\np <- ggplot() +\n  geom_ribbon(\n    data = bands,\n    aes(x = x, ymin = ymin, ymax = ymax, group = group_id, fill = origin),\n    color = INK, linewidth = 0.12, alpha = 0.28\n  ) +\n  geom_rect(\n    data = node_all,\n    aes(xmin = stage - NODE_WIDTH, xmax = stage + NODE_WIDTH, ymin = ymin, ymax = ymax),\n    fill = PAGE_BG, color = INK_SOFT, linewidth = 0.6\n  ) +\n  geom_text(\n    data = node_all,\n    aes(x = stage, y = (ymin + ymax) / 2, label = category),\n    angle = 90, size = 3.4, color = INK\n  ) +\n  scale_fill_manual(\n    values = setNames(IMPRINT_PALETTE[seq_along(channel_levels)], channel_levels),\n    name   = \"Acquisition Channel\"\n  ) +\n  scale_x_continuous(\n    breaks = 1:4, labels = c(\"Channel\", \"Device\", \"Product\", \"Outcome\"),\n    expand = expansion(mult = c(0.06, 0.06))\n  ) +\n  scale_y_continuous(expand = expansion(mult = c(0.02, 0.08))) +\n  guides(fill = guide_legend(override.aes = list(alpha = 1))) +\n  labs(\n    title = \"parallel-categories-basic · r · ggplot2 · anyplot.ai\",\n    x = NULL, y = NULL\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        = element_blank(),\n    axis.title        = element_blank(),\n    axis.text.y       = element_blank(),\n    axis.ticks        = element_blank(),\n    axis.text.x       = element_text(color = INK_SOFT, size = 10),\n    plot.title        = element_text(color = INK, size = 15),\n    legend.position    = \"top\",\n    legend.background = element_rect(fill = ELEVATED_BG, color = INK_SOFT),\n    legend.text       = element_text(color = INK_SOFT, size = 8),\n    legend.title      = element_text(color = INK, size = 10),\n    plot.margin       = margin(12, 20, 10, 20)\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"}