{"spec_id":"heatmap-clustered","library":"ggplot2","language":"r","code":"#' anyplot.ai\n#' heatmap-clustered: Clustered Heatmap\n#' Library: ggplot2 3.5.1 | R 4.4.1\n#' Quality: 96/100 | Created: 2026-09-05\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\"\n# Distinct from PAGE_BG (not equal) so near-zero z-score tiles stay visible\n# as part of the grid instead of fading into the canvas.\nDIV_MID     <- ELEVATED_BG\nIMPRINT_PALETTE <- c(\"#009E73\", \"#C475FD\", \"#4467A3\", \"#BD8233\",\n                     \"#AE3030\", \"#2ABCCD\", \"#954477\", \"#99B314\")\n\n# --- Data: synthetic gene-expression matrix ----------------------------------\n# 20 genes across 14 samples (7 control, 7 treatment); three latent gene\n# programs create block structure for clustering to recover.\nn_genes   <- 20\nn_samples <- 14\ngene_module  <- rep(c(\"Up\", \"Down\", \"Stable\"), c(8, 7, 5))\nsample_group <- rep(c(\"Control\", \"Treatment\"), each = 7)\ngene_id      <- sprintf(\"Gene %02d\", seq_len(n_genes))\nsample_id    <- c(paste(\"Control\", 1:7), paste(\"Treatment\", 1:7))\n\nexpr <- matrix(rnorm(n_genes * n_samples, mean = 0, sd = 0.45),\n               nrow = n_genes, ncol = n_samples,\n               dimnames = list(gene_id, sample_id))\ntreat_cols <- sample_group == \"Treatment\"\nexpr[gene_module == \"Up\",   treat_cols] <- expr[gene_module == \"Up\",   treat_cols] + 2.3\nexpr[gene_module == \"Down\", treat_cols] <- expr[gene_module == \"Down\", treat_cols] - 2.3\n\n# Per-gene z-score so every row is centered before clustering & coloring\nexpr_z <- t(scale(t(expr)))\n\n# --- Hierarchical clustering (Ward's linkage) --------------------------------\nrow_hc <- hclust(dist(expr_z), method = \"ward.D2\")\ncol_hc <- hclust(dist(t(expr_z)), method = \"ward.D2\")\n\n# Heatmap coordinates: leaf order sets 1..n grid position along each axis.\n# Rows are flipped so the first leaf in clustering order sits at the top.\nrow_rank <- integer(n_genes)\nrow_rank[row_hc$order] <- seq_len(n_genes)\nrow_leaf_y <- n_genes - row_rank + 1\n\ncol_rank <- integer(n_samples)\ncol_rank[col_hc$order] <- seq_len(n_samples)\ncol_leaf_x <- col_rank\n\n# --- Heatmap tile data --------------------------------------------------------\ntile_df <- expand.grid(gene_i = seq_len(n_genes), sample_j = seq_len(n_samples))\ntile_df$value  <- expr_z[cbind(tile_df$gene_i, tile_df$sample_j)]\ntile_df$x      <- col_leaf_x[tile_df$sample_j]\ntile_df$y      <- row_leaf_y[tile_df$gene_i]\n\nx_axis_labels <- sample_id[col_hc$order]\ny_axis_labels <- gene_id[rev(row_hc$order)]\n\n# --- Row group annotation strip (gene module) --------------------------------\nROW_ANN_THICK <- 0.6\nROW_ANN_X     <- -0.3\nrow_color_map <- c(Up = IMPRINT_PALETTE[4], Down = IMPRINT_PALETTE[6], Stable = IMPRINT_PALETTE[7])\nrow_ann_df <- data.frame(\n  y     = row_leaf_y,\n  group = gene_module,\n  color = row_color_map[gene_module]\n)\nrow_ann_label_df <- data.frame(\n  y     = tapply(row_ann_df$y, row_ann_df$group, mean),\n  label = names(tapply(row_ann_df$y, row_ann_df$group, mean))\n)\nROW_LABEL_X <- ROW_ANN_X - ROW_ANN_THICK / 2 - 0.5\n\n# --- Row dendrogram: rotated (height -> x, leaf position -> y) ---------------\n# Placed left of the row annotation strip; leaves touch ROW_LEAF_X, root extends left.\nROW_LEAF_X     <- ROW_LABEL_X - 0.6\nrow_dend_width <- 3.5\nrow_h_scale    <- row_dend_width / max(row_hc$height)\n\nn_row_merges <- n_genes - 1\nrow_node_y   <- numeric(n_row_merges)\nfor (k in seq_len(n_row_merges)) {\n  lft <- row_hc$merge[k, 1]\n  rgt <- row_hc$merge[k, 2]\n  yl  <- if (lft < 0) row_leaf_y[-lft] else row_node_y[lft]\n  yr  <- if (rgt < 0) row_leaf_y[-rgt] else row_node_y[rgt]\n  row_node_y[k] <- (yl + yr) / 2\n}\n\nn_row_segs  <- 3L * n_row_merges\nrow_seg_h    <- numeric(n_row_segs)\nrow_seg_hend <- numeric(n_row_segs)\nrow_seg_y    <- numeric(n_row_segs)\nrow_seg_yend <- numeric(n_row_segs)\nfor (k in seq_len(n_row_merges)) {\n  lft <- row_hc$merge[k, 1]\n  rgt <- row_hc$merge[k, 2]\n  yl  <- if (lft < 0) row_leaf_y[-lft] else row_node_y[lft]\n  hl  <- if (lft < 0) 0                else row_hc$height[lft]\n  yr  <- if (rgt < 0) row_leaf_y[-rgt] else row_node_y[rgt]\n  hr  <- if (rgt < 0) 0                else row_hc$height[rgt]\n  Hk  <- row_hc$height[k]\n  i <- (k - 1L) * 3L + 1L\n  row_seg_h[i]      <- hl; row_seg_hend[i]      <- Hk; row_seg_y[i]      <- yl; row_seg_yend[i]      <- yl\n  row_seg_h[i + 1L] <- Hk; row_seg_hend[i + 1L] <- Hk; row_seg_y[i + 1L] <- yl; row_seg_yend[i + 1L] <- yr\n  row_seg_h[i + 2L] <- hr; row_seg_hend[i + 2L] <- Hk; row_seg_y[i + 2L] <- yr; row_seg_yend[i + 2L] <- yr\n}\nrow_dend_df <- data.frame(\n  x    = ROW_LEAF_X - row_seg_h * row_h_scale,\n  xend = ROW_LEAF_X - row_seg_hend * row_h_scale,\n  y    = row_seg_y,\n  yend = row_seg_yend\n)\n\n# --- Column group annotation strip (Control / Treatment) --------------------\nANN_Y      <- n_genes + 0.5 + 0.5 + 0.3\nANN_THICK  <- 0.6\nann_df <- data.frame(\n  x     = col_leaf_x,\n  group = sample_group,\n  color = ifelse(sample_group == \"Control\", IMPRINT_PALETTE[1], IMPRINT_PALETTE[2])\n)\nann_label_df <- data.frame(\n  x     = tapply(ann_df$x, ann_df$group, mean),\n  label = names(tapply(ann_df$x, ann_df$group, mean))\n)\n\n# --- Column dendrogram: standard orientation (leaf position -> x, height -> y)\nCOL_LEAF_Y     <- ANN_Y + ANN_THICK / 2 + 1.1\ncol_dend_height <- 5\ncol_h_scale     <- col_dend_height / max(col_hc$height)\n\nn_col_merges <- n_samples - 1\ncol_node_x   <- numeric(n_col_merges)\nfor (k in seq_len(n_col_merges)) {\n  lft <- col_hc$merge[k, 1]\n  rgt <- col_hc$merge[k, 2]\n  xl  <- if (lft < 0) col_leaf_x[-lft] else col_node_x[lft]\n  xr  <- if (rgt < 0) col_leaf_x[-rgt] else col_node_x[rgt]\n  col_node_x[k] <- (xl + xr) / 2\n}\n\nn_col_segs   <- 3L * n_col_merges\ncol_seg_x    <- numeric(n_col_segs)\ncol_seg_xend <- numeric(n_col_segs)\ncol_seg_h    <- numeric(n_col_segs)\ncol_seg_hend <- numeric(n_col_segs)\nfor (k in seq_len(n_col_merges)) {\n  lft <- col_hc$merge[k, 1]\n  rgt <- col_hc$merge[k, 2]\n  xl  <- if (lft < 0) col_leaf_x[-lft] else col_node_x[lft]\n  hl  <- if (lft < 0) 0                else col_hc$height[lft]\n  xr  <- if (rgt < 0) col_leaf_x[-rgt] else col_node_x[rgt]\n  hr  <- if (rgt < 0) 0                else col_hc$height[rgt]\n  Hk  <- col_hc$height[k]\n  i <- (k - 1L) * 3L + 1L\n  col_seg_x[i]      <- xl; col_seg_xend[i]      <- xl; col_seg_h[i]      <- hl; col_seg_hend[i]      <- Hk\n  col_seg_x[i + 1L] <- xl; col_seg_xend[i + 1L] <- xr; col_seg_h[i + 1L] <- Hk; col_seg_hend[i + 1L] <- Hk\n  col_seg_x[i + 2L] <- xr; col_seg_xend[i + 2L] <- xr; col_seg_h[i + 2L] <- hr; col_seg_hend[i + 2L] <- Hk\n}\ncol_dend_df <- data.frame(\n  x    = col_seg_x,\n  xend = col_seg_xend,\n  y    = COL_LEAF_Y + col_seg_h * col_h_scale,\n  yend = COL_LEAF_Y + col_seg_hend * col_h_scale\n)\n\nmax_abs <- max(abs(range(expr_z)))\nplot_title    <- \"heatmap-clustered · r · ggplot2 · anyplot.ai\"\nplot_subtitle <- \"Synthetic gene expression, Ward's-linkage clustering on both axes\"\n\n# --- Plot ---------------------------------------------------------------------\np <- ggplot() +\n  geom_tile(\n    data = tile_df, aes(x = x, y = y, fill = value),\n    color = PAGE_BG, linewidth = 0.5\n  ) +\n  geom_tile(\n    data = ann_df, aes(x = x, y = ANN_Y, fill = I(color)),\n    color = PAGE_BG, linewidth = 0.5, height = ANN_THICK\n  ) +\n  geom_text(\n    data = ann_label_df, aes(x = x, y = ANN_Y + ANN_THICK / 2 + 0.5, label = label),\n    color = INK_SOFT, size = 3.0\n  ) +\n  geom_tile(\n    data = row_ann_df, aes(x = ROW_ANN_X, y = y, fill = I(color)),\n    color = PAGE_BG, linewidth = 0.5, width = ROW_ANN_THICK\n  ) +\n  geom_text(\n    data = row_ann_label_df, aes(x = ROW_LABEL_X, y = y, label = label),\n    color = INK_SOFT, size = 3.0, angle = 90\n  ) +\n  geom_segment(\n    data = row_dend_df, aes(x = x, xend = xend, y = y, yend = yend),\n    color = INK_SOFT, linewidth = 0.6\n  ) +\n  geom_segment(\n    data = col_dend_df, aes(x = x, xend = xend, y = y, yend = yend),\n    color = INK_SOFT, linewidth = 0.6\n  ) +\n  scale_fill_gradient2(\n    low = \"#AE3030\", mid = DIV_MID, high = \"#4467A3\",\n    midpoint = 0, limits = c(-max_abs, max_abs), name = \"Z-score\"\n  ) +\n  scale_x_continuous(breaks = seq_len(n_samples), labels = x_axis_labels,\n                     expand = expansion(mult = 0.03)) +\n  scale_y_continuous(breaks = seq_len(n_genes), labels = y_axis_labels,\n                     position = \"right\", expand = expansion(mult = 0.02)) +\n  labs(title = plot_title, subtitle = plot_subtitle, x = NULL, y = NULL) +\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.ticks        = element_blank(),\n    axis.text.x       = element_text(color = INK_SOFT, size = 8, angle = 45, hjust = 1),\n    axis.text.y       = element_text(color = INK_SOFT, size = 7),\n    plot.title        = element_text(color = INK, size = 12, face = \"bold\",\n                                     margin = margin(b = 4)),\n    plot.subtitle     = element_text(color = INK_SOFT, size = 8,\n                                     margin = margin(b = 8)),\n    legend.background = element_rect(fill = NA, color = NA),\n    legend.text       = element_text(color = INK_SOFT, size = 8),\n    legend.title      = element_text(color = INK, size = 9),\n    legend.position   = \"bottom\",\n    plot.margin       = margin(20, 30, 20, 20)\n  )\n\n# --- Save (square canvas: 2400x2400 px = 6in x 6in @ 400 dpi) ---------------\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"}