{"spec_id":"alluvial-opinion-flow","library":"ggplot2","language":"r","code":"#' anyplot.ai\n#' alluvial-opinion-flow: Opinion Flow Diagram\n#' Library: ggplot2 3.5.1 | R 4.4.1\n#' Quality: 88/100 | Created: 2026-05-30\n\nlibrary(ggplot2)\nlibrary(ragg)\n\nset.seed(42)\n\n# Theme tokens (Imprint palette, theme-adaptive chrome)\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\"\nINK_MUTED   <- if (THEME == \"light\") \"#6B6A63\" else \"#A8A79F\"\n\n# Imprint palette — semantic mapping: positive→green, neutral→ochre, negative→red\nIMPRINT_PALETTE <- c(\n    \"Strongly Agree\"    = \"#009E73\",   # brand green (positive)\n    \"Agree\"             = \"#4467A3\",   # blue\n    \"Neutral\"           = \"#BD8233\",   # ochre\n    \"Disagree\"          = \"#C475FD\",   # lavender\n    \"Strongly Disagree\" = \"#AE3030\"    # matte red (negative)\n)\n\ncategories <- names(IMPRINT_PALETTE)\n\n# Climate policy opinion survey: 500 respondents tracked across 3 quarterly waves\n# Transition matrices show increasing polarization over time\nm12 <- matrix(c(\n    65, 12,  3,  0,  0,   # Strongly Agree →\n    10,110, 15,  5,  0,   # Agree →\n     3, 18, 72, 25, 12,   # Neutral →\n     0,  5, 15, 78, 12,   # Disagree →\n     0,  0,  2,  8, 30    # Strongly Disagree →\n), nrow = 5, byrow = TRUE, dimnames = list(categories, categories))\n\nm23 <- matrix(c(\n    68,  8,  2,  0,  0,   # Strongly Agree →\n    12,115, 12,  6,  0,   # Agree →\n     2, 12, 63, 22,  8,   # Neutral →\n     0,  4, 10, 90, 12,   # Disagree →\n     0,  0,  1,  8, 45    # Strongly Disagree →\n), nrow = 5, byrow = TRUE, dimnames = list(categories, categories))\n\nwave_x  <- c(1.0, 2.0, 3.0)\nnode_w  <- 0.10\n\n# Compute stacked y-positions for each category at a wave\nstack_pos <- function(totals, gap_frac = 0.025) {\n    g   <- sum(totals) * gap_frac\n    pos <- data.frame(\n        category = names(totals), total = as.numeric(totals),\n        y_bot = NA_real_, y_top = NA_real_, y_mid = NA_real_,\n        stringsAsFactors = FALSE\n    )\n    y <- 0\n    for (i in seq_len(nrow(pos))) {\n        pos$y_bot[i] <- y\n        pos$y_top[i] <- y + pos$total[i]\n        pos$y_mid[i] <- y + pos$total[i] / 2\n        y            <- y + pos$total[i] + g\n    }\n    pos\n}\n\npos1 <- stack_pos(setNames(rowSums(m12), categories))\npos2 <- stack_pos(setNames(colSums(m12), categories))\npos3 <- stack_pos(setNames(colSums(m23), categories))\n\n# Compute flow y-segments — stacked within each node in category order\nflow_segs <- function(mat, pfrom, pto) {\n    src_off <- setNames(pfrom$y_bot, pfrom$category)\n    tgt_off <- setNames(pto$y_bot,   pto$category)\n    rows    <- list()\n    for (from_c in categories) {\n        for (to_c in categories) {\n            cnt <- mat[from_c, to_c]\n            if (cnt == 0) next\n            y1b <- src_off[[from_c]]\n            y2b <- tgt_off[[to_c]]\n            rows[[length(rows) + 1]] <- data.frame(\n                from = from_c, to = to_c, count = cnt,\n                y1_bot = y1b, y1_top = y1b + cnt,\n                y2_bot = y2b, y2_top = y2b + cnt,\n                stringsAsFactors = FALSE\n            )\n            src_off[[from_c]] <- src_off[[from_c]] + cnt\n            tgt_off[[to_c]]   <- tgt_off[[to_c]]   + cnt\n        }\n    }\n    do.call(rbind, rows)\n}\n\nsegs12 <- flow_segs(m12, pos1, pos2)\nsegs23 <- flow_segs(m23, pos2, pos3)\n\n# S-curve bezier ribbon polygon (control points keep curve horizontal at nodes)\nbezier_ribbon <- function(x1, x2, y1b, y1t, y2b, y2t, n = 80) {\n    t  <- seq(0, 1, length.out = n)\n    xm <- (x1 + x2) / 2\n    bx <- (1 - t)^3 * x1 + 3 * (1 - t)^2 * t * xm + 3 * (1 - t) * t^2 * xm + t^3 * x2\n    yh <- (1 - t)^3 * y1t + 3 * (1 - t)^2 * t * y1t + 3 * (1 - t) * t^2 * y2t + t^3 * y2t\n    yl <- (1 - t)^3 * y1b + 3 * (1 - t)^2 * t * y1b + 3 * (1 - t) * t^2 * y2b + t^3 * y2b\n    data.frame(x = c(bx, rev(bx)), y = c(yh, rev(yl)))\n}\n\nmake_ribbons <- function(segs, x1, x2) {\n    do.call(rbind, lapply(seq_len(nrow(segs)), function(i) {\n        s   <- segs[i, ]\n        rbn <- bezier_ribbon(x1, x2, s$y1_bot, s$y1_top, s$y2_bot, s$y2_top)\n        rbn$from      <- s$from\n        rbn$is_stable <- s$from == s$to\n        rbn$ribbon_id <- paste0(s$from, \"_\", s$to, \"_x\", x1)\n        rbn\n    }))\n}\n\nribbons <- rbind(\n    make_ribbons(segs12, wave_x[1], wave_x[2]),\n    make_ribbons(segs23, wave_x[2], wave_x[3])\n)\n\n# Split stable (same category) vs. changer ribbons for distinct visual treatment\nribbons_changers <- ribbons[!ribbons$is_stable, ]\nribbons_stable   <- ribbons[ribbons$is_stable,  ]\n\n# Node rectangles for all 3 waves\nnode_rects <- do.call(rbind, lapply(list(\n    list(pos = pos1, wx = wave_x[1]),\n    list(pos = pos2, wx = wave_x[2]),\n    list(pos = pos3, wx = wave_x[3])\n), function(pw) {\n    data.frame(\n        category = pw$pos$category,\n        xmin  = pw$wx - node_w / 2,\n        xmax  = pw$wx + node_w / 2,\n        ymin  = pw$pos$y_bot,\n        ymax  = pw$pos$y_top,\n        y_mid = pw$pos$y_mid,\n        x_ctr = pw$wx,\n        total = pw$pos$total,\n        stringsAsFactors = FALSE\n    )\n}))\n\n# Wave column headers\nwave_top <- max(pos1$y_top, pos2$y_top, pos3$y_top)\nheaders <- data.frame(\n    x     = wave_x,\n    y     = wave_top * 1.14,\n    label = c(\"Wave 1\\n(January)\", \"Wave 2\\n(April)\", \"Wave 3\\n(July)\")\n)\n\n# Category + count labels: left of Wave 1 nodes, right of Wave 3 nodes\nwrap_cat <- function(cat) gsub(\"Strongly \", \"Strongly\\n\", cat)\n\ncat_left <- data.frame(\n    x        = wave_x[1] - node_w / 2 - 0.04,\n    y        = pos1$y_mid,\n    label    = paste0(wrap_cat(pos1$category), \"\\n(\", pos1$total, \")\"),\n    category = pos1$category,\n    hjust    = 1.0,\n    stringsAsFactors = FALSE\n)\ncat_right <- data.frame(\n    x        = wave_x[3] + node_w / 2 + 0.04,\n    y        = pos3$y_mid,\n    label    = paste0(wrap_cat(pos3$category), \"\\n(\", pos3$total, \")\"),\n    category = pos3$category,\n    hjust    = 0.0,\n    stringsAsFactors = FALSE\n)\n\n# Wave 2 count labels (right side of Wave 2 nodes)\nw2_counts <- data.frame(\n    x     = wave_x[2] + node_w / 2 + 0.025,\n    y     = pos2$y_mid,\n    label = as.character(pos2$total),\n    hjust = 0.0\n)\n\n# Net change Wave 1 → Wave 3 for polarization subtitle\nw1_totals  <- setNames(pos1$total, pos1$category)\nw3_totals  <- setNames(pos3$total, pos3$category)\n\n# Title: scale fontsize for long title string\ntitle_str    <- \"alluvial-opinion-flow · r · ggplot2 · anyplot.ai\"\ntitle_fs     <- max(8L, round(12L * 67L / nchar(title_str)))\nsubtitle_str <- paste0(\n    \"Polarization trend (Wave 1→3): Neutral −42  ·  \",\n    \"Strongly Disagree +25  ·  shaded ribbons = stable respondents\"\n)\n\np <- ggplot() +\n    # Changer ribbons (cross-category flows) drawn first at lower opacity\n    geom_polygon(\n        data  = ribbons_changers,\n        aes(x = x, y = y, group = ribbon_id, fill = from),\n        alpha = 0.20,\n        color = NA\n    ) +\n    # Stable (same-category) ribbons emphasized with higher opacity\n    geom_polygon(\n        data  = ribbons_stable,\n        aes(x = x, y = y, group = ribbon_id, fill = from),\n        alpha = 0.52,\n        color = NA\n    ) +\n    # Nodes\n    geom_rect(\n        data      = node_rects,\n        aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = category),\n        color     = PAGE_BG,\n        linewidth = 0.35\n    ) +\n    # Category + count labels (Wave 1 left, Wave 3 right)\n    geom_text(\n        data     = cat_left,\n        aes(x = x, y = y, label = label, hjust = hjust, color = category),\n        size     = 3.0,\n        lineheight = 0.85\n    ) +\n    geom_text(\n        data     = cat_right,\n        aes(x = x, y = y, label = label, hjust = hjust, color = category),\n        size     = 3.0,\n        lineheight = 0.85\n    ) +\n    # Wave 2 count labels\n    geom_text(\n        data  = w2_counts,\n        aes(x = x, y = y, label = label, hjust = hjust),\n        size  = 2.8,\n        color = INK_MUTED\n    ) +\n    # Wave headers\n    geom_text(\n        data     = headers,\n        aes(x = x, y = y, label = label),\n        size     = 3.2,\n        color    = INK,\n        fontface = \"bold\",\n        lineheight = 0.9\n    ) +\n    scale_fill_manual(values  = IMPRINT_PALETTE, guide = \"none\") +\n    scale_color_manual(values = IMPRINT_PALETTE, guide = \"none\") +\n    labs(title = title_str, subtitle = subtitle_str) +\n    theme_void() +\n    theme(\n        plot.background = element_rect(fill = PAGE_BG, color = NA),\n        plot.title      = element_text(\n            color  = INK_SOFT,\n            size   = title_fs,\n            hjust  = 0.5,\n            margin = margin(t = 14, b = 4)\n        ),\n        plot.subtitle   = element_text(\n            color  = INK_MUTED,\n            size   = 7,\n            hjust  = 0.5,\n            margin = margin(b = 8)\n        ),\n        plot.margin = margin(t = 12, r = 100, b = 20, l = 100, unit = \"pt\")\n    ) +\n    coord_cartesian(clip = \"off\")\n\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"}