{"spec_id":"heatmap-cohort-retention","library":"ggplot2","language":"r","code":"#' anyplot.ai\n#' heatmap-cohort-retention: Cohort Retention Heatmap\n#' Library: ggplot2 3.5.1 | R 4.4.1\n#' Quality: 90/100 | Created: 2026-06-20\n\nlibrary(ggplot2)\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\"\nANYPLOT_AMBER <- \"#DDCC77\"\n\n# --- Data ---\ncohort_names <- c(\"Jan '24\", \"Feb '24\", \"Mar '24\", \"Apr '24\", \"May '24\",\n                  \"Jun '24\", \"Jul '24\", \"Aug '24\", \"Sep '24\", \"Oct '24\")\ncohort_sizes <- c(1240L, 980L, 1120L, 1380L, 1050L, 1290L, 1480L, 1340L, 1180L, 1420L)\nn_cohorts    <- length(cohort_names)\n\n# Realistic retention decay: steep initial drop then gradual plateau\nperiod_base  <- c(100.0, 61.5, 47.0, 38.5, 33.0, 29.5, 27.0, 25.0, 23.5, 22.0)\n\n# Per-cohort quality offset (product improvements lift retention over time)\ncohort_drift <- c(2.0, -1.5, 0.5, 3.0, -2.0, 1.0, 4.0, 2.5, -0.5, 1.5)\n\nrows <- list()\nfor (i in seq_along(cohort_names)) {\n  n_periods <- n_cohorts - i + 1L  # Jan: 10 periods, ..., Oct: 1 period\n  for (p in 0L:(n_periods - 1L)) {\n    rate <- if (p == 0L) {\n      100.0\n    } else {\n      raw <- period_base[p + 1L] + cohort_drift[i] + rnorm(1L, 0, 1.5)\n      max(8.0, min(95.0, raw))\n    }\n    rows[[length(rows) + 1L]] <- data.frame(\n      cohort      = cohort_names[i],\n      cohort_size = cohort_sizes[i],\n      period      = p,\n      ret_rate    = round(rate),\n      stringsAsFactors = FALSE\n    )\n  }\n}\ndf <- do.call(rbind, rows)\n\n# Week 1 cliff: the key insight in this chart\nwk1_avg    <- round(mean(df$ret_rate[df$period == 1L]))\ncliff_drop <- 100L - wk1_avg\n\n# Y-axis labels: \"Jan '24\\n1,240 users\" (two lines)\nsize_fmt <- formatC(cohort_sizes, format = \"d\", big.mark = \",\")\ny_labels_full <- paste0(cohort_names, \"\\n\", size_fmt, \" users\")\n\ndf$cohort_label <- paste0(\n  df$cohort, \"\\n\",\n  formatC(df$cohort_size, format = \"d\", big.mark = \",\"), \" users\"\n)\n\n# Factor for y-axis: levels bottom-to-top = Oct → Jan (Jan displayed at top)\ndf$cohort_label <- factor(df$cohort_label, levels = rev(y_labels_full))\n\n# Factor for x-axis: Wk 0 → Wk 9 (all levels present via Jan's full row)\ndf$week_label <- factor(\n  paste0(\"Wk \", df$period),\n  levels = paste0(\"Wk \", 0L:(n_cohorts - 1L))\n)\n\n# --- Plot ---\nTITLE    <- \"heatmap-cohort-retention · r · ggplot2 · anyplot.ai\"\nSUBTITLE <- sprintf(\n  \"Week 1 cliff: ~%d pp drop from signup — subsequent weeks show gradual plateau\",\n  cliff_drop\n)\n\np <- ggplot(df, aes(x = week_label, y = cohort_label, fill = ret_rate)) +\n  geom_tile(color = PAGE_BG, linewidth = 0.6) +\n  geom_text(\n    aes(label = paste0(ret_rate, \"%\")),\n    color    = \"#FFFDF6\",\n    size     = 3.0,\n    fontface = \"bold\"\n  ) +\n  # Amber dashed separator marks the \"cliff\" between Wk 0 and Wk 1\n  geom_vline(\n    xintercept = 1.5,\n    color      = ANYPLOT_AMBER,\n    linewidth  = 0.8,\n    linetype   = \"dashed\",\n    alpha      = 0.9\n  ) +\n  scale_fill_gradient(\n    low    = \"#4467A3\",  # Imprint blue  → low retention\n    high   = \"#009E73\", # Imprint green → high retention (positive signal)\n    name   = \"Retention\",\n    labels = function(x) paste0(x, \"%\"),\n    limits = c(0, 100),\n    breaks = c(0, 25, 50, 75, 100)\n  ) +\n  scale_x_discrete(expand = expansion(add = 0.5)) +\n  scale_y_discrete(expand = expansion(add = 0.5)) +\n  guides(fill = guide_colorbar(\n    barheight    = unit(6, \"cm\"),\n    barwidth     = unit(0.5, \"cm\"),\n    title.hjust  = 0.5,\n    ticks.colour = INK_SOFT,\n    frame.colour = INK_SOFT\n  )) +\n  labs(\n    title    = TITLE,\n    subtitle = SUBTITLE,\n    x        = \"Weeks Since Signup\",\n    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.x        = element_text(color = INK, size = 10,\n                                       margin = margin(t = 8)),\n    axis.text.x         = element_text(color = INK_SOFT, size = 8),\n    axis.text.y         = element_text(color = INK_SOFT, size = 8.5,\n                                       lineheight = 1.2, hjust = 1),\n    plot.title          = element_text(color = INK, size = 12,\n                                       hjust = 0.5,\n                                       margin = margin(b = 4)),\n    plot.subtitle       = element_text(color = INK_SOFT, size = 8.5,\n                                       hjust = 0.5,\n                                       margin = margin(b = 10)),\n    plot.title.position = \"plot\",\n    legend.position     = \"right\",\n    legend.background   = element_rect(fill = ELEVATED_BG, color = INK_SOFT,\n                                       linewidth = 0.3),\n    legend.text         = element_text(color = INK_SOFT, size = 8),\n    legend.title        = element_text(color = INK, size = 9),\n    legend.key.height   = unit(1.5, \"cm\"),\n    legend.key.width    = unit(0.5, \"cm\"),\n    plot.margin         = margin(t = 20, r = 10, b = 15, l = 10)\n  )\n\n# --- Save (square canvas: 2400x2400 px) ---\nggsave(\n  filename = sprintf(\"plot-%s.png\", THEME),\n  plot     = p,\n  device   = ragg::agg_png,\n  width    = 6,\n  height   = 6,\n  units    = \"in\",\n  dpi      = 400\n)\n"}