{
"raw_base": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/",
"github_base": "https://github.com/Xuzhen-Li/paper-viz/blob/main/",
"tasks": [
{
"id": "compare",
"zh": "比较组",
"en": "Compare groups"
},
{
"id": "distribution",
"zh": "分布",
"en": "Distribution"
},
{
"id": "relationship",
"zh": "相关/关系",
"en": "Relationship"
},
{
"id": "composition",
"zh": "组成",
"en": "Composition"
},
{
"id": "de",
"zh": "差异表达",
"en": "Differential expression"
},
{
"id": "enrichment",
"zh": "富集",
"en": "Enrichment"
},
{
"id": "ordination",
"zh": "降维",
"en": "Dimension reduction"
},
{
"id": "genome",
"zh": "基因组",
"en": "Genome"
},
{
"id": "popgen",
"zh": "群体遗传",
"en": "Population genetics"
},
{
"id": "phylogeny",
"zh": "系统发育",
"en": "Phylogeny"
},
{
"id": "network",
"zh": "网络",
"en": "Network"
},
{
"id": "clinical",
"zh": "临床",
"en": "Clinical"
},
{
"id": "microbiome",
"zh": "微生物/生态",
"en": "Microbiome & ecology"
},
{
"id": "layout",
"zh": "拼图",
"en": "Layout"
},
{
"id": "schematic",
"zh": "流程图",
"en": "Schematics"
}
],
"figures": [
{
"title": "Forest plot",
"title_zh": "森林图",
"slug": "forest",
"category": "clinical",
"tags": [
"forest",
"hazard-ratio",
"confidence-interval"
],
"packages": [
"ggplot2"
],
"data_columns": {
"study": "研究或亚组名（字符串，行顺序即从上到下的反向）",
"hr": "风险比（数值，大于 0）",
"ci_low": "95% 区间下限（数值）",
"ci_high": "95% 区间上限（数值）"
},
"when_to_use": "多个研究或亚组要并列展示效应量和区间时用。",
"customize": "在 `plot.R` 调整 `show_values` 开关（默认值为 `TRUE`）以在区间上方显示数值，颜色取自 `pv_palette(\"house\")`；并在 `data.csv` 填入 study、hr、ci_low 和 ci_high 列。",
"lang": "R",
"task": "clinical",
"task_zh": "临床",
"task_en": "Clinical",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_values",
"value": "TRUE"
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "point_col",
"value": "hp[[\"blue\"]]"
},
{
"name": "footnote",
"value": "\"Simulated data for\\nillustration; not\\nbiological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "89",
"label": "43 × 89 mm (1×2 cells)",
"cells": "1x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/clinical/forest/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/clinical/forest/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/forest/plot.R"
},
{
"name": "data.csv",
"path": "figures/clinical/forest/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/clinical/forest/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/forest/data.csv"
},
{
"name": "make_data.R",
"path": "figures/clinical/forest/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/clinical/forest/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/forest/make_data.R"
}
],
"dir": "figures/clinical/forest",
"preview": "figures/clinical/forest/preview.png",
"docs_preview": "previews/forest.png",
"code": "figures/clinical/forest/plot.R",
"data": "figures/clinical/forest/data.csv",
"data_files": [
"figures/clinical/forest/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/forest/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/forest/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/clinical/forest",
"code_text": "# Forest plot (house style): hazard ratio and 95% CI per study on a log axis, dashed line at HR = 1,\n# HR [CI] written beside each row and the study count in the panel. Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nshow_values <- TRUE # HR [low, high] written just above each CI line\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue is >= 3:1 on white, so the point colour is also used for the value text\npoint_col <- hp[[\"blue\"]]\nfootnote <- \"Simulated data for\\nillustration; not\\nbiological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$y <- rev(seq_len(nrow(df)))\ndf$lab <- sprintf(\"%.2f [%.2f, %.2f]\", df$hr, df$ci_low, df$ci_high)\nn_up <- sum(df$ci_low > 1); n_down <- sum(df$ci_high < 1)\nx_lim <- c(min(df$ci_low) / 1.2, max(df$ci_high) * 1.2)\ny_lim <- c(0.4, nrow(df) + 1.75)\n\np <- ggplot(df, aes(hr, y)) +\n geom_vline(xintercept = 1, linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_segment(aes(x = ci_low, xend = ci_high, yend = y), linewidth = pv_house_lw(0.9),\n colour = point_col) +\n geom_point(shape = 16, size = 3, colour = point_col) +\n annotate(\"text\", x = x_lim[1] * 1.06, y = nrow(df) + 1.2, hjust = 0, vjust = 0.5,\n label = sprintf(\"N = %d studies\\n%d CI > 1, %d CI < 1\", nrow(df), n_up, n_down),\n lineheight = 0.9)\nif (isTRUE(show_values)) {\n p <- p + geom_text(aes(x = x_lim[1] * 1.06, y = y + 0.42, label = lab), hjust = 0, colour = point_col)\n}\np <- p +\n scale_x_log10(breaks = c(0.5, 1, 2, 4), labels = c(\"0.5\", \"1\", \"2\", \"4\")) +\n scale_y_continuous(breaks = df$y, labels = df$study) +\n coord_cartesian(xlim = x_lim, ylim = y_lim, expand = FALSE) +\n labs(x = \"Hazard ratio\", y = NULL, caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "forest plot\n森林图\nforest\n\nclinical\n临床\nclinical\n临床\nclinical\n多个研究或亚组要并列展示效应量和区间时用。\n在 `plot.r` 调整 `show_values` 开关（默认值为 `true`）以在区间上方显示数值，颜色取自 `pv_palette(\"house\")`；并在 `data.csv` 填入 study、hr、ci_low 和 ci_high 列。\nforest hazard-ratio confidence-interval\nstudy 研究或亚组名（字符串，行顺序即从上到下的反向） hr 风险比（数值，大于 0） ci_low 95% 区间下限（数值） ci_high 95% 区间上限（数值）"
},
{
"title": "Kaplan-Meier curves",
"title_zh": "Kaplan-Meier 生存曲线",
"slug": "km",
"category": "clinical",
"tags": [
"survival",
"kaplan-meier"
],
"packages": [
"ggplot2",
"survival"
],
"data_columns": {
"id": "个体编号（字符串）",
"time": "随访时间（数值）",
"status": "事件指示，1 为发生事件，0 为删失（整数）",
"arm": "分组（字符串）"
},
"when_to_use": "要比较两组或多组的时间-事件结局时用。",
"customize": "在 `plot.R` 调整 `arm_levels` 设定分组顺序，控制 `show_censor` 开关（默认值为 `TRUE`）显隐删失点；并在 `data.csv` 填入 id、time、status 和 arm 列。",
"lang": "R",
"task": "clinical",
"task_zh": "临床",
"task_en": "Clinical",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_censor",
"value": "TRUE"
},
{
"name": "arm_levels",
"value": "c(\"Control\", \"Treatment\")"
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "cols",
"value": "stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]]), arm_levels)"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/clinical/km/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/clinical/km/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/km/plot.R"
},
{
"name": "data.csv",
"path": "figures/clinical/km/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/clinical/km/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/km/data.csv"
},
{
"name": "make_data.R",
"path": "figures/clinical/km/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/clinical/km/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/km/make_data.R"
}
],
"dir": "figures/clinical/km",
"preview": "figures/clinical/km/preview.png",
"docs_preview": "previews/km.png",
"code": "figures/clinical/km/plot.R",
"data": "figures/clinical/km/data.csv",
"data_files": [
"figures/clinical/km/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/km/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/km/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/clinical/km",
"code_text": "# Kaplan-Meier curves (house style): step lines per arm with censor ticks, arm names and\n# median survival written at the curve ends, log-rank P in the panel. survival only computes.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nshow_censor <- TRUE\narm_levels <- c(\"Control\", \"Treatment\")\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue and red are both >= 3:1 on white, so the arm labels keep the line colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]]), arm_levels)\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$arm <- factor(df$arm, levels = arm_levels)\nfit <- survival::survfit(survival::Surv(time, status) ~ arm, data = df)\nsf <- summary(fit, censored = TRUE)\narm <- factor(sub(\"^arm=\", \"\", sf$strata), levels = arm_levels)\ncurve <- data.frame(time = sf$time, surv = sf$surv, arm = arm, n_censor = sf$n.censor)\n# start every curve at (0, 1)\ncurve <- rbind(data.frame(time = 0, surv = 1, arm = factor(arm_levels, levels = arm_levels), n_censor = 0), curve)\ncurve <- curve[order(curve$arm, curve$time), ]\ncens <- curve[curve$n_censor > 0, , drop = FALSE]\nlr <- survival::survdiff(survival::Surv(time, status) ~ arm, data = df)\np_lr <- stats::pchisq(lr$chisq, df = length(arm_levels) - 1, lower.tail = FALSE)\nmed <- summary(fit)$table[, \"median\"]\nnames(med) <- sub(\"^arm=\", \"\", names(med))\nends <- do.call(rbind, lapply(arm_levels, function(a) {\n d <- curve[curve$arm == a, ]\n data.frame(arm = factor(a, levels = arm_levels), time = max(d$time), surv = d$surv[nrow(d)],\n n = sum(df$arm == a), med = med[[a]])\n}))\nends$lab <- sprintf(\"%s (n = %d)\\nmedian %s\", ends$arm, ends$n,\n ifelse(is.na(ends$med), \"not reached\", sprintf(\"%.1f mo\", ends$med)))\nx_max <- max(curve$time)\n# keep the end labels apart\nends <- ends[order(ends$surv), ]\nfor (i in seq_len(nrow(ends))[-1]) ends$surv[i] <- max(ends$surv[i], ends$surv[i - 1] + 0.2)\n\np <- ggplot(curve, aes(time, surv, colour = arm)) +\n geom_step(linewidth = pv_house_lw(\"main\"))\nif (isTRUE(show_censor)) {\n # censor marks as short vertical segments (a \"|\" point shape would be drawn as a text glyph)\n tick_h <- 0.025\n p <- p + geom_segment(data = cens, aes(x = time, xend = time, y = surv - tick_h, yend = surv + tick_h),\n linewidth = pv_house_lw(\"minor\"))\n}\np <- p +\n geom_text(data = ends, aes(x = x_max * 1.02, y = surv, label = lab), hjust = 0, vjust = 0.5,\n lineheight = 0.9) +\n annotate(\"text\", x = x_max * 0.02, y = 0.04, hjust = 0, vjust = 0,\n label = sprintf(\"'Log-rank '*%s\", pv_fmt_p(p_lr)), parse = TRUE) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(breaks = seq(0, 40, 10)) +\n scale_y_continuous(breaks = seq(0, 1, 0.25)) +\n coord_cartesian(xlim = c(0, x_max * 1.42), ylim = c(0, 1.02), expand = FALSE) +\n labs(x = \"Time (months)\", y = \"Survival probability\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "kaplan-meier curves\nkaplan-meier 生存曲线\nkm\n\nclinical\n临床\nclinical\n临床\nclinical\n要比较两组或多组的时间-事件结局时用。\n在 `plot.r` 调整 `arm_levels` 设定分组顺序，控制 `show_censor` 开关（默认值为 `true`）显隐删失点；并在 `data.csv` 填入 id、time、status 和 arm 列。\nsurvival kaplan-meier\nid 个体编号（字符串） time 随访时间（数值） status 事件指示，1 为发生事件，0 为删失（整数） arm 分组（字符串）"
},
{
"title": "ROC curve",
"title_zh": "ROC 曲线",
"slug": "roc",
"category": "clinical",
"tags": [
"roc",
"auc",
"biomarker"
],
"packages": [
"ggplot2",
"pROC"
],
"data_columns": {
"subject": "受试者编号（字符串）",
"marker": "标志物名称（字符串）",
"score": "连续得分（数值）",
"label": "观察期内是否发生事件，1 或 0（整数）",
"time": "事件或删失时间，月（数值）"
},
"when_to_use": "几个连续标志物要比较区分病例和对照的能力时用。",
"customize": "在 `plot.R` 修改 `markers_keep` 选定标志物，控制 `show_auc` 显隐面积标签，利用 `time_dependent` 和 `landmark_time` 指定时间；在 `data.csv` 填入 subject、marker、score、label 和 time 列。",
"lang": "R",
"task": "clinical",
"task_zh": "临床",
"task_en": "Clinical",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "markers_keep",
"value": "c(\"AFP\", \"DCP\", \"ALT\")"
},
{
"name": "show_auc",
"value": "TRUE"
},
{
"name": "time_dependent",
"value": "FALSE"
},
{
"name": "landmark_time",
"value": "18"
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "pal",
"value": "stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"magenta\"]], hp[[\"brown\"]])[seq_along(markers_keep)], markers_keep)"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration;\\nnot biological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/clinical/roc/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/clinical/roc/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/roc/plot.R"
},
{
"name": "data.csv",
"path": "figures/clinical/roc/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/clinical/roc/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/roc/data.csv"
},
{
"name": "make_data.R",
"path": "figures/clinical/roc/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/clinical/roc/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/roc/make_data.R"
}
],
"dir": "figures/clinical/roc",
"preview": "figures/clinical/roc/preview.png",
"docs_preview": "previews/roc.png",
"code": "figures/clinical/roc/plot.R",
"data": "figures/clinical/roc/data.csv",
"data_files": [
"figures/clinical/roc/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/roc/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/clinical/roc/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/clinical/roc",
"code_text": "# ROC curves (house style): one curve per marker, marker names with AUC written in the panel in the\n# curve colour (no legend), optional landmark status. pROC only computes; ggplot2 draws.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nmarkers_keep <- c(\"AFP\", \"DCP\", \"ALT\")\nshow_auc <- TRUE\ntime_dependent <- FALSE\nlandmark_time <- 18\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue, red, green: all >= 3:1 on white, so the marker labels keep the curve colour\npal <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"magenta\"]],\n hp[[\"brown\"]])[seq_along(markers_keep)], markers_keep)\nfootnote <- \"Simulated data for illustration;\\nnot biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$marker %in% markers_keep, , drop = FALSE]\nif (isTRUE(time_dependent)) {\n event <- df$label == 1 & df$time <= landmark_time\n control <- df$time > landmark_time\n df <- df[event | control, , drop = FALSE]\n df$label <- as.integer(event[event | control])\n}\n\ncurves <- lapply(split(df, df$marker), function(sub) {\n roc <- pROC::roc(sub$label, sub$score, quiet = TRUE, direction = \"<\")\n data.frame(fpr = 1 - roc$specificities, tpr = roc$sensitivities,\n marker = unique(sub$marker), auc = as.numeric(pROC::auc(roc)))\n})\nplot_df <- do.call(rbind, curves)\nplot_df$marker <- factor(plot_df$marker, levels = markers_keep)\nplot_df <- plot_df[order(plot_df$marker, plot_df$fpr, plot_df$tpr), ]\nkey <- data.frame(marker = factor(markers_keep, levels = markers_keep), i = seq_along(markers_keep))\nkey$auc <- vapply(markers_keep, function(m) plot_df$auc[plot_df$marker == m][1], numeric(1))\nkey$lab <- if (isTRUE(show_auc)) sprintf(\"%s AUC %.2f\", key$marker, key$auc) else markers_keep\nn_case <- sum(df$label == 1 & df$marker == markers_keep[1])\nn_ctrl <- sum(df$label == 0 & df$marker == markers_keep[1])\n\np <- ggplot(plot_df, aes(fpr, tpr, colour = marker)) +\n geom_abline(slope = 1, intercept = 0, linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_step(linewidth = pv_house_lw(\"main\"), direction = \"vh\") +\n geom_text(data = key, aes(x = 0.98, y = 0.04 + 0.11 * (nrow(key) - i + 1), label = lab), hjust = 1,\n vjust = 0) +\n annotate(\"text\", x = 0.98, y = 0.04, hjust = 1, vjust = 0,\n label = sprintf(\"%d cases, %d controls\", n_case, n_ctrl)) +\n scale_colour_manual(values = pal, guide = \"none\") +\n scale_x_continuous(breaks = c(0, 0.5, 1), labels = c(\"0\", \"0.5\", \"1\")) +\n scale_y_continuous(breaks = c(0, 0.5, 1), labels = c(\"0\", \"0.5\", \"1\")) +\n coord_cartesian(xlim = c(0, 1), ylim = c(0, 1), expand = TRUE) +\n labs(x = \"False positive rate\", y = \"True positive rate\",\n title = if (isTRUE(time_dependent)) sprintf(\"Status at %s months\", landmark_time) else NULL,\n caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "roc curve\nroc 曲线\nroc\n\nclinical\n临床\nclinical\n临床\nclinical\n几个连续标志物要比较区分病例和对照的能力时用。\n在 `plot.r` 修改 `markers_keep` 选定标志物，控制 `show_auc` 显隐面积标签，利用 `time_dependent` 和 `landmark_time` 指定时间；在 `data.csv` 填入 subject、marker、score、label 和 time 列。\nroc auc biomarker\nsubject 受试者编号（字符串） marker 标志物名称（字符串） score 连续得分（数值） label 观察期内是否发生事件，1 或 0（整数） time 事件或删失时间，月（数值）"
},
{
"title": "Ablation study bars (house style)",
"title_zh": "消融实验柱图（house 风格）",
"slug": "ablation-bar",
"category": "comparison",
"tags": [
"ablation",
"bar",
"baseline",
"model-comparison",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"variant": "模型版本（字符串；其中一行为完整模型，其余为去掉某一组件的版本）",
"seed": "随机种子或重复编号（整数）",
"score": "该次运行的评价指标（数值，此例为准确率 %）"
},
"when_to_use": "消融实验（逐一去掉某个模块看性能下降多少的实验）中，比较完整模型与各删减变体在多次重复实验下的平均得分与差值时用。",
"customize": "在 `data.csv` 填入 `variant`（模型变体名，完整模型一行，其余写「w/o 模块名」）、`seed`（随机种子，即每次重复实验的编号）和 `score`（得分）；在 `plot.R` 顶部修改 `full_name` 指定完整模型名称（默认「Full model」），改 `metric_label` 和 `x_limits` 设横轴名称与范围（有真实零点时保持从 0 开始），用 `sort_by_drop` 控制是否按性能下降幅度排序，`show_points` 设为 `TRUE` 可画出每次实验的散点。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "full_name",
"value": "\"Full model\""
},
{
"name": "metric_label",
"value": "\"Accuracy (%)\""
},
{
"name": "x_limits",
"value": "c(0, 100)"
},
{
"name": "sort_by_drop",
"value": "TRUE"
},
{
"name": "show_points",
"value": "FALSE"
},
{
"name": "drop_digits",
"value": "1"
},
{
"name": "footnote",
"value": "\"Simulated data; not real model results.\\nBars: mean \\u00b1 s.d. of %d seeds; dashed line: full model\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "col_full",
"value": "hp[[\"blue\"]]"
},
{
"name": "col_ablated",
"value": "grey[[\"ref\"]]"
},
{
"name": "col_ref",
"value": "grey[[\"dark\"]]"
},
{
"name": "col_text",
"value": "\"#1A1A1A\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/ablation-bar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/ablation-bar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/ablation-bar/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/ablation-bar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/ablation-bar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/ablation-bar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/ablation-bar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/ablation-bar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/ablation-bar/make_data.R"
}
],
"dir": "figures/comparison/ablation-bar",
"preview": "figures/comparison/ablation-bar/preview.png",
"docs_preview": "previews/ablation-bar.png",
"code": "figures/comparison/ablation-bar/plot.R",
"data": "figures/comparison/ablation-bar/data.csv",
"data_files": [
"figures/comparison/ablation-bar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/ablation-bar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/ablation-bar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/ablation-bar",
"code_text": "# Ablation study bars (house style): one bar per model variant (mean of seeds, s.d. error bar,\n# one open point per seed), the full model as a dashed reference line, and the drop from the full\n# model written at the right of each ablated row. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nfull_name <- \"Full model\" # the reference row in column `variant`\nmetric_label <- \"Accuracy (%)\" # x-axis title\nx_limits <- c(0, 100) # bars start at 0; keep 0 unless the metric has no true zero\nsort_by_drop <- TRUE # largest drop right under the full model\nshow_points <- FALSE # TRUE: one open circle per seed on each bar\ndrop_digits <- 1 # decimals of the drop labels\nfootnote <- \"Simulated data; not real model results.\\nBars: mean \\u00b1 s.d. of %d seeds; dashed line: full model\" # %d = number of seeds in data.csv\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\ncol_full <- hp[[\"blue\"]] # 5.15:1 on white, so its value label keeps the bar colour\ncol_ablated <- grey[[\"ref\"]] # #757575 bars for the variants (4.6:1 on white)\ncol_ref <- grey[[\"dark\"]] # #333333 dashed full-model line, darker than the grey bars\ncol_text <- \"#1A1A1A\" # drop labels\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nstopifnot(full_name %in% df$variant)\nfootnote <- sprintf(footnote, length(unique(df$seed)))\ns <- do.call(rbind, lapply(split(df, df$variant), function(d) {\n data.frame(variant = d$variant[1], mean = mean(d$score), sd = stats::sd(d$score), n = nrow(d))\n}))\nfull_mean <- s$mean[s$variant == full_name]\ns$drop <- s$mean - full_mean\nlv <- if (isTRUE(sort_by_drop)) {\n c(full_name, s$variant[s$variant != full_name][order(s$drop[s$variant != full_name])])\n} else unique(df$variant)\n# first level on top\ns$variant <- factor(s$variant, levels = rev(lv))\ndf$variant <- factor(df$variant, levels = rev(lv))\ns$is_full <- s$variant == full_name\n# drop labels: ASCII hyphen-minus, fixed x right of the reference line and every error bar\ns$lab <- ifelse(s$is_full, sprintf(paste0(\"%.\", drop_digits, \"f\"), s$mean),\n sprintf(paste0(\"%+.\", drop_digits, \"f\"), s$drop))\ns$lab <- gsub(\"\\u2212\", \"-\", s$lab)\nlab_x <- max(s$mean + s$sd, full_mean) + 0.025 * diff(x_limits)\ns$lab_col <- ifelse(s$is_full, col_full, col_text)\n# seed points at fixed vertical offsets (no jitter, so every render is identical)\ndf <- df[order(df$variant, df$seed), ]\ndf$k <- stats::ave(df$score, df$variant, FUN = seq_along)\ndf$n <- stats::ave(df$score, df$variant, FUN = length)\ndf$y <- as.numeric(df$variant) + (df$k - (df$n + 1) / 2) * 0.1\n\np <- ggplot(s, aes(mean, variant)) +\n geom_col(aes(fill = is_full), width = 0.7, colour = NA, orientation = \"y\") +\n geom_vline(xintercept = full_mean, linetype = \"22\", colour = col_ref,\n linewidth = pv_house_lw(\"ref\"))\nif (isTRUE(show_points)) {\n p <- p + geom_point(data = df, aes(score, y), inherit.aes = FALSE, shape = 21, size = 0.8,\n stroke = 0.3, fill = \"white\", colour = \"black\")\n}\np <- p +\n geom_errorbar(aes(xmin = mean - sd, xmax = mean + sd), width = 0.22,\n linewidth = pv_house_lw(\"errorbar\"), orientation = \"y\") +\n geom_text(aes(x = lab_x, label = lab, colour = lab_col), hjust = 0, size = pv_pt2size(7)) +\n scale_fill_manual(values = c(`TRUE` = col_full, `FALSE` = col_ablated), guide = \"none\") +\n scale_colour_identity() +\n scale_x_continuous(limits = x_limits, expand = c(0, 0), breaks = pretty(x_limits, n = 5)) +\n scale_y_discrete(expand = expansion(add = 0.55)) +\n labs(x = metric_label, y = NULL, caption = footnote) +\n theme_house() +\n theme(axis.ticks.y = element_blank(),\n plot.margin = margin(1.6, 2.4, 0.9, 0.4, \"mm\"), # room for the last x tick \"100\"\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "ablation study bars (house style)\n消融实验柱图（house 风格）\nablation-bar\n\ncomparison\n比较\ncompare\n比较组\ncompare groups\n消融实验（逐一去掉某个模块看性能下降多少的实验）中，比较完整模型与各删减变体在多次重复实验下的平均得分与差值时用。\n在 `data.csv` 填入 `variant`（模型变体名，完整模型一行，其余写「w/o 模块名」）、`seed`（随机种子，即每次重复实验的编号）和 `score`（得分）；在 `plot.r` 顶部修改 `full_name` 指定完整模型名称（默认「full model」），改 `metric_label` 和 `x_limits` 设横轴名称与范围（有真实零点时保持从 0 开始），用 `sort_by_drop` 控制是否按性能下降幅度排序，`show_points` 设为 `true` 可画出每次实验的散点。\nablation bar baseline model-comparison house-style\nvariant 模型版本（字符串；其中一行为完整模型，其余为去掉某一组件的版本） seed 随机种子或重复编号（整数） score 该次运行的评价指标（数值，此例为准确率 %）"
},
{
"title": "Grouped bar chart",
"title_zh": "分组柱状图",
"slug": "bar-grouped",
"category": "comparison",
"tags": [
"bar",
"grouped",
"comparison"
],
"packages": [
"ggplot2"
],
"data_columns": {
"group": "横轴类别（字符串）",
"series": "并排系列名（字符串）",
"value": "该格的均值（数值）"
},
"when_to_use": "类别少、要并排比较两个或多个系列的汇总数值时用。",
"customize": "在 `plot.R` 修改 `bar_width` 和 `dodge_width` 调整柱宽与间距，控制 `show_values`（默认值为 `TRUE`）显示数值，及 `show_legend` 图例；在 `data.csv` 填入 group、series 和 value 列。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": "Grouped",
"variants": [
{
"slug": "bar-grouped",
"variant_label": "Grouped",
"title": "Grouped bar chart",
"title_zh": "分组柱状图",
"docs_preview": "previews/bar-grouped.png"
},
{
"slug": "circular-bar",
"variant_label": "Circular",
"title": "Circular bar",
"title_zh": "环状柱形图",
"docs_preview": "previews/circular-bar.png"
}
],
"parameters": [
{
"name": "bar_width",
"value": "0.72"
},
{
"name": "dodge_width",
"value": "0.8"
},
{
"name": "show_legend",
"value": "TRUE"
},
{
"name": "show_values",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/bar-grouped/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/bar-grouped/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/bar-grouped/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/bar-grouped/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/bar-grouped/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/bar-grouped/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/bar-grouped/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/bar-grouped/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/bar-grouped/make_data.R"
}
],
"dir": "figures/comparison/bar-grouped",
"preview": "figures/comparison/bar-grouped/preview.png",
"docs_preview": "previews/bar-grouped.png",
"code": "figures/comparison/bar-grouped/plot.R",
"data": "figures/comparison/bar-grouped/data.csv",
"data_files": [
"figures/comparison/bar-grouped/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/bar-grouped/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/bar-grouped/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/bar-grouped",
"code_text": "# Grouped bars (house style): series side by side, value on each bar, series names as a coloured\n# key inside the panel (no legend), mean ratio of the last to the first series written in the panel.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nbar_width <- 0.72\ndodge_width <- 0.8\nshow_legend <- TRUE # coloured series key inside the panel\nshow_values <- TRUE\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = unique(df$group))\ndf$series <- factor(df$series, levels = unique(df$series))\ns_lv <- levels(df$series)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue, red, green, purple: all >= 3:1 on white, so key text keeps the bar colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]])[seq_along(s_lv)], s_lv)\nfootnote <- \"Simulated data for illustration; not biological results\"\ny_top <- max(df$value) * 1.32\n\nfirst <- df[df$series == s_lv[1], ]; last <- df[df$series == s_lv[length(s_lv)], ]\nratio <- mean(last$value[match(first$group, last$group)] / first$value)\n\npd <- position_dodge(width = dodge_width)\np <- ggplot(df, aes(group, value, fill = series)) +\n geom_col(width = bar_width, position = pd, colour = NA)\nif (isTRUE(show_values)) {\n p <- p + geom_text(aes(label = sprintf(\"%.1f\", value), group = series), position = pd, vjust = -0.4)\n}\nif (isTRUE(show_legend)) {\n key <- data.frame(series = factor(s_lv, levels = s_lv), i = seq_along(s_lv))\n p <- p + geom_text(data = key, aes(x = 0.56, y = y_top * (0.97 - 0.09 * (i - 1)), label = series,\n colour = series),\n hjust = 0, vjust = 1, inherit.aes = FALSE)\n}\np <- p +\n annotate(\"text\", x = nlevels(df$group) + 0.44, y = y_top * 0.97, hjust = 1, vjust = 1,\n label = sprintf(\"Mean %s / %s = %.2f\", s_lv[length(s_lv)], s_lv[1], ratio)) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_y_continuous(limits = c(0, y_top), expand = c(0, 0)) +\n scale_x_discrete(expand = expansion(add = 0.5)) +\n labs(x = NULL, y = \"Value\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "grouped bar chart\n分组柱状图\nbar-grouped\ngrouped\ncomparison\n比较\ncompare\n比较组\ncompare groups\n类别少、要并排比较两个或多个系列的汇总数值时用。\n在 `plot.r` 修改 `bar_width` 和 `dodge_width` 调整柱宽与间距，控制 `show_values`（默认值为 `true`）显示数值，及 `show_legend` 图例；在 `data.csv` 填入 group、series 和 value 列。\nbar grouped comparison\ngroup 横轴类别（字符串） series 并排系列名（字符串） value 该格的均值（数值）"
},
{
"title": "Bump chart",
"title_zh": "凹凸图",
"slug": "bump-chart",
"category": "comparison",
"tags": [
"bump-chart",
"rank",
"comparison"
],
"packages": [
"ggplot2"
],
"data_columns": {
"item": "项目名称（字符串）",
"time": "时间点（字符串）",
"rank": "该时间点的名次（整数，1 为最高）"
},
"when_to_use": "比较多个对象在若干时间点的名次升降时用。",
"customize": "plot.R 顶部 highlight_items 填写要高亮的项目名，其余画成灰色。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "highlight_items",
"value": "c(\"TP53\", \"KRAS\")"
},
{
"name": "time_levels",
"value": "paste0(\"T\", 1:6)"
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "hi_cols",
"value": "c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"magenta\"]])[seq_along(highlight_items)]"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/bump-chart/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/bump-chart/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/bump-chart/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/bump-chart/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/bump-chart/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/bump-chart/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/bump-chart/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/bump-chart/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/bump-chart/make_data.R"
}
],
"dir": "figures/comparison/bump-chart",
"preview": "figures/comparison/bump-chart/preview.png",
"docs_preview": "previews/bump-chart.png",
"code": "figures/comparison/bump-chart/plot.R",
"data": "figures/comparison/bump-chart/data.csv",
"data_files": [
"figures/comparison/bump-chart/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/bump-chart/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/bump-chart/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/bump-chart",
"code_text": "# Bump chart (house style): ranks over time, named items coloured and the rest grey, item names\n# written at the line ends in the line colour, rank change of the highlighted items in the panel.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nhighlight_items <- c(\"TP53\", \"KRAS\")\ntime_levels <- paste0(\"T\", 1:6)\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue and red are >= 3:1 on white, so highlighted names keep the line colour;\n# grey lines (#BFBFBF, < 3:1) get their names in mid grey #6B6B6B (5.3:1)\nhi_cols <- c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"magenta\"]])[seq_along(highlight_items)]\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$time <- factor(df$time, levels = time_levels)\ndf$x <- as.numeric(df$time)\ndf$mark <- ifelse(df$item %in% highlight_items, df$item, \"Other\")\nmark_levels <- c(highlight_items, \"Other\")\ndf$mark <- factor(df$mark, levels = mark_levels)\nline_cols <- stats::setNames(c(hi_cols, grey[[\"ci\"]]), mark_levels)\ntext_cols <- stats::setNames(c(hi_cols, grey[[\"mid\"]]), mark_levels)\ndf <- df[order(df$mark != \"Other\"), ] # highlighted lines drawn last (on top)\nn_t <- length(time_levels)\nends <- df[df$time == time_levels[n_t], , drop = FALSE]\nstarts <- df[df$time == time_levels[1], , drop = FALSE]\nchg <- vapply(highlight_items, function(it) {\n sprintf(\"%s: rank %d to %d\", it, starts$rank[starts$item == it], ends$rank[ends$item == it])\n}, character(1))\nn_rank <- max(df$rank)\ny_bottom <- n_rank + 1.45 # one line of rank-change text under the last rank\n\np <- ggplot(df, aes(x, rank, group = item)) +\n geom_line(aes(colour = mark, linewidth = mark == \"Other\")) +\n geom_point(aes(fill = mark), shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = \"black\") +\n geom_text(data = ends, aes(x = n_t + 0.22, label = item, colour = I(text_cols[as.character(mark)])),\n hjust = 0) +\n annotate(\"text\", x = 0.8, y = y_bottom - 0.12, hjust = 0, vjust = 0, lineheight = 0.95,\n label = paste(chg, collapse = \"; \"), colour = \"black\") +\n scale_colour_manual(values = line_cols, guide = \"none\") +\n scale_fill_manual(values = line_cols, guide = \"none\") +\n scale_linewidth_manual(values = c(`TRUE` = pv_house_lw(\"minor\"), `FALSE` = pv_house_lw(\"main\")),\n guide = \"none\") +\n scale_x_continuous(breaks = seq_len(n_t), labels = time_levels) +\n scale_y_reverse(breaks = seq_len(n_rank)) +\n coord_cartesian(xlim = c(0.7, n_t + 1.05), ylim = c(y_bottom, 0.6),\n expand = FALSE) +\n labs(x = \"Time point\", y = \"Rank\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "bump chart\n凹凸图\nbump-chart\n\ncomparison\n比较\ncompare\n比较组\ncompare groups\n比较多个对象在若干时间点的名次升降时用。\nplot.r 顶部 highlight_items 填写要高亮的项目名，其余画成灰色。\nbump-chart rank comparison\nitem 项目名称（字符串） time 时间点（字符串） rank 该时间点的名次（整数，1 为最高）"
},
{
"title": "Circular bar",
"title_zh": "环状柱形图",
"slug": "circular-bar",
"category": "comparison",
"tags": [
"circular-bar",
"comparison",
"polar"
],
"packages": [
"ggplot2",
"scales"
],
"data_columns": {
"category": "类别名称（字符串）",
"group": "分组（字符串）",
"value": "数值（正数）"
},
"when_to_use": "类别较多、又要并排比较两组时，用环形柱代替长条形图。",
"customize": "plot.R 顶部 show_groups 控制是否分组并排；labels_outside 控制环外标签；inner_hole 为内圆半径占最大值的比例。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": "bar-grouped",
"variant_label": "Circular",
"variants": [],
"parameters": [
{
"name": "show_groups",
"value": "TRUE"
},
{
"name": "labels_outside",
"value": "TRUE"
},
{
"name": "inner_hole",
"value": "0.42"
},
{
"name": "category_levels",
"value": "c( \"Liver\", \"Lung\", \"Colon\", \"Breast\", \"Skin\", \"Kidney\", \"Brain\", \"Pancreas\", \"Stomach\", \"Ovary\", \"Prostate\", \"Bladder\", \"Thyroid\", \"Uterus\", \"Esophagus\", \"Blood\" )"
},
{
"name": "group_levels",
"value": "c(\"Primary\", \"Metastasis\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/circular-bar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/circular-bar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/circular-bar/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/circular-bar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/circular-bar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/circular-bar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/circular-bar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/circular-bar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/circular-bar/make_data.R"
}
],
"dir": "figures/comparison/circular-bar",
"preview": "figures/comparison/circular-bar/preview.png",
"docs_preview": "previews/circular-bar.png",
"code": "figures/comparison/circular-bar/plot.R",
"data": "figures/comparison/circular-bar/data.csv",
"data_files": [
"figures/comparison/circular-bar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/circular-bar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/circular-bar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/circular-bar",
"code_text": "# Circular bars (house style): grouped dodge, optional outside labels, optional inner hole; group\n# names and the count of categories where the second group is higher are written in the hole.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nshow_groups <- TRUE\nlabels_outside <- TRUE\ninner_hole <- 0.42\ncategory_levels <- c(\n \"Liver\", \"Lung\", \"Colon\", \"Breast\", \"Skin\", \"Kidney\", \"Brain\", \"Pancreas\",\n \"Stomach\", \"Ovary\", \"Prostate\", \"Bladder\", \"Thyroid\", \"Uterus\", \"Esophagus\", \"Blood\"\n)\ngroup_levels <- c(\"Primary\", \"Metastasis\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nif (!isTRUE(show_groups)) df <- df[df$group == group_levels[1], , drop = FALSE]\ndf$category <- factor(df$category, levels = category_levels)\ndf$group <- factor(df$group, levels = intersect(group_levels, unique(df$group)))\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue and red are both >= 3:1 on white, so the group names in the hole keep the bar colour\npal <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]])[seq_len(nlevels(df$group))], levels(df$group))\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nymax <- max(df$value)\npad <- if (inner_hole > 0) inner_hole * ymax else 0\nncat <- nlevels(df$category)\nng <- nlevels(df$group)\ndf$x <- as.numeric(df$category)\noff <- if (ng == 1L) 0 else (as.numeric(df$group) - (ng + 1) / 2) * 0.46\nhalf <- if (ng == 1L) 0.34 else 0.18\ndf$xmin <- df$x + off - half\ndf$xmax <- df$x + off + half\ndf$ymin <- pad\ndf$ymax <- pad + df$value\n# Each label sits just outside the longer bar of its own category.\nbar_outer <- pad + ymax\ntheta <- (seq_len(ncat) - 0.5) / ncat\nlab <- data.frame(\n x = seq_len(ncat),\n y = pad + as.numeric(tapply(df$value, df$category, max)) + 0.03 * bar_outer,\n label = category_levels,\n angle = 0,\n hjust = 0\n)\n\n# ggplot2 polar coords draw inside a hard 0.4 radius, so the ring stays small\n# no matter how tight scale_y is. Build the same wedges in cartesian space\n# (clockwise from 12 o'clock, matching coord_polar) and let them fill the panel.\nx_min <- 0.35\nx_max <- ncat + 0.65\ntheta_of <- function(x) (x - x_min) / (x_max - x_min) * 2 * pi\nsector_poly <- function(xmin, xmax, r0, r1, id, group, n = 14) {\n ang <- seq(theta_of(xmin), theta_of(xmax), length.out = n)\n data.frame(\n x = c(r1 * sin(ang), r0 * sin(rev(ang))),\n y = c(r1 * cos(ang), r0 * cos(rev(ang))),\n id = id,\n group = group,\n stringsAsFactors = FALSE\n )\n}\npoly_df <- do.call(rbind, lapply(seq_len(nrow(df)), function(i) {\n sector_poly(df$xmin[i], df$xmax[i], df$ymin[i], df$ymax[i], i, as.character(df$group[i]))\n}))\npoly_df$group <- factor(poly_df$group, levels = levels(df$group))\nlab$theta <- theta_of(lab$x)\nlab$lx <- lab$y * sin(lab$theta)\nlab$ly <- lab$y * cos(lab$theta)\n# radial text, read left to right on both halves\ndeg <- 90 - lab$theta * 180 / pi\nflip <- lab$theta > pi\nlab$angle <- ifelse(flip, deg + 180, deg)\nlab$hjust <- ifelse(flip, 1, 0)\nlim <- bar_outer * 1.12\n\nng_lv <- levels(df$group)\nkey <- data.frame(group = factor(ng_lv, levels = ng_lv), y = lim - (seq_along(ng_lv) - 1) * 0.085 * lim)\nkey$lab <- as.character(key$group)\nstat_lab <- if (ng == 2L) {\n w <- tapply(df$value, list(df$category, df$group), sum)\n sprintf(\"%s higher\\nin %d of %d\\ncategories\", ng_lv[2], sum(w[, 2] > w[, 1]), ncat)\n} else sprintf(\"max %.0f\", ymax)\n\np <- ggplot() +\n geom_polygon(data = poly_df, aes(x, y, group = id, fill = group), colour = NA) +\n geom_text(data = key, aes(x = -lim, y = y, label = lab, colour = group), hjust = 0, vjust = 1) +\n annotate(\"text\", x = lim, y = lim, label = stat_lab, hjust = 1, vjust = 1, lineheight = 0.95) +\n scale_fill_manual(values = pal, guide = \"none\") +\n scale_colour_manual(values = pal, guide = \"none\") +\n coord_equal(xlim = c(-lim, lim), ylim = c(-lim, lim), expand = FALSE, clip = \"off\") +\n scale_x_continuous(breaks = NULL) +\n scale_y_continuous(breaks = NULL) +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() +\n theme(axis.text = element_blank(), axis.ticks = element_blank(), axis.title = element_blank(),\n panel.border = element_blank(), plot.margin = margin(1, 3, 0.9, 3, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nif (isTRUE(labels_outside)) {\n p <- p + geom_text(data = lab, aes(x = lx, y = ly, label = label, hjust = hjust, angle = angle), vjust = 0.5, colour = \"black\")\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "circular bar\n环状柱形图\ncircular-bar\ncircular\ncomparison\n比较\ncompare\n比较组\ncompare groups\n类别较多、又要并排比较两组时，用环形柱代替长条形图。\nplot.r 顶部 show_groups 控制是否分组并排；labels_outside 控制环外标签；inner_hole 为内圆半径占最大值的比例。\ncircular-bar comparison polar\ncategory 类别名称（字符串） group 分组（字符串） value 数值（正数）"
},
{
"title": "Cleveland dot plot",
"title_zh": "Cleveland 点图",
"slug": "cleveland-dot",
"category": "comparison",
"tags": [
"cleveland",
"dot",
"ranking",
"comparison"
],
"packages": [
"ggplot2"
],
"data_columns": {
"category": "指标或类别名（字符串）",
"group": "系列名（字符串）",
"value": "得分（数值）"
},
"when_to_use": "多类指标要按大小排序、并在同一行比较两个或多个系列时用；比柱状图更省墨、更易读排序。",
"customize": "在 `plot.R` 修改 `sort_by_group` 确定排序组别，设定 `group_levels` 顺序，控制 `show_segment` 显隐极值连线，点形由 `HOUSE_POINT` 决定；在 `data.csv` 填入 category、group 和 value 列。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": "Cleveland",
"variants": [
{
"slug": "cleveland-dot",
"variant_label": "Cleveland",
"title": "Cleveland dot plot",
"title_zh": "Cleveland 点图",
"docs_preview": "previews/cleveland-dot.png"
},
{
"slug": "dumbbell",
"variant_label": "Dumbbell",
"title": "Dumbbell chart",
"title_zh": "哑铃图",
"docs_preview": "previews/dumbbell.png"
}
],
"parameters": [
{
"name": "sort_by_group",
"value": "\"Urban\""
},
{
"name": "show_segment",
"value": "TRUE"
},
{
"name": "point_size",
"value": "HOUSE_POINT$size"
},
{
"name": "group_levels",
"value": "c(\"Urban\", \"Rural\")"
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "cols",
"value": "stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]])[seq_along(group_levels)], group_levels)"
},
{
"name": "footnote",
"value": "\"Simulated data for\\nillustration; not\\nbiological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "89",
"label": "43 × 89 mm (1×2 cells)",
"cells": "1x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/cleveland-dot/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/cleveland-dot/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/cleveland-dot/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/cleveland-dot/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/cleveland-dot/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/cleveland-dot/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/cleveland-dot/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/cleveland-dot/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/cleveland-dot/make_data.R"
}
],
"dir": "figures/comparison/cleveland-dot",
"preview": "figures/comparison/cleveland-dot/preview.png",
"docs_preview": "previews/cleveland-dot.png",
"code": "figures/comparison/cleveland-dot/plot.R",
"data": "figures/comparison/cleveland-dot/data.csv",
"data_files": [
"figures/comparison/cleveland-dot/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/cleveland-dot/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/cleveland-dot/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/cleveland-dot",
"code_text": "# Cleveland dot plot (house style): categories sorted by one group, a grey guide from min to max in\n# each row, group names as a coloured key and the count of rows where the first group is higher,\n# both inside the panel. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nsort_by_group <- \"Urban\" # which group drives category order\nshow_segment <- TRUE # light guide from min to max within row\npoint_size <- HOUSE_POINT$size\ngroup_levels <- c(\"Urban\", \"Rural\")\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue and red are both >= 3:1 on white, so the key keeps the point colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]])[seq_along(group_levels)],\n group_levels)\nfootnote <- \"Simulated data for\\nillustration; not\\nbiological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_levels)\nord_vals <- df$value[df$group == sort_by_group]\nnames(ord_vals) <- df$category[df$group == sort_by_group]\ncat_order <- names(sort(ord_vals, decreasing = FALSE))\ndf$category <- factor(df$category, levels = cat_order)\ndf$y <- as.numeric(df$category)\nseg <- do.call(rbind, lapply(split(df, df$category), function(d) {\n data.frame(y = d$y[1], xmin = min(d$value), xmax = max(d$value))\n}))\nw <- tapply(df$value, list(df$category, df$group), sum)\nn_hi <- sum(w[, group_levels[1]] > w[, group_levels[2]])\nn_cat <- nlevels(df$category)\nx_lim <- range(df$value) + c(-0.05, 0.05) * diff(range(df$value))\nkey <- data.frame(group = factor(group_levels, levels = group_levels), i = seq_along(group_levels))\n\np <- ggplot()\nif (isTRUE(show_segment)) {\n p <- p + geom_segment(data = seg, aes(x = xmin, xend = xmax, y = y, yend = y),\n linewidth = pv_house_lw(\"minor\"), colour = grey[[\"ci\"]])\n}\np <- p +\n geom_point(data = df, aes(value, y, fill = group), shape = HOUSE_POINT$shape, size = point_size,\n stroke = HOUSE_POINT$stroke, colour = \"black\") +\n geom_text(data = key, aes(x = x_lim[2] - 0.02 * diff(x_lim), y = 1.75 + 0.5 * (nrow(key) - i + 1), label = group,\n colour = group), hjust = 1, vjust = 0) +\n annotate(\"text\", x = x_lim[2] - 0.02 * diff(x_lim), y = 0.6, hjust = 1, vjust = 0, lineheight = 0.95,\n label = sprintf(\"%s higher\\nin %d of %d\", group_levels[1], n_hi, n_cat)) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_y_continuous(breaks = seq_len(n_cat), labels = levels(df$category)) +\n coord_cartesian(xlim = x_lim, ylim = c(0.4, n_cat + 0.6), expand = FALSE) +\n labs(x = \"Score\", y = NULL, caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "cleveland dot plot\ncleveland 点图\ncleveland-dot\ncleveland\ncomparison\n比较\ncompare\n比较组\ncompare groups\n多类指标要按大小排序、并在同一行比较两个或多个系列时用；比柱状图更省墨、更易读排序。\n在 `plot.r` 修改 `sort_by_group` 确定排序组别，设定 `group_levels` 顺序，控制 `show_segment` 显隐极值连线，点形由 `house_point` 决定；在 `data.csv` 填入 category、group 和 value 列。\ncleveland dot ranking comparison\ncategory 指标或类别名（字符串） group 系列名（字符串） value 得分（数值）"
},
{
"title": "Diverging bar chart",
"title_zh": "正负条形图",
"slug": "diverging-bar",
"category": "comparison",
"tags": [
"bar",
"diverging",
"comparison"
],
"packages": [
"ggplot2"
],
"data_columns": {
"item": "指标名（字符串）",
"value": "相对基线的变化，百分比（数值）",
"class": "升高或降低（字符串）"
},
"when_to_use": "一批指标有正有负、需要以 0 为中心比较方向和幅度时用。",
"customize": "在 `plot.R` 控制 `sort_bars` 决定是否排序，开启 `center_at_zero` 确保零点居中，设定 `class_levels` 分类顺序，由 `pv_palette(\"house_div\")` 映射颜色；在 `data.csv` 填入 item、value 和 class 列。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "sort_bars",
"value": "TRUE"
},
{
"name": "center_at_zero",
"value": "TRUE"
},
{
"name": "class_levels",
"value": "c(\"Decreased\", \"Increased\")"
},
{
"name": "div",
"value": "pv_palette(\"house_div\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "cols",
"value": "stats::setNames(div[c(1, length(div))], class_levels)"
},
{
"name": "footnote",
"value": "\"Simulated data for\\nillustration; not\\nbiological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "89",
"label": "43 × 89 mm (1×2 cells)",
"cells": "1x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/diverging-bar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/diverging-bar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/diverging-bar/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/diverging-bar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/diverging-bar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/diverging-bar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/diverging-bar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/diverging-bar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/diverging-bar/make_data.R"
}
],
"dir": "figures/comparison/diverging-bar",
"preview": "figures/comparison/diverging-bar/preview.png",
"docs_preview": "previews/diverging-bar.png",
"code": "figures/comparison/diverging-bar/plot.R",
"data": "figures/comparison/diverging-bar/data.csv",
"data_files": [
"figures/comparison/diverging-bar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/diverging-bar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/diverging-bar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/diverging-bar",
"code_text": "# Diverging bars (house style): bars centred at zero in the two ends of house_div, class names with\n# counts written inside the panel in the bar colour (no legend). Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nsort_bars <- TRUE\ncenter_at_zero <- TRUE\nclass_levels <- c(\"Decreased\", \"Increased\")\n\ndiv <- pv_palette(\"house_div\"); grey <- pv_palette(\"house_grey\")\n# both ends of house_div are >= 3:1 on white (blue 4.5:1, red 5.5:1), so labels keep the bar colour\ncols <- stats::setNames(div[c(1, length(div))], class_levels)\nfootnote <- \"Simulated data for\\nillustration; not\\nbiological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$class <- factor(df$class, levels = class_levels)\nord <- if (sort_bars) order(df$value) else rev(seq_len(nrow(df)))\ndf$y[ord] <- seq_len(nrow(df))\nref <- if (center_at_zero) 0 else stats::median(df$value)\nn <- nrow(df)\nx_lim <- range(c(df$value, 0)) * 1.08\nkey <- data.frame(class = factor(class_levels, levels = class_levels),\n n = as.integer(table(df$class)[class_levels]))\nkey$lab <- sprintf(\"%s\\nn = %d\", key$class, key$n)\n# Decreased key bottom right, Increased key top left: the empty corners of a sorted diverging plot\nkey$x <- c(x_lim[2] * 0.96, x_lim[1] * 0.96)\nkey$y <- c(1.6, n - 0.6)\nkey$hjust <- c(1, 0)\n\np <- ggplot(df) +\n geom_col(aes(value, y, fill = class), orientation = \"y\", width = 0.7) +\n geom_vline(xintercept = ref, linewidth = pv_house_lw(\"frame\"), colour = \"black\") +\n geom_text(data = key, aes(x = x, y = y, label = lab, colour = class, hjust = hjust), lineheight = 0.95) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(labels = function(x) paste0(x, \"%\")) +\n scale_y_continuous(breaks = df$y, labels = df$item) +\n coord_cartesian(xlim = x_lim, ylim = c(0.4, n + 0.6), expand = FALSE) +\n labs(x = \"Change from baseline\", y = NULL, caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "diverging bar chart\n正负条形图\ndiverging-bar\n\ncomparison\n比较\ncompare\n比较组\ncompare groups\n一批指标有正有负、需要以 0 为中心比较方向和幅度时用。\n在 `plot.r` 控制 `sort_bars` 决定是否排序，开启 `center_at_zero` 确保零点居中，设定 `class_levels` 分类顺序，由 `pv_palette(\"house_div\")` 映射颜色；在 `data.csv` 填入 item、value 和 class 列。\nbar diverging comparison\nitem 指标名（字符串） value 相对基线的变化，百分比（数值） class 升高或降低（字符串）"
},
{
"title": "Dumbbell chart",
"title_zh": "哑铃图",
"slug": "dumbbell",
"category": "comparison",
"tags": [
"dumbbell",
"comparison",
"before-after"
],
"packages": [
"ggplot2"
],
"data_columns": {
"item": "位点或对象（字符串）",
"stage": "时间点（字符串）",
"value": "得分（数值）"
},
"when_to_use": "同一批对象要比较两个时间点或两种状态的变化方向时用。",
"customize": "在 `plot.R` 控制 `use_arrow` 显隐变化方向指示（差值不到约两个点直径时不画箭头），用 `sort_by` 改变排序基准，指定 `stage_levels` 前后顺序并由 `colour_by_stage` 着色；在 `data.csv` 填入 item、stage 和 value 列。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": "cleveland-dot",
"variant_label": "Dumbbell",
"variants": [],
"parameters": [
{
"name": "use_arrow",
"value": "TRUE"
},
{
"name": "sort_by",
"value": "\"change\""
},
{
"name": "colour_by_stage",
"value": "TRUE"
},
{
"name": "stage_levels",
"value": "c(\"Baseline\", \"Week 12\")"
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "cols",
"value": "stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]]), stage_levels)"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "89",
"label": "43 × 89 mm (1×2 cells)",
"cells": "1x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/dumbbell/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/dumbbell/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/dumbbell/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/dumbbell/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/dumbbell/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/dumbbell/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/dumbbell/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/dumbbell/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/dumbbell/make_data.R"
}
],
"dir": "figures/comparison/dumbbell",
"preview": "figures/comparison/dumbbell/preview.png",
"docs_preview": "previews/dumbbell.png",
"code": "figures/comparison/dumbbell/plot.R",
"data": "figures/comparison/dumbbell/data.csv",
"data_files": [
"figures/comparison/dumbbell/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/dumbbell/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/dumbbell/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/dumbbell",
"code_text": "# Dumbbell (house style): two stages per row joined by a grey segment with an optional arrow,\n# stage names as a coloured key and the mean change written inside the panel (no legend).\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nuse_arrow <- TRUE\nsort_by <- \"change\" # change | week12 | input\ncolour_by_stage <- TRUE\nstage_levels <- c(\"Baseline\", \"Week 12\")\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue and red are both >= 3:1 on white, so the stage key keeps the point colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]]), stage_levels)\nif (!isTRUE(colour_by_stage)) cols[] <- grey[[\"dark\"]]\nfootnote <- \"Simulated data for\\nillustration; not\\nbiological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$stage <- factor(df$stage, levels = stage_levels)\nwide <- reshape(df, idvar = \"item\", timevar = \"stage\", direction = \"wide\")\nnames(wide) <- c(\"item\", \"baseline\", \"week12\")\nwide$change <- wide$week12 - wide$baseline\nif (sort_by == \"change\") {\n wide <- wide[order(wide$change), ]\n} else if (sort_by == \"week12\") {\n wide <- wide[order(wide$week12), ]\n}\nwide$y <- seq_len(nrow(wide))\nlong <- rbind(\n data.frame(y = wide$y, stage = stage_levels[1], value = wide$baseline),\n data.frame(y = wide$y, stage = stage_levels[2], value = wide$week12)\n)\nlong$stage <- factor(long$stage, levels = stage_levels)\narr <- if (use_arrow) grid::arrow(length = grid::unit(1.2, \"mm\"), type = \"closed\") else NULL\nn <- nrow(wide)\nx_lim <- range(long$value) + c(-0.05, 0.05) * diff(range(long$value))\nkey <- data.frame(stage = factor(stage_levels, levels = stage_levels), i = seq_along(stage_levels))\n# point diameter in x units (HOUSE_POINT size in mm over the panel width, about 33 mm in a 1x2 tile)\npt_x <- pv_point_dims()[[\"outer_mm\"]] / 33 * diff(x_lim)\n# rows whose change is smaller than ~2 point diameters get a plain segment (no arrow head);\n# otherwise the segment stops at the edge of the end point so the head stays visible\nwide$arrow <- abs(wide$change) > 2 * pt_x\nwide$xend <- ifelse(wide$arrow, wide$week12 - sign(wide$change) * pt_x / 2, wide$week12)\nstat_lab <- sprintf(\"Mean change %+.1f\\n%d of %d decrease\", mean(wide$change), sum(wide$change < 0), n)\n\np <- ggplot() +\n geom_segment(data = wide[!wide$arrow, ], aes(x = baseline, xend = xend, y = y, yend = y),\n linewidth = pv_house_lw(\"minor\"), colour = grey[[\"ref\"]]) +\n geom_segment(data = wide[wide$arrow, ], aes(x = baseline, xend = xend, y = y, yend = y),\n linewidth = pv_house_lw(\"minor\"), colour = grey[[\"ref\"]], arrow = arr) +\n geom_point(data = long, aes(value, y, fill = stage), shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = \"black\") +\n geom_text(data = key, aes(x = x_lim[2] - 0.02 * diff(x_lim), y = 2.0 + 0.6 * (nrow(key) - i + 1),\n label = stage, colour = stage), hjust = 1, vjust = 0) +\n annotate(\"text\", x = x_lim[2] - 0.02 * diff(x_lim), y = 0.6, hjust = 1, vjust = 0, lineheight = 0.95,\n label = stat_lab) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_y_continuous(breaks = wide$y, labels = wide$item) +\n coord_cartesian(xlim = x_lim, ylim = c(0.4, n + 0.6), expand = FALSE) +\n labs(x = \"Score\", y = NULL, caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "dumbbell chart\n哑铃图\ndumbbell\ndumbbell\ncomparison\n比较\ncompare\n比较组\ncompare groups\n同一批对象要比较两个时间点或两种状态的变化方向时用。\n在 `plot.r` 控制 `use_arrow` 显隐变化方向指示（差值不到约两个点直径时不画箭头），用 `sort_by` 改变排序基准，指定 `stage_levels` 前后顺序并由 `colour_by_stage` 着色；在 `data.csv` 填入 item、stage 和 value 列。\ndumbbell comparison before-after\nitem 位点或对象（字符串） stage 时间点（字符串） value 得分（数值）"
},
{
"title": "Grouped boxplot with significance",
"title_zh": "分组箱线图与显著性",
"slug": "grouped-boxplot-signif",
"category": "comparison",
"tags": [
"boxplot",
"significance",
"wilcoxon"
],
"packages": [
"ggplot2"
],
"data_columns": {
"group": "分组（字符串）",
"value": "观测值（数值）"
},
"when_to_use": "少数组的连续指标要看分布并标两两比较时用。",
"customize": "在 `plot.R` 修改 `comparisons` 列表指定需要进行两两比较的组别对，控制 `show_points` 开关（默认值为 `TRUE`，为 `FALSE` 时显示离群点）显隐原始数据点；在 `data.csv` 填入 group 和 value 列。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": "raincloud",
"variant_label": "Boxplot",
"variants": [],
"parameters": [
{
"name": "comparisons",
"value": "list(c(\"A\", \"B\"), c(\"B\", \"C\"))"
},
{
"name": "show_points",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/grouped-boxplot-signif/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/grouped-boxplot-signif/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/grouped-boxplot-signif/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/grouped-boxplot-signif/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/grouped-boxplot-signif/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/grouped-boxplot-signif/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/grouped-boxplot-signif/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/grouped-boxplot-signif/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/grouped-boxplot-signif/make_data.R"
}
],
"dir": "figures/comparison/grouped-boxplot-signif",
"preview": "figures/comparison/grouped-boxplot-signif/preview.png",
"docs_preview": "previews/grouped-boxplot-signif.png",
"code": "figures/comparison/grouped-boxplot-signif/plot.R",
"data": "figures/comparison/grouped-boxplot-signif/data.csv",
"data_files": [
"figures/comparison/grouped-boxplot-signif/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/grouped-boxplot-signif/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/grouped-boxplot-signif/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/grouped-boxplot-signif",
"code_text": "# Grouped boxplot (house style): semi-transparent boxes, jittered shape-21 points instead of outliers,\n# Wilcoxon P over brackets and n per group written in the group colour. Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\ncomparisons <- list(c(\"A\", \"B\"), c(\"B\", \"C\"))\nshow_points <- TRUE\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = unique(df$group))\ng_lv <- levels(df$group)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue, red, green, purple: all >= 3:1 on white, so the n labels keep the group colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"magenta\"]],\n hp[[\"brown\"]])[seq_along(g_lv)], g_lv)\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nrng <- range(df$value)\nstep <- diff(rng) * 0.13\nbr <- do.call(rbind, lapply(seq_along(comparisons), function(i) {\n pair <- comparisons[[i]]\n pw <- stats::wilcox.test(value ~ group, data = droplevels(df[df$group %in% pair, ]))$p.value\n data.frame(x1 = match(pair[1], g_lv), x2 = match(pair[2], g_lv), y = rng[2] + step * (i - 0.3),\n label = pv_fmt_p(pw))\n}))\ntick <- step * 0.18\ncnt <- data.frame(group = factor(g_lv, levels = g_lv), x = seq_along(g_lv),\n lab = sprintf(\"n = %d\", as.integer(table(df$group)[g_lv])))\ny_lim <- c(rng[1] - step * 1.15, max(br$y) + step * 0.75)\n\nset.seed(7)\np <- ggplot(df, aes(group, value)) +\n # outliers are drawn only when the raw points are hidden\n geom_boxplot(aes(fill = group), width = 0.55, alpha = 0.6,\n outlier.shape = if (isTRUE(show_points)) NA else 19, outlier.size = 1.2,\n outlier.colour = \"black\", linewidth = pv_house_lw(\"frame\"), colour = \"black\")\nif (isTRUE(show_points)) {\n p <- p + geom_point(aes(fill = group), position = position_jitter(width = 0.12, height = 0),\n shape = HOUSE_POINT$shape, size = 1.4, stroke = HOUSE_POINT$stroke,\n colour = \"black\", alpha = 0.7)\n}\np <- p +\n geom_segment(data = br, aes(x = x1, xend = x2, y = y, yend = y), inherit.aes = FALSE,\n linewidth = pv_house_lw(\"frame\")) +\n geom_segment(data = br, aes(x = x1, xend = x1, y = y - tick, yend = y), inherit.aes = FALSE,\n linewidth = pv_house_lw(\"frame\")) +\n geom_segment(data = br, aes(x = x2, xend = x2, y = y - tick, yend = y), inherit.aes = FALSE,\n linewidth = pv_house_lw(\"frame\")) +\n geom_text(data = br, aes(x = (x1 + x2) / 2, y = y + step * 0.08, label = label), inherit.aes = FALSE,\n parse = TRUE, vjust = 0) +\n geom_text(data = cnt, aes(x = x, y = rng[1] - step * 0.75, label = lab, colour = group),\n inherit.aes = FALSE) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n coord_cartesian(ylim = y_lim, expand = FALSE) +\n labs(x = NULL, y = \"Value\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "grouped boxplot with significance\n分组箱线图与显著性\ngrouped-boxplot-signif\nboxplot\ncomparison\n比较\ncompare\n比较组\ncompare groups\n少数组的连续指标要看分布并标两两比较时用。\n在 `plot.r` 修改 `comparisons` 列表指定需要进行两两比较的组别对，控制 `show_points` 开关（默认值为 `true`，为 `false` 时显示离群点）显隐原始数据点；在 `data.csv` 填入 group 和 value 列。\nboxplot significance wilcoxon\ngroup 分组（字符串） value 观测值（数值）"
},
{
"title": "Bar chart with points and P values (house style)",
"title_zh": "带原始点与 P 值的柱图（house 风格）",
"slug": "house-bar",
"category": "comparison",
"tags": [
"bar",
"mean-sd",
"t-test",
"raw-points",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"treatment": "处理（字符串，第一组为对照）",
"replicate": "重复编号（整数）",
"expression": "相对表达量（数值）"
},
"when_to_use": "几个处理与对照比较均值时用；柱为均值、误差棒为 s.d.，叠加原始点，柱内写均值，括号线标出与对照的 t 检验 P。",
"customize": "plot.R 顶部 control 指定对照组；gene_label 为左上角标题；y_max 为 y 轴上限（括号放不下时自动加高）；wrap_width 控制类别名换行；short_labels 为 x 轴显示用的短名（只改显示，不改数据；1×1 时每类约 8.6 mm，\"Control\" 会碰到 \"Drought\"，故显示为 \"Ctrl\"）；point_size 为原始点径（1.6）。柱不描边。颜色：对照组取 pv_palette(\"house_grey\")[[\"ci\"]]，处理组依次取 pv_palette(\"house_warm\")[2:4]，柱内数字按底色深浅自动用黑或白；文字字号写成印刷 pt（pv_pt2size），本图 1×1 格（43 × 43 mm），字号保持 7/8 pt（只有单个 2×2 面板才由 pv_save_house() 自动 +2 pt）。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "control",
"value": "\"Control\""
},
{
"name": "gene_label",
"value": "\"VvSWEET10\""
},
{
"name": "y_max",
"value": "6"
},
{
"name": "wrap_width",
"value": "9"
},
{
"name": "short_labels",
"value": "c(Control = \"Ctrl\")"
},
{
"name": "point_size",
"value": "1.6"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/house-bar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/house-bar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/house-bar/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/house-bar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/house-bar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/house-bar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/house-bar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/house-bar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/house-bar/make_data.R"
}
],
"dir": "figures/comparison/house-bar",
"preview": "figures/comparison/house-bar/preview.png",
"docs_preview": "previews/house-bar.png",
"code": "figures/comparison/house-bar/plot.R",
"data": "figures/comparison/house-bar/data.csv",
"data_files": [
"figures/comparison/house-bar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/house-bar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/house-bar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/house-bar",
"code_text": "# House-style bar chart: mean ± s.d., raw points, values on bars, P vs control above.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\ncontrol <- \"Control\"\ngene_label <- \"VvSWEET10\"\ny_max <- 6\nwrap_width <- 9\n# display-only short names: at 1x1 (~8.6 mm per category) \"Control\" touches \"Drought\"\nshort_labels <- c(Control = \"Ctrl\")\npoint_size <- 1.6 # raw-data overlay on bars (style-contract.md, points): size 1.6, alpha 0.8\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nlv <- unique(df$treatment)\ndf$x <- match(df$treatment, lv)\ncols <- stats::setNames(c(pv_palette(\"house_grey\")[[\"ci\"]], pv_palette(\"house_warm\")[2:4])[seq_along(lv)], lv)\n\nsm <- do.call(rbind, lapply(lv, function(t) {\n y <- df$expression[df$treatment == t]\n data.frame(treatment = t, x = match(t, lv), m = mean(y), sd = stats::sd(y), n = length(y))\n}))\n# value labels: white on dark fills, black on light fills\nlum <- colSums(grDevices::col2rgb(cols[sm$treatment]) * c(0.299, 0.587, 0.114)) / 255\nsm$txt <- ifelse(lum < 0.6, \"white\", \"black\")\nothers <- setdiff(lv, control)\npv <- vapply(others, function(t) stats::t.test(df$expression[df$treatment == t],\n df$expression[df$treatment == control])$p.value, numeric(1))\nbr <- data.frame(x1 = match(others, lv), lab = vapply(pv, pv_fmt_p, character(1)))\nbr$y <- 0\nprev <- -Inf\nfor (i in seq_len(nrow(br))) { # each bracket clears every bar it spans and the bracket below it\n br$y[i] <- max(max(df$expression[df$x <= br$x1[i]]) + 0.35, prev + 0.6)\n prev <- br$y[i]\n}\ny_max <- max(y_max, ceiling(max(br$y) + 0.6))\n\nset.seed(11)\ndf$xj <- df$x + stats::runif(nrow(df), -0.14, 0.14)\n\np <- ggplot(sm, aes(x, m)) +\n geom_col(aes(fill = treatment), width = 0.66, colour = NA) +\n geom_errorbar(aes(ymin = m - sd, ymax = m + sd), width = 0.22, linewidth = pv_house_lw(\"errorbar\")) +\n geom_point(data = df, aes(xj, expression), shape = HOUSE_POINT$shape, fill = \"white\", colour = \"black\",\n size = point_size, stroke = HOUSE_POINT$stroke, alpha = 0.8) +\n geom_text(aes(y = 0.16, label = sprintf(\"%.2f\", m), colour = txt), vjust = 0, size = pv_pt2size(7),\n fontface = \"bold\") +\n scale_colour_identity() +\n geom_segment(data = br, aes(x = 1, xend = x1, y = y, yend = y), linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = br, aes(x = 1, xend = 1, y = y, yend = y - 0.12), linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = br, aes(x = x1, xend = x1, y = y, yend = y - 0.12), linewidth = pv_house_lw(\"ref\")) +\n geom_text(data = br, aes(x = x1 - 0.05, y = y + 0.06, label = lab), hjust = 1, vjust = 0, parse = TRUE,\n size = pv_pt2size(7)) +\n annotate(\"text\", x = 0.6, y = y_max * 0.975, label = gene_label, fontface = \"italic\", hjust = 0, vjust = 1,\n size = pv_pt2size(8)) +\n annotate(\"text\", x = 0.6, y = y_max * 0.875, label = sprintf(\"Mean \\u00b1 s.d., n = %d\", max(sm$n)),\n hjust = 0, vjust = 1, size = pv_pt2size(6), colour = pv_palette(\"house_grey\")[[\"mid\"]]) +\n scale_fill_manual(values = cols) +\n scale_x_continuous(breaks = seq_along(lv), labels = function(b) vapply(lv[b], function(s)\n paste(strwrap(if (s %in% names(short_labels)) short_labels[[s]] else s, wrap_width), collapse = \"\\n\"),\n character(1)), limits = c(0.5, length(lv) + 0.5),\n expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, y_max), breaks = 0:y_max, expand = c(0, 0)) +\n labs(x = NULL, y = \"Relative expression\") +\n theme_house() +\n theme(axis.text.x = element_text(lineheight = 0.85))\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "bar chart with points and p values (house style)\n带原始点与 p 值的柱图（house 风格）\nhouse-bar\n\ncomparison\n比较\ncompare\n比较组\ncompare groups\n几个处理与对照比较均值时用；柱为均值、误差棒为 s.d.，叠加原始点，柱内写均值，括号线标出与对照的 t 检验 p。\nplot.r 顶部 control 指定对照组；gene_label 为左上角标题；y_max 为 y 轴上限（括号放不下时自动加高）；wrap_width 控制类别名换行；short_labels 为 x 轴显示用的短名（只改显示，不改数据；1×1 时每类约 8.6 mm，\"control\" 会碰到 \"drought\"，故显示为 \"ctrl\"）；point_size 为原始点径（1.6）。柱不描边。颜色：对照组取 pv_palette(\"house_grey\")[[\"ci\"]]，处理组依次取 pv_palette(\"house_warm\")[2:4]，柱内数字按底色深浅自动用黑或白；文字字号写成印刷 pt（pv_pt2size），本图 1×1 格（43 × 43 mm），字号保持 7/8 pt（只有单个 2×2 面板才由 pv_save_house() 自动 +2 pt）。\nbar mean-sd t-test raw-points house-style\ntreatment 处理（字符串，第一组为对照） replicate 重复编号（整数） expression 相对表达量（数值）"
},
{
"title": "Forest plot of effects (house style)",
"title_zh": "效应量森林图（house 风格）",
"slug": "house-forest",
"category": "comparison",
"tags": [
"forest",
"dot-plot",
"effect-size",
"confidence-interval",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"season": "分组（此例为年份）",
"locus": "条目名（字符串，y 轴）",
"estimate": "效应估计值",
"se": "标准误"
},
"when_to_use": "多个条目的效应量（± 95% CI）在两个批次或条件下对照时用；CI 跨 0 的点画成空心，数值写在 CI 右侧，N 写在角落。",
"customize": "plot.R 顶部 ci_mult 调置信区间倍数；n_accessions 写样本量（右上角 N 为斜体）；est_point 为点估计的点规格（HOUSE_POINT 改 size 为 3.2，范围 3–3.5）；dodge 调两组上下错开距离；x_limits 调 x 范围。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 2×2 格（89 × 89 mm）单面板，由 pv_save_house() 自动 +2 pt（刻度 9 / 轴标题 10 pt）。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "ci_mult",
"value": "1.96"
},
{
"name": "n_accessions",
"value": "278"
},
{
"name": "dodge",
"value": "0.17"
},
{
"name": "x_limits",
"value": "c(-0.65, 1.1)"
},
{
"name": "est_point",
"value": "utils::modifyList(HOUSE_POINT, list(size = 3.2))"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/house-forest/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/house-forest/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/house-forest/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/house-forest/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/house-forest/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/house-forest/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/house-forest/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/house-forest/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/house-forest/make_data.R"
}
],
"dir": "figures/comparison/house-forest",
"preview": "figures/comparison/house-forest/preview.png",
"docs_preview": "previews/house-forest.png",
"code": "figures/comparison/house-forest/plot.R",
"data": "figures/comparison/house-forest/data.csv",
"data_files": [
"figures/comparison/house-forest/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/house-forest/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/house-forest/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/house-forest",
"code_text": "# House-style forest plot: two seasons per locus, 95% CI, open points when the CI spans 0.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nci_mult <- 1.96\nn_accessions <- 278\ndodge <- 0.17\nx_limits <- c(-0.65, 1.1)\n# point estimate (style-contract.md, points): HOUSE_POINT with size 3.2 (STYLE size 3–3.5)\nest_point <- utils::modifyList(HOUSE_POINT, list(size = 3.2))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\npal <- pv_palette(\"house\")\nseasons <- sort(unique(as.character(df$season)))\nscol <- stats::setNames(c(pal[[\"purple\"]], pal[[\"orange\"]])[seq_along(seasons)], seasons)\nloci <- unique(df$locus)\ndf$season <- as.character(df$season)\ndf$lo <- df$estimate - ci_mult * df$se\ndf$hi <- df$estimate + ci_mult * df$se\ndf$sig <- df$lo > 0 | df$hi < 0\ndf$y <- (length(loci) + 1 - match(df$locus, loci)) + ifelse(df$season == seasons[1], dodge, -dodge)\ndf$fillc <- ifelse(df$sig, df$season, \"ns\")\nminus <- function(x) gsub(\"-\", \"\\u2212\", x)\ntop <- length(loci) + 1\n\np <- ggplot(df, aes(estimate, y, colour = season)) +\n geom_vline(xintercept = 0, linetype = \"22\", linewidth = pv_house_lw(\"ref\"),\n colour = pv_palette(\"house_grey\")[[\"mid\"]]) +\n geom_linerange(aes(xmin = lo, xmax = hi), linewidth = pv_house_lw(0.9)) +\n geom_point(aes(fill = fillc), shape = est_point$shape, size = est_point$size,\n stroke = est_point$stroke) +\n geom_text(aes(x = hi + 0.03, label = minus(sprintf(\"%+.2f\", estimate))), hjust = 0,\n size = pv_pt2size(6)) +\n annotate(\"text\", x = x_limits[1] + 0.03, y = top + 0.05, label = seasons[1], colour = scol[[1]],\n hjust = 0, size = pv_pt2size(7), fontface = \"bold\") +\n annotate(\"text\", x = x_limits[1] + 0.32, y = top + 0.05, label = seasons[2], colour = scol[[2]],\n hjust = 0, size = pv_pt2size(7), fontface = \"bold\") +\n annotate(\"text\", x = x_limits[2] - 0.03, y = top + 0.45,\n label = sprintf(\"italic(N)*' = %d accessions'\", n_accessions), parse = TRUE,\n hjust = 1, vjust = 1, size = pv_pt2size(6), colour = pv_palette(\"house_grey\")[[\"mid\"]]) +\n annotate(\"text\", x = x_limits[2] - 0.03, y = top + 0.03, label = \"open: 95% CI spans 0\",\n hjust = 1, vjust = 1, size = pv_pt2size(6), colour = pv_palette(\"house_grey\")[[\"mid\"]]) +\n scale_colour_manual(values = scol) +\n scale_fill_manual(values = c(scol, ns = \"white\")) +\n scale_y_continuous(breaks = rev(seq_along(loci)), labels = loci, limits = c(0.45, top + 0.6),\n expand = c(0, 0)) +\n scale_x_continuous(limits = x_limits, breaks = seq(-0.5, 1, 0.5), expand = c(0, 0),\n labels = function(x) minus(format(x, nsmall = 1))) +\n labs(x = \"Effect on berry weight (g)\", y = NULL) +\n theme_house() +\n theme(axis.text.y = element_text(face = \"italic\"),\n plot.margin = margin(1.6, 2.6, 0.9, 0.4, \"mm\"))\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "forest plot of effects (house style)\n效应量森林图（house 风格）\nhouse-forest\n\ncomparison\n比较\ncompare\n比较组\ncompare groups\n多个条目的效应量（± 95% ci）在两个批次或条件下对照时用；ci 跨 0 的点画成空心，数值写在 ci 右侧，n 写在角落。\nplot.r 顶部 ci_mult 调置信区间倍数；n_accessions 写样本量（右上角 n 为斜体）；est_point 为点估计的点规格（house_point 改 size 为 3.2，范围 3–3.5）；dodge 调两组上下错开距离；x_limits 调 x 范围。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 2×2 格（89 × 89 mm）单面板，由 pv_save_house() 自动 +2 pt（刻度 9 / 轴标题 10 pt）。\nforest dot-plot effect-size confidence-interval house-style\nseason 分组（此例为年份） locus 条目名（字符串，y 轴） estimate 效应估计值 se 标准误"
},
{
"title": "Lollipop chart",
"title_zh": "棒棒糖图",
"slug": "lollipop",
"category": "comparison",
"tags": [
"lollipop",
"ranking",
"importance"
],
"packages": [
"ggplot2"
],
"data_columns": {
"item": "特征名（字符串）",
"value": "重要性得分（数值）",
"signif": "是否强调（逻辑值）"
},
"when_to_use": "特征较多、要按大小排序并标出需要强调的条目时用。",
"customize": "在 `plot.R` 控制 `rank_items` 决定是否按得分排序，开启 `highlight_signif` 高亮显著项，控制 `map_importance` 映射点大小；在 `data.csv` 填入 item、value 和 signif 列。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "rank_items",
"value": "TRUE"
},
{
"name": "highlight_signif",
"value": "TRUE"
},
{
"name": "map_importance",
"value": "FALSE"
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "signif_colour",
"value": "hp[[\"red\"]]"
},
{
"name": "base_colour",
"value": "hp[[\"blue\"]]"
},
{
"name": "footnote",
"value": "\"Simulated data for\\nillustration; not\\nbiological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "89",
"label": "43 × 89 mm (1×2 cells)",
"cells": "1x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/lollipop/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/lollipop/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/lollipop/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/lollipop/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/lollipop/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/lollipop/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/lollipop/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/lollipop/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/lollipop/make_data.R"
}
],
"dir": "figures/comparison/lollipop",
"preview": "figures/comparison/lollipop/preview.png",
"docs_preview": "previews/lollipop.png",
"code": "figures/comparison/lollipop/plot.R",
"data": "figures/comparison/lollipop/data.csv",
"data_files": [
"figures/comparison/lollipop/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/lollipop/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/lollipop/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/lollipop",
"code_text": "# Ranked lollipops (house style): stems from zero, items flagged in the signif column in the accent\n# colour, key and count written inside the panel (no legend). Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nrank_items <- TRUE\nhighlight_signif <- TRUE\nmap_importance <- FALSE\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# red and blue are both >= 3:1 on white, so the key text keeps the point colour\nsignif_colour <- hp[[\"red\"]]\nbase_colour <- hp[[\"blue\"]]\nfootnote <- \"Simulated data for\\nillustration; not\\nbiological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$signif <- as.logical(df$signif)\nif (rank_items) df <- df[order(df$value), ]\ndf$y <- seq_len(nrow(df))\ndf$mark <- factor(ifelse(highlight_signif & df$signif, \"Significant\", \"Other\"), levels = c(\"Significant\", \"Other\"))\ncols <- c(Significant = signif_colour, Other = base_colour)\ndf$pt <- if (map_importance) pmax(1.2, 1.2 + df$value / max(df$value) * 1.6) else HOUSE_POINT$size\nn <- nrow(df)\nx_max <- max(df$value) * 1.08\nkey <- data.frame(mark = factor(c(\"Significant\", \"Other\"), levels = levels(df$mark)),\n lab = c(sprintf(\"Significant (%d)\", sum(df$mark == \"Significant\")),\n sprintf(\"Not significant (%d)\", sum(df$mark == \"Other\"))),\n y = c(2.9, 1.6))\nif (!isTRUE(highlight_signif)) key <- key[2, ]\n\np <- ggplot(df, aes(value, y)) +\n geom_segment(aes(x = 0, xend = value, yend = y, colour = mark), linewidth = pv_house_lw(\"minor\")) +\n geom_point(aes(fill = mark, size = pt), shape = HOUSE_POINT$shape, stroke = HOUSE_POINT$stroke,\n colour = \"black\") +\n geom_text(data = key, aes(x = x_max * 0.98, y = y, label = lab, colour = mark), hjust = 1) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_size_identity() +\n scale_y_continuous(breaks = df$y, labels = df$item) +\n coord_cartesian(xlim = c(0, x_max), ylim = c(0.4, n + 0.6), expand = FALSE) +\n labs(x = \"Importance\", y = NULL, caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "lollipop chart\n棒棒糖图\nlollipop\n\ncomparison\n比较\ncompare\n比较组\ncompare groups\n特征较多、要按大小排序并标出需要强调的条目时用。\n在 `plot.r` 控制 `rank_items` 决定是否按得分排序，开启 `highlight_signif` 高亮显著项，控制 `map_importance` 映射点大小；在 `data.csv` 填入 item、value 和 signif 列。\nlollipop ranking importance\nitem 特征名（字符串） value 重要性得分（数值） signif 是否强调（逻辑值）"
},
{
"title": "Multi-metric faceted bars (house style)",
"title_zh": "多指标分面柱图（house 风格）",
"slug": "metric-facet-bar",
"category": "comparison",
"tags": [
"bar",
"facet",
"small-multiples",
"benchmark",
"multi-metric",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"method": "方法名（字符串，横轴）",
"metric": "指标名，含单位（字符串，每个一个面板）",
"direction": "该指标越大越好（higher）或越小越好（lower）（字符串）",
"fold": "交叉验证折或重复编号（整数）",
"value": "该次运行的指标值（数值）"
},
"when_to_use": "在多个具有不同单位或量纲的评价指标下，分小面板并排比较几种方法在多折交叉验证（把数据分成几份轮流测试）中的平均表现时用。",
"customize": "在 `data.csv` 填入 `method`（方法名）、`metric`（带单位的指标名，每个指标占一个小面板）、`direction`（填 `higher` 表示越高越好，或 `lower` 表示越低越好）、`fold`（交叉验证折数编号）和 `value`（数值）；在 `plot.R` 顶部修改 `n_cols` 和 `fig_cells` 调整面板排列列数与画布尺寸，用 `mark_best` 控制是否依 `direction` 加粗最佳方法的数值，`show_direction` 控制是否在标题注明优劣方向，`digits` 设各指标小数位。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "n_cols",
"value": "4"
},
{
"name": "fig_cells",
"value": "\"4x1\""
},
{
"name": "show_values",
"value": "TRUE"
},
{
"name": "mark_best",
"value": "TRUE"
},
{
"name": "show_direction",
"value": "TRUE"
},
{
"name": "digits",
"value": "c(\"Accuracy (%)\" = 1, \"F1 score\" = 3, \"AUROC\" = 3, \"Runtime (min)\" = 1)"
},
{
"name": "headroom",
"value": "1.22"
},
{
"name": "footnote",
"value": "\"Simulated data; not real benchmark results. Bars: mean \\u00b1 s.d. of %d folds; bold = best\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "method_cols",
"value": "c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"brown\"]], hp[[\"magenta\"]])"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "43",
"label": "183 × 43 mm (4×1 cells)",
"cells": "4x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/metric-facet-bar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/metric-facet-bar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/metric-facet-bar/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/metric-facet-bar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/metric-facet-bar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/metric-facet-bar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/metric-facet-bar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/metric-facet-bar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/metric-facet-bar/make_data.R"
}
],
"dir": "figures/comparison/metric-facet-bar",
"preview": "figures/comparison/metric-facet-bar/preview.png",
"docs_preview": "previews/metric-facet-bar.png",
"code": "figures/comparison/metric-facet-bar/plot.R",
"data": "figures/comparison/metric-facet-bar/data.csv",
"data_files": [
"figures/comparison/metric-facet-bar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/metric-facet-bar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/metric-facet-bar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/metric-facet-bar",
"code_text": "# Multi-metric faceted bars (house style): one small panel per metric, each with its own y axis\n# starting at zero, bars = mean over folds with an s.d. error bar, the mean written above each bar\n# and the best method per metric (by the `direction` column) written in bold.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nn_cols <- 4 # panels per row (4 panels in one 4x1 row)\nfig_cells <- \"4x1\" # house grid cells (183 x 43 mm)\nshow_values <- TRUE # mean above each bar\nmark_best <- TRUE # bold value for the best method in each panel\nshow_direction <- TRUE # add \"higher/lower is better\" to the panel title\ndigits <- c(\"Accuracy (%)\" = 1, \"F1 score\" = 3, \"AUROC\" = 3, \"Runtime (min)\" = 1)\nheadroom <- 1.22 # y top = headroom x (mean + s.d.) of the tallest bar, per panel\nfootnote <- \"Simulated data; not real benchmark results. Bars: mean \\u00b1 s.d. of %d folds; bold = best\" # %d = number of folds in data.csv\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nmethod_cols <- c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"brown\"]], hp[[\"magenta\"]])\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$method <- factor(df$method, levels = unique(df$method))\nfootnote <- sprintf(footnote, length(unique(df$fold)))\nm_lv <- unique(df$metric)\ns <- do.call(rbind, lapply(split(df, list(df$metric, df$method), drop = TRUE), function(d) {\n data.frame(metric = d$metric[1], direction = d$direction[1], method = d$method[1],\n mean = mean(d$value), sd = stats::sd(d$value), stringsAsFactors = FALSE)\n}))\ns$method <- factor(s$method, levels = levels(df$method))\ndirs <- tapply(s$direction, s$metric, `[`, 1)\nstrip <- if (isTRUE(show_direction)) {\n sprintf(\"%s, %s is better\", m_lv, dirs[m_lv])\n} else m_lv\ns$panel <- factor(strip[match(s$metric, m_lv)], levels = strip)\ns$best <- stats::ave(seq_len(nrow(s)), s$metric, FUN = function(i) {\n v <- s$mean[i]\n if (s$direction[i[1]] == \"lower\") v == min(v) else v == max(v)\n}) == 1\ndg <- ifelse(s$metric %in% names(digits), digits[s$metric], 2)\ns$lab <- mapply(function(v, d) formatC(v, format = \"f\", digits = d), s$mean, dg)\n# per-panel y top, set by an invisible point so every panel keeps 0 at the bottom\ntops <- tapply(s$mean + s$sd, s$panel, max) * headroom\nblank <- data.frame(panel = factor(names(tops), levels = strip), y = as.numeric(tops),\n method = factor(levels(s$method)[1], levels = levels(s$method)))\ns$lab_y <- s$mean + s$sd + 0.035 * as.numeric(tops[as.character(s$panel)])\ncols <- stats::setNames(method_cols[seq_len(nlevels(s$method))], levels(s$method))\n\np <- ggplot(s, aes(method, mean)) +\n geom_blank(data = blank, aes(method, y)) +\n geom_col(aes(fill = method), width = 0.7, colour = NA) +\n geom_errorbar(aes(ymin = mean - sd, ymax = mean + sd), width = 0.25,\n linewidth = pv_house_lw(\"errorbar\"))\nif (isTRUE(show_values)) {\n p <- p + geom_text(aes(y = lab_y, label = lab,\n fontface = ifelse(mark_best & best, \"bold\", \"plain\")),\n vjust = 0, size = pv_pt2size(7), colour = \"#1A1A1A\")\n}\np <- p +\n facet_wrap(~panel, nrow = ceiling(length(strip) / n_cols), scales = \"free_y\") +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_y_continuous(limits = c(0, NA), expand = expansion(mult = c(0, 0)),\n breaks = function(l) pretty(c(0, l[2] / headroom), n = 3)) +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() +\n theme(panel.spacing.x = unit(3, \"mm\"),\n strip.text = element_text(size = 7, hjust = 0, margin = margin(b = 0.8, unit = \"mm\")),\n axis.text.x = element_text(size = 7, colour = \"black\", angle = 0,\n margin = margin(t = 0.7, unit = \"mm\")),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = fig_cells)\nmessage(\"wrote preview.png\")\n",
"search_text": "multi-metric faceted bars (house style)\n多指标分面柱图（house 风格）\nmetric-facet-bar\n\ncomparison\n比较\ncompare\n比较组\ncompare groups\n在多个具有不同单位或量纲的评价指标下，分小面板并排比较几种方法在多折交叉验证（把数据分成几份轮流测试）中的平均表现时用。\n在 `data.csv` 填入 `method`（方法名）、`metric`（带单位的指标名，每个指标占一个小面板）、`direction`（填 `higher` 表示越高越好，或 `lower` 表示越低越好）、`fold`（交叉验证折数编号）和 `value`（数值）；在 `plot.r` 顶部修改 `n_cols` 和 `fig_cells` 调整面板排列列数与画布尺寸，用 `mark_best` 控制是否依 `direction` 加粗最佳方法的数值，`show_direction` 控制是否在标题注明优劣方向，`digits` 设各指标小数位。\nbar facet small-multiples benchmark multi-metric house-style\nmethod 方法名（字符串，横轴） metric 指标名，含单位（字符串，每个一个面板） direction 该指标越大越好（higher）或越小越好（lower）（字符串） fold 交叉验证折或重复编号（整数） value 该次运行的指标值（数值）"
},
{
"title": "Radar chart",
"title_zh": "雷达图",
"slug": "radar",
"category": "comparison",
"tags": [
"radar",
"comparison",
"profile"
],
"packages": [
"ggplot2"
],
"data_columns": {
"group": "品系或组别（字符串）",
"axis": "性状轴（字符串）",
"value": "0 到 100 的得分（数值）"
},
"when_to_use": "少数组别要在同一组性状上比较轮廓差异时用。",
"customize": "在 `plot.R` 调整 `axis_levels` 与 `group_levels` 顺序，设定 `radius_max` 极值，控制 `fill_polygon` 填充与 `facet_groups` 分面；在 `data.csv` 填入 group、axis 和 value 列。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": "parallel-coordinates",
"variant_label": "Radar",
"variants": [],
"parameters": [
{
"name": "fill_polygon",
"value": "TRUE"
},
{
"name": "facet_groups",
"value": "FALSE"
},
{
"name": "axis_levels",
"value": "c(\"Growth\", \"Stress\", \"Yield\", \"Size\", \"Color\", \"Firm\")"
},
{
"name": "group_levels",
"value": "c(\"Line A\", \"Line B\", \"Line C\", \"Line D\")"
},
{
"name": "radius_max",
"value": "100"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/radar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/radar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/radar/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/radar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/radar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/radar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/radar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/radar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/radar/make_data.R"
}
],
"dir": "figures/comparison/radar",
"preview": "figures/comparison/radar/preview.png",
"docs_preview": "previews/radar.png",
"code": "figures/comparison/radar/plot.R",
"data": "figures/comparison/radar/data.csv",
"data_files": [
"figures/comparison/radar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/radar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/radar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/radar",
"code_text": "# Radar (house style): polygons in cartesian space so edges stay straight; group names with their\n# mean score written as a coloured key inside the panel (no legend). Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nfill_polygon <- TRUE\nfacet_groups <- FALSE\naxis_levels <- c(\"Growth\", \"Stress\", \"Yield\", \"Size\", \"Color\", \"Firm\")\ngroup_levels <- c(\"Line A\", \"Line B\", \"Line C\", \"Line D\")\nradius_max <- 100\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$axis <- factor(df$axis, levels = axis_levels)\ndf$group <- factor(df$group, levels = group_levels)\nn_ax <- length(axis_levels)\nang_of <- function(axis) {\n pi / 2 - (as.numeric(axis) - 1) * 2 * pi / n_ax\n}\ndf$x <- df$value * cos(ang_of(df$axis))\ndf$y <- df$value * sin(ang_of(df$axis))\nclosed <- do.call(rbind, lapply(split(df, df$group), function(g) rbind(g, g[1, ])))\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue, red, green, purple: all >= 3:1 on white, so the key keeps the line colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"magenta\"]],\n hp[[\"brown\"]])[seq_along(group_levels)], group_levels)\nfootnote <- \"Simulated data for illustration; not biological results\"\nkey <- data.frame(group = factor(group_levels, levels = group_levels), i = seq_along(group_levels))\nkey$m <- vapply(group_levels, function(g) mean(df$value[df$group == g]), numeric(1))\nkey$lab <- sprintf(\"%s mean %.0f\", key$group, key$m)\n\nring_n <- 160\nrings <- do.call(rbind, lapply(c(25, 50, 75, 100), function(r) {\n a <- seq(0, 2 * pi, length.out = ring_n)\n data.frame(x = r * cos(a), y = r * sin(a), ring = r)\n}))\nspoke_a <- ang_of(factor(axis_levels, levels = axis_levels))\nspokes <- data.frame(\n x = 0, y = 0,\n xend = radius_max * cos(spoke_a),\n yend = radius_max * sin(spoke_a)\n)\nlab_r <- radius_max + 12\nlabs <- data.frame(\n x = lab_r * cos(spoke_a),\n y = lab_r * sin(spoke_a),\n label = axis_levels,\n stringsAsFactors = FALSE\n)\n\n# ring values on the lower-left bisector between two axes, clear of the key\nring_a <- spoke_a[1] - pi + pi / n_ax\nring_lab <- data.frame(x = c(25, 50, 75, 100) * cos(ring_a), y = c(25, 50, 75, 100) * sin(ring_a),\n label = c(25, 50, 75, 100))\nlim <- 128\n\ndraw_one <- function(dat, with_key = TRUE) {\n g <- ggplot() +\n geom_path(data = rings, aes(x, y, group = ring), colour = grey[[\"light\"]], linewidth = pv_house_lw(\"frame\")) +\n geom_segment(data = spokes, aes(x = x, y = y, xend = xend, yend = yend), colour = grey[[\"light\"]],\n linewidth = pv_house_lw(\"frame\")) +\n geom_text(data = ring_lab, aes(x, y, label = label), colour = grey[[\"mid\"]], vjust = -0.3) +\n geom_polygon(data = dat, aes(x, y, group = group, colour = group, fill = group),\n alpha = if (fill_polygon) 0.12 else 0, linewidth = pv_house_lw(\"main\")) +\n geom_point(data = dat[!duplicated(interaction(dat$group, dat$axis)), ],\n aes(x, y, fill = group), shape = HOUSE_POINT$shape, size = 1.6, stroke = HOUSE_POINT$stroke,\n colour = \"black\") +\n geom_text(data = labs, aes(x, y, label = label))\n if (with_key) {\n g <- g + geom_text(data = key, aes(x = -lim, y = lim - (i - 1) * 13, label = lab, colour = group),\n hjust = 0, vjust = 1)\n }\n g +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_x_continuous(breaks = NULL) +\n scale_y_continuous(breaks = NULL) +\n coord_equal(xlim = c(-lim, lim), ylim = c(-lim, lim), expand = FALSE, clip = \"off\") +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() +\n theme(panel.border = element_blank(),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n}\n\nif (facet_groups) {\n p <- draw_one(closed, with_key = FALSE) + facet_wrap(~group)\n} else {\n p <- draw_one(closed)\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "radar chart\n雷达图\nradar\nradar\ncomparison\n比较\ncompare\n比较组\ncompare groups\n少数组别要在同一组性状上比较轮廓差异时用。\n在 `plot.r` 调整 `axis_levels` 与 `group_levels` 顺序，设定 `radius_max` 极值，控制 `fill_polygon` 填充与 `facet_groups` 分面；在 `data.csv` 填入 group、axis 和 value 列。\nradar comparison profile\ngroup 品系或组别（字符串） axis 性状轴（字符串） value 0 到 100 的得分（数值）"
},
{
"title": "Slope chart",
"title_zh": "斜率图",
"slug": "slope-chart",
"category": "comparison",
"tags": [
"slope",
"comparison",
"before-after"
],
"packages": [
"ggplot2"
],
"data_columns": {
"item": "指标名（字符串）",
"stage": "阶段（字符串）",
"value": "指数（数值）"
},
"when_to_use": "一批指标只有前后两个时间点、要看谁升谁降时用。",
"customize": "在 `plot.R` 修改 `highlight` 数组以高亮特定指标线，调整 `stage_levels` 设定阶段顺序，控制 `label_ends` 显隐两端名称标签；在 `data.csv` 填入 item、stage 和 value 列。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "highlight",
"value": "c(\"P04\", \"P07\", \"P11\")"
},
{
"name": "label_ends",
"value": "TRUE"
},
{
"name": "stage_levels",
"value": "c(\"Before\", \"After\")"
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "hi_cols",
"value": "c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"magenta\"]])[seq_along(highlight)]"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration;\\nnot biological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/slope-chart/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/slope-chart/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/slope-chart/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/slope-chart/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/slope-chart/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/slope-chart/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/slope-chart/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/slope-chart/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/slope-chart/make_data.R"
}
],
"dir": "figures/comparison/slope-chart",
"preview": "figures/comparison/slope-chart/preview.png",
"docs_preview": "previews/slope-chart.png",
"code": "figures/comparison/slope-chart/plot.R",
"data": "figures/comparison/slope-chart/data.csv",
"data_files": [
"figures/comparison/slope-chart/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/slope-chart/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/slope-chart/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/slope-chart",
"code_text": "# Slope chart (house style): every item from the first to the second stage, highlighted items\n# coloured and named at both ends in the line colour, the rest grey, mean change in the panel.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nhighlight <- c(\"P04\", \"P07\", \"P11\")\nlabel_ends <- TRUE\nstage_levels <- c(\"Before\", \"After\")\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue, red, green: all >= 3:1 on white, so the end labels keep the line colour\nhi_cols <- c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"magenta\"]])[seq_along(highlight)]\nfootnote <- \"Simulated data for illustration;\\nnot biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$stage <- factor(df$stage, levels = stage_levels)\ndf$x <- as.numeric(df$stage)\ndf$emph <- factor(ifelse(df$item %in% highlight, df$item, \"Other\"), levels = c(highlight, \"Other\"))\npal <- stats::setNames(c(hi_cols, grey[[\"ci\"]]), c(highlight, \"Other\"))\ndf <- df[order(df$emph != \"Other\"), ]\nw <- reshape(df[, c(\"item\", \"stage\", \"value\")], idvar = \"item\", timevar = \"stage\", direction = \"wide\")\nchg <- w[[paste0(\"value.\", stage_levels[2])]] - w[[paste0(\"value.\", stage_levels[1])]]\nstat_lab <- sprintf(\"Mean change %+.1f\\n%d of %d rise\", mean(chg), sum(chg > 0), length(chg))\ny_rng <- range(df$value)\ny_lim <- c(y_rng[1] - 0.04 * diff(y_rng), y_rng[2] + 0.22 * diff(y_rng))\n\np <- ggplot(df, aes(x, value, group = item, colour = emph)) +\n geom_line(aes(linewidth = emph == \"Other\")) +\n geom_point(aes(fill = emph), shape = HOUSE_POINT$shape, size = 1.6, stroke = HOUSE_POINT$stroke,\n colour = \"black\") +\n annotate(\"text\", x = 0.62, y = y_lim[2], hjust = 0, vjust = 1.15, lineheight = 0.95, label = stat_lab,\n colour = \"black\")\nif (isTRUE(label_ends)) {\n ends <- df[df$emph != \"Other\", ]\n ends$hjust <- ifelse(ends$x == 1, 1, 0)\n ends$nx <- ifelse(ends$x == 1, 0.9, 2.1)\n # keep labels on the same side at least min_gap apart (in y units)\n min_gap <- 0.075 * diff(y_lim)\n ends <- do.call(rbind, lapply(split(ends, ends$x), function(d) {\n d <- d[order(d$value), ]\n d$ly <- d$value\n for (i in seq_len(nrow(d))[-1]) d$ly[i] <- max(d$ly[i], d$ly[i - 1] + min_gap)\n d\n }))\n p <- p + geom_text(data = ends, aes(x = nx, y = ly, label = item, hjust = hjust), vjust = 0.5)\n}\np <- p +\n scale_colour_manual(values = pal, guide = \"none\") +\n scale_fill_manual(values = pal, guide = \"none\") +\n scale_linewidth_manual(values = c(`TRUE` = pv_house_lw(\"minor\"), `FALSE` = pv_house_lw(\"main\")),\n guide = \"none\") +\n scale_x_continuous(breaks = 1:2, labels = stage_levels) +\n coord_cartesian(xlim = c(0.55, 2.45), ylim = y_lim, expand = FALSE) +\n labs(x = NULL, y = \"Index\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "slope chart\n斜率图\nslope-chart\n\ncomparison\n比较\ncompare\n比较组\ncompare groups\n一批指标只有前后两个时间点、要看谁升谁降时用。\n在 `plot.r` 修改 `highlight` 数组以高亮特定指标线，调整 `stage_levels` 设定阶段顺序，控制 `label_ends` 显隐两端名称标签；在 `data.csv` 填入 item、stage 和 value 列。\nslope comparison before-after\nitem 指标名（字符串） stage 阶段（字符串） value 指数（数值）"
},
{
"title": "Waterfall chart",
"title_zh": "瀑布图",
"slug": "waterfall",
"category": "comparison",
"tags": [
"waterfall",
"contribution",
"bridge",
"comparison"
],
"packages": [
"ggplot2"
],
"data_columns": {
"label": "步骤名（字符串；首尾为期初/期末总量）",
"kind": "total 或 step（字符串）",
"value": "总量水平或有符号增量（数值）"
},
"when_to_use": "要把期初水平拆成若干增减项并接到期末总量时用；适合贡献分解、预算桥接。",
"customize": "在 `plot.R` 调整 `bar_width` 设定柱宽，修改 `label_size` 控制字号，控制 `show_connectors` 和 `show_value_labels` 显隐连线与数值；在 `data.csv` 填入 label、kind 和 value 列。",
"lang": "R",
"task": "compare",
"task_zh": "比较组",
"task_en": "Compare groups",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "bar_width",
"value": "0.62"
},
{
"name": "show_connectors",
"value": "TRUE"
},
{
"name": "show_value_labels",
"value": "TRUE"
},
{
"name": "label_size",
"value": "pv_pt2size(7)"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/comparison/waterfall/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/waterfall/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/waterfall/plot.R"
},
{
"name": "data.csv",
"path": "figures/comparison/waterfall/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/waterfall/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/waterfall/data.csv"
},
{
"name": "make_data.R",
"path": "figures/comparison/waterfall/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/comparison/waterfall/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/waterfall/make_data.R"
}
],
"dir": "figures/comparison/waterfall",
"preview": "figures/comparison/waterfall/preview.png",
"docs_preview": "previews/waterfall.png",
"code": "figures/comparison/waterfall/plot.R",
"data": "figures/comparison/waterfall/data.csv",
"data_files": [
"figures/comparison/waterfall/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/waterfall/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/comparison/waterfall/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/comparison/waterfall",
"code_text": "# Waterfall (house style): opening, signed steps, closing; value on every bar, bar classes as a\n# coloured key and the net change written inside the panel (no legend). Reads data.csv only.\n# Run from this directory. Pure ggplot2 (no waterfalls package).\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nbar_width <- 0.62\nshow_connectors <- TRUE\nshow_value_labels <- TRUE\nlabel_size <- pv_pt2size(7)\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$label <- factor(df$label, levels = unique(df$label))\nn <- nrow(df)\n\nymin <- numeric(n)\nymax <- numeric(n)\nfill_key <- character(n)\nleave <- numeric(n)\nrunning <- 0\nfor (i in seq_len(n)) {\n if (df$kind[i] == \"total\") {\n ymin[i] <- 0\n ymax[i] <- df$value[i]\n running <- df$value[i]\n fill_key[i] <- \"Total\"\n } else {\n start <- running\n end <- running + df$value[i]\n ymin[i] <- min(start, end)\n ymax[i] <- max(start, end)\n running <- end\n fill_key[i] <- if (df$value[i] >= 0) \"Increase\" else \"Decrease\"\n }\n leave[i] <- running\n}\n\nplot_df <- data.frame(\n label = df$label,\n xmin = as.numeric(df$label) - bar_width / 2,\n xmax = as.numeric(df$label) + bar_width / 2,\n ymin = ymin,\n ymax = ymax,\n fill_key = factor(fill_key, levels = c(\"Increase\", \"Decrease\", \"Total\")),\n stringsAsFactors = FALSE\n)\n\nconn <- NULL\nif (isTRUE(show_connectors) && n > 1) {\n conn <- data.frame(\n x = as.numeric(df$label[-n]) + bar_width / 2,\n xend = as.numeric(df$label[-1]) - bar_width / 2,\n y = leave[-n],\n yend = leave[-n]\n )\n}\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# key and net change sit in the empty band under the steps\n# green, red, blue: all >= 3:1 on white, so the key text keeps the bar colour\ncols <- c(Increase = hp[[\"green\"]], Decrease = hp[[\"red\"]], Total = hp[[\"blue\"]])\nfootnote <- \"Simulated data for illustration; not biological results\"\ny_top <- max(plot_df$ymax) * 1.16\ntot <- which(df$kind == \"total\")\nnet <- if (length(tot) >= 2) df$value[tot[length(tot)]] - df$value[tot[1]] else sum(df$value[df$kind != \"total\"])\nkey <- data.frame(k = factor(c(\"Increase\", \"Decrease\", \"Total\"), levels = c(\"Increase\", \"Decrease\", \"Total\")),\n i = 1:3)\n\np <- ggplot() +\n geom_rect(data = plot_df, aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = fill_key),\n colour = NA)\nif (!is.null(conn)) {\n p <- p + geom_segment(data = conn, aes(x = x, xend = xend, y = y, yend = y),\n linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]], linetype = \"22\")\n}\nif (isTRUE(show_value_labels)) {\n lab_df <- plot_df\n lab_df$txt <- ifelse(df$kind == \"total\", sprintf(\"%.1f\", df$value), sprintf(\"%+.1f\", df$value))\n p <- p + geom_text(data = lab_df, aes(x = (xmin + xmax) / 2, y = ymax, label = txt), vjust = -0.4,\n size = label_size, colour = \"black\")\n}\np <- p +\n geom_text(data = key, aes(x = 1.55, y = y_top * (0.5 - 0.085 * (i - 1)), label = k, colour = k),\n hjust = 0, vjust = 1) +\n annotate(\"text\", x = n - 0.55, y = y_top * 0.5, hjust = 1, vjust = 1,\n label = sprintf(\"Net change %+.1f\", net)) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(breaks = as.numeric(df$label), labels = as.character(levels(df$label))) +\n scale_y_continuous(limits = c(0, y_top), expand = c(0, 0)) +\n coord_cartesian(xlim = c(0.45, n + 0.55), expand = FALSE) +\n labs(x = NULL, y = \"Value\", caption = footnote) +\n theme_house() +\n theme(axis.text.x = element_text(angle = 35, hjust = 1, vjust = 1),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "waterfall chart\n瀑布图\nwaterfall\n\ncomparison\n比较\ncompare\n比较组\ncompare groups\n要把期初水平拆成若干增减项并接到期末总量时用；适合贡献分解、预算桥接。\n在 `plot.r` 调整 `bar_width` 设定柱宽，修改 `label_size` 控制字号，控制 `show_connectors` 和 `show_value_labels` 显隐连线与数值；在 `data.csv` 填入 label、kind 和 value 列。\nwaterfall contribution bridge comparison\nlabel 步骤名（字符串；首尾为期初/期末总量） kind total 或 step（字符串） value 总量水平或有符号增量（数值）"
},
{
"title": "Alluvial and Sankey",
"title_zh": "桑基 / 冲积图",
"slug": "alluvial",
"category": "composition",
"tags": [
"alluvial",
"sankey",
"flow"
],
"packages": [
"ggplot2",
"ggalluvial"
],
"data_columns": {
"stage1": "第一轴类别，这里是队列（字符串）",
"stage2": "第二轴类别，这里是分子亚型（字符串）",
"stage3": "第三轴类别，这里是治疗反应（字符串）",
"value": "该路径的人数（数值）"
},
"when_to_use": "同一批样本在两三个分类之间怎么分流时用。",
"customize": "在 `plot.R` 修改 `highlight` 选定高亮流，调整 `axis_labels` 设轴名，控制 `show_bubbles`（默认 `FALSE`）显隐气泡；在 `data.csv` 填入 `stage1`、`stage2`、`stage3` 和 `value` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "highlight",
"value": "\"CR\""
},
{
"name": "axis_labels",
"value": "c(\"Cohort\", \"Subtype\", \"Response\")"
},
{
"name": "show_bubbles",
"value": "FALSE"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/alluvial/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/alluvial/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/alluvial/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/alluvial/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/alluvial/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/alluvial/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/alluvial/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/alluvial/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/alluvial/make_data.R"
}
],
"dir": "figures/composition/alluvial",
"preview": "figures/composition/alluvial/preview.png",
"docs_preview": "previews/alluvial.png",
"code": "figures/composition/alluvial/plot.R",
"data": "figures/composition/alluvial/data.csv",
"data_files": [
"figures/composition/alluvial/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/alluvial/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/alluvial/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/alluvial",
"code_text": "# Alluvial / Sankey (house style). Highlight one label, rename axes, optional stratum bubbles.\n# Flows take the cohort colour; flows that touch the highlighted label stay strong, others fade.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(ggalluvial)\n\nhighlight <- \"CR\"\naxis_labels <- c(\"Cohort\", \"Subtype\", \"Response\")\nshow_bubbles <- FALSE\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$stage1 <- factor(df$stage1, levels = c(\"Control\", \"Case\", \"Treated\"))\ndf$stage2 <- factor(df$stage2, levels = c(\"LumA\", \"LumB\", \"HER2\", \"Basal\"))\ndf$stage3 <- factor(df$stage3, levels = c(\"CR\", \"PR\", \"SD\", \"PD\", \"NE\"))\ndf$on <- df$stage1 == highlight | df$stage2 == highlight | df$stage3 == highlight\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npal <- stats::setNames(unname(hp[seq_len(nlevels(df$stage1))]), levels(df$stage1))\n\np <- ggplot(df, aes(y = value, axis1 = stage1, axis2 = stage2, axis3 = stage3)) +\n geom_alluvium(aes(fill = stage1, alpha = on), width = 0.34, colour = NA, curve_type = \"sigmoid\",\n key_glyph = \"rect\") +\n geom_stratum(width = 0.34, fill = \"white\", colour = grey[[\"dark\"]], linewidth = pv_house_lw(\"frame\")) +\n geom_text(stat = \"stratum\", aes(label = after_stat(stratum)), size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family()) +\n scale_x_discrete(limits = axis_labels, expand = expansion(add = 0.25)) +\n scale_y_continuous(expand = expansion(mult = c(0, 0.02))) +\n scale_fill_manual(values = pal, name = NULL) +\n scale_alpha_manual(values = c(`TRUE` = 0.85, `FALSE` = 0.25), guide = \"none\") +\n guides(fill = guide_legend(override.aes = list(alpha = 0.85))) +\n labs(x = NULL, y = \"Patients\", caption = footnote) +\n theme_house() +\n theme(legend.position = \"top\", legend.justification = \"left\",\n legend.margin = margin(0, 0, 0, 0), legend.box.spacing = unit(1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nif (isTRUE(show_bubbles)) {\n p <- p + geom_point(stat = \"stratum\", aes(size = after_stat(y)),\n shape = 21, fill = \"white\", colour = grey[[\"dark\"]], stroke = 0.3) +\n scale_size_area(max_size = 5, guide = \"none\")\n}\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "alluvial and sankey\n桑基 / 冲积图\nalluvial\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n同一批样本在两三个分类之间怎么分流时用。\n在 `plot.r` 修改 `highlight` 选定高亮流，调整 `axis_labels` 设轴名，控制 `show_bubbles`（默认 `false`）显隐气泡；在 `data.csv` 填入 `stage1`、`stage2`、`stage3` 和 `value` 列。\nalluvial sankey flow\nstage1 第一轴类别，这里是队列（字符串） stage2 第二轴类别，这里是分子亚型（字符串） stage3 第三轴类别，这里是治疗反应（字符串） value 该路径的人数（数值）"
},
{
"title": "Donut chart",
"title_zh": "环形图",
"slug": "donut",
"category": "composition",
"tags": [
"donut",
"ring",
"composition",
"proportion"
],
"packages": [
"ggplot2"
],
"data_columns": {
"part": "组成分名称（字符串）",
"value": "份额权重（正数；图中换算为占比）"
},
"when_to_use": "一个整体拆成少数几份、要用中空环强调份额时用；需要独立 slug 的环形图，而不是改 pie。",
"customize": "在 `plot.R` 控制 `show_labels`（默认 `TRUE`）显隐外侧名称，用 `inner_r` 和 `outer_r` 调半径，改 `part_drop` 剔除组分；在 `data.csv` 填入 `part` 和 `value` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": "pie",
"variant_label": "Donut",
"variants": [],
"parameters": [
{
"name": "show_labels",
"value": "TRUE"
},
{
"name": "inner_r",
"value": "1.15"
},
{
"name": "outer_r",
"value": "2.2"
},
{
"name": "part_drop",
"value": "character(0)"
},
{
"name": "inner_frac",
"value": "inner_r / outer_r"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/donut/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/donut/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/donut/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/donut/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/donut/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/donut/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/donut/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/donut/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/donut/make_data.R"
}
],
"dir": "figures/composition/donut",
"preview": "figures/composition/donut/preview.png",
"docs_preview": "previews/donut.png",
"code": "figures/composition/donut/plot.R",
"data": "figures/composition/donut/data.csv",
"data_files": [
"figures/composition/donut/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/donut/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/donut/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/donut",
"code_text": "# Donut (house style): ring drawn as polygons, share inside each sector, names outside in the sector\n# colour (#1A1A1A when that colour is < 3:1 on white), total in the centre.\n# Reads data.csv only. Run from this directory. Dedicated slug; does not modify figures/composition/pie/.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nshow_labels <- TRUE\ninner_r <- 1.15\nouter_r <- 2.2\npart_drop <- character(0)\ninner_frac <- inner_r / outer_r\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nif (length(part_drop)) df <- df[!df$part %in% part_drop, , drop = FALSE]\ndf <- df[order(df$value, decreasing = TRUE), , drop = FALSE]\ndf$share <- df$value / sum(df$value)\ndf$end <- cumsum(df$share)\ndf$start <- df$end - df$share\ndf$mid <- (df$start + df$end) / 2\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\ncols <- stats::setNames(unname(hp[seq_len(nrow(df))]), df$part)\n# names sit on white: keep the sector colour when it is >= 3:1 on white, else #1A1A1A\nlow_contrast <- c(hp[[\"orange\"]], hp[[\"sky\"]], hp[[\"gold\"]])\nname_col <- ifelse(cols %in% low_contrast, \"#1A1A1A\", cols)\n# percentages sit on the fill: black on light fills, white on dark fills\npct_col <- ifelse(cols %in% low_contrast, \"black\", \"white\")\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nrin <- inner_frac # ring outer radius = 1\nto_xy <- function(frac, r) data.frame(x = r * sin(2 * pi * frac), y = r * cos(2 * pi * frac))\nring <- do.call(rbind, lapply(seq_len(nrow(df)), function(i) {\n f <- seq(df$start[i], df$end[i], length.out = max(2, ceiling(df$share[i] * 360)))\n inner <- if (rin > 0) to_xy(rev(f), rin) else data.frame(x = 0, y = 0)\n cbind(rbind(to_xy(f, 1), inner), part = df$part[i])\n}))\npct <- cbind(df, to_xy(df$mid, if (rin > 0) (rin + 1) / 2 else 0.62), col = pct_col)\npct <- pct[pct$share >= 0.05, ] # too thin for a number inside: the name carries the share\nnm <- cbind(df, to_xy(df$mid, 1.06), col = name_col)\ns_mid <- sin(2 * pi * df$mid)\nnm$hj <- ifelse(abs(s_mid) < 0.15, 0.5, ifelse(s_mid > 0, 0, 1))\nnm$vj <- ifelse(abs(s_mid) < 0.15, ifelse(cos(2 * pi * df$mid) > 0, 0, 1), 0.5)\n# a name centred above or below the ring moves out a little more, clear of its neighbours\ntop_bot <- abs(s_mid) < 0.15\nnm[top_bot, c(\"x\", \"y\")] <- to_xy(df$mid[top_bot], 1.13)\nnm$lab <- ifelse(df$share >= 0.05, df$part, sprintf(\"%s %.0f%%\", df$part, 100 * df$share))\n\ncells <- c(2, 1)\nview_y <- c(-1.22, 1.27)\nview_x <- c(-1, 1) * diff(view_y) * 86 / 34 / 2 # panel about 86 x 34 mm after margins and footnote\np <- ggplot() +\n geom_polygon(data = ring, aes(x, y, group = part, fill = part), colour = \"white\", linewidth = pv_house_lw(0.5)) +\n geom_text(data = pct, aes(x, y, label = sprintf(\"%.0f%%\", 100 * share), colour = col))\nif (isTRUE(show_labels)) {\n p <- p + geom_text(data = nm, aes(x, y, label = lab, hjust = hj, vjust = vj, colour = col))\n}\nif (rin > 0) {\n p <- p + annotate(\"text\", x = 0, y = 0, label = sprintf(\"Total\\n%s\", format(round(sum(df$value), 1))),\n size = pv_pt2size(8), lineheight = 0.95)\n} else {\n p <- p + annotate(\"text\", x = view_x[1], y = view_y[2], hjust = 0, vjust = 1,\n label = sprintf(\"Total %s\", format(round(sum(df$value), 1))))\n}\np <- p +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_identity() +\n scale_x_continuous(breaks = NULL, expand = c(0, 0)) +\n scale_y_continuous(breaks = NULL, expand = c(0, 0)) +\n coord_fixed(xlim = view_x, ylim = view_y, clip = \"off\") +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() +\n theme(panel.border = element_blank(),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = cells)\nmessage(\"wrote preview.png\")\n",
"search_text": "donut chart\n环形图\ndonut\ndonut\ncomposition\n组成\ncomposition\n组成\ncomposition\n一个整体拆成少数几份、要用中空环强调份额时用；需要独立 slug 的环形图，而不是改 pie。\n在 `plot.r` 控制 `show_labels`（默认 `true`）显隐外侧名称，用 `inner_r` 和 `outer_r` 调半径，改 `part_drop` 剔除组分；在 `data.csv` 填入 `part` 和 `value` 列。\ndonut ring composition proportion\npart 组成分名称（字符串） value 份额权重（正数；图中换算为占比）"
},
{
"title": "Donut chart with direct labels (house style)",
"title_zh": "直标环图（house 风格）",
"slug": "house-donut",
"category": "composition",
"tags": [
"donut",
"proportion",
"composition",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"cover": "类别名（字符串）",
"area_km2": "类别量（正数，图中换算成占比）"
},
"when_to_use": "一个整体分成 ≤6 份时用；百分比写在环上，类别名用扇区同色写在环外，中心写总量；<3% 的类别合并为 Other。",
"customize": "plot.R 顶部 inner_r 为内径比例（0.5–0.6）；min_share 为并入 Other 的阈值；label_r 为外圈名称半径；cells 为网格尺寸；view_y 为上下可见范围（换数据后名称出界就放宽），view_x 按面板宽高比自动算出、左右居中；centre_title / unit_label 为中心文字。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 2×1 格（89 × 43 mm），字号保持 7/8 pt（只有单个 2×2 面板才由 pv_save_house() 自动 +2 pt）。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "inner_r",
"value": "0.56"
},
{
"name": "min_share",
"value": "0.03"
},
{
"name": "label_r",
"value": "1.05"
},
{
"name": "cells",
"value": "c(2, 1)"
},
{
"name": "plot_margin_mm",
"value": "c(1, 1, 1, 0.8)"
},
{
"name": "view_y",
"value": "c(-1.13, 1.2)"
},
{
"name": "panel_mm",
"value": "c(pv_grid_span(cells[1]) - sum(plot_margin_mm[c(2, 4)]), pv_grid_span(cells[2]) - sum(plot_margin_mm[c(1, 3)]))"
},
{
"name": "view_x",
"value": "c(-1, 1) * diff(view_y) * panel_mm[1] / panel_mm[2] / 2"
},
{
"name": "centre_title",
"value": "\"Catchment\""
},
{
"name": "unit_label",
"value": "\"km\\u00b2\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/house-donut/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/house-donut/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/house-donut/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/house-donut/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/house-donut/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/house-donut/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/house-donut/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/house-donut/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/house-donut/make_data.R"
}
],
"dir": "figures/composition/house-donut",
"preview": "figures/composition/house-donut/preview.png",
"docs_preview": "previews/house-donut.png",
"code": "figures/composition/house-donut/plot.R",
"data": "figures/composition/house-donut/data.csv",
"data_files": [
"figures/composition/house-donut/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/house-donut/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/house-donut/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/house-donut",
"code_text": "# House-style donut: shares on the ring, names in the sector colour, total in the centre.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\ninner_r <- 0.56\nmin_share <- 0.03\nlabel_r <- 1.05 # radius of the outer names (ring outer radius = 1)\ncells <- c(2, 1) # composition figure: 2 x 1 grid cells (89 x 43 mm)\nplot_margin_mm <- c(1, 1, 1, 0.8) # t, r, b, l\n# visible window in ring units: view_y leaves room for the names above and below the ring;\n# view_x is centred and follows the panel aspect (coord_fixed), so the ring fills the height\nview_y <- c(-1.13, 1.2)\npanel_mm <- c(pv_grid_span(cells[1]) - sum(plot_margin_mm[c(2, 4)]),\n pv_grid_span(cells[2]) - sum(plot_margin_mm[c(1, 3)]))\nview_x <- c(-1, 1) * diff(view_y) * panel_mm[1] / panel_mm[2] / 2\ncentre_title <- \"Catchment\"\nunit_label <- \"km\\u00b2\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$share <- df$area_km2 / sum(df$area_km2)\nsmall <- df$share < min_share\nif (any(small)) {\n df <- rbind(df[!small, c(\"cover\", \"area_km2\")],\n data.frame(cover = \"Other\", area_km2 = sum(df$area_km2[small])))\n}\ndf <- df[order(df$cover == \"Other\", -df$area_km2), ]\ndf$share <- df$area_km2 / sum(df$area_km2)\ndf$end <- cumsum(df$share)\ndf$start <- df$end - df$share\ndf$mid <- (df$start + df$end) / 2\nn_col <- sum(df$cover != \"Other\")\ncols <- stats::setNames(c(unname(pv_palette(\"house\", n_col)), pv_palette(\"house_grey\")[[\"ci\"]])[seq_len(nrow(df))],\n df$cover)\nlight <- c(\"#E6C32A\", \"#62B4E7\", \"#BFBFBF\")\ndf$txt <- ifelse(cols[df$cover] %in% light, \"black\", \"white\")\nname_col <- ifelse(df$cover == \"Other\", pv_palette(\"house_grey\")[[\"mid\"]], cols[df$cover])\n# Ring drawn as polygons in Cartesian space (coord_polar always pads the radius to 80% of the\n# panel, which leaves the white bands this layout avoids). Angles run clockwise from 12 o'clock.\nto_xy <- function(frac, r) data.frame(x = r * sin(2 * pi * frac), y = r * cos(2 * pi * frac))\nring <- do.call(rbind, lapply(seq_len(nrow(df)), function(i) {\n f <- seq(df$start[i], df$end[i], length.out = max(2, ceiling(df$share[i] * 360)))\n cbind(rbind(to_xy(f, 1), to_xy(rev(f), inner_r)), cover = df$cover[i])\n}))\npct <- cbind(df, to_xy(df$mid, (inner_r + 1) / 2))\nnm <- cbind(df, to_xy(df$mid, label_r))\ns_mid <- sin(2 * pi * df$mid)\nnm$hj <- ifelse(abs(s_mid) < 0.15, 0.5, ifelse(s_mid > 0, 0, 1))\nnm$vj <- ifelse(abs(s_mid) < 0.15, ifelse(cos(2 * pi * df$mid) > 0, 0, 1), 0.5)\nnm$col <- name_col\n\np <- ggplot() +\n geom_polygon(data = ring, aes(x, y, group = cover, fill = cover), colour = \"white\",\n linewidth = pv_house_lw(0.5)) +\n geom_text(data = pct, aes(x, y, label = sprintf(\"%.0f%%\", 100 * share), colour = txt),\n size = pv_pt2size(7)) +\n geom_text(data = nm, aes(x, y, label = cover, hjust = hj, vjust = vj, colour = col),\n size = pv_pt2size(7)) +\n annotate(\"text\", x = 0, y = 0, label = sprintf(\"%s\\n%s %s\", centre_title,\n format(round(sum(df$area_km2)), big.mark = \",\"), unit_label), size = pv_pt2size(8), lineheight = 0.95) +\n scale_fill_manual(values = cols) +\n scale_colour_identity() +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(expand = c(0, 0)) +\n coord_fixed(xlim = view_x, ylim = view_y, clip = \"off\") +\n theme_house() +\n theme(panel.border = element_blank(), axis.line = element_blank(), axis.text.x = element_blank(),\n axis.text.y = element_blank(), axis.ticks = element_blank(), axis.title.x = element_blank(),\n axis.title.y = element_blank(), legend.position = \"none\",\n plot.margin = margin(plot_margin_mm[1], plot_margin_mm[2], plot_margin_mm[3], plot_margin_mm[4], \"mm\"))\n\npv_save_house(p, \"figure\", cells = cells)\nmessage(\"wrote preview.png\")\n",
"search_text": "donut chart with direct labels (house style)\n直标环图（house 风格）\nhouse-donut\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n一个整体分成 ≤6 份时用；百分比写在环上，类别名用扇区同色写在环外，中心写总量；<3% 的类别合并为 other。\nplot.r 顶部 inner_r 为内径比例（0.5–0.6）；min_share 为并入 other 的阈值；label_r 为外圈名称半径；cells 为网格尺寸；view_y 为上下可见范围（换数据后名称出界就放宽），view_x 按面板宽高比自动算出、左右居中；centre_title / unit_label 为中心文字。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 2×1 格（89 × 43 mm），字号保持 7/8 pt（只有单个 2×2 面板才由 pv_save_house() 自动 +2 pt）。\ndonut proportion composition house-style\ncover 类别名（字符串） area_km2 类别量（正数，图中换算成占比）"
},
{
"title": "UpSet plot of set intersections (house style)",
"title_zh": "UpSet 交集图（house 风格）",
"slug": "house-upset",
"category": "composition",
"tags": [
"upset",
"intersection",
"venn-alternative",
"sets",
"house-style"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"gene": "基因 ID（每行一个元素）",
"leaf": "是否属于该集合（0/1，此例为叶片响应）",
"root": "是否属于该集合（0/1，根）",
"berry_skin": "是否属于该集合（0/1，果皮）",
"berry_flesh": "是否属于该集合（0/1，果肉）",
"seed": "是否属于该集合（0/1，种子）"
},
"when_to_use": "4 个以上集合比较重叠时用（集合多时比韦恩图清楚）；上方柱为互斥交集大小，下方点阵标出交集由哪些集合组成，左侧横柱为各集合大小。只属于一个集合的柱与点用该集合的颜色，多个集合的交集用黑色；数值直接写在柱上，点阵列交替浅灰底，集合名用同色写在点阵旁。",
"customize": "plot.R 顶部 set_cols 把 0/1 列映射为显示名（顺序即行序与配色顺序）；n_show 为显示的交集个数（按大小排序）；band_fill 为交替列底色；dot_size 为点阵点径；widths_mm 为左侧集合柱与集合名的宽度；matrix_share 为点阵与交集柱的高度比。右上角的一句结论由数据算出（最大的多集合交集及其基因数），不写死；左侧集合柱的轴上限与顶部轴同一规则：max × 1.08 向上取到 250 的倍数（891 → 1000，刻度 0/500/1000），数值放得下（两侧各留 ≥1 mm）时写在柱内末端，字色由 on_fill_text() 按 WCAG 对比度自动选择（白色达到 4.5:1 就用白色，否则用 #1A1A1A）；放不下时写在柱外，用集合色；左上说明贴在集合柱上方，并写明只显示前 n_show 个交集（此例 31 个非空交集中的前 15 个，共 1,718 个基因；数字由数据算出），左侧集合柱统计的是全部基因（1,854 个）。颜色依次取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size）。本图 4×2 格（183 × 89 mm），多面板（patchwork）字号保持 7/8 pt，不自动 +2 pt。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "set_cols",
"value": "c(leaf = \"Leaf\", root = \"Root\", berry_skin = \"Berry skin\", berry_flesh = \"Berry flesh\", seed = \"Seed\")"
},
{
"name": "n_show",
"value": "15"
},
{
"name": "band_fill",
"value": "pv_palette(\"house_grey\")[[\"bg\"]]"
},
{
"name": "dot_size",
"value": "2.3"
},
{
"name": "widths_mm",
"value": "c(22, 16)"
},
{
"name": "matrix_share",
"value": "0.42"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/house-upset/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/house-upset/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/house-upset/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/house-upset/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/house-upset/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/house-upset/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/house-upset/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/house-upset/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/house-upset/make_data.R"
}
],
"dir": "figures/composition/house-upset",
"preview": "figures/composition/house-upset/preview.png",
"docs_preview": "previews/house-upset.png",
"code": "figures/composition/house-upset/plot.R",
"data": "figures/composition/house-upset/data.csv",
"data_files": [
"figures/composition/house-upset/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/house-upset/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/house-upset/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/house-upset",
"code_text": "# House-style UpSet: intersection bars + dot matrix + set-size bars, drawn with ggplot2 + patchwork.\n# Single-set columns, dots and set bars in the set colour; multi-set intersections in black.\n# Counts are written on the bars; matrix columns alternate a light grey band.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\nset_cols <- c(leaf = \"Leaf\", root = \"Root\", berry_skin = \"Berry skin\", berry_flesh = \"Berry flesh\", seed = \"Seed\")\nn_show <- 15 # largest intersections shown (exclusive counts)\nband_fill <- pv_palette(\"house_grey\")[[\"bg\"]]\ndot_size <- 2.3 # matrix dots (HOUSE_POINT size)\nwidths_mm <- c(22, 16) # set-size bars, set labels: kept tight so the bars and matrix get the width\nmatrix_share <- 0.42 # matrix height / intersection-bar height\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nsets <- names(set_cols)\nk <- length(sets)\npal <- pv_palette(\"house\")\ncols <- stats::setNames(unname(pal[seq_len(k)]), sets)\ngrey <- pv_palette(\"house_grey\")\n\n# exclusive intersections: each gene counted once, in its exact combination\nkey <- apply(df[, sets] == 1, 1, function(r) paste(sets[r], collapse = \"&\"))\ntab_all <- sort(table(key), decreasing = TRUE)\nn_inter <- length(tab_all) # non-empty intersections in the data\ntab <- tab_all[seq_len(min(n_show, n_inter))]\n# UpSet column capacity (measured on house-mosaic-transcriptome e, 3x1 = 135 mm): everything outside the\n# intersection columns (set bars, set names, gaps, y-axis band, right margin) takes 59 mm; each column needs\n# >= 4.8 mm (three-digit label 4.23 mm + 0.6 mm). Limit = floor((width_mm - 59) / 4.8): 2x1 6, 3x1 15, 4x1 25.\nUPSET_OVERHEAD_MM <- 59; UPSET_COL_MM <- 4.8\nstopifnot(floor((pv_grid_span(4) - UPSET_OVERHEAD_MM) / UPSET_COL_MM) >= nrow(tab)) # 4 cells wide (content 181 mm)\nn_in_shown <- sum(tab) # genes covered by the columns shown\ninter <- data.frame(key = names(tab), n = as.integer(tab), stringsAsFactors = FALSE)\ninter$col_i <- seq_len(nrow(inter))\ninter$members <- strsplit(inter$key, \"&\", fixed = TRUE)\ninter$degree <- lengths(inter$members)\ninter$fill <- ifelse(inter$degree == 1, cols[vapply(inter$members, `[`, \"\", 1)], \"#000000\")\nset_n <- data.frame(set = sets, row = rev(seq_len(k)), n = colSums(df[, sets]))\n\ndots <- do.call(rbind, lapply(seq_len(nrow(inter)), function(i) {\n on <- sets %in% inter$members[[i]]\n data.frame(col_i = i, row = set_n$row, on = on,\n fill = ifelse(on, inter$fill[i], grey[[\"light\"]]))\n}))\nlinks <- do.call(rbind, lapply(which(inter$degree > 1), function(i) {\n r <- set_n$row[sets %in% inter$members[[i]]]\n data.frame(col_i = i, lo = min(r), hi = max(r))\n}))\nbands <- data.frame(col_i = seq(2, nrow(inter), 2))\n# one-sentence conclusion from the data: the largest intersection of two or more sets\ntop_shared <- inter[inter$degree > 1, ][1, ]\nconclusion <- sprintf(\"Largest shared set: %s (%d genes)\",\n paste(set_cols[top_shared$members[[1]]], collapse = \" + \"), top_shared$n)\nx_sc <- scale_x_continuous(limits = c(0.5, nrow(inter) + 0.5), expand = c(0, 0))\ny_rows <- scale_y_continuous(limits = c(0.5, k + 0.5), expand = c(0, 0))\ny_top <- ceiling(max(inter$n) * 1.08 / 25) * 25 # max x 1.08, rounded up to 25 (375 -> 425)\nno_x <- theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(), axis.title.x = element_blank())\n\n# intersection bars ------------------------------------------------------------------------\np_bar <- ggplot(inter, aes(col_i, n)) +\n geom_rect(data = bands, aes(xmin = col_i - 0.5, xmax = col_i + 0.5, ymin = 0, ymax = Inf),\n inherit.aes = FALSE, fill = band_fill) +\n geom_col(aes(fill = fill), width = 0.62) +\n geom_text(aes(label = n, colour = fill), vjust = -0.35, size = pv_pt2size(8)) +\n annotate(\"text\", x = nrow(inter) + 0.35, y = y_top * 0.97, hjust = 1, vjust = 1, size = pv_pt2size(8),\n label = conclusion) +\n scale_fill_identity() + scale_colour_identity() + x_sc +\n scale_y_continuous(limits = c(0, y_top), breaks = seq(0, floor(y_top / 100) * 100, 100), expand = c(0, 0)) +\n labs(y = \"Intersection size (genes)\") +\n theme_house() + no_x\n\n# dot matrix -------------------------------------------------------------------------------\np_mat <- ggplot() +\n geom_rect(data = bands, aes(xmin = col_i - 0.5, xmax = col_i + 0.5, ymin = -Inf, ymax = Inf),\n fill = band_fill) +\n # inactive dots, then the connector, then the member dots on top (the line stays solid)\n # every dot is HOUSE_POINT shape 21 / size / stroke; only fill (and outline for inactive) differs\n geom_point(data = dots[!dots$on, ], aes(col_i, row), shape = HOUSE_POINT$shape, size = dot_size,\n stroke = HOUSE_POINT$stroke, fill = grey[[\"light\"]], colour = grey[[\"light\"]]) +\n geom_segment(data = links, aes(x = col_i, xend = col_i, y = lo, yend = hi),\n linewidth = pv_house_lw(\"main\"), colour = \"#000000\") +\n geom_point(data = dots[dots$on, ], aes(col_i, row, fill = fill), shape = HOUSE_POINT$shape, size = dot_size,\n stroke = HOUSE_POINT$stroke, colour = \"#000000\") +\n scale_fill_identity() + x_sc + y_rows +\n theme_house() + no_x +\n theme(axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank())\n\n# set labels in the set colour -------------------------------------------------------------\np_lab <- ggplot(set_n, aes(1, row, label = set_cols[set], colour = set)) +\n geom_text(hjust = 0.5, size = pv_pt2size(8)) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(limits = c(0, 2), expand = c(0, 0)) + y_rows +\n theme_void()\n\n# set sizes (bars run leftwards, counts on the bars) ---------------------------------------\nx_set <- ceiling(max(set_n$n) * 1.08 / 250) * 250 # same rule as the top axis; 891 -> 1000\n# Text colour for a label drawn on a filled bar (WCAG 2.x contrast).\n# Relative luminance L = 0.2126 R + 0.7152 G + 0.0722 B on linearised sRGB;\n# contrast = (L_light + 0.05) / (L_dark + 0.05). White is used when it reaches\n# 4.5:1 (normal-size text), otherwise near-black #1A1A1A.\nwcag_lum <- function(hex) {\n c <- grDevices::col2rgb(hex)[, 1] / 255\n c <- ifelse(c <= 0.04045, c / 12.92, ((c + 0.055) / 1.055)^2.4)\n sum(c(0.2126, 0.7152, 0.0722) * c)\n}\nwcag_contrast <- function(a, b) {\n l <- sort(c(wcag_lum(a), wcag_lum(b)), decreasing = TRUE)\n (l[1] + 0.05) / (l[2] + 0.05)\n}\non_fill_text <- function(fill, min_ratio = 4.5) {\n vapply(fill, function(f) {\n if (wcag_contrast(\"#FFFFFF\", f) >= min_ratio) \"#FFFFFF\" else \"#1A1A1A\"\n }, character(1), USE.NAMES = FALSE)\n}\n\n# Set-size labels go inside the bar end when they fit with >= 1 mm either\n# side; otherwise just outside it in the set colour (axis stays at x_set).\nlab_pt <- 8\npad_mm <- 1\ndigit_mm <- 0.556 * lab_pt * 25.4 / 72 # Arial digit advance\nset_n$bar_mm <- set_n$n / x_set * widths_mm[1]\nset_n$text_mm <- nchar(format(set_n$n)) * digit_mm\nset_n$inside <- set_n$bar_mm >= set_n$text_mm + 2 * pad_mm\nset_n$fill_hex <- unname(cols[as.character(set_n$set)])\nset_n$lab_col <- ifelse(set_n$inside, on_fill_text(set_n$fill_hex), set_n$fill_hex)\nset_n$lab_x <- set_n$n + ifelse(set_n$inside, -1, 1.2) * pad_mm / widths_mm[1] * x_set # 1.2: digit side bearing\nset_n$lab_h <- ifelse(set_n$inside, 0, 1) # reversed axis: 0 = text runs toward 0\n\np_set <- ggplot(set_n, aes(n, row, fill = set)) +\n geom_col(width = 0.76, orientation = \"y\") + # 3.2 mm bars: >= 0.3 mm above 8 pt digits\n geom_text(aes(x = lab_x, label = n, hjust = lab_h), colour = set_n$lab_col,\n size = pv_pt2size(lab_pt)) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_x_reverse(limits = c(x_set, 0), breaks = seq(0, x_set, 500), expand = c(0, 0)) + y_rows +\n labs(x = \"Set size (genes)\") +\n theme_house() +\n theme(axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank())\n\n# note, bottom-anchored in the top-left cell so it sits just above the set-size bars ---------\nfmt_n <- function(x) format(x, big.mark = \",\")\nnote <- data.frame(y = 5.2 - (0:5), face = c(\"bold\", rep(\"plain\", 5)),\n col = c(\"#000000\", rep(grey[[\"mid\"]], 4), \"#000000\"),\n lab = c(\"Drought-responsive genes\",\n sprintf(\"n = %s genes in %d tissues\", fmt_n(nrow(df)), k),\n sprintf(\"Top %d of %d intersections shown\", nrow(inter), n_inter),\n sprintf(\"(%s genes); set bars count all\", fmt_n(n_in_shown)),\n \"Colour: one tissue only\", \"Black: shared by 2+ tissues\"))\np_note <- ggplot(note, aes(0, y, label = lab)) +\n geom_text(aes(fontface = face, colour = col), hjust = 0, vjust = 0, size = pv_pt2size(7)) +\n scale_colour_identity() +\n scale_x_continuous(limits = c(0, 1), expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 16), expand = c(0, 0)) +\n coord_cartesian(clip = \"off\") +\n theme_void()\n\np <- p_bar + p_mat + p_lab + p_set + p_note +\n plot_layout(design = \"EEA\\nDCB\", widths = unit(c(widths_mm, 1), c(\"mm\", \"mm\", \"null\")),\n heights = c(1, matrix_share))\npv_save_house(p, \"figure\", cells = \"4x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "upset plot of set intersections (house style)\nupset 交集图（house 风格）\nhouse-upset\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n4 个以上集合比较重叠时用（集合多时比韦恩图清楚）；上方柱为互斥交集大小，下方点阵标出交集由哪些集合组成，左侧横柱为各集合大小。只属于一个集合的柱与点用该集合的颜色，多个集合的交集用黑色；数值直接写在柱上，点阵列交替浅灰底，集合名用同色写在点阵旁。\nplot.r 顶部 set_cols 把 0/1 列映射为显示名（顺序即行序与配色顺序）；n_show 为显示的交集个数（按大小排序）；band_fill 为交替列底色；dot_size 为点阵点径；widths_mm 为左侧集合柱与集合名的宽度；matrix_share 为点阵与交集柱的高度比。右上角的一句结论由数据算出（最大的多集合交集及其基因数），不写死；左侧集合柱的轴上限与顶部轴同一规则：max × 1.08 向上取到 250 的倍数（891 → 1000，刻度 0/500/1000），数值放得下（两侧各留 ≥1 mm）时写在柱内末端，字色由 on_fill_text() 按 wcag 对比度自动选择（白色达到 4.5:1 就用白色，否则用 #1a1a1a）；放不下时写在柱外，用集合色；左上说明贴在集合柱上方，并写明只显示前 n_show 个交集（此例 31 个非空交集中的前 15 个，共 1,718 个基因；数字由数据算出），左侧集合柱统计的是全部基因（1,854 个）。颜色依次取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size）。本图 4×2 格（183 × 89 mm），多面板（patchwork）字号保持 7/8 pt，不自动 +2 pt。\nupset intersection venn-alternative sets house-style\ngene 基因 id（每行一个元素） leaf 是否属于该集合（0/1，此例为叶片响应） root 是否属于该集合（0/1，根） berry_skin 是否属于该集合（0/1，果皮） berry_flesh 是否属于该集合（0/1，果肉） seed 是否属于该集合（0/1，种子）"
},
{
"title": "Mosaic plot",
"title_zh": "马赛克图",
"slug": "mosaic",
"category": "composition",
"tags": [
"mosaic",
"spine",
"composition"
],
"packages": [
"ggplot2",
"scales"
],
"data_columns": {
"row": "行因子，这里是分期（字符串）",
"col": "列因子，这里是结局（字符串）",
"n": "该格计数（整数）"
},
"when_to_use": "两个分类变量的联合计数要同时看边际和条件比例时用。",
"customize": "在 `plot.R` 控制 `show_labels`（默认 `TRUE`）显隐图块内计数，调整 `row_levels` 和 `col_levels` 设定行列顺序与映射；在 `data.csv` 填入 `row`、`col` 和 `n` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_labels",
"value": "TRUE"
},
{
"name": "row_levels",
"value": "c(\"Stage I\", \"Stage II\", \"Stage III\", \"Stage IV\")"
},
{
"name": "col_levels",
"value": "c(\"Response\", \"Stable\", \"Progression\")"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/mosaic/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/mosaic/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/mosaic/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/mosaic/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/mosaic/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/mosaic/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/mosaic/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/mosaic/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/mosaic/make_data.R"
}
],
"dir": "figures/composition/mosaic",
"preview": "figures/composition/mosaic/preview.png",
"docs_preview": "previews/mosaic.png",
"code": "figures/composition/mosaic/plot.R",
"data": "figures/composition/mosaic/data.csv",
"data_files": [
"figures/composition/mosaic/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/mosaic/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/mosaic/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/mosaic",
"code_text": "# Mosaic / spine plot (house style). Width is the row margin; height is the share within the row.\n# Counts sit inside tiles that are large enough: white on dark fills, black on light fills.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nshow_labels <- TRUE\nrow_levels <- c(\"Stage I\", \"Stage II\", \"Stage III\", \"Stage IV\")\ncol_levels <- c(\"Response\", \"Stable\", \"Progression\")\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$row <- factor(df$row, levels = row_levels)\ndf$col <- factor(df$col, levels = col_levels)\ngap <- 0.015\nrt <- sapply(row_levels, function(r) sum(df$n[df$row == r]))\nusable <- 1 - gap * (length(row_levels) - 1)\nwidths <- as.numeric(rt) / sum(rt) * usable\nx_left <- cumsum(c(0, utils::head(widths, -1) + gap))\n\nrects <- vector(\"list\", length(row_levels))\nfor (i in seq_along(row_levels)) {\n sub <- df[df$row == row_levels[i], , drop = FALSE]\n sub <- sub[order(sub$col), , drop = FALSE]\n h <- sub$n / sum(sub$n)\n y1 <- cumsum(h)\n y0 <- y1 - h\n rects[[i]] <- data.frame(\n row = row_levels[i], col = sub$col, n = sub$n,\n xmin = x_left[i], xmax = x_left[i] + widths[i],\n ymin = y0, ymax = y1\n )\n}\nrd <- do.call(rbind, rects)\nrd$cx <- (rd$xmin + rd$xmax) / 2\nrd$cy <- (rd$ymin + rd$ymax) / 2\nrd$lab <- ifelse(rd$ymax - rd$ymin > 0.07 & rd$xmax - rd$xmin > 0.08, as.character(rd$n), \"\")\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npal <- stats::setNames(unname(hp[c(\"green\", \"blue\", \"red\")]), col_levels)\nrd$txt <- \"white\"\nmids <- x_left + widths / 2\n\np <- ggplot(rd) +\n geom_rect(aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = col),\n colour = \"white\", linewidth = 0.3) +\n scale_fill_manual(values = pal, name = NULL) +\n scale_x_continuous(breaks = mids, labels = row_levels, expand = c(0.01, 0.01)) +\n scale_y_continuous(labels = scales::label_percent(), expand = c(0, 0)) +\n labs(x = NULL, y = \"Share within stage\", caption = footnote) +\n theme_house() +\n theme(legend.position = \"right\", legend.text = element_text(size = 7),\n legend.margin = margin(0, 0, 0, 0), legend.box.spacing = unit(1.5, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nif (isTRUE(show_labels)) {\n p <- p + geom_text(aes(x = cx, y = cy, label = lab), size = pv_pt2size(7),\n colour = rd$txt, family = house_family())\n}\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "mosaic plot\n马赛克图\nmosaic\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n两个分类变量的联合计数要同时看边际和条件比例时用。\n在 `plot.r` 控制 `show_labels`（默认 `true`）显隐图块内计数，调整 `row_levels` 和 `col_levels` 设定行列顺序与映射；在 `data.csv` 填入 `row`、`col` 和 `n` 列。\nmosaic spine composition\nrow 行因子，这里是分期（字符串） col 列因子，这里是结局（字符串） n 该格计数（整数）"
},
{
"title": "Pie and donut",
"title_zh": "饼图与环形图",
"slug": "pie",
"category": "composition",
"tags": [
"pie",
"donut",
"composition"
],
"packages": [
"ggplot2"
],
"data_columns": {
"part": "组成分名称（字符串）",
"value": "份额的权重（正数，图中换算为百分比）"
},
"when_to_use": "一个整体拆成少数几份、要强调份额时用。",
"customize": "在 `plot.R` 控制 `donut`（默认 `TRUE`）切换环形或实心饼图，调 `show_labels`（默认 `TRUE`）显隐名称，修改 `part_drop` 与 `inner_frac`；在 `data.csv` 填入 `part` 和 `value` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": "Pie",
"variants": [
{
"slug": "pie",
"variant_label": "Pie",
"title": "Pie and donut",
"title_zh": "饼图与环形图",
"docs_preview": "previews/pie.png"
},
{
"slug": "donut",
"variant_label": "Donut",
"title": "Donut chart",
"title_zh": "环形图",
"docs_preview": "previews/donut.png"
}
],
"parameters": [
{
"name": "donut",
"value": "TRUE"
},
{
"name": "show_labels",
"value": "TRUE"
},
{
"name": "part_drop",
"value": "character(0)"
},
{
"name": "inner_frac",
"value": "if (isTRUE(donut)) 0.52 else 0"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/pie/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/pie/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/pie/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/pie/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/pie/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/pie/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/pie/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/pie/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/pie/make_data.R"
}
],
"dir": "figures/composition/pie",
"preview": "figures/composition/pie/preview.png",
"docs_preview": "previews/pie.png",
"code": "figures/composition/pie/plot.R",
"data": "figures/composition/pie/data.csv",
"data_files": [
"figures/composition/pie/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/pie/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/pie/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/pie",
"code_text": "# Pie or donut (house style): sectors drawn as polygons, share inside each sector, names outside in\n# the sector colour (#1A1A1A when that colour is < 3:1 on white), total in the centre or corner.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\ndonut <- TRUE\nshow_labels <- TRUE\npart_drop <- character(0)\ninner_frac <- if (isTRUE(donut)) 0.52 else 0 # inner radius as a fraction of the outer radius\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nif (length(part_drop)) df <- df[!df$part %in% part_drop, , drop = FALSE]\ndf <- df[order(df$value, decreasing = TRUE), , drop = FALSE]\ndf$share <- df$value / sum(df$value)\ndf$end <- cumsum(df$share)\ndf$start <- df$end - df$share\ndf$mid <- (df$start + df$end) / 2\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\ncols <- stats::setNames(unname(hp[seq_len(nrow(df))]), df$part)\n# names sit on white: keep the sector colour when it is >= 3:1 on white, else #1A1A1A\nlow_contrast <- c(hp[[\"orange\"]], hp[[\"sky\"]], hp[[\"gold\"]])\nname_col <- ifelse(cols %in% low_contrast, \"#1A1A1A\", cols)\n# percentages sit on the fill: black on light fills, white on dark fills\npct_col <- ifelse(cols %in% low_contrast, \"black\", \"white\")\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nrin <- inner_frac # ring outer radius = 1\nto_xy <- function(frac, r) data.frame(x = r * sin(2 * pi * frac), y = r * cos(2 * pi * frac))\nring <- do.call(rbind, lapply(seq_len(nrow(df)), function(i) {\n f <- seq(df$start[i], df$end[i], length.out = max(2, ceiling(df$share[i] * 360)))\n inner <- if (rin > 0) to_xy(rev(f), rin) else data.frame(x = 0, y = 0)\n cbind(rbind(to_xy(f, 1), inner), part = df$part[i])\n}))\npct <- cbind(df, to_xy(df$mid, if (rin > 0) (rin + 1) / 2 else 0.62), col = pct_col)\npct <- pct[pct$share >= 0.05, ] # too thin for a number inside: the name carries the share\nnm <- cbind(df, to_xy(df$mid, 1.06), col = name_col)\ns_mid <- sin(2 * pi * df$mid)\nnm$hj <- ifelse(abs(s_mid) < 0.15, 0.5, ifelse(s_mid > 0, 0, 1))\nnm$vj <- ifelse(abs(s_mid) < 0.15, ifelse(cos(2 * pi * df$mid) > 0, 0, 1), 0.5)\n# a name centred above or below the ring moves out a little more, clear of its neighbours\ntop_bot <- abs(s_mid) < 0.15\nnm[top_bot, c(\"x\", \"y\")] <- to_xy(df$mid[top_bot], 1.13)\nnm$lab <- ifelse(df$share >= 0.05, df$part, sprintf(\"%s %.0f%%\", df$part, 100 * df$share))\n\ncells <- c(2, 1)\nview_y <- c(-1.22, 1.27)\nview_x <- c(-1, 1) * diff(view_y) * 86 / 34 / 2 # panel about 86 x 34 mm after margins and footnote\np <- ggplot() +\n geom_polygon(data = ring, aes(x, y, group = part, fill = part), colour = \"white\", linewidth = pv_house_lw(0.5)) +\n geom_text(data = pct, aes(x, y, label = sprintf(\"%.0f%%\", 100 * share), colour = col))\nif (isTRUE(show_labels)) {\n p <- p + geom_text(data = nm, aes(x, y, label = lab, hjust = hj, vjust = vj, colour = col))\n}\nif (rin > 0) {\n p <- p + annotate(\"text\", x = 0, y = 0, label = sprintf(\"Total\\n%s\", format(round(sum(df$value), 1))),\n size = pv_pt2size(8), lineheight = 0.95)\n} else {\n p <- p + annotate(\"text\", x = view_x[1], y = view_y[2], hjust = 0, vjust = 1,\n label = sprintf(\"Total %s\", format(round(sum(df$value), 1))))\n}\np <- p +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_identity() +\n scale_x_continuous(breaks = NULL, expand = c(0, 0)) +\n scale_y_continuous(breaks = NULL, expand = c(0, 0)) +\n coord_fixed(xlim = view_x, ylim = view_y, clip = \"off\") +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() +\n theme(panel.border = element_blank(),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = cells)\nmessage(\"wrote preview.png\")\n",
"search_text": "pie and donut\n饼图与环形图\npie\npie\ncomposition\n组成\ncomposition\n组成\ncomposition\n一个整体拆成少数几份、要强调份额时用。\n在 `plot.r` 控制 `donut`（默认 `true`）切换环形或实心饼图，调 `show_labels`（默认 `true`）显隐名称，修改 `part_drop` 与 `inner_frac`；在 `data.csv` 填入 `part` 和 `value` 列。\npie donut composition\npart 组成分名称（字符串） value 份额的权重（正数，图中换算为百分比）"
},
{
"title": "Stacked area",
"title_zh": "堆叠面积图",
"slug": "stacked-area",
"category": "composition",
"tags": [
"stacked-area",
"streamgraph",
"composition",
"time-series"
],
"packages": [
"ggplot2",
"scales"
],
"data_columns": {
"time": "时间点（整数，第几天）",
"part": "组成分名称（字符串）",
"value": "该时间点的丰度（正数）"
},
"when_to_use": "若干组分随时间同时变化、要看总量和份额时用。",
"customize": "在 `plot.R` 修改 `chart_mode` 切换堆叠、流式或百分比模式，调整 `part_levels` 设定填充顺序与映射；在 `data.csv` 填入 `time`、`part` 和 `value` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "chart_mode",
"value": "\"stack\""
},
{
"name": "part_levels",
"value": "c(\"CD4 T\", \"CD8 T\", \"B cell\", \"NK\", \"Myeloid\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/stacked-area/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/stacked-area/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/stacked-area/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/stacked-area/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/stacked-area/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/stacked-area/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/stacked-area/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/stacked-area/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/stacked-area/make_data.R"
}
],
"dir": "figures/composition/stacked-area",
"preview": "figures/composition/stacked-area/preview.png",
"docs_preview": "previews/stacked-area.png",
"code": "figures/composition/stacked-area/plot.R",
"data": "figures/composition/stacked-area/data.csv",
"data_files": [
"figures/composition/stacked-area/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/stacked-area/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/stacked-area/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/stacked-area",
"code_text": "# Stacked area (house style). chart_mode: stack, stream, or percent.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nchart_mode <- \"stack\"\npart_levels <- c(\"CD4 T\", \"CD8 T\", \"B cell\", \"NK\", \"Myeloid\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$part <- factor(df$part, levels = part_levels)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npal <- stats::setNames(unname(hp[seq_along(part_levels)]), part_levels)\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nstack_bounds <- function(d, center) {\n parts <- levels(d$part)\n times <- sort(unique(d$time))\n out <- vector(\"list\", length(times))\n for (i in seq_along(times)) {\n sub <- d[d$time == times[i], ]\n sub <- sub[match(parts, as.character(sub$part)), ]\n v <- sub$value\n top <- cumsum(v)\n bot <- c(0, utils::head(top, -1))\n if (center) {\n mid <- sum(v) / 2\n top <- top - mid\n bot <- bot - mid\n }\n out[[i]] <- data.frame(time = times[i], part = parts, ymin = bot, ymax = top)\n }\n do.call(rbind, out)\n}\n\nif (chart_mode == \"percent\") {\n y_lab <- \"Share of cells\"\n p <- ggplot2::ggplot(df, ggplot2::aes(time, value, fill = part)) +\n ggplot2::geom_area(position = \"fill\", colour = \"white\", linewidth = 0.15, alpha = 1) +\n ggplot2::scale_y_continuous(labels = scales::label_percent(), expand = c(0, 0))\n} else {\n center <- chart_mode == \"stream\"\n y_lab <- if (center) \"Centered abundance\" else \"Cell abundance\"\n bands <- stack_bounds(df, center = center)\n bands$part <- factor(bands$part, levels = part_levels)\n p <- ggplot2::ggplot(bands, ggplot2::aes(time, ymin = ymin, ymax = ymax, fill = part)) +\n ggplot2::geom_ribbon(colour = \"white\", linewidth = 0.15, alpha = 1) +\n ggplot2::scale_y_continuous(expand = ggplot2::expansion(mult = c(0.02, 0.04)))\n}\n\np <- p +\n scale_fill_manual(values = pal, name = NULL) +\n scale_x_continuous(breaks = c(1, 10, 20, 30), expand = c(0, 0)) +\n labs(x = \"Day\", y = y_lab, caption = footnote) +\n theme_house() +\n theme(legend.position = \"top\", legend.justification = \"left\", legend.text = element_text(size = 7),\n plot.margin = margin(1, 3, 1, 1, unit = \"mm\"),\n legend.margin = margin(0, 0, 0, 0), legend.box.spacing = unit(1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "stacked area\n堆叠面积图\nstacked-area\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n若干组分随时间同时变化、要看总量和份额时用。\n在 `plot.r` 修改 `chart_mode` 切换堆叠、流式或百分比模式，调整 `part_levels` 设定填充顺序与映射；在 `data.csv` 填入 `time`、`part` 和 `value` 列。\nstacked-area streamgraph composition time-series\ntime 时间点（整数，第几天） part 组成分名称（字符串） value 该时间点的丰度（正数）"
},
{
"title": "Stacked bar",
"title_zh": "堆积柱状图",
"slug": "stacked-bar",
"category": "composition",
"tags": [
"stacked-bar",
"composition",
"microbiome"
],
"packages": [
"ggplot2",
"scales"
],
"data_columns": {
"sample": "样本编号（字符串）",
"group": "临床分组（字符串）",
"part": "组成分，这里是门水平类群（字符串）",
"value": "读段计数（整数）"
},
"when_to_use": "每个样本由若干组分构成、要比较组间比例时用。",
"customize": "在 `plot.R` 控制 `as_percent`（默认 `TRUE`）切换百分比或计数，设定 `part_levels` 顺序，`Other` 映射为浅灰；在 `data.csv` 填入 `sample`、`group`、`part` 和 `value` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "as_percent",
"value": "TRUE"
},
{
"name": "part_levels",
"value": "c( \"Firmicutes\", \"Bacteroidota\", \"Proteobacteria\", \"Actinobacteriota\", \"Verrucomicrobiota\", \"Other\" )"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/stacked-bar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/stacked-bar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/stacked-bar/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/stacked-bar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/stacked-bar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/stacked-bar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/stacked-bar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/stacked-bar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/stacked-bar/make_data.R"
}
],
"dir": "figures/composition/stacked-bar",
"preview": "figures/composition/stacked-bar/preview.png",
"docs_preview": "previews/stacked-bar.png",
"code": "figures/composition/stacked-bar/plot.R",
"data": "figures/composition/stacked-bar/data.csv",
"data_files": [
"figures/composition/stacked-bar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/stacked-bar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/stacked-bar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/stacked-bar",
"code_text": "# Stacked composition (house style). Percent or raw counts; taxon order is a parameter.\n# Samples sorted by the first taxon within each group; \"Other\" stays light grey on top.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nas_percent <- TRUE\npart_levels <- c(\n \"Firmicutes\", \"Bacteroidota\", \"Proteobacteria\",\n \"Actinobacteriota\", \"Verrucomicrobiota\", \"Other\"\n)\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = c(\"Healthy\", \"IBD\", \"Treated\"))\ndf$part <- factor(df$part, levels = part_levels)\nfirst <- df$part == part_levels[1]\ndom <- tapply(df$value[first], df$sample[first], sum)\nord <- unlist(lapply(levels(df$group), function(g) {\n ss <- unique(df$sample[df$group == g])\n ss[order(dom[ss], decreasing = TRUE)]\n}))\ndf$sample <- factor(df$sample, levels = ord)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nnamed <- setdiff(part_levels, \"Other\")\npal <- stats::setNames(c(unname(hp[seq_along(named)]), grey[[\"light\"]]), c(named, \"Other\"))\n\np <- ggplot(df, aes(sample, value, fill = part)) +\n geom_col(width = 0.86, position = if (isTRUE(as_percent)) \"fill\" else \"stack\",\n colour = \"white\", linewidth = 0.1) +\n scale_fill_manual(values = pal, name = NULL) +\n scale_y_continuous(expand = c(0, 0),\n labels = if (isTRUE(as_percent)) scales::label_percent() else scales::label_comma()) +\n facet_grid(~ group, scales = \"free_x\", space = \"free_x\") +\n labs(x = NULL, y = if (isTRUE(as_percent)) \"Relative abundance\" else \"Read count\", caption = footnote) +\n guides(fill = guide_legend(nrow = 2, byrow = TRUE, keywidth = unit(2.5, \"mm\"), keyheight = unit(2.5, \"mm\"))) +\n theme_house() +\n theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5, size = 7),\n legend.position = \"top\", legend.justification = \"left\",\n legend.margin = margin(0, 0, 0, 0), legend.box.spacing = unit(1, \"mm\"),\n legend.text = element_text(size = 7), legend.key.spacing.y = unit(0.4, \"mm\"),\n panel.spacing.x = unit(1.5, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "stacked bar\n堆积柱状图\nstacked-bar\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n每个样本由若干组分构成、要比较组间比例时用。\n在 `plot.r` 控制 `as_percent`（默认 `true`）切换百分比或计数，设定 `part_levels` 顺序，`other` 映射为浅灰；在 `data.csv` 填入 `sample`、`group`、`part` 和 `value` 列。\nstacked-bar composition microbiome\nsample 样本编号（字符串） group 临床分组（字符串） part 组成分，这里是门水平类群（字符串） value 读段计数（整数）"
},
{
"title": "Sunburst",
"title_zh": "旭日图",
"slug": "sunburst",
"category": "composition",
"tags": [
"sunburst",
"composition",
"hierarchy"
],
"packages": [
"ggplot2"
],
"data_columns": {
"parent": "内环大类（字符串）",
"child": "外环子类，属于对应的 parent（字符串）",
"value": "组成权重（正数，图中按总和换算成圆心角）"
},
"when_to_use": "一个整体分成大类、大类再分成子类，要在同一张圆图里看两层份额时用。Use when a whole splits into parent categories and their children, drawn as two concentric rings.",
"customize": "在 `plot.R` 调整 `label_min_share` 设定切线标签最小份额，修改 `hole` 设定内孔半径；在 `data.csv` 填入 `parent`、`child` 和 `value` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "label_min_share",
"value": "0.075"
},
{
"name": "hole",
"value": "0.5"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/sunburst/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/sunburst/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/sunburst/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/sunburst/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/sunburst/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/sunburst/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/sunburst/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/sunburst/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/sunburst/make_data.R"
}
],
"dir": "figures/composition/sunburst",
"preview": "figures/composition/sunburst/preview.png",
"docs_preview": "previews/sunburst.png",
"code": "figures/composition/sunburst/plot.R",
"data": "figures/composition/sunburst/data.csv",
"data_files": [
"figures/composition/sunburst/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/sunburst/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/sunburst/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/sunburst",
"code_text": "# Two-level sunburst (house style) from geom_rect + coord_polar. Inner ring: parent in its house\n# colour; outer ring: children in the parent colour at reduced opacity. Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\n\n# --- adjustable ---\nlabel_min_share <- 0.075\nhole <- 0.5\n# ------------------\n\nmix_hex <- function(hex, target, amount) {\n amount <- max(0, min(1, amount))\n a <- grDevices::col2rgb(hex)[, 1]\n b <- grDevices::col2rgb(target)[, 1]\n out <- (1 - amount) * a + amount * b\n grDevices::rgb(out[1], out[2], out[3], maxColorValue = 255)\n}\n\nluminance <- function(hex) {\n rgb <- grDevices::col2rgb(hex) / 255\n 0.2126 * rgb[1, ] + 0.7152 * rgb[2, ] + 0.0722 * rgb[3, ]\n}\n\n# ggplot2 4 maps a polar radius into c(0, 0.4), so the disk only\n# covers 80% of the panel. Stretch it to the panel edge.\ncoord_sunburst <- function(start = 0, direction = 1, clip = \"off\") {\n ggplot2::ggproto(\n \"CoordSunburst\",\n ggplot2::CoordPolar,\n theta = \"y\",\n r = \"x\",\n start = start,\n direction = direction,\n clip = clip,\n transform = function(self, data, panel_params) {\n if (inherits(data$x, \"AsIs\") && inherits(data$y, \"AsIs\")) {\n return(data)\n }\n theta <- data$y\n radius <- data$x\n tr <- panel_params$theta.range\n rr <- panel_params$r.range\n span <- diff(tr)\n if (!is.finite(span) || span == 0) span <- 1\n rspan <- diff(rr)\n if (!is.finite(rspan) || rspan == 0) rspan <- 1\n ang <- ((theta - tr[1]) / span) * (2 * pi)\n ang <- ((self$start + ang) %% (2 * pi)) * self$direction\n rad <- (radius - rr[1]) / rspan * 0.5\n data$x <- rad * sin(ang) + 0.5\n data$y <- rad * cos(ang) + 0.5\n data\n }\n )\n}\n\nchild_shades <- function(hex, n) {\n # Lighter tints of the parent only. Never mix toward black.\n # One step: the parent colour at 55% opacity on white (no extra colours).\n rep(mix_hex(hex, \"#FFFFFF\", 0.45), n)\n}\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nparent_sum <- tapply(df$value, df$parent, sum)\nparent_levels <- names(sort(parent_sum, decreasing = TRUE))\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npal <- stats::setNames(unname(hp[seq_along(parent_levels)]), parent_levels)\nfootnote <- \"Simulated data for illustration; not biological results\"\n\n# Thick rings, limit tight to the outer edge, so the disk fills the square.\ninner_r <- c(hole, hole + 0.62)\nouter_r <- c(inner_r[2], inner_r[2] + 1.42)\nouter_lim <- outer_r[2] + 0.02\ntext_pt <- 7\ncanvas_mm <- 82 # square panel inside the 89 mm canvas, above the footnote\nmargin_mm <- 1.2\n\ninner_rows <- vector(\"list\", length(parent_levels))\nouter_rows <- vector(\"list\", length(parent_levels))\ncursor <- 0\nfor (par in parent_levels) {\n sub <- df[df$parent == par, , drop = FALSE]\n sub <- sub[order(sub$value, decreasing = TRUE), , drop = FALSE]\n shades <- child_shades(pal[[par]], nrow(sub))\n cend <- cursor + cumsum(sub$value)\n cstart <- cend - sub$value\n inner_rows[[par]] <- data.frame(\n xmin = inner_r[1], xmax = inner_r[2],\n ymin = cursor, ymax = cursor + sum(sub$value),\n fill_hex = pal[[par]],\n label = par,\n lab_r = inner_r[1] + 0.50 * diff(inner_r),\n stringsAsFactors = FALSE\n )\n outer_rows[[par]] <- data.frame(\n xmin = outer_r[1], xmax = outer_r[2],\n ymin = cstart, ymax = cend,\n fill_hex = shades,\n label = sub$child,\n lab_r = outer_r[1] + 0.50 * diff(outer_r),\n stringsAsFactors = FALSE\n )\n cursor <- cursor + sum(sub$value)\n}\nrings <- rbind(do.call(rbind, inner_rows), do.call(rbind, outer_rows))\ntotal <- cursor\nstopifnot(all(rings$xmax > rings$xmin), all(rings$ymax > rings$ymin))\nstopifnot(abs(sum(rings$ymax[rings$label %in% parent_levels] - rings$ymin[rings$label %in% parent_levels]) - total) < 1e-6)\n\nrings$share <- (rings$ymax - rings$ymin) / total\nrings$mid <- (rings$ymin + rings$ymax) / 2\n# Square canvas minus a thin margin. The circle is inscribed in that panel.\npanel_r_mm <- (canvas_mm - 2 * margin_mm) / 2\nchar_mm <- 0.50 * pv_pt2size(text_pt)\nglyph_mm <- pv_pt2size(text_pt)\nrings$arc_mm <- 2 * pi * (rings$lab_r / outer_lim) * panel_r_mm * rings$share\nrings$band_mm <- (rings$xmax - rings$xmin) / outer_lim * panel_r_mm\nrings$text_mm <- nchar(rings$label) * char_mm\n# Inner end of a label centered on lab_r, in data units, then as an arc.\nhalf_r <- (rings$text_mm / panel_r_mm) * outer_lim / 2\nradial_inner <- pmax(rings$xmin, rings$lab_r - half_r)\nrings$arc_inner_mm <- 2 * pi * (radial_inner / outer_lim) * panel_r_mm * rings$share\ndeg <- (360 * rings$mid / total) %% 360\ntang <- -deg\ntang <- ifelse(deg > 90 & deg < 270, tang + 180, tang)\ntan_ok <- rings$share >= label_min_share & rings$text_mm <= rings$arc_mm * 0.90\nrad_ok <- rings$text_mm <= rings$band_mm * 0.88 & glyph_mm <= rings$arc_inner_mm * 0.82\nrings$mode <- ifelse(tan_ok, \"tangential\", ifelse(rad_ok, \"radial\", \"none\"))\nrings$angle <- ifelse(rings$mode == \"radial\", tang + 90, tang)\n# 0° reads left-to-right, 90° bottom-to-top. Flip the upside-down half.\npage <- rings$angle %% 360\nrings$angle <- rings$angle + ifelse(page > 90 & page <= 270, 180, 0)\nrings$lab_col <- ifelse(luminance(rings$fill_hex) >= 0.5, \"black\", \"white\")\nlabs <- rings[rings$mode != \"none\", , drop = FALSE]\nmiss <- rings$label[rings$mode == \"none\"]\nif (length(miss)) message(\"unlabeled: \", paste(miss, collapse = \", \"))\n\np <- ggplot2::ggplot(rings) +\n ggplot2::geom_rect(\n ggplot2::aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = fill_hex),\n colour = \"white\", linewidth = 0.25\n ) +\n ggplot2::scale_fill_identity() +\n ggplot2::geom_text(\n data = labs,\n ggplot2::aes(x = lab_r, y = mid, label = label, angle = angle, colour = lab_col),\n size = pv_pt2size(text_pt),\n family = house_family(),\n hjust = 0.5, vjust = 0.5\n ) +\n ggplot2::scale_colour_identity(guide = \"none\") +\n coord_sunburst(start = 0, direction = 1, clip = \"off\") +\n ggplot2::scale_x_continuous(limits = c(0, outer_lim), expand = c(0, 0)) +\n ggplot2::scale_y_continuous(expand = c(0, 0)) +\n ggplot2::labs(caption = footnote) +\n theme_house() +\n ggplot2::theme(\n axis.text = ggplot2::element_blank(),\n axis.text.x = ggplot2::element_blank(),\n axis.text.y = ggplot2::element_blank(),\n axis.title = ggplot2::element_blank(),\n axis.title.x = ggplot2::element_blank(),\n axis.title.y = ggplot2::element_blank(),\n axis.ticks = ggplot2::element_blank(),\n axis.ticks.length = ggplot2::unit(0, \"mm\"),\n axis.line = ggplot2::element_blank(),\n panel.border = ggplot2::element_blank(),\n legend.position = \"none\",\n aspect.ratio = 1,\n panel.background = ggplot2::element_rect(fill = \"white\", colour = NA),\n plot.background = ggplot2::element_rect(fill = \"white\", colour = NA),\n plot.margin = ggplot2::margin(margin_mm, margin_mm, margin_mm, margin_mm, \"mm\"),\n plot.caption = ggplot2::element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = ggplot2::margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\"\n )\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "sunburst\n旭日图\nsunburst\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n一个整体分成大类、大类再分成子类，要在同一张圆图里看两层份额时用。use when a whole splits into parent categories and their children, drawn as two concentric rings.\n在 `plot.r` 调整 `label_min_share` 设定切线标签最小份额，修改 `hole` 设定内孔半径；在 `data.csv` 填入 `parent`、`child` 和 `value` 列。\nsunburst composition hierarchy\nparent 内环大类（字符串） child 外环子类，属于对应的 parent（字符串） value 组成权重（正数，图中按总和换算成圆心角）"
},
{
"title": "Ternary plot",
"title_zh": "三元图",
"slug": "ternary",
"category": "composition",
"tags": [
"ternary",
"composition",
"simplex"
],
"packages": [
"ggplot2"
],
"data_columns": {
"a": "组分 A 的比例（0 到 1，与 b、c 之和为 1）",
"b": "组分 B 的比例（0 到 1）",
"c": "组分 C 的比例（0 到 1）",
"group": "聚类标签（字符串）"
},
"when_to_use": "三个组分之和为 1、要看样本落在单纯形的哪一区时用。",
"customize": "在 `plot.R` 控制 `colour_by_cluster`（默认 `TRUE`）按组着色，设定 `group_levels` 顺序与 `vertex_labels` 顶点说明；在 `data.csv` 填入 `a`、`b`、`c` 和 `group` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "colour_by_cluster",
"value": "TRUE"
},
{
"name": "group_levels",
"value": "c(\"Cluster 1\", \"Cluster 2\", \"Cluster 3\")"
},
{
"name": "vertex_labels",
"value": "c(a = \"Component A\", b = \"Component B\", c = \"Component C\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/ternary/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/ternary/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/ternary/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/ternary/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/ternary/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/ternary/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/ternary/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/ternary/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/ternary/make_data.R"
}
],
"dir": "figures/composition/ternary",
"preview": "figures/composition/ternary/preview.png",
"docs_preview": "previews/ternary.png",
"code": "figures/composition/ternary/plot.R",
"data": "figures/composition/ternary/data.csv",
"data_files": [
"figures/composition/ternary/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/ternary/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/ternary/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/ternary",
"code_text": "# Ternary scatter (house style) in Cartesian barycentric coordinates. Cluster colours are a switch.\n# The triangle and 25% grid are drawn here. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\ncolour_by_cluster <- TRUE\ngroup_levels <- c(\"Cluster 1\", \"Cluster 2\", \"Cluster 3\")\nvertex_labels <- c(a = \"Component A\", b = \"Component B\", c = \"Component C\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nh <- sqrt(3) / 2\ndf$x <- df$b * 0 + df$c * 1 + df$a * 0.5\ndf$y <- df$a * h\nif (isTRUE(colour_by_cluster)) {\n df$group <- factor(df$group, levels = group_levels)\n pal <- stats::setNames(unname(pv_palette(\"house\")[1:3]), group_levels)\n} else {\n df$group <- factor(rep(\"All\", nrow(df)))\n pal <- c(All = pv_palette(\"house\")[[\"blue\"]])\n}\ngrey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ngrid_line <- function(fixed, value, n = 40) {\n others <- setdiff(c(\"a\", \"b\", \"c\"), fixed)\n t <- seq(0, 1 - value, length.out = n)\n comp <- list(a = 0, b = 0, c = 0)\n comp[[fixed]] <- value\n comp[[others[1]]] <- t\n comp[[others[2]]] <- 1 - value - t\n data.frame(\n x = comp$b * 0 + comp$c * 1 + comp$a * 0.5,\n y = comp$a * h,\n which = fixed,\n value = value\n )\n}\ngrid <- do.call(rbind, lapply(c(\"a\", \"b\", \"c\"), function(ax) {\n do.call(rbind, lapply(c(0.25, 0.5, 0.75), function(v) grid_line(ax, v)))\n}))\ngrid$id <- paste(grid$which, grid$value, sep = \"-\")\n\ntri <- data.frame(x = c(0.5, 0, 1), y = c(h, 0, 0))\nlabs <- data.frame(\n x = c(0.5, 0, 1),\n y = c(h + 0.03, -0.035, -0.035),\n label = unname(vertex_labels),\n hjust = c(0.5, 0, 1),\n vjust = c(0, 1, 1)\n)\n\np <- ggplot() +\n geom_path(data = grid, aes(x, y, group = id), colour = grey[[\"light\"]], linewidth = pv_house_lw(\"minor\")) +\n geom_polygon(data = tri, aes(x, y), fill = NA, colour = grey[[\"dark\"]], linewidth = pv_house_lw(\"frame\")) +\n geom_point(data = df, aes(x, y, fill = group), shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = HOUSE_POINT$colour) +\n geom_text(data = labs, aes(x, y, label = label, hjust = hjust, vjust = vjust),\n size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family()) +\n scale_fill_manual(values = pal, name = NULL) +\n scale_x_continuous(breaks = NULL) + scale_y_continuous(breaks = NULL) +\n coord_equal(clip = \"off\", xlim = c(-0.02, 1.02), ylim = c(-0.08, h + 0.07)) +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() +\n theme(axis.line = element_blank(), panel.border = element_blank(),\n legend.position = \"inside\", legend.position.inside = c(0, 1),\n legend.justification.inside = c(0, 1),\n plot.margin = margin(1, 4, 1, 4, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "ternary plot\n三元图\nternary\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n三个组分之和为 1、要看样本落在单纯形的哪一区时用。\n在 `plot.r` 控制 `colour_by_cluster`（默认 `true`）按组着色，设定 `group_levels` 顺序与 `vertex_labels` 顶点说明；在 `data.csv` 填入 `a`、`b`、`c` 和 `group` 列。\nternary composition simplex\na 组分 a 的比例（0 到 1，与 b、c 之和为 1） b 组分 b 的比例（0 到 1） c 组分 c 的比例（0 到 1） group 聚类标签（字符串）"
},
{
"title": "Treemap",
"title_zh": "矩形树图",
"slug": "treemap",
"category": "composition",
"tags": [
"treemap",
"composition"
],
"packages": [
"ggplot2"
],
"data_columns": {
"group": "上级分组（字符串）",
"tile": "矩形块名称（字符串）",
"value": "面积权重（正数）"
},
"when_to_use": "两组里各有多块、要用面积比较大小时用。",
"customize": "在 `plot.R` 控制 `show_subgroup`（默认 `TRUE`）设间距，调 `show_labels`（默认 `TRUE`）显隐名称，设 `group_levels` 顺序；在 `data.csv` 填 `group`、`tile`、`value` 列，太小的图块不显示标签。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_subgroup",
"value": "TRUE"
},
{
"name": "show_labels",
"value": "TRUE"
},
{
"name": "group_levels",
"value": "c(\"Up\", \"Down\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/treemap/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/treemap/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/treemap/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/treemap/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/treemap/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/treemap/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/treemap/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/treemap/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/treemap/make_data.R"
}
],
"dir": "figures/composition/treemap",
"preview": "figures/composition/treemap/preview.png",
"docs_preview": "previews/treemap.png",
"code": "figures/composition/treemap/plot.R",
"data": "figures/composition/treemap/data.csv",
"data_files": [
"figures/composition/treemap/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/treemap/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/treemap/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/treemap",
"code_text": "# Treemap (house style) laid out with alternating slices; tile area is proportional to value.\n# Tile names in white (both fills are >= 3:1 against white). Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nshow_subgroup <- TRUE\nshow_labels <- TRUE\ngroup_levels <- c(\"Up\", \"Down\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_levels)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npal <- stats::setNames(unname(hp[c(\"red\", \"blue\")]), group_levels)\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nslice_layout <- function(values, x, y, w, h, horizontal) {\n n <- length(values)\n out <- data.frame(xmin = numeric(n), xmax = numeric(n), ymin = numeric(n), ymax = numeric(n))\n place <- function(i, x, y, w, h, horizontal) {\n if (!length(i)) return()\n if (length(i) == 1L) {\n out$xmin[i] <<- x\n out$xmax[i] <<- x + w\n out$ymin[i] <<- y\n out$ymax[i] <<- y + h\n return()\n }\n share <- values[i[1]] / sum(values[i])\n if (horizontal) {\n hh <- h * share\n out$xmin[i[1]] <<- x\n out$xmax[i[1]] <<- x + w\n out$ymin[i[1]] <<- y\n out$ymax[i[1]] <<- y + hh\n place(i[-1], x, y + hh, w, h - hh, FALSE)\n } else {\n ww <- w * share\n out$xmin[i[1]] <<- x\n out$xmax[i[1]] <<- x + ww\n out$ymin[i[1]] <<- y\n out$ymax[i[1]] <<- y + h\n place(i[-1], x + ww, y, w - ww, h, TRUE)\n }\n }\n ord <- order(values, decreasing = TRUE)\n place(ord, x, y, w, h, horizontal)\n out\n}\n\ngap <- if (isTRUE(show_subgroup)) 0.018 else 0\ntotals <- sapply(group_levels, function(g) sum(df$value[df$group == g]))\nspan <- 1 - gap\nwidths <- as.numeric(totals) / sum(totals) * span\nx0 <- c(0, widths[1] + gap)\nrects <- vector(\"list\", length(group_levels))\nfor (i in seq_along(group_levels)) {\n sub <- df[df$group == group_levels[i], , drop = FALSE]\n lay <- slice_layout(sub$value, x0[i], 0, widths[i], 1, FALSE)\n sub$xmin <- lay$xmin\n sub$xmax <- lay$xmax\n sub$ymin <- lay$ymin\n sub$ymax <- lay$ymax\n rects[[i]] <- sub\n}\nrd <- do.call(rbind, rects)\npad <- 0.003\nrd$xmin <- rd$xmin + pad\nrd$xmax <- rd$xmax - pad\nrd$ymin <- rd$ymin + pad\nrd$ymax <- rd$ymax - pad\nrd$cx <- (rd$xmin + rd$xmax) / 2\nrd$cy <- (rd$ymin + rd$ymax) / 2\nrd$w <- rd$xmax - rd$xmin\nrd$hgt <- rd$ymax - rd$ymin\n# fit test in mm on the ~87 x 35 mm panel: horizontal first, else rotated for tall narrow tiles\nw_mm <- rd$w * 87; h_mm <- rd$hgt * 35; txt_mm <- nchar(rd$tile) * 1.5 + 1.2\nfit_h <- txt_mm < w_mm & h_mm > 3.5\nfit_v <- !fit_h & txt_mm < h_mm & w_mm > 3.5\nrd$lab <- ifelse(isTRUE(show_labels) & (fit_h | fit_v), rd$tile, \"\")\nrd$angle <- ifelse(fit_v, 90, 0)\n\np <- ggplot(rd) +\n geom_rect(aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = group),\n colour = \"white\", linewidth = 0.3) +\n geom_text(aes(x = cx, y = cy, label = lab, angle = angle), size = pv_pt2size(7), colour = \"white\",\n family = house_family()) +\n scale_fill_manual(values = pal, name = NULL) +\n scale_x_continuous(breaks = NULL, expand = c(0, 0)) +\n scale_y_continuous(breaks = NULL, expand = c(0, 0)) +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() +\n theme(legend.position = \"top\", legend.justification = \"left\", legend.text = element_text(size = 7),\n legend.margin = margin(0, 0, 0, 0), legend.box.spacing = unit(1, \"mm\"),\n axis.line = element_blank(), panel.border = element_blank(),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "treemap\n矩形树图\ntreemap\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n两组里各有多块、要用面积比较大小时用。\n在 `plot.r` 控制 `show_subgroup`（默认 `true`）设间距，调 `show_labels`（默认 `true`）显隐名称，设 `group_levels` 顺序；在 `data.csv` 填 `group`、`tile`、`value` 列，太小的图块不显示标签。\ntreemap composition\ngroup 上级分组（字符串） tile 矩形块名称（字符串） value 面积权重（正数）"
},
{
"title": "UpSet plot",
"title_zh": "UpSet 图",
"slug": "upset",
"category": "composition",
"tags": [
"upset",
"sets",
"intersection"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"element": "元素编号（字符串）",
"set": "集合名（字符串）",
"present": "是否属于该集合，1 或 0（整数）"
},
"when_to_use": "四个以上集合要看组合交集的大小时用。",
"customize": "在 `plot.R` 修改 `n_sets` 选定集合数，用 `sort_by` 决定按度或大小排序，调整 `max_intersections` 和 `set_levels`；在 `data.csv` 填入 `element`、`set` 和 `present` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "n_sets",
"value": "5"
},
{
"name": "sort_by",
"value": "\"degree\""
},
{
"name": "max_intersections",
"value": "16"
},
{
"name": "set_levels",
"value": "c(\"ATAC\", \"H3K27ac\", \"H3K4me3\", \"CTCF\", \"RNA\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/upset/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/upset/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/upset/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/upset/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/upset/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/upset/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/upset/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/upset/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/upset/make_data.R"
}
],
"dir": "figures/composition/upset",
"preview": "figures/composition/upset/preview.png",
"docs_preview": "previews/upset.png",
"code": "figures/composition/upset/plot.R",
"data": "figures/composition/upset/data.csv",
"data_files": [
"figures/composition/upset/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/upset/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/upset/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/upset",
"code_text": "# UpSet bars and dot matrix (house style). Choose how many sets and how to sort.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\nn_sets <- 5\nsort_by <- \"degree\"\nmax_intersections <- 16\nset_levels <- c(\"ATAC\", \"H3K27ac\", \"H3K4me3\", \"CTCF\", \"RNA\")\ngrey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nuse <- set_levels[seq_len(min(n_sets, length(set_levels)))]\ndf <- df[df$set %in% use, , drop = FALSE]\ndf$set <- factor(df$set, levels = use)\nwide <- reshape(df, idvar = \"element\", timevar = \"set\", direction = \"wide\")\ncolnames(wide) <- sub(\"^present\\\\.\", \"\", colnames(wide))\nwide <- wide[rowSums(wide[, use, drop = FALSE]) > 0, , drop = FALSE]\nbits <- as.matrix(wide[, use, drop = FALSE])\ncode <- apply(bits, 1, paste0, collapse = \"\")\ntab <- aggregate(wide$element, by = list(code = code), FUN = length)\ncolnames(tab)[2] <- \"n\"\ntab$degree <- nchar(gsub(\"0\", \"\", tab$code))\nif (sort_by == \"degree\") {\n tab <- tab[order(tab$degree, tab$n, decreasing = TRUE), ]\n} else {\n tab <- tab[order(tab$n, decreasing = TRUE), ]\n}\ntab <- head(tab, max_intersections)\ntab$code <- factor(tab$code, levels = rev(tab$code))\n\nset_n <- sapply(use, function(s) sum(wide[[s]]))\nset_df <- data.frame(set = factor(use, levels = rev(use)), n = set_n[use])\nset_lab <- setNames(sprintf(\"%s (%d)\", use, set_n[use]), use)\n\ndot <- do.call(rbind, lapply(seq_len(nrow(tab)), function(i) {\n on <- strsplit(as.character(tab$code[i]), \"\")[[1]] == \"1\"\n data.frame(code = tab$code[i], set = factor(use, levels = rev(use)), on = on)\n}))\non_pts <- dot[dot$on, , drop = FALSE]\n\np_bar <- ggplot(tab, aes(code, n)) +\n geom_col(fill = grey[[\"dark\"]], width = 0.72) +\n scale_y_continuous(expand = expansion(mult = c(0, 0.05))) +\n labs(x = NULL, y = \"Intersection\") +\n theme_house() +\n theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(),\n plot.margin = margin(1, 1, 0, 1, \"mm\"))\n\np_dot <- ggplot(dot, aes(code, set)) +\n geom_line(data = on_pts, aes(code, set, group = code), linewidth = pv_house_lw(\"main\"),\n colour = grey[[\"dark\"]]) +\n geom_point(aes(colour = on), shape = 16, size = 2.1) +\n scale_colour_manual(values = c(`TRUE` = grey[[\"dark\"]], `FALSE` = grey[[\"light\"]]), guide = \"none\") +\n scale_y_discrete(labels = set_lab[rev(use)]) +\n labs(x = NULL, y = NULL) +\n theme_house() +\n theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(),\n axis.line.x = element_blank(), axis.text.y = element_text(size = 7),\n plot.margin = margin(0, 1, 0, 1, \"mm\"))\n\np <- p_bar / p_dot + plot_layout(heights = c(1, 1)) +\n plot_annotation(caption = footnote,\n theme = theme(text = element_text(family = house_family()),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\"))\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "upset plot\nupset 图\nupset\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n四个以上集合要看组合交集的大小时用。\n在 `plot.r` 修改 `n_sets` 选定集合数，用 `sort_by` 决定按度或大小排序，调整 `max_intersections` 和 `set_levels`；在 `data.csv` 填入 `element`、`set` 和 `present` 列。\nupset sets intersection\nelement 元素编号（字符串） set 集合名（字符串） present 是否属于该集合，1 或 0（整数）"
},
{
"title": "Venn diagram",
"title_zh": "韦恩图",
"slug": "venn",
"category": "composition",
"tags": [
"venn",
"sets",
"overlap"
],
"packages": [
"ggplot2",
"ggvenn"
],
"data_columns": {
"set": "集合名（字符串）",
"id": "元素编号；出现在几个集合就有几行（字符串）"
},
"when_to_use": "两三个集合要看共享和独有的元素个数时用。",
"customize": "在 `plot.R` 修改 `n_sets` 设为两或三个集合，控制 `show_labels`（默认 `FALSE`）切换显示编号或计数，设定 `set_levels`；在 `data.csv` 填入 `set` 和 `id` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "n_sets",
"value": "3"
},
{
"name": "show_labels",
"value": "FALSE"
},
{
"name": "set_levels",
"value": "c(\"RNA-seq\", \"Proteome\", \"ChIP\")"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/venn/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/venn/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/venn/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/venn/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/venn/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/venn/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/venn/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/venn/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/venn/make_data.R"
}
],
"dir": "figures/composition/venn",
"preview": "figures/composition/venn/preview.png",
"docs_preview": "previews/venn.png",
"code": "figures/composition/venn/plot.R",
"data": "figures/composition/venn/data.csv",
"data_files": [
"figures/composition/venn/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/venn/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/venn/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/venn",
"code_text": "# Venn diagram (house style) for two or three sets, counts or element labels.\n# Set names take the set colour when it is >= 3:1 on white, else #1A1A1A. Text is 7 pt.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nn_sets <- 3\nshow_labels <- FALSE\nset_levels <- c(\"RNA-seq\", \"Proteome\", \"ChIP\")\nfootnote <- \"Simulated data;\\nnot biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nuse <- set_levels[seq_len(min(n_sets, length(set_levels)))]\ndf <- df[df$set %in% use, , drop = FALSE]\nlst <- lapply(use, function(s) unique(df$id[df$set == s]))\nnames(lst) <- use\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npal <- unname(hp[seq_along(use)])\nname_col <- ifelse(pal %in% hp[c(\"orange\", \"sky\", \"gold\")], \"#1A1A1A\", pal)\n\np <- ggvenn::ggvenn(\n lst,\n show_stats = \"c\",\n show_elements = isTRUE(show_labels),\n digits = 0,\n fill_color = pal,\n fill_alpha = 0.35,\n stroke_color = grey[[\"dark\"]],\n stroke_size = pv_house_lw(\"frame\"),\n set_name_color = name_col,\n set_name_size = pv_pt2size(7),\n text_color = \"#1A1A1A\",\n text_size = pv_pt2size(7)\n) +\n labs(title = NULL, caption = footnote) +\n theme_house() +\n theme(axis.line = element_blank(), panel.border = element_blank(),\n axis.text.x = element_blank(), axis.text.y = element_blank(),\n axis.ticks = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank(),\n plot.margin = margin(1, 1, 1, 1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\n# ggvenn draws its labels without a font family; they inherit the house font from this wrapper\ng <- grid::grobTree(ggplotGrob(p), gp = grid::gpar(fontfamily = house_family()))\npv_save_house(g, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "venn diagram\n韦恩图\nvenn\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n两三个集合要看共享和独有的元素个数时用。\n在 `plot.r` 修改 `n_sets` 设为两或三个集合，控制 `show_labels`（默认 `false`）切换显示编号或计数，设定 `set_levels`；在 `data.csv` 填入 `set` 和 `id` 列。\nvenn sets overlap\nset 集合名（字符串） id 元素编号；出现在几个集合就有几行（字符串）"
},
{
"title": "Waffle chart",
"title_zh": "华夫图",
"slug": "waffle",
"category": "composition",
"tags": [
"waffle",
"parliament",
"composition"
],
"packages": [
"ggplot2"
],
"data_columns": {
"cell": "单元格序号（整数，共 100 个）",
"part": "该格所属组成分（字符串）"
},
"when_to_use": "用可数的格子表示份额、总数固定为一百时用。",
"customize": "在 `plot.R` 设定 `layout` 切换正方形或议会型布局，调整 `part_levels` 填充顺序，`Other` 映射为浅灰色；在 `data.csv` 填入 `cell` 和 `part` 列。",
"lang": "R",
"task": "composition",
"task_zh": "组成",
"task_en": "Composition",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "layout",
"value": "\"square\""
},
{
"name": "part_levels",
"value": "c(\"Clone A\", \"Clone B\", \"Clone C\", \"Clone D\", \"Other\")"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/composition/waffle/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/waffle/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/waffle/plot.R"
},
{
"name": "data.csv",
"path": "figures/composition/waffle/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/waffle/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/waffle/data.csv"
},
{
"name": "make_data.R",
"path": "figures/composition/waffle/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/composition/waffle/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/waffle/make_data.R"
}
],
"dir": "figures/composition/waffle",
"preview": "figures/composition/waffle/preview.png",
"docs_preview": "previews/waffle.png",
"code": "figures/composition/waffle/plot.R",
"data": "figures/composition/waffle/data.csv",
"data_files": [
"figures/composition/waffle/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/waffle/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/composition/waffle/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/composition/waffle",
"code_text": "# Waffle (house style). layout is square or parliament. \"Other\" stays light grey.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nlayout <- \"square\"\npart_levels <- c(\"Clone A\", \"Clone B\", \"Clone C\", \"Clone D\", \"Other\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$part <- factor(df$part, levels = part_levels)\ndf <- df[order(df$part, df$cell), , drop = FALSE]\ndf$cell <- seq_len(nrow(df))\nnamed <- setdiff(levels(df$part), \"Other\")\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npal <- stats::setNames(unname(hp[seq_along(named)]), named)\nif (\"Other\" %in% levels(df$part)) pal[\"Other\"] <- grey[[\"light\"]]\nfootnote <- \"Simulated data;\\nnot biological results\"\n\nif (layout == \"parliament\") {\n n <- nrow(df)\n n_rows <- 5\n w <- seq_len(n_rows)\n n_per <- as.integer(round(w / sum(w) * n))\n while (sum(n_per) > n) {\n n_per[which.max(n_per)] <- n_per[which.max(n_per)] - 1L\n }\n while (sum(n_per) < n) {\n n_per[which.min(n_per)] <- n_per[which.min(n_per)] + 1L\n }\n xs <- numeric(n)\n ys <- numeric(n)\n k <- 1L\n for (r in seq_len(n_rows)) {\n m <- n_per[r]\n rad <- 1.15 + (r - 1) * 0.72\n ang <- if (m == 1L) pi / 2 else seq(pi - 0.06, 0.06, length.out = m)\n xs[k:(k + m - 1L)] <- rad * cos(ang)\n ys[k:(k + m - 1L)] <- rad * sin(ang)\n k <- k + m\n }\n seat <- data.frame(x = xs, y = ys, ord = seq_len(n))\n seat <- seat[order(atan2(seat$y, seat$x), seat$y), , drop = FALSE]\n df$x <- seat$x\n df$y <- seat$y\n pt <- 1.5\n} else {\n ncol_grid <- 10L\n df$x <- (df$cell - 1L) %% ncol_grid\n df$y <- (df$cell - 1L) %/% ncol_grid\n pt <- NA\n}\n\np <- ggplot(df, aes(x, y, fill = part))\np <- if (layout == \"parliament\") {\n p + geom_point(shape = 21, size = pt, colour = \"white\", stroke = 0.2)\n} else {\n p + geom_tile(width = 0.88, height = 0.88, colour = NA)\n}\np <- p +\n scale_fill_manual(values = pal, name = NULL) +\n scale_x_continuous(breaks = NULL) + scale_y_continuous(breaks = NULL) +\n coord_equal(clip = \"off\") +\n labs(x = NULL, y = NULL, caption = footnote) +\n guides(fill = guide_legend(ncol = 1, keywidth = unit(2.2, \"mm\"), keyheight = unit(2.2, \"mm\"))) +\n theme_house() +\n theme(axis.line = element_blank(), panel.border = element_blank(),\n legend.position = \"right\", legend.text = element_text(size = 7),\n legend.margin = margin(0, 0, 0, 0), legend.box.spacing = unit(1, \"mm\"),\n legend.key.spacing.y = unit(0.3, \"mm\"),\n plot.margin = margin(1, 1, 1, 1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "waffle chart\n华夫图\nwaffle\n\ncomposition\n组成\ncomposition\n组成\ncomposition\n用可数的格子表示份额、总数固定为一百时用。\n在 `plot.r` 设定 `layout` 切换正方形或议会型布局，调整 `part_levels` 填充顺序，`other` 映射为浅灰色；在 `data.csv` 填入 `cell` 和 `part` 列。\nwaffle parliament composition\ncell 单元格序号（整数，共 100 个） part 该格所属组成分（字符串）"
},
{
"title": "Bland–Altman plot",
"title_zh": "Bland–Altman 图",
"slug": "bland-altman",
"category": "correlation",
"tags": [
"bland-altman",
"agreement",
"method-comparison",
"correlation"
],
"packages": [
"ggplot2"
],
"data_columns": {
"method_a": "方法 A 的测量值（数值）",
"method_b": "方法 B 的测量值（数值）"
},
"when_to_use": "比较两种测量方法是否一致时用；看差值是否随均值漂移，并标出均值差与一致性界限。",
"customize": "plot.R 顶部 point_size 调点大小，loa_mult 设一致性界限 SD 倍数，show_loa_labels 显示偏差与界限标签。在 data.csv 填入 method_a 和 method_b 列。点形 HOUSE_POINT，色取 pv_palette(\"house\")。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "point_size",
"value": "1.6"
},
{
"name": "loa_mult",
"value": "1.96"
},
{
"name": "show_loa_labels",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/bland-altman/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/bland-altman/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/bland-altman/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/bland-altman/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/bland-altman/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/bland-altman/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/bland-altman/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/bland-altman/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/bland-altman/make_data.R"
}
],
"dir": "figures/correlation/bland-altman",
"preview": "figures/correlation/bland-altman/preview.png",
"docs_preview": "previews/bland-altman.png",
"code": "figures/correlation/bland-altman/plot.R",
"data": "figures/correlation/bland-altman/data.csv",
"data_files": [
"figures/correlation/bland-altman/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/bland-altman/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/bland-altman/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/bland-altman",
"code_text": "# Bland-Altman (house style): mean vs difference, bias and limits of agreement as labelled lines.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\npoint_size <- 1.6 # 160 points: smaller shape-21 points, alpha 0.7 (STYLE §5)\nloa_mult <- 1.96 # limits of agreement multiplier (SD)\nshow_loa_labels <- TRUE # value labels on the bias and LoA lines\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nba <- data.frame(mean = (df$method_a + df$method_b) / 2, diff = df$method_a - df$method_b)\nbias <- mean(ba$diff)\nsd_d <- stats::sd(ba$diff)\nloa_hi <- bias + loa_mult * sd_d\nloa_lo <- bias - loa_mult * sd_d\ninside <- mean(ba$diff >= loa_lo & ba$diff <= loa_hi)\n\npal <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npt_fill <- pal[[\"blue\"]] # points\nbias_col <- pal[[\"red\"]] # bias line + label (5.2:1 on white)\nloa_col <- grey[[\"ref\"]] # LoA lines + labels (4.6:1 on white)\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nx_lim <- c(floor(min(ba$mean) / 5) * 5, ceiling(max(ba$mean) / 5) * 5)\ny_lim <- c(min(ba$diff, loa_lo) - 2.5, max(ba$diff, loa_hi) + 2.5)\n\np <- ggplot(ba, aes(mean, diff)) +\n geom_hline(yintercept = 0, linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ci\"]]) +\n geom_hline(yintercept = c(loa_lo, loa_hi), linewidth = pv_house_lw(\"ref\"), linetype = \"22\",\n colour = loa_col) +\n geom_hline(yintercept = bias, linewidth = pv_house_lw(\"main\"), colour = bias_col) +\n geom_point(shape = HOUSE_POINT$shape, size = point_size, stroke = HOUSE_POINT$stroke,\n colour = \"black\", fill = pt_fill, alpha = 0.7) +\n annotate(\"text\", x = x_lim[1] + 1, y = y_lim[1] + 0.6, hjust = 0, vjust = 0,\n label = sprintf(\"n = %d; %.0f%% within limits\", nrow(ba), 100 * inside)) +\n coord_cartesian(xlim = x_lim, ylim = y_lim, expand = FALSE, clip = \"off\") +\n labs(x = \"Mean of methods ((A + B) / 2)\", y = \"Difference (A - B)\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\",\n plot.margin = margin(1.6, if (isTRUE(show_loa_labels)) 12 else 0.8, 0.9, 0.4, \"mm\"))\n\nif (isTRUE(show_loa_labels)) {\n lab <- data.frame(y = c(bias, loa_hi, loa_lo), col = c(bias_col, loa_col, loa_col),\n label = c(sprintf(\"Bias\\n%.2f\", bias),\n sprintf(\"+%.2f SD\\n%.2f\", loa_mult, loa_hi),\n sprintf(\"-%.2f SD\\n%.2f\", loa_mult, loa_lo)))\n # line-end labels just right of the frame, same colour as their line\n p <- p + geom_text(data = lab, aes(x = x_lim[2] + 0.02 * diff(x_lim), y = y, label = label, colour = col),\n hjust = 0, lineheight = 0.9) +\n scale_colour_identity()\n}\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "bland–altman plot\nbland–altman 图\nbland-altman\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n比较两种测量方法是否一致时用；看差值是否随均值漂移，并标出均值差与一致性界限。\nplot.r 顶部 point_size 调点大小，loa_mult 设一致性界限 sd 倍数，show_loa_labels 显示偏差与界限标签。在 data.csv 填入 method_a 和 method_b 列。点形 house_point，色取 pv_palette(\"house\")。\nbland-altman agreement method-comparison correlation\nmethod_a 方法 a 的测量值（数值） method_b 方法 b 的测量值（数值）"
},
{
"title": "Bubble chart",
"title_zh": "气泡图",
"slug": "bubble",
"category": "correlation",
"tags": [
"bubble",
"scatter",
"effect-size"
],
"packages": [
"ggplot2"
],
"data_columns": {
"x": "效应量（数值，连续）",
"y": "-log10(p)（数值，连续）",
"size": "样本量 N（数值）",
"group": "组织来源（字符串）"
},
"when_to_use": "两个连续坐标之外还要用点的面积表示第三个数时用。",
"customize": "plot.R 顶部 map_size 是否把 N 映成面积；colour_by 取 group 或 size（第三变量上色）；x_categorical 为 TRUE 时按 x 的四分位做成分类横轴。分组在 plot 里做，数据保持连续。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "map_size",
"value": "TRUE"
},
{
"name": "colour_by",
"value": "\"group\""
},
{
"name": "x_categorical",
"value": "FALSE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/bubble/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/bubble/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/bubble/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/bubble/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/bubble/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/bubble/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/bubble/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/bubble/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/bubble/make_data.R"
}
],
"dir": "figures/correlation/bubble",
"preview": "figures/correlation/bubble/preview.png",
"docs_preview": "previews/bubble.png",
"code": "figures/correlation/bubble/plot.R",
"data": "figures/correlation/bubble/data.csv",
"data_files": [
"figures/correlation/bubble/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/bubble/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/bubble/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/bubble",
"code_text": "# Bubble chart (house style): point area = N, group colour, group names as a coloured key and\n# a size key inside the panel. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nmap_size <- TRUE\ncolour_by <- \"group\" # group | size (size: house_warm sequential fill)\nx_categorical <- FALSE\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ngroup_order <- c(\"Liver\", \"Lung\", \"Kidney\", \"Brain\")\ndf$group <- factor(df$group, levels = group_order)\nif (isTRUE(x_categorical)) {\n df$x_plot <- cut(df$x, breaks = 4, labels = c(\"Q1\", \"Q2\", \"Q3\", \"Q4\"))\n} else {\n df$x_plot <- df$x\n}\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# all four are >= 3:1 on white, so the key text keeps the group colour\npal <- c(Liver = hp[[\"blue\"]], Lung = hp[[\"red\"]], Kidney = hp[[\"green\"]], Brain = hp[[\"purple\"]])\nfootnote <- \"Simulated data for illustration; not biological results\"\ndf$sz <- if (isTRUE(map_size)) df$size else 25\nmax_d_mm <- 6 # STYLE §5: largest bubble <= 6 mm\n\np <- ggplot(df, aes(x_plot, y))\nif (colour_by == \"size\") {\n p <- p + geom_point(aes(size = sz, fill = size), shape = 21, colour = grey[[\"dark\"]],\n stroke = HOUSE_POINT$stroke, alpha = 0.8) +\n scale_fill_gradientn(colours = pv_palette(\"house_warm\"), name = \"N\", breaks = c(10, 30, 50),\n guide = \"legend\") # merged with the size key\n} else {\n p <- p + geom_point(aes(size = sz, fill = group), shape = 21, colour = grey[[\"dark\"]],\n stroke = HOUSE_POINT$stroke, alpha = 0.8) +\n scale_fill_manual(values = pal, guide = \"none\")\n key <- data.frame(group = factor(group_order, levels = group_order), i = seq_along(group_order))\n key$lab <- sprintf(\"%s (n = %d)\", group_order, as.integer(table(df$group)[group_order]))\n p <- p + geom_text(data = key, aes(x = -Inf, y = Inf, label = lab, colour = group),\n hjust = -0.06, vjust = 1.4 * key$i, inherit.aes = FALSE) +\n scale_colour_manual(values = pal, guide = \"none\")\n}\ny_top <- max(df$y) * 1.30 # headroom for the keys\np <- p +\n scale_size_area(max_size = max_d_mm / 0.75 / 25.4 * 72 / .pt, name = \"N\",\n breaks = c(10, 30, 50)) +\n scale_y_continuous(limits = c(-0.2, y_top), breaks = 0:4, expand = c(0, 0)) +\n labs(x = if (isTRUE(x_categorical)) \"Effect-size quartile\" else \"Effect size\",\n y = \"-log10(P)\", caption = footnote) +\n theme_house(legend = \"inside\") +\n theme(legend.direction = \"horizontal\", legend.title.position = \"left\",\n legend.key.spacing.x = unit(0.5, \"mm\"), legend.margin = margin(0, 0, 0, 0),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\nif (!isTRUE(x_categorical)) {\n p <- p + scale_x_continuous(limits = range(df$x) + c(-0.35, 0.35), expand = c(0, 0))\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "bubble chart\n气泡图\nbubble\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n两个连续坐标之外还要用点的面积表示第三个数时用。\nplot.r 顶部 map_size 是否把 n 映成面积；colour_by 取 group 或 size（第三变量上色）；x_categorical 为 true 时按 x 的四分位做成分类横轴。分组在 plot 里做，数据保持连续。\nbubble scatter effect-size\nx 效应量（数值，连续） y -log10(p)（数值，连续） size 样本量 n（数值） group 组织来源（字符串）"
},
{
"title": "Correlation matrix",
"title_zh": "相关矩阵",
"slug": "correlation-matrix",
"category": "correlation",
"tags": [
"correlation",
"matrix",
"heatmap"
],
"packages": [
"ggplot2"
],
"data_columns": {
"var_a": "变量甲的短名（字符串）",
"var_b": "变量乙的短名（字符串）",
"r": "皮尔逊相关系数（数值，-1 到 1）",
"p": "相关检验的 p 值（数值，0 到 1）"
},
"when_to_use": "十几个连续指标要一眼看出谁和谁同向或反向时用。",
"customize": "plot.R 顶部 cell_shape 取 circle 或 square；show_significance 是否标 p < sig_cut 的星号；upper_only 只画上三角。变量顺序按 1-r 聚类，不要在数据里预先切显著与否。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "cell_shape",
"value": "\"circle\""
},
{
"name": "show_significance",
"value": "TRUE"
},
{
"name": "upper_only",
"value": "TRUE"
},
{
"name": "sig_cut",
"value": "0.05"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/correlation-matrix/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/correlation-matrix/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/correlation-matrix/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/correlation-matrix/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/correlation-matrix/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/correlation-matrix/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/correlation-matrix/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/correlation-matrix/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/correlation-matrix/make_data.R"
}
],
"dir": "figures/correlation/correlation-matrix",
"preview": "figures/correlation/correlation-matrix/preview.png",
"docs_preview": "previews/correlation-matrix.png",
"code": "figures/correlation/correlation-matrix/plot.R",
"data": "figures/correlation/correlation-matrix/data.csv",
"data_files": [
"figures/correlation/correlation-matrix/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/correlation-matrix/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/correlation-matrix/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/correlation-matrix",
"code_text": "# Correlation matrix (house style): circle or square cells on the blue-red diverging scale,\n# stars for P < sig_cut, colour bar inside the empty lower triangle. Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\ncell_shape <- \"circle\"\nshow_significance <- TRUE\nupper_only <- TRUE\nsig_cut <- 0.05\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nvars <- unique(c(df$var_a, df$var_b))\nr_mat <- matrix(0, length(vars), length(vars), dimnames = list(vars, vars))\ndiag(r_mat) <- 1\nr_mat[cbind(df$var_a, df$var_b)] <- df$r\nr_mat[cbind(df$var_b, df$var_a)] <- df$r\nord <- vars[stats::hclust(stats::as.dist(1 - r_mat))$order]\ndf$var_a <- factor(df$var_a, levels = ord)\ndf$var_b <- factor(df$var_b, levels = ord)\nia <- as.integer(df$var_a)\nib <- as.integer(df$var_b)\n# each pair is stored once; put it on the x < y side so the upper triangle is complete\nswap <- ia > ib\ndf[swap, c(\"var_a\", \"var_b\")] <- df[swap, c(\"var_b\", \"var_a\")]\nia <- as.integer(df$var_a)\nib <- as.integer(df$var_b)\nif (!isTRUE(upper_only)) {\n mirror <- df; mirror[, c(\"var_a\", \"var_b\")] <- df[, c(\"var_b\", \"var_a\")]\n df <- rbind(df, mirror); ia <- as.integer(df$var_a); ib <- as.integer(df$var_b)\n}\nkeep <- if (isTRUE(upper_only)) ia < ib else ia != ib\nplot_df <- df[keep, , drop = FALSE]\nplot_df$stars <- ifelse(plot_df$p < sig_cut, \"*\", \"\")\nfills <- pv_palette(\"house_div\") # blue (negative) to red (positive), centred on 0\ngrey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\nn_sig <- sum(df$p[keep] < sig_cut & as.integer(df$var_a)[keep] < as.integer(df$var_b)[keep])\n\np <- ggplot(plot_df, aes(var_a, var_b, fill = r))\nif (cell_shape == \"square\") {\n p <- p + geom_tile(colour = \"white\", linewidth = pv_house_lw(0.3))\n} else {\n p <- p + geom_point(aes(size = abs(r)), shape = 21, stroke = HOUSE_POINT$stroke, colour = grey[[\"dark\"]])\n p <- p + scale_size_area(max_size = 5.2, limits = c(0, 1), guide = \"none\")\n}\nif (isTRUE(show_significance)) {\n p <- p + geom_text(aes(label = stars), vjust = 0.75, colour = \"black\")\n}\nk <- length(ord)\n# annotation sits a fixed fraction (23.5%) of the panel height above the bottom edge, clear of the\n# colour bar, so it stays in the empty lower triangle for any k (k = 15 gives about 4)\nnote_y <- 0.5 + 0.235 * k\nif (isTRUE(upper_only)) {\n p <- p + annotate(\"text\", x = k, y = note_y, hjust = 1, vjust = 0, lineheight = 0.95,\n label = sprintf(\"* P < %.2f\\n%d of %d pairs\", sig_cut, n_sig, nrow(plot_df)))\n}\np <- p +\n scale_fill_gradientn(colours = fills, limits = c(-1, 1), breaks = c(-1, 0, 1), name = \"r\",\n guide = guide_colourbar(direction = \"horizontal\", title.position = \"top\",\n barwidth = unit(16, \"mm\"), barheight = unit(2, \"mm\"))) +\n scale_x_discrete(drop = FALSE) +\n scale_y_discrete(drop = FALSE) +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house(legend = \"inside\") +\n theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1),\n legend.position.inside = c(0.98, 0.02), legend.justification.inside = c(1, 0),\n legend.title = element_text(face = \"italic\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "correlation matrix\n相关矩阵\ncorrelation-matrix\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n十几个连续指标要一眼看出谁和谁同向或反向时用。\nplot.r 顶部 cell_shape 取 circle 或 square；show_significance 是否标 p < sig_cut 的星号；upper_only 只画上三角。变量顺序按 1-r 聚类，不要在数据里预先切显著与否。\ncorrelation matrix heatmap\nvar_a 变量甲的短名（字符串） var_b 变量乙的短名（字符串） r 皮尔逊相关系数（数值，-1 到 1） p 相关检验的 p 值（数值，0 到 1）"
},
{
"title": "Cumulative count over time with event markers (house style)",
"title_zh": "带事件标注的累计数量时间曲线（house 风格）",
"slug": "cumulative-timeline",
"category": "correlation",
"tags": [
"cumulative",
"time-series",
"step",
"events",
"literature",
"house-style"
],
"packages": [
"ggplot2",
"systemfonts"
],
"data_columns": {
"year": "年份（整数，x 轴）",
"topic": "主题或检索词（字符串，每个一条线）",
"n": "该年新增数量（整数，此例为发表文献数）"
},
"when_to_use": "展示一个或多个主题随年份增长的累计数量变化（如文献逐年累计发表量），并在时间轴上标出关键历史事件时用。",
"customize": "在 `data.csv` 填入 `year`（年份）、`topic`（主题名，每个主题画一条线）和 `n`（当年新增数量），在 `data_events.csv` 填入 `year` 和 `event`（事件名称）；在 `plot.R` 顶部将 `cumulative` 设为 `FALSE` 可改为画每年新增量，`as_step` 控制是否画成阶梯线（逐年跃升的折线），`show_events` 和 `event_rows` 控制事件竖线开关与顶部标签排布行数，`show_end_labels` 控制线末端是否标出主题名和最终数值。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "cumulative",
"value": "TRUE"
},
{
"name": "as_step",
"value": "TRUE"
},
{
"name": "show_events",
"value": "TRUE"
},
{
"name": "event_rows",
"value": "3"
},
{
"name": "show_event_year",
"value": "FALSE"
},
{
"name": "show_end_labels",
"value": "TRUE"
},
{
"name": "x_break_step",
"value": "5"
},
{
"name": "fig_cells",
"value": "\"3x1\""
},
{
"name": "y_label",
"value": "\"Cumulative publications\""
},
{
"name": "footnote",
"value": "\"Simulated data; not a real literature search\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "line_cols",
"value": "c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"brown\"]], hp[[\"magenta\"]])"
}
],
"canvas": {
"width_mm": "135",
"height_mm": "43",
"label": "135 × 43 mm (3×1 cells)",
"cells": "3x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/cumulative-timeline/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/cumulative-timeline/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/cumulative-timeline/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/cumulative-timeline/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/cumulative-timeline/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/cumulative-timeline/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/cumulative-timeline/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/cumulative-timeline/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/cumulative-timeline/make_data.R"
},
{
"name": "data_events.csv",
"path": "figures/correlation/cumulative-timeline/data_events.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/cumulative-timeline/data_events.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/cumulative-timeline/data_events.csv"
}
],
"dir": "figures/correlation/cumulative-timeline",
"preview": "figures/correlation/cumulative-timeline/preview.png",
"docs_preview": "previews/cumulative-timeline.png",
"code": "figures/correlation/cumulative-timeline/plot.R",
"data": "figures/correlation/cumulative-timeline/data.csv",
"data_files": [
"figures/correlation/cumulative-timeline/data.csv",
"figures/correlation/cumulative-timeline/data_events.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/cumulative-timeline/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/cumulative-timeline/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/cumulative-timeline",
"code_text": "# Cumulative publication count over time with event markers (house style): one step line per\n# topic (running total of the yearly counts), the topic name and final total at the line end, and\n# dated events as dashed vertical lines labelled at the top of the panel.\n# Reads data.csv and data_events.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\ncumulative <- TRUE # FALSE: plot the yearly counts instead of the running total\nas_step <- TRUE # step line (counts change once a year); FALSE: straight segments\nshow_events <- TRUE # dashed lines and labels from data_events.csv\nevent_rows <- 3 # at most this many label rows at the top (used only when labels would collide)\nshow_event_year <- FALSE # TRUE: write \"2006 Method X released\"; the x axis already gives the year\nshow_end_labels <- TRUE # topic name and final value at the right end of each line\nx_break_step <- 5 # years between x ticks\nfig_cells <- \"3x1\" # house grid cells (135 x 43 mm)\ny_label <- \"Cumulative publications\"\nfootnote <- \"Simulated data; not a real literature search\"\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue, red, green: all >= 3:1 on white, so end labels keep the line colour\nline_cols <- c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"brown\"]], hp[[\"magenta\"]])\n# push label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nev <- utils::read.csv(\"data_events.csv\", stringsAsFactors = FALSE)\ndf <- df[order(df$topic, df$year), ]\ndf$topic <- factor(df$topic, levels = unique(df$topic))\n# drop each topic's leading zero years, so a line starts at its first paper instead of running\n# along the bottom frame\nfirst_year <- tapply(ifelse(df$n > 0, df$year, Inf), df$topic, min)\ndf <- df[df$year >= first_year[as.character(df$topic)], ]\ndf$y <- if (isTRUE(cumulative)) stats::ave(df$n, df$topic, FUN = cumsum) else df$n\ncols <- stats::setNames(line_cols[seq_len(nlevels(df$topic))], levels(df$topic))\n\nx_min <- min(df$year); x_max <- max(df$year)\ny_max <- max(df$y)\ny_top <- y_max / 0.70 # top 30 % of the panel holds the event labels\nx_right <- x_max + 0.30 * (x_max - x_min) # room for the end labels\n\nends <- do.call(rbind, lapply(split(df, df$topic), function(d) d[which.max(d$year), ]))\nends$lab <- sprintf(\"%s (%s)\", ends$topic, formatC(ends$y, format = \"d\", big.mark = \",\"))\nends$ly <- spread(ends$y, gap = 0.075 * y_top)\n# a step line ends with a flat segment over the last year; start the label just past it\nend_x <- x_max + if (isTRUE(as_step)) 1 else 0\n\np <- ggplot(df, aes(year, y, colour = topic))\nif (isTRUE(show_events) && nrow(ev)) {\n ev <- ev[order(ev$year), ]\n ev$lab <- if (isTRUE(show_event_year)) sprintf(\"%d %s\", ev$year, ev$event) else ev$event\n # label width in years: text width (mm, Arial 7 pt) over the panel width (mm per year), with\n # the panel taken as the canvas minus about 15 mm of axis and margin\n w_mm <- systemfonts::string_width(ev$lab, family = house_family(), size = 7, res = 72) / 72 * 25.4\n mm_per_year <- (pv_house_canvas(fig_cells)$width_mm - 15) / (x_right - x_min)\n ev$x0 <- ev$year + 0.25; ev$x1 <- ev$x0 + w_mm / mm_per_year + 0.15\n # greedy rows: a later event's dashed line runs up to its own row, so it must sit on a lower\n # row than any earlier label it would cross; labels on one row must not overlap\n ev$row <- 0\n for (j in seq_len(nrow(ev))[-1]) {\n r <- 0\n repeat {\n prev <- seq_len(j - 1)\n clash <- any(ev$x1[prev] > ev$x0[j] - 0.25 & ev$row[prev] >= r)\n if (!clash) break\n if (r >= event_rows - 1) {\n warning(\"event labels collide: shorten the names in data_events.csv or raise event_rows\")\n break\n }\n r <- r + 1\n }\n ev$row[j] <- r\n }\n ev$ly <- y_top * (0.975 - 0.095 * ev$row)\n p <- p +\n geom_segment(data = ev, aes(x = year, xend = year, y = 0, yend = ly), inherit.aes = FALSE,\n linetype = \"22\", colour = grey[[\"ref\"]], linewidth = pv_house_lw(\"ref\")) +\n geom_text(data = ev, aes(x = year + 0.25, y = ly, label = lab), inherit.aes = FALSE,\n hjust = 0, vjust = 1, colour = \"#1A1A1A\", size = pv_pt2size(7))\n}\nif (isTRUE(as_step)) {\n # extend each topic by one year so the last count gets its own flat step\n last <- ends; last$year <- last$year + 1\n p <- p + geom_step(data = rbind(df, last[, names(df)]), direction = \"hv\",\n linewidth = pv_house_lw(\"main\"))\n} else {\n p <- p + geom_line(linewidth = pv_house_lw(\"main\"))\n}\nif (isTRUE(show_end_labels)) {\n p <- p + geom_text(data = ends, aes(x = end_x + 0.5, y = ly, label = lab), hjust = 0,\n size = pv_pt2size(7))\n}\np <- p +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(limits = c(x_min, x_right), expand = c(0, 0),\n breaks = seq(ceiling(x_min / x_break_step) * x_break_step, x_max + 1, by = x_break_step)) +\n scale_y_continuous(limits = c(0, y_top), expand = c(0, 0), breaks = pretty(c(0, y_max), n = 4),\n labels = function(b) formatC(b, format = \"d\", big.mark = \",\")) +\n labs(x = \"Year\", y = y_label, caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = fig_cells)\nmessage(\"wrote preview.png\")\n",
"search_text": "cumulative count over time with event markers (house style)\n带事件标注的累计数量时间曲线（house 风格）\ncumulative-timeline\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n展示一个或多个主题随年份增长的累计数量变化（如文献逐年累计发表量），并在时间轴上标出关键历史事件时用。\n在 `data.csv` 填入 `year`（年份）、`topic`（主题名，每个主题画一条线）和 `n`（当年新增数量），在 `data_events.csv` 填入 `year` 和 `event`（事件名称）；在 `plot.r` 顶部将 `cumulative` 设为 `false` 可改为画每年新增量，`as_step` 控制是否画成阶梯线（逐年跃升的折线），`show_events` 和 `event_rows` 控制事件竖线开关与顶部标签排布行数，`show_end_labels` 控制线末端是否标出主题名和最终数值。\ncumulative time-series step events literature house-style\nyear 年份（整数，x 轴） topic 主题或检索词（字符串，每个一条线） n 该年新增数量（整数，此例为发表文献数）"
},
{
"title": "Hexbin density",
"title_zh": "六边形分箱密度图",
"slug": "hexbin",
"category": "correlation",
"tags": [
"hexbin",
"density",
"scatter",
"correlation"
],
"packages": [
"ggplot2",
"hexbin"
],
"data_columns": {
"x": "横轴连续变量（数值）",
"y": "纵轴连续变量（数值）"
},
"when_to_use": "散点很密、普通散点叠成一团时用；用六边形分箱看二维密度与热点，比透明散点更清晰。",
"customize": "plot.R 顶部 bins 调六边形分箱数，show_counts 显计数，legend_title 定图例。data.csv 提供 x 和 y 连续变量列。使用 pv_palette(\"house_warm\") 配色，比透明散点看二维密度更清晰。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "bins",
"value": "22"
},
{
"name": "show_counts",
"value": "FALSE"
},
{
"name": "legend_title",
"value": "\"Count\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/hexbin/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/hexbin/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/hexbin/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/hexbin/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/hexbin/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/hexbin/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/hexbin/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/hexbin/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/hexbin/make_data.R"
}
],
"dir": "figures/correlation/hexbin",
"preview": "figures/correlation/hexbin/preview.png",
"docs_preview": "previews/hexbin.png",
"code": "figures/correlation/hexbin/plot.R",
"data": "figures/correlation/hexbin/data.csv",
"data_files": [
"figures/correlation/hexbin/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/hexbin/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/hexbin/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/hexbin",
"code_text": "# Hexbin density of a bivariate scatter (house style): house_warm counts, colour bar inside,\n# Pearson r and n in the panel. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nbins <- 22\nshow_counts <- FALSE\nlegend_title <- \"Count\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nseq_cols <- pv_palette(\"house_warm\")\ngrey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration;\\nnot biological results\"\nr <- stats::cor(df$x, df$y)\n\np <- ggplot(df, aes(x, y)) +\n geom_hex(bins = bins, colour = \"white\", linewidth = pv_house_lw(0.2)) +\n scale_fill_gradientn(colours = seq_cols, name = legend_title,\n breaks = function(l) c(ceiling(l[1] / 10), floor(l[2] / 10)) * 10, # two end ticks\n guide = guide_colourbar(direction = \"horizontal\", title.position = \"top\",\n barwidth = unit(8, \"mm\"), barheight = unit(1.8, \"mm\"))) +\n annotate(\"text\", x = -Inf, y = Inf, hjust = -0.08, vjust = 1.3, lineheight = 0.95,\n label = sprintf(\"r = %.2f\\nn = %s\", r, format(nrow(df), big.mark = \",\"))) +\n scale_x_continuous(expand = expansion(mult = 0.02)) +\n scale_y_continuous(expand = expansion(mult = 0.02)) +\n labs(x = \"Feature X\", y = \"Feature Y\", caption = footnote) +\n theme_house(legend = \"inside\") +\n theme(legend.position.inside = c(0.985, 0.02), legend.justification.inside = c(1, 0),\n legend.title = element_text(size = 7, margin = margin(b = 0.6, unit = \"mm\")),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nif (isTRUE(show_counts)) {\n p <- p + stat_bin_hex(aes(label = after_stat(count)), bins = bins, geom = \"text\",\n size = pv_pt2size(6), colour = \"black\")\n}\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "hexbin density\n六边形分箱密度图\nhexbin\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n散点很密、普通散点叠成一团时用；用六边形分箱看二维密度与热点，比透明散点更清晰。\nplot.r 顶部 bins 调六边形分箱数，show_counts 显计数，legend_title 定图例。data.csv 提供 x 和 y 连续变量列。使用 pv_palette(\"house_warm\") 配色，比透明散点看二维密度更清晰。\nhexbin density scatter correlation\nx 横轴连续变量（数值） y 纵轴连续变量（数值）"
},
{
"title": "Stacked area with scenario lines and gap arrows (house style)",
"title_zh": "堆叠面积与情景折线、差距箭头（house 风格）",
"slug": "house-area-scenarios",
"category": "correlation",
"tags": [
"area",
"stacked-area",
"scenario",
"projection",
"line",
"direct-labels",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"year": "年份",
"series": "系列（history / no_control / current_practice / target / ambitious / annual_share_of_target）",
"value": "种子库（10³ seeds per m²）"
},
"when_to_use": "适用于展示总量拆分及多个未来情景从共享历史产生分歧时的差距，采用单面板 2x2 89 × 89 mm 尺寸及 9/10 pt Arial 字体，数据为模拟的 2000 至 2100 年杂草种子库，包含黑色历史实线、无控制、当前实践、目标及激进情景折线，底层为深浅 house_div 蓝色的年度和多年生杂草堆叠面积，图内标注了由 data.csv 在 2050 年计算得出的差距及灰色向下箭头。",
"customize": "在 plot.R 中修改 at <- 2050 以更改差距年份，差距值将从 data.csv 重新计算并通过 stopifnot 验证正值，系列颜色来自 pal[[\"…\"]]，面积填充为 div[3] 和 div[4]，数据变更时需手动调整 annotate() 的标签位置，y 轴标题使用 Arial 的 ³ 和 ²。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/house-area-scenarios/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-area-scenarios/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-area-scenarios/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/house-area-scenarios/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-area-scenarios/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-area-scenarios/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/house-area-scenarios/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-area-scenarios/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-area-scenarios/make_data.R"
}
],
"dir": "figures/correlation/house-area-scenarios",
"preview": "figures/correlation/house-area-scenarios/preview.png",
"docs_preview": "previews/house-area-scenarios.png",
"code": "figures/correlation/house-area-scenarios/plot.R",
"data": "figures/correlation/house-area-scenarios/data.csv",
"data_files": [
"figures/correlation/house-area-scenarios/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-area-scenarios/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-area-scenarios/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/house-area-scenarios",
"code_text": "# House example: stacked composition area under a pathway line, scenario lines,\n# open-circle \"commitment\" marker, vertical gap arrows with printed values, direct labels.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nd <- read.csv(\"data.csv\")\ng <- function(s) d[d$series == s, ]\npal <- pv_palette(\"house\"); div <- pv_palette(\"house_div\"); grey <- pv_palette(\"house_grey\")\ntg <- g(\"target\"); an <- g(\"annual_share_of_target\")\narea <- data.frame(year = tg$year, total = tg$value, annual = an$value)\nat <- 2050\nv <- function(s) g(s)$value[g(s)$year == at]\ngap1 <- v(\"no_control\") - v(\"target\"); gap2 <- v(\"target\") - v(\"ambitious\")\nstopifnot(gap1 > 0, gap2 > 0)\nlw <- pv_house_lw(\"main\")\np <- ggplot() +\n geom_ribbon(data = area, aes(year, ymin = 0, ymax = total), fill = div[4]) +\n geom_ribbon(data = area, aes(year, ymin = 0, ymax = annual), fill = div[3]) +\n geom_line(data = g(\"history\"), aes(year, value), colour = \"black\", linewidth = lw * 1.4) +\n geom_line(data = g(\"no_control\"), aes(year, value), colour = pal[[\"magenta\"]], linewidth = lw) +\n geom_line(data = g(\"current_practice\"), aes(year, value), colour = pal[[\"orange\"]], linewidth = lw,\n linetype = \"22\") +\n geom_line(data = tg[tg$year >= 2020, ], aes(year, value), colour = pal[[\"sky\"]], linewidth = lw) +\n geom_line(data = g(\"ambitious\"), aes(year, value), colour = pal[[\"gold\"]], linewidth = lw) +\n annotate(\"point\", x = 2030, y = v2030 <- tg$value[tg$year == 2030], shape = 21, size = 2.6,\n stroke = 1, fill = \"white\", colour = pal[[\"blue\"]]) +\n annotate(\"segment\", x = at, xend = at, y = v(\"no_control\") - 0.8, yend = v(\"target\") + 0.8,\n colour = grey[[\"mid\"]], linewidth = pv_lw <- pv_pt2lw(0.8),\n arrow = arrow(length = unit(1.4, \"mm\"), type = \"closed\")) +\n annotate(\"segment\", x = at, xend = at, y = v(\"target\") - 0.8, yend = v(\"ambitious\") + 0.8,\n colour = grey[[\"mid\"]], linewidth = pv_lw, arrow = arrow(length = unit(1.4, \"mm\"), type = \"closed\")) +\n annotate(\"text\", x = at + 3, y = (v(\"no_control\") + v(\"target\")) / 2 + 9, hjust = 0, lineheight = 0.9,\n label = sprintf(\"Control gap\\n(%.0f \\u00d7 10\\u00b3 seeds)\", gap1)) +\n annotate(\"text\", x = at + 3, y = 8.3, hjust = 0, lineheight = 0.9,\n label = sprintf(\"Ambition gap\\n(%.0f \\u00d7 10\\u00b3 seeds)\", gap2)) +\n annotate(\"text\", x = 2013, y = 40, label = \"Perennial\", colour = \"black\") +\n annotate(\"text\", x = 2009, y = 18, label = \"Annual\\nweeds\", lineheight = 0.9, colour = \"black\") +\n annotate(\"text\", x = 2099, y = 61.5, hjust = 1, label = \"No control\", colour = pal[[\"magenta\"]]) +\n annotate(\"text\", x = 2099, y = g(\"current_practice\")$value[8] + 3.2, hjust = 1,\n label = \"Current practice\", colour = \"#1A1A1A\") +\n annotate(\"text\", x = 2099, y = tg$value[11] + 3.2, hjust = 1, label = \"Target\", colour = \"#1A1A1A\") +\n annotate(\"text\", x = 2099, y = 4.2, hjust = 1, label = \"Ambitious\", colour = \"#1A1A1A\") +\n annotate(\"text\", x = 2033, y = 49.8, hjust = 0, label = \"Pledge\", colour = pal[[\"blue\"]]) +\n scale_x_continuous(breaks = seq(2000, 2100, 20)) +\n scale_y_continuous(breaks = seq(0, 60, 20)) +\n coord_cartesian(xlim = c(2000, 2100), ylim = c(0, 64), expand = FALSE, clip = \"off\") +\n labs(x = NULL, y = \"Weed seed bank (10\\u00b3 seeds per m\\u00b2)\",\n caption = \"Simulated data for illustration; not biological results\") +\n theme_house() +\n theme(plot.caption = element_text(hjust = 0, colour = grey[[\"mid\"]]),\n plot.caption.position = \"plot\",\n plot.margin = margin(2, 4, 1, 1, \"mm\"))\npv_save_house(p, \"figure\", cells = \"2x2\")\n",
"search_text": "stacked area with scenario lines and gap arrows (house style)\n堆叠面积与情景折线、差距箭头（house 风格）\nhouse-area-scenarios\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n适用于展示总量拆分及多个未来情景从共享历史产生分歧时的差距，采用单面板 2x2 89 × 89 mm 尺寸及 9/10 pt arial 字体，数据为模拟的 2000 至 2100 年杂草种子库，包含黑色历史实线、无控制、当前实践、目标及激进情景折线，底层为深浅 house_div 蓝色的年度和多年生杂草堆叠面积，图内标注了由 data.csv 在 2050 年计算得出的差距及灰色向下箭头。\n在 plot.r 中修改 at <- 2050 以更改差距年份，差距值将从 data.csv 重新计算并通过 stopifnot 验证正值，系列颜色来自 pal[[\"…\"]]，面积填充为 div[3] 和 div[4]，数据变更时需手动调整 annotate() 的标签位置，y 轴标题使用 arial 的 ³ 和 ²。\narea stacked-area scenario projection line direct-labels house-style\nyear 年份 series 系列（history / no_control / current_practice / target / ambitious / annual_share_of_target） value 种子库（10³ seeds per m²）"
},
{
"title": "Line chart with CI ribbons (house style)",
"title_zh": "带置信带的折线图（house 风格）",
"slug": "house-line",
"category": "correlation",
"tags": [
"line",
"time-series",
"confidence-band",
"direct-labels",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"group": "分组（字符串）",
"vine": "重复编号（整数）",
"days_after_flowering": "开花后天数（数值，x 轴）",
"brix": "可溶性固形物（°Brix）"
},
"when_to_use": "少数几组随时间（或剂量）变化、每个时间点有重复时用；画均值线 + 95% 置信带，线尾直标组名，组间差和 P 写在图内。",
"customize": "plot.R 顶部 phase_start / phase_end / phase_label 设阶段底色；compare 选要比较的两组（取最后一个时间点）。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 2×1 格（89 × 43 mm），字号保持 7/8 pt（只有单个 2×2 面板才由 pv_save_house() 自动 +2 pt）。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "phase_start",
"value": "63"
},
{
"name": "phase_end",
"value": "77"
},
{
"name": "phase_label",
"value": "\"Véraison\""
},
{
"name": "compare",
"value": "c(\"Wine\", \"Table\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/house-line/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-line/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-line/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/house-line/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-line/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-line/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/house-line/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-line/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-line/make_data.R"
}
],
"dir": "figures/correlation/house-line",
"preview": "figures/correlation/house-line/preview.png",
"docs_preview": "previews/house-line.png",
"code": "figures/correlation/house-line/plot.R",
"data": "figures/correlation/house-line/data.csv",
"data_files": [
"figures/correlation/house-line/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-line/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-line/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/house-line",
"code_text": "# House-style line chart: mean ± 95% CI ribbons, line-end labels, harvest difference in the panel.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nphase_start <- 63\nphase_end <- 77\nphase_label <- \"Véraison\"\ncompare <- c(\"Wine\", \"Table\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\npal <- pv_palette(\"house\")\ncols <- c(Wild = pal[[\"green\"]], Wine = pal[[\"red\"]], Table = pal[[\"blue\"]])\ngrey <- pv_palette(\"house_grey\")\n\nkey <- interaction(df$group, df$days_after_flowering, drop = TRUE)\nsm <- do.call(rbind, lapply(split(df, key), function(x) {\n n <- nrow(x); m <- mean(x$brix); se <- stats::sd(x$brix) / sqrt(n)\n data.frame(group = x$group[1], daf = x$days_after_flowering[1], m = m, se = se,\n lo = m - stats::qt(0.975, n - 1) * se, hi = m + stats::qt(0.975, n - 1) * se, n = n)\n}))\nends <- sm[sm$daf == max(sm$daf), ]\nends$y <- ends$m + c(Table = 0.5, Wild = -0.6, Wine = 0)[ends$group]\na <- ends[ends$group == compare[1], ]; b <- ends[ends$group == compare[2], ]\ndlt <- a$m - b$m\npd <- 2 * stats::pt(-abs(dlt / sqrt(a$se^2 + b$se^2)), df = a$n + b$n - 2)\nn_vines <- max(sm$n)\n\np <- ggplot(sm, aes(daf, m)) +\n annotate(\"rect\", xmin = phase_start, xmax = phase_end, ymin = -Inf, ymax = Inf, fill = grey[[\"bg\"]]) +\n annotate(\"text\", x = (phase_start + phase_end) / 2, y = 2.3, vjust = 0, label = phase_label,\n size = pv_pt2size(6), colour = grey[[\"mid\"]]) +\n geom_ribbon(aes(ymin = lo, ymax = hi, fill = group), alpha = 0.2) +\n geom_line(aes(colour = group), linewidth = pv_house_lw(\"main\")) +\n geom_point(aes(fill = group), shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = \"black\") +\n geom_text(data = ends, aes(x = daf + 2.5, y = y, label = group, colour = group), hjust = 0,\n size = pv_pt2size(7), fontface = \"bold\") +\n annotate(\"text\", x = 20, y = 26.9, hjust = 0, vjust = 1, size = pv_pt2size(7),\n colour = cols[[compare[1]]], label = paste(compare[1], \"\\u2212\", compare[2], \"at harvest\")) +\n annotate(\"text\", x = 20, y = 24.7, hjust = 0, vjust = 1, size = pv_pt2size(7),\n colour = cols[[compare[1]]], parse = TRUE,\n label = sprintf(\"'%+.1f \\u00b0Brix, '*%s\", dlt, pv_fmt_p(pd))) +\n annotate(\"text\", x = 136, y = 2.6, hjust = 1, vjust = 0, size = pv_pt2size(6), colour = grey[[\"mid\"]],\n label = sprintf(\"Mean \\u00b1 95%% CI\\nn = %d vines per group\", n_vines), lineheight = 0.9) +\n scale_colour_manual(values = cols) +\n scale_fill_manual(values = cols) +\n scale_x_continuous(breaks = seq(20, 120, 20)) +\n scale_y_continuous(breaks = seq(5, 25, 5)) +\n coord_cartesian(xlim = c(16, 138), ylim = c(2, 27.5), expand = FALSE) +\n labs(x = \"Days after flowering\", y = \"Soluble solids (\\u00b0Brix)\") +\n theme_house()\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "line chart with ci ribbons (house style)\n带置信带的折线图（house 风格）\nhouse-line\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n少数几组随时间（或剂量）变化、每个时间点有重复时用；画均值线 + 95% 置信带，线尾直标组名，组间差和 p 写在图内。\nplot.r 顶部 phase_start / phase_end / phase_label 设阶段底色；compare 选要比较的两组（取最后一个时间点）。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 2×1 格（89 × 43 mm），字号保持 7/8 pt（只有单个 2×2 面板才由 pv_save_house() 自动 +2 pt）。\nline time-series confidence-band direct-labels house-style\ngroup 分组（字符串） vine 重复编号（整数） days_after_flowering 开花后天数（数值，x 轴） brix 可溶性固形物（°brix）"
},
{
"title": "Dense open-circle time series with line-end labels (house style)",
"title_zh": "空心圆点时间序列与线尾标注（house 风格）",
"slug": "house-point-series",
"category": "correlation",
"tags": [
"time-series",
"open-circles",
"line-end-labels",
"direct-labels",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"genotype": "基因型（WT / hsp-ko）",
"height": "叶位（upper / lower）",
"time_s": "时间（s）",
"temp_c": "叶温（°C）"
},
"when_to_use": "适用于展示不多于 5 个均匀且密集采样的系列以保持单个读数可见，采用单面板 2x2 89 × 89 mm 尺寸及 9/10 pt Arial 字体，数据为 0 至 3600 秒的模拟叶片温度，使用 pv_palette(\"house\") 分配四种颜色的空心圆点且无连线，线尾带粗体同色标注并在图内计算 2400 至 3600 秒的平均温差。",
"customize": "使用 cols 将系列映射到 house 颜色，通过 side 为 +1 或 -1 将标签置于系列上方或下方，标签高度由 x 大于等于 1800 秒的最值加 1 个单位间距计算得出，平台期窗口在 plat 中定义，数据点配置为 shape 1 且 size 1.1 与 stroke 0.6 pt。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/house-point-series/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-point-series/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-point-series/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/house-point-series/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-point-series/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-point-series/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/house-point-series/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-point-series/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-point-series/make_data.R"
}
],
"dir": "figures/correlation/house-point-series",
"preview": "figures/correlation/house-point-series/preview.png",
"docs_preview": "previews/house-point-series.png",
"code": "figures/correlation/house-point-series/plot.R",
"data": "figures/correlation/house-point-series/data.csv",
"data_files": [
"figures/correlation/house-point-series/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-point-series/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-point-series/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/house-point-series",
"code_text": "# House example: dense open-circle time series, one colour per series,\n# bold series labels at the line ends in the series colour, plateau stats printed in the panel.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nd <- read.csv(\"data.csv\")\npal <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nd$series <- paste(d$genotype, d$height)\ncols <- c(\"WT upper\" = pal[[\"magenta\"]], \"hsp-ko upper\" = pal[[\"orange\"]],\n \"hsp-ko lower\" = pal[[\"purple\"]], \"WT lower\" = pal[[\"green\"]])\nplat <- aggregate(temp_c ~ series, d[d$time_s >= 2400, ], mean)\npm <- setNames(plat$temp_c, plat$series)\nends <- d[d$time_s == max(d$time_s), ]\nends$lab <- sprintf(\"%s (%s leaf)\", ends$genotype, ends$height)\n# label y from the series' extreme over the label's x span (x >= 1800 covers the longest label):\n# above the max for the upper series of each pair, below the min for the other, 1 unit clear.\nside <- c(\"WT upper\" = 1, \"hsp-ko upper\" = -1, \"hsp-ko lower\" = 1, \"WT lower\" = -1)\nspan <- d[d$time_s >= 1800, ]\nends$y <- vapply(ends$series, function(s) {\n v <- span$temp_c[span$series == s]\n if (side[[s]] > 0) max(v) + 1 else min(v) - 1\n}, numeric(1))\ndup <- pm[[\"WT upper\"]] - pm[[\"WT lower\"]]; dko <- pm[[\"hsp-ko upper\"]] - pm[[\"hsp-ko lower\"]]\np <- ggplot(d, aes(time_s, temp_c, colour = series)) +\n geom_point(shape = 1, size = 1.1, stroke = pv_pt2lw(0.6)) +\n geom_text(data = ends, aes(x = 3640, y = y, label = lab), hjust = 1, fontface = \"bold\") +\n annotate(\"text\", x = 80, y = 43.6, hjust = 0, vjust = 1, lineheight = 0.95, colour = grey[[\"dark\"]],\n label = paste(\"Upper - lower leaf, 2400\\u20133600 s\",\n sprintf(\"WT +%.1f \\u00b0C, hsp-ko +%.1f \\u00b0C\", dup, dko), sep = \"\\n\")) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(breaks = seq(0, 3600, 900)) +\n scale_y_continuous(breaks = seq(20, 44, 4)) +\n coord_cartesian(xlim = c(0, 3700), ylim = c(20, 44), expand = FALSE) +\n labs(x = \"Time (s)\", y = \"Leaf temperature (\\u00b0C)\",\n caption = \"Simulated data for illustration; not biological results\") +\n theme_house() +\n theme(plot.caption = element_text(hjust = 0, colour = grey[[\"mid\"]]), plot.caption.position = \"plot\",\n plot.margin = margin(2, 3, 1, 1, \"mm\"))\npv_save_house(p, \"figure\", cells = \"2x2\")\n",
"search_text": "dense open-circle time series with line-end labels (house style)\n空心圆点时间序列与线尾标注（house 风格）\nhouse-point-series\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n适用于展示不多于 5 个均匀且密集采样的系列以保持单个读数可见，采用单面板 2x2 89 × 89 mm 尺寸及 9/10 pt arial 字体，数据为 0 至 3600 秒的模拟叶片温度，使用 pv_palette(\"house\") 分配四种颜色的空心圆点且无连线，线尾带粗体同色标注并在图内计算 2400 至 3600 秒的平均温差。\n使用 cols 将系列映射到 house 颜色，通过 side 为 +1 或 -1 将标签置于系列上方或下方，标签高度由 x 大于等于 1800 秒的最值加 1 个单位间距计算得出，平台期窗口在 plat 中定义，数据点配置为 shape 1 且 size 1.1 与 stroke 0.6 pt。\ntime-series open-circles line-end-labels direct-labels house-style\ngenotype 基因型（wt / hsp-ko） height 叶位（upper / lower） time_s 时间（s） temp_c 叶温（°c）"
},
{
"title": "Scatter with group fits (house style)",
"title_zh": "分组散点与回归（house 风格）",
"slug": "house-scatter",
"category": "correlation",
"tags": [
"scatter",
"regression",
"direct-labels",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"group": "分组（字符串，3 组）",
"name": "样品名（字符串，用于点标签）",
"berry_weight_g": "浆果重（g，正数，x 轴取对数）",
"anthocyanin_mg_g": "花青素含量（mg/g FW）"
},
"when_to_use": "两个连续变量、分几组看关系时用；每组一条拟合线，R² 与 P 写在图内，组名和重点样品直接标在点旁，不用图例。",
"customize": "plot.R 顶部 label_names 选要标名的点（≤30 个）；group_order 定组序与配色；点用 HOUSE_POINT（shape 21 / size 2.3 / stroke 0.3）。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 2×2 格（89 × 89 mm）单面板，由 pv_save_house() 自动 +2 pt（刻度 9 / 轴标题 10 pt）。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "label_names",
"value": "c(\"Cabernet Sauvignon\", \"Pinot Noir\", \"Saperavi\", \"Gamay\", \"Kyoho\", \"VS133\")"
},
{
"name": "group_order",
"value": "c(\"Wild\", \"Wine\", \"Table\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/house-scatter/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-scatter/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-scatter/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/house-scatter/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-scatter/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-scatter/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/house-scatter/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/house-scatter/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-scatter/make_data.R"
}
],
"dir": "figures/correlation/house-scatter",
"preview": "figures/correlation/house-scatter/preview.png",
"docs_preview": "previews/house-scatter.png",
"code": "figures/correlation/house-scatter/plot.R",
"data": "figures/correlation/house-scatter/data.csv",
"data_files": [
"figures/correlation/house-scatter/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-scatter/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/house-scatter/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/house-scatter",
"code_text": "# House-style scatter: three groups, per-group fit, R² and P in the panel, direct labels.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nlabel_names <- c(\"Cabernet Sauvignon\", \"Pinot Noir\", \"Saperavi\", \"Gamay\", \"Kyoho\", \"VS133\")\ngroup_order <- c(\"Wild\", \"Wine\", \"Table\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\npal <- pv_palette(\"house\")\ncols <- c(Wild = pal[[\"green\"]], Wine = pal[[\"red\"]], Table = pal[[\"blue\"]])\ndf$group <- factor(df$group, levels = group_order)\n\nstat_lab <- vapply(group_order, function(g) {\n s <- summary(stats::lm(anthocyanin_mg_g ~ log10(berry_weight_g), data = df[df$group == g, ]))\n sprintf(\"italic(R)*'\\u00b2 = %.2f, '*%s\", s$r.squared, pv_fmt_p(stats::coef(s)[2, 4], exact = TRUE)) # 2x2 bumped: exponent 0.7 x 9 pt = 6.3 pt\n}, character(1))\nstats_df <- data.frame(group = factor(group_order, levels = group_order), x = 13.5,\n y = c(13.6, 12.5, 11.4), lab = stat_lab)\nglab <- data.frame(group = factor(group_order, levels = group_order),\n x = c(0.335, 3.5, 7.2), y = c(9.3, 7.4, 4.9), hj = c(0, 0.5, 0.5))\ndf$lab <- ifelse(df$name %in% label_names, df$name, \"\")\n# Names sit at fixed positions (no repel solver), so the PDF and PNG layouts match on every\n# device. Each name sits beside the fit, away from the points, with a straight leader that\n# stops just short of the name. Positions are in data units (x on the original scale).\nlab_pos <- data.frame(\n name = c(\"VS133\", \"Saperavi\", \"Pinot Noir\", \"Gamay\", \"Cabernet Sauvignon\", \"Kyoho\"),\n lx = c(0.62, 0.66, 1.09, 1.24, 1.40, 6.95),\n ly = c(8.2, 6.9, 5.3, 3.9, 2.3, 2.8)\n)\nlab_df <- merge(df[df$lab != \"\", ], lab_pos, by = \"name\", sort = FALSE)\nlab_df$vj <- ifelse(lab_df$ly < lab_df$anthocyanin_mg_g, 1, 0) # name below or above its point\nlab_df$sy <- lab_df$ly + ifelse(lab_df$vj == 1, 0.25, -0.25)\n\np <- ggplot(df, aes(berry_weight_g, anthocyanin_mg_g)) +\n geom_smooth(aes(group = group), method = \"lm\", formula = y ~ x, colour = NA,\n fill = pv_palette(\"house_grey\")[[\"ci\"]], alpha = 0.5) +\n geom_smooth(aes(colour = group), method = \"lm\", formula = y ~ x, se = FALSE,\n linewidth = pv_house_lw(\"emph\")) +\n # leaders under the points, so each starts at the marker edge\n geom_segment(data = lab_df, aes(x = berry_weight_g, y = anthocyanin_mg_g, xend = lx, yend = sy,\n colour = group), linewidth = pv_house_lw(0.4)) +\n geom_point(aes(fill = group), shape = HOUSE_POINT$shape, size = HOUSE_POINT$size, stroke = HOUSE_POINT$stroke,\n colour = \"black\") +\n geom_text(data = lab_df, aes(lx, ly, label = name, colour = group, vjust = vj),\n size = pv_pt2size(6)) +\n geom_text(data = glab, aes(x, y, label = group, colour = group, hjust = hj), size = pv_pt2size(8),\n fontface = \"bold\") +\n geom_text(data = stats_df, aes(x, y, label = lab, colour = group), parse = TRUE,\n hjust = 1, vjust = 1, size = pv_pt2size(7)) +\n scale_colour_manual(values = cols) +\n scale_fill_manual(values = cols) +\n scale_x_log10(limits = c(0.3, 14), breaks = c(0.5, 1, 2, 5, 10),\n labels = c(\"0.5\", \"1\", \"2\", \"5\", \"10\"), expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 14), breaks = seq(0, 14, 2), expand = c(0, 0)) +\n labs(x = \"Berry weight (g, log scale)\", y = \"Anthocyanin (mg/g FW)\") +\n theme_house()\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "scatter with group fits (house style)\n分组散点与回归（house 风格）\nhouse-scatter\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n两个连续变量、分几组看关系时用；每组一条拟合线，r² 与 p 写在图内，组名和重点样品直接标在点旁，不用图例。\nplot.r 顶部 label_names 选要标名的点（≤30 个）；group_order 定组序与配色；点用 house_point（shape 21 / size 2.3 / stroke 0.3）。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 2×2 格（89 × 89 mm）单面板，由 pv_save_house() 自动 +2 pt（刻度 9 / 轴标题 10 pt）。\nscatter regression direct-labels house-style\ngroup 分组（字符串，3 组） name 样品名（字符串，用于点标签） berry_weight_g 浆果重（g，正数，x 轴取对数） anthocyanin_mg_g 花青素含量（mg/g fw）"
},
{
"title": "Line chart",
"title_zh": "折线图",
"slug": "line-basic",
"category": "correlation",
"tags": [
"line",
"time-series",
"ribbon"
],
"packages": [
"ggplot2"
],
"data_columns": {
"x": "有序自变量，这里是天数（数值）",
"y": "相对丰度（数值）",
"series": "曲线名称（字符串）"
},
"when_to_use": "自变量有顺序、要比较几条带噪声的轨迹时用。",
"customize": "plot.R 顶部 series_keep 选择曲线；show_ribbon 加 loess 置信带；show_area 铺面积；show_points 在折线上加点。同目录 plot.py 仍读 x 和 y，作单序列 Python 变体。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "series_keep",
"value": "c(\"Control\", \"Low dose\", \"High dose\")"
},
{
"name": "show_ribbon",
"value": "TRUE"
},
{
"name": "show_area",
"value": "FALSE"
},
{
"name": "show_points",
"value": "FALSE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/line-basic/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/line-basic/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/line-basic/plot.R"
},
{
"name": "plot.py",
"path": "figures/correlation/line-basic/plot.py",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/line-basic/plot.py",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/line-basic/plot.py"
},
{
"name": "data.csv",
"path": "figures/correlation/line-basic/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/line-basic/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/line-basic/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/line-basic/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/line-basic/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/line-basic/make_data.R"
},
{
"name": "make_data.py",
"path": "figures/correlation/line-basic/make_data.py",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/line-basic/make_data.py",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/line-basic/make_data.py"
}
],
"dir": "figures/correlation/line-basic",
"preview": "figures/correlation/line-basic/preview.png",
"docs_preview": "previews/line-basic.png",
"code": "figures/correlation/line-basic/plot.R",
"data": "figures/correlation/line-basic/data.csv",
"data_files": [
"figures/correlation/line-basic/data.csv"
],
"code_python": "figures/correlation/line-basic/plot.py",
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/line-basic/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/line-basic/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/line-basic",
"code_text": "# Line chart (house style): several noisy series, same-colour loess band, line-end labels,\n# slope per series in the panel. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nseries_keep <- c(\"Control\", \"Low dose\", \"High dose\")\nshow_ribbon <- TRUE\nshow_area <- FALSE\nshow_points <- FALSE # STYLE: points on the line only when a series has < 30 points\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$series %in% series_keep, , drop = FALSE]\ndf$series <- factor(df$series, levels = series_keep)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# reference series dark grey, treatments blue / red; all >= 3:1 on white, labels keep the line colour\npal <- stats::setNames(c(grey[[\"dark\"]], hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]],\n hp[[\"purple\"]])[seq_along(series_keep)], series_keep)\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nx_max <- max(df$x)\nends <- do.call(rbind, lapply(series_keep, function(s) {\n d <- df[df$series == s, ]\n fit <- stats::loess(y ~ x, data = d, span = 0.45)\n sl <- summary(stats::lm(y ~ x, data = d))$coefficients\n band <- stats::predict(fit, se = TRUE)\n data.frame(series = factor(s, levels = series_keep), y = stats::predict(fit, data.frame(x = x_max)),\n slope = sl[2, 1], se = sl[2, 2],\n lo = min(band$fit - stats::qt(0.975, band$df) * band$se.fit))\n}))\n# keep line-end labels at least 0.09 y-units apart\no <- order(ends$y); yy <- ends$y[o]\nfor (i in seq_along(yy)[-1]) yy[i] <- max(yy[i], yy[i - 1] + 0.14)\nends$ly[o] <- yy\nends$stat <- sprintf(\"%s %+.3f \\u00b1 %.3f per day\", ends$series, ends$slope, ends$se)\nline_h <- 0.14 # y-units per stat line\ny_lim <- c(min(df$y, ends$lo) - 0.03, max(df$y) + 0.05 + line_h * length(series_keep))\n\np <- ggplot(df, aes(x, y, colour = series, fill = series))\nif (isTRUE(show_area)) {\n p <- p + geom_area(aes(group = series), alpha = 0.15, linewidth = 0, position = \"identity\")\n}\nif (isTRUE(show_ribbon)) {\n p <- p + geom_ribbon(stat = \"smooth\", method = \"loess\", formula = y ~ x, span = 0.45,\n alpha = 0.2, colour = NA)\n}\np <- p + geom_line(linewidth = pv_house_lw(\"main\"))\nif (isTRUE(show_points)) {\n p <- p + geom_point(shape = HOUSE_POINT$shape, size = HOUSE_POINT$size, stroke = HOUSE_POINT$stroke,\n colour = \"black\")\n}\np <- p +\n geom_text(data = ends, aes(x = x_max + 1, y = ly, label = series, colour = series), hjust = 0,\n inherit.aes = FALSE) +\n geom_text(data = ends, aes(x = 1, y = y_lim[2] - line_h * (as.integer(series) - 0.4), label = stat,\n colour = series), hjust = 0, inherit.aes = FALSE) +\n scale_colour_manual(values = pal) +\n scale_fill_manual(values = pal) +\n scale_x_continuous(breaks = seq(0, 50, 10)) +\n coord_cartesian(xlim = c(0, x_max), ylim = y_lim, expand = FALSE, clip = \"off\") +\n labs(x = \"Day\", y = \"Relative abundance\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\",\n plot.margin = margin(1.6, 13, 0.9, 0.4, \"mm\"))\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "line chart\n折线图\nline-basic\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n自变量有顺序、要比较几条带噪声的轨迹时用。\nplot.r 顶部 series_keep 选择曲线；show_ribbon 加 loess 置信带；show_area 铺面积；show_points 在折线上加点。同目录 plot.py 仍读 x 和 y，作单序列 python 变体。\nline time-series ribbon\nx 有序自变量，这里是天数（数值） y 相对丰度（数值） series 曲线名称（字符串）"
},
{
"title": "Parallel coordinates",
"title_zh": "平行坐标",
"slug": "parallel-coordinates",
"category": "correlation",
"tags": [
"parallel-coordinates",
"multivariate"
],
"packages": [
"ggplot2"
],
"data_columns": {
"item": "个体编号（字符串）",
"group": "分组（字符串）",
"axis": "坐标轴名称（字符串）",
"value": "该轴上的原始读数（数值）"
},
"when_to_use": "多个量纲不同的指标要放在一起比较各组轮廓时用。",
"customize": "plot.R 顶部 highlight_group 填高亮组名，或 \"none\" 颜色全开。data.csv 填 item 编号、group 分组、axis 轴名和 value 原始读数列。高亮色取 pv_palette(\"house\") 与 house_grey。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": "Parallel",
"variants": [
{
"slug": "parallel-coordinates",
"variant_label": "Parallel",
"title": "Parallel coordinates",
"title_zh": "平行坐标",
"docs_preview": "previews/parallel-coordinates.png"
},
{
"slug": "radar",
"variant_label": "Radar",
"title": "Radar chart",
"title_zh": "雷达图",
"docs_preview": "previews/radar.png"
}
],
"parameters": [
{
"name": "highlight_group",
"value": "\"Batch-A\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/parallel-coordinates/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/parallel-coordinates/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/parallel-coordinates/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/parallel-coordinates/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/parallel-coordinates/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/parallel-coordinates/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/parallel-coordinates/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/parallel-coordinates/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/parallel-coordinates/make_data.R"
}
],
"dir": "figures/correlation/parallel-coordinates",
"preview": "figures/correlation/parallel-coordinates/preview.png",
"docs_preview": "previews/parallel-coordinates.png",
"code": "figures/correlation/parallel-coordinates/plot.R",
"data": "figures/correlation/parallel-coordinates/data.csv",
"data_files": [
"figures/correlation/parallel-coordinates/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/parallel-coordinates/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/parallel-coordinates/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/parallel-coordinates",
"code_text": "# Parallel coordinates (house style): each axis scaled to 0-1, one group highlighted over grey,\n# group names written at the right end in the line colour, group medians as thick lines.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# --- adjustable ---\nhighlight_group <- \"Batch-A\" # one group name, or \"none\" to colour every group\n# ------------------\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\naxes <- unique(df$axis)\ndf$axis <- factor(df$axis, levels = axes)\ndf$group <- factor(df$group, levels = unique(df$group))\nscaled <- lapply(split(df, df$axis), function(d) {\n rng <- range(d$value)\n d$y <- if (diff(rng) == 0) 0.5 else (d$value - rng[1]) / diff(rng)\n d\n})\ndf <- do.call(rbind, scaled)\ndf$xn <- as.integer(df$axis)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\ngroups <- levels(df$group)\n# blue, red, green, purple: all >= 3:1 on white, so the end labels keep the line colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]],\n hp[[\"brown\"]], hp[[\"magenta\"]])[seq_along(groups)], groups)\nn_items <- tapply(df$item, df$group, function(v) length(unique(v)))\nmed <- stats::aggregate(y ~ group + xn, data = df, FUN = stats::median)\nlast <- length(axes)\n\nbase <- ggplot(df, aes(xn, y, group = item)) +\n geom_vline(xintercept = seq_along(axes), linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ci\"]]) +\n scale_x_continuous(breaks = seq_along(axes), labels = axes, expand = expansion(add = c(0.15, 0.15))) +\n scale_y_continuous(limits = c(0, 1), breaks = c(0, 0.5, 1), expand = expansion(add = 0.03)) +\n coord_cartesian(clip = \"off\") +\n labs(x = NULL, y = \"Scaled value (0-1)\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\",\n plot.margin = margin(1.6, 13, 0.9, 0.4, \"mm\"))\n\nif (highlight_group == \"none\") {\n ends <- med[med$xn == last, ]\n ends$lab <- sprintf(\"%s\\n(n = %d)\", ends$group, n_items[as.character(ends$group)])\n p <- base +\n geom_line(aes(colour = group), alpha = 0.35, linewidth = pv_house_lw(\"minor\")) +\n geom_line(data = med, aes(xn, y, group = group, colour = group), linewidth = pv_house_lw(\"emph\")) +\n geom_text(data = ends, aes(x = last + 0.2, y = y, label = lab, colour = group), hjust = 0,\n lineheight = 0.9, inherit.aes = FALSE) +\n scale_colour_manual(values = cols)\n} else {\n other <- df[df$group != highlight_group, , drop = FALSE]\n hi <- df[df$group == highlight_group, , drop = FALSE]\n hmed <- med[med$group == highlight_group, ]\n y_end <- hmed$y[hmed$xn == last]\n hcol <- hp[[\"blue\"]]\n p <- base +\n geom_line(data = other, colour = grey[[\"light\"]], linewidth = pv_house_lw(\"minor\")) +\n geom_line(data = hi, colour = hcol, alpha = 0.5, linewidth = pv_house_lw(\"minor\")) +\n geom_line(data = hmed, aes(xn, y, group = 1), colour = hcol, linewidth = pv_house_lw(\"emph\"),\n inherit.aes = FALSE) +\n annotate(\"text\", x = last + 0.2, y = y_end, hjust = 0, lineheight = 0.9, colour = hcol,\n label = sprintf(\"%s\\nmedian\\n(n = %d)\", highlight_group, n_items[[highlight_group]])) +\n annotate(\"text\", x = last + 0.2, y = if (y_end > 0.5) 0.12 else 0.88, hjust = 0, lineheight = 0.9,\n colour = grey[[\"mid\"]], label = sprintf(\"Other\\n(n = %d)\", sum(n_items) - n_items[[highlight_group]]))\n}\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "parallel coordinates\n平行坐标\nparallel-coordinates\nparallel\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n多个量纲不同的指标要放在一起比较各组轮廓时用。\nplot.r 顶部 highlight_group 填高亮组名，或 \"none\" 颜色全开。data.csv 填 item 编号、group 分组、axis 轴名和 value 原始读数列。高亮色取 pv_palette(\"house\") 与 house_grey。\nparallel-coordinates multivariate\nitem 个体编号（字符串） group 分组（字符串） axis 坐标轴名称（字符串） value 该轴上的原始读数（数值）"
},
{
"title": "Scatter with regression",
"title_zh": "回归散点图",
"slug": "scatter",
"category": "correlation",
"tags": [
"scatter",
"regression",
"correlation"
],
"packages": [
"ggplot2"
],
"data_columns": {
"x": "自变量，这里是基因 A 的 log2 CPM（数值）",
"y": "因变量，这里是基因 B 的 log2 CPM（数值）",
"group": "样本来源细胞系（字符串）"
},
"when_to_use": "两个连续变量要看趋势，并按组别比较斜率时用。",
"customize": "plot.R 顶部 show_regression 开关回归线和置信带；colour_by_group 是否按细胞系上色；show_density 叠加二维等高线。三组颜色在 pal 里换。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_regression",
"value": "TRUE"
},
{
"name": "colour_by_group",
"value": "TRUE"
},
{
"name": "show_density",
"value": "FALSE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/scatter/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/scatter/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/scatter/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/scatter/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/scatter/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/scatter/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/scatter/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/scatter/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/scatter/make_data.R"
}
],
"dir": "figures/correlation/scatter",
"preview": "figures/correlation/scatter/preview.png",
"docs_preview": "previews/scatter.png",
"code": "figures/correlation/scatter/plot.R",
"data": "figures/correlation/scatter/data.csv",
"data_files": [
"figures/correlation/scatter/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/scatter/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/scatter/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/scatter",
"code_text": "# Scatter (house style): three groups, per-group fit with grey CI, R² and P per group in the panel.\n# Group names in the stat lines double as the legend. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nshow_regression <- TRUE\ncolour_by_group <- TRUE\nshow_density <- FALSE\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ngroup_order <- c(\"MCF7\", \"A549\", \"HepG2\")\ndf$group <- factor(df$group, levels = group_order)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# all three are >= 3:1 on white, so labels keep the group colour\npal <- c(MCF7 = hp[[\"blue\"]], A549 = hp[[\"red\"]], HepG2 = hp[[\"green\"]])\nfootnote <- \"Simulated data for illustration; not biological results\"\nif (!isTRUE(colour_by_group)) pal[] <- hp[[\"blue\"]]\n\nx_lim <- range(df$x) + c(-1, 1) * 0.04 * diff(range(df$x))\ny_lim <- c(min(df$y) - 0.04 * diff(range(df$y)), max(df$y) + 0.22 * diff(range(df$y)))\n\np <- ggplot(df, aes(x, y))\nif (isTRUE(show_density)) {\n p <- p + geom_density_2d(aes(colour = group), linewidth = pv_house_lw(\"minor\"), bins = 5)\n}\nif (isTRUE(show_regression)) {\n p <- p +\n geom_smooth(aes(group = group), method = \"lm\", formula = y ~ x, colour = NA,\n fill = grey[[\"ci\"]], alpha = 0.5) +\n geom_smooth(aes(colour = group), method = \"lm\", formula = y ~ x, se = FALSE,\n linewidth = pv_house_lw(\"emph\"))\n}\np <- p +\n geom_point(aes(fill = group), shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = \"black\")\n\nif (isTRUE(colour_by_group)) {\n st <- do.call(rbind, lapply(seq_along(group_order), function(i) {\n s <- summary(stats::lm(y ~ x, data = df[df$group == group_order[i], ]))\n data.frame(group = factor(group_order[i], levels = group_order), i = i,\n lab = sprintf(\"'%s '*italic(R)*'\\u00b2 = %.2f, '*%s\", group_order[i], s$r.squared,\n pv_fmt_p(stats::coef(s)[2, 4])))\n }))\n st$y <- y_lim[2] - (st$i - 0.5) * 0.065 * diff(y_lim)\n p <- p + geom_text(data = st, aes(x = x_lim[1] + 0.02 * diff(x_lim), y = y, label = lab, colour = group),\n parse = TRUE, hjust = 0, vjust = 0.5)\n}\n\np <- p +\n scale_colour_manual(values = pal) +\n scale_fill_manual(values = pal) +\n coord_cartesian(xlim = x_lim, ylim = y_lim, expand = FALSE) +\n labs(x = \"Gene A expression (log2 CPM)\", y = \"Gene B expression (log2 CPM)\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "scatter with regression\n回归散点图\nscatter\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n两个连续变量要看趋势，并按组别比较斜率时用。\nplot.r 顶部 show_regression 开关回归线和置信带；colour_by_group 是否按细胞系上色；show_density 叠加二维等高线。三组颜色在 pal 里换。\nscatter regression correlation\nx 自变量，这里是基因 a 的 log2 cpm（数值） y 因变量，这里是基因 b 的 log2 cpm（数值） group 样本来源细胞系（字符串）"
},
{
"title": "Scatter with marginal distributions",
"title_zh": "带边缘分布的散点图",
"slug": "scatter-marginal",
"category": "correlation",
"tags": [
"scatter",
"marginal",
"density",
"regression"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"x": "自变量，基因 A 的 log2 CPM（数值）",
"y": "因变量，基因 B 的 log2 CPM（数值）",
"group": "样本来源细胞系，三组（字符串）"
},
"when_to_use": "要同时看两个连续变量的组间相关，以及各变量在各组里的边缘分布时用。Use when a grouped scatter should also show each axis as a marginal density, histogram, or boxplot.",
"customize": "plot.R 顶部 marginal 选 density、histogram 或 boxplot，show_regression 显组别回归统计。data.csv 填 x、y 与 group。点形取 HOUSE_POINT，组色取 pv_palette(\"house\")。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "marginal",
"value": "\"density\""
},
{
"name": "show_regression",
"value": "TRUE"
},
{
"name": "marginal",
"value": "match.arg(marginal, c(\"density\", \"histogram\", \"boxplot\"))"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/correlation/scatter-marginal/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/scatter-marginal/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/scatter-marginal/plot.R"
},
{
"name": "data.csv",
"path": "figures/correlation/scatter-marginal/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/scatter-marginal/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/scatter-marginal/data.csv"
},
{
"name": "make_data.R",
"path": "figures/correlation/scatter-marginal/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/correlation/scatter-marginal/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/scatter-marginal/make_data.R"
}
],
"dir": "figures/correlation/scatter-marginal",
"preview": "figures/correlation/scatter-marginal/preview.png",
"docs_preview": "previews/scatter-marginal.png",
"code": "figures/correlation/scatter-marginal/plot.R",
"data": "figures/correlation/scatter-marginal/data.csv",
"data_files": [
"figures/correlation/scatter-marginal/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/scatter-marginal/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/correlation/scatter-marginal/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/correlation/scatter-marginal",
"code_text": "# Scatter with marginal density, histogram, or boxplot (house style). Reads data.csv only.\n# Per-group fits with grey CI; R² and P per group in the main panel double as the legend.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# --- adjustable ---\nmarginal <- \"density\" # density | histogram | boxplot\nshow_regression <- TRUE\n# ------------------\n\nmarginal <- match.arg(marginal, c(\"density\", \"histogram\", \"boxplot\"))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ngroup_order <- c(\"MCF7\", \"A549\", \"HepG2\")\ndf$group <- factor(df$group, levels = group_order)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npal <- c(MCF7 = hp[[\"blue\"]], A549 = hp[[\"red\"]], HepG2 = hp[[\"green\"]]) # all >= 3:1 on white\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nxr <- range(df$x); yr <- range(df$y)\nxlim <- xr + c(-0.04, 0.04) * diff(xr)\nylim <- c(yr[1] - 0.04 * diff(yr), yr[2] + 0.30 * diff(yr)) # headroom for the stat lines\n\nmargin_theme <- theme_house() +\n theme(axis.title = element_blank(), axis.title.x = element_blank(), axis.title.y = element_blank(),\n axis.text = element_blank(), axis.text.x = element_blank(), axis.text.y = element_blank(),\n axis.ticks = element_blank(),\n axis.ticks.length = unit(0, \"mm\"), panel.border = element_blank(),\n plot.margin = margin(0, 0, 0, 0))\n\nbuild_marginal <- function(along = c(\"x\", \"y\")) {\n along <- match.arg(along)\n lim <- if (along == \"x\") xlim else ylim\n if (marginal == \"boxplot\") {\n p <- if (along == \"x\") ggplot(df, aes(x = x, y = group, fill = group)) else\n ggplot(df, aes(x = group, y = y, fill = group))\n p <- p + geom_boxplot(width = 0.62, linewidth = pv_house_lw(\"ref\"), outlier.shape = NA, alpha = 0.6,\n colour = \"black\")\n } else {\n p <- if (along == \"x\") ggplot(df, aes(x = x, fill = group)) else ggplot(df, aes(y = y, fill = group))\n if (marginal == \"density\") {\n p <- p + geom_density(aes(colour = group), linewidth = pv_house_lw(1.2), alpha = 0.3, adjust = 0.85)\n } else {\n p <- p + geom_histogram(binwidth = diff(lim) / 18, boundary = lim[1], position = \"identity\",\n alpha = 0.4, colour = \"white\", linewidth = pv_house_lw(0.3))\n }\n }\n # variable axis: exact limits shared with the main panel; count/density axis: 8% headroom\n grow <- if (marginal == \"boxplot\") expansion(add = 0.6) else expansion(mult = c(0, 0.08))\n if (along == \"x\") {\n p <- p + scale_x_continuous(expand = c(0, 0)) + coord_cartesian(xlim = lim)\n p <- if (marginal == \"boxplot\") p + scale_y_discrete(expand = grow) else p + scale_y_continuous(expand = grow)\n } else {\n p <- p + scale_y_continuous(expand = c(0, 0)) + coord_cartesian(ylim = lim)\n p <- if (marginal == \"boxplot\") p + scale_x_discrete(expand = grow) else p + scale_x_continuous(expand = grow)\n }\n if (marginal == \"density\") p <- p + scale_colour_manual(values = pal)\n p + scale_fill_manual(values = pal) + margin_theme\n}\n\np_main <- ggplot(df, aes(x, y))\nif (isTRUE(show_regression)) {\n p_main <- p_main +\n geom_smooth(aes(group = group), method = \"lm\", formula = y ~ x, colour = NA,\n fill = grey[[\"ci\"]], alpha = 0.5) +\n geom_smooth(aes(colour = group), method = \"lm\", formula = y ~ x, se = FALSE,\n linewidth = pv_house_lw(\"emph\"))\n}\nst <- do.call(rbind, lapply(seq_along(group_order), function(i) {\n s <- summary(stats::lm(y ~ x, data = df[df$group == group_order[i], ]))\n data.frame(group = factor(group_order[i], levels = group_order), i = i,\n lab = sprintf(\"'%s '*italic(R)*'\\u00b2 = %.2f, '*%s\", group_order[i], s$r.squared,\n pv_fmt_p(stats::coef(s)[2, 4])))\n}))\nst$y <- ylim[2] - (st$i - 0.5) * 0.07 * diff(ylim)\np_main <- p_main +\n geom_point(aes(fill = group), shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = \"black\") +\n geom_text(data = st, aes(x = xlim[1] + 0.02 * diff(xlim), y = y, label = lab, colour = group),\n parse = TRUE, hjust = 0) +\n scale_colour_manual(values = pal) +\n scale_fill_manual(values = pal) +\n coord_cartesian(xlim = xlim, ylim = ylim, expand = FALSE) +\n labs(x = \"Gene A (log2 CPM)\", y = \"Gene B (log2 CPM)\") +\n theme_house()\n\np <- patchwork::wrap_plots(A = build_marginal(\"x\"), B = p_main, C = build_marginal(\"y\"),\n design = \"AAAAA#\\nBBBBBC\", heights = c(1, 4.2)) +\n patchwork::plot_annotation(caption = footnote, theme = theme(\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], family = house_family(),\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\", plot.margin = margin(0.4, 0.4, 0.9, 0.4, \"mm\")))\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "scatter with marginal distributions\n带边缘分布的散点图\nscatter-marginal\n\ncorrelation\n相关\nrelationship\n相关/关系\nrelationship\n要同时看两个连续变量的组间相关，以及各变量在各组里的边缘分布时用。use when a grouped scatter should also show each axis as a marginal density, histogram, or boxplot.\nplot.r 顶部 marginal 选 density、histogram 或 boxplot，show_regression 显组别回归统计。data.csv 填 x、y 与 group。点形取 house_point，组色取 pv_palette(\"house\")。\nscatter marginal density regression\nx 自变量，基因 a 的 log2 cpm（数值） y 因变量，基因 b 的 log2 cpm（数值） group 样本来源细胞系，三组（字符串）"
},
{
"title": "Expression trend",
"title_zh": "表达趋势图",
"slug": "expression-trend",
"category": "differential-expression",
"tags": [
"expression",
"time-course",
"trend"
],
"packages": [
"ggplot2"
],
"data_columns": {
"gene": "基因编号（字符串）",
"cluster": "趋势类群（字符串）",
"time": "时间，小时（数值）",
"value": "标准化表达（数值）"
},
"when_to_use": "时间序列基因已分成几种变化模式、要叠看单基因和类群均值时用。",
"customize": "Edit `facet_clusters` (default `TRUE`) in `plot.R` to split or overlay clusters, and `show_smooth` (default `TRUE`) to show cluster mean lines; supply `gene`, `cluster`, `time`, and `value` columns in `data.csv`.",
"lang": "R",
"task": "de",
"task_zh": "差异表达",
"task_en": "Differential expression",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "facet_clusters",
"value": "TRUE"
},
{
"name": "show_smooth",
"value": "TRUE"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/differential-expression/expression-trend/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/differential-expression/expression-trend/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/expression-trend/plot.R"
},
{
"name": "data.csv",
"path": "figures/differential-expression/expression-trend/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/differential-expression/expression-trend/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/expression-trend/data.csv"
},
{
"name": "make_data.R",
"path": "figures/differential-expression/expression-trend/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/differential-expression/expression-trend/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/expression-trend/make_data.R"
}
],
"dir": "figures/differential-expression/expression-trend",
"preview": "figures/differential-expression/expression-trend/preview.png",
"docs_preview": "previews/expression-trend.png",
"code": "figures/differential-expression/expression-trend/plot.R",
"data": "figures/differential-expression/expression-trend/data.csv",
"data_files": [
"figures/differential-expression/expression-trend/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/expression-trend/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/expression-trend/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/differential-expression/expression-trend",
"code_text": "# Expression trends by cluster (house style). Single genes in light grey, cluster means in house\n# colours. Faceted: one panel per cluster; overlaid: cluster names written at the line ends.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# --- adjustable ---\nfacet_clusters <- TRUE\nshow_smooth <- TRUE\n# ------------------\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$cluster <- factor(df$cluster, levels = unique(df$cluster))\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\ncols <- stats::setNames(unname(hp[seq_len(nlevels(df$cluster))]), levels(df$cluster))\n# names written on white: the cluster colour when it is >= 3:1 on white, else #1A1A1A\nname_cols <- stats::setNames(ifelse(cols %in% hp[c(\"orange\", \"sky\", \"gold\")], \"#1A1A1A\", cols), names(cols))\n\nmean_df <- stats::aggregate(value ~ cluster + time, df, mean)\n\np <- ggplot(df, aes(time, value, group = gene)) +\n geom_line(colour = grey[[\"light\"]], linewidth = pv_house_lw(\"minor\")) +\n scale_x_continuous(breaks = function(l) pretty(l, n = 4)) +\n labs(x = \"Time (h)\", y = \"Expression (z)\", caption = footnote) +\n theme_house() +\n theme(plot.margin = margin(1, 1, 1, 1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nif (isTRUE(show_smooth)) {\n p <- p + geom_line(data = mean_df, aes(time, value, colour = cluster, group = cluster),\n linewidth = pv_house_lw(\"main\"), inherit.aes = FALSE) +\n scale_colour_manual(values = cols, guide = \"none\")\n}\n\nif (isTRUE(facet_clusters)) {\n p <- p + facet_wrap(~cluster, ncol = 3) +\n theme(strip.background = element_blank(), panel.spacing = unit(1.5, \"mm\"))\n} else if (isTRUE(show_smooth)) {\n ends <- mean_df[mean_df$time == max(mean_df$time), , drop = FALSE]\n p <- p + geom_text(data = ends, aes(time, value, label = cluster), inherit.aes = FALSE,\n hjust = -0.1, size = pv_pt2size(7), colour = name_cols[as.character(ends$cluster)],\n family = house_family()) +\n coord_cartesian(clip = \"off\") +\n theme(plot.margin = margin(1, 14, 1, 1, \"mm\"))\n}\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "expression trend\n表达趋势图\nexpression-trend\n\ndifferential-expression\n差异表达\nde\n差异表达\ndifferential expression\n时间序列基因已分成几种变化模式、要叠看单基因和类群均值时用。\nedit `facet_clusters` (default `true`) in `plot.r` to split or overlay clusters, and `show_smooth` (default `true`) to show cluster mean lines; supply `gene`, `cluster`, `time`, and `value` columns in `data.csv`.\nexpression time-course trend\ngene 基因编号（字符串） cluster 趋势类群（字符串） time 时间，小时（数值） value 标准化表达（数值）"
},
{
"title": "MA plot",
"title_zh": "MA 图",
"slug": "ma-plot",
"category": "differential-expression",
"tags": [
"ma-plot",
"differential-expression",
"fold-change",
"差异基因"
],
"packages": [
"ggplot2",
"ggrepel"
],
"data_columns": {
"gene": "基因编号（字符串）",
"base_mean": "平均表达量（数值，正数）",
"log2fc": "log2 倍数变化（数值）",
"pvalue": "原始 p 值（数值，0 到 1）"
},
"when_to_use": "要同时看平均表达和倍数变化、并标出显著基因时用。",
"customize": "Set `lfc_cut` (default 1) and `p_cut` (default 0.01) in `plot.R` to define significant genes, and toggle `show_labels` (default `TRUE`) with `n_label` (default 5) to draw `geom_text` labels at fixed coordinates with straight leader lines and no `ggrepel`; supply `gene`, `base_mean`, `log2fc`, and `pvalue` columns in `data.csv`.",
"lang": "R",
"task": "de",
"task_zh": "差异表达",
"task_en": "Differential expression",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "lfc_cut",
"value": "1"
},
{
"name": "p_cut",
"value": "0.01"
},
{
"name": "show_labels",
"value": "TRUE"
},
{
"name": "n_label",
"value": "5"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/differential-expression/ma-plot/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/differential-expression/ma-plot/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/ma-plot/plot.R"
},
{
"name": "data.csv",
"path": "figures/differential-expression/ma-plot/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/differential-expression/ma-plot/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/ma-plot/data.csv"
},
{
"name": "make_data.R",
"path": "figures/differential-expression/ma-plot/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/differential-expression/ma-plot/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/ma-plot/make_data.R"
}
],
"dir": "figures/differential-expression/ma-plot",
"preview": "figures/differential-expression/ma-plot/preview.png",
"docs_preview": "previews/ma-plot.png",
"code": "figures/differential-expression/ma-plot/plot.R",
"data": "figures/differential-expression/ma-plot/data.csv",
"data_files": [
"figures/differential-expression/ma-plot/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/ma-plot/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/ma-plot/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/differential-expression/ma-plot",
"code_text": "# MA plot (house style). Up red, down blue, others light grey; counts in the panel, top genes named.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# --- adjustable ---\nlfc_cut <- 1\np_cut <- 0.01\nshow_labels <- TRUE\nn_label <- 5 # more than about 5 names do not fit a 1x1 panel at 7 pt\n# ------------------\nfootnote <- \"Simulated data;\\nnot biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$A <- log2(df$base_mean)\ndf$direction <- ifelse(\n df$pvalue >= p_cut | abs(df$log2fc) < lfc_cut, \"ns\",\n ifelse(df$log2fc > 0, \"up\", \"down\")\n)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\ncols <- c(ns = grey[[\"light\"]], up = hp[[\"red\"]], down = hp[[\"blue\"]])\ndf <- df[order(df$direction != \"ns\"), , drop = FALSE]\nn_up <- sum(df$direction == \"up\"); n_down <- sum(df$direction == \"down\")\n\np <- ggplot(df, aes(A, log2fc, colour = direction)) +\n geom_hline(yintercept = 0, linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_hline(yintercept = c(-lfc_cut, lfc_cut), linetype = \"dashed\",\n linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_point(size = 0.7, shape = 16) +\n # both counts sit in the empty lower-right corner, clear of the gene names above the cloud\n annotate(\"text\", x = Inf, y = -Inf, hjust = 1.08, vjust = -1.9, label = paste(\"Up\", n_up),\n colour = hp[[\"red\"]], size = pv_pt2size(7), family = house_family()) +\n annotate(\"text\", x = Inf, y = -Inf, hjust = 1.08, vjust = -0.5, label = paste(\"Down\", n_down),\n colour = hp[[\"blue\"]], size = pv_pt2size(7), family = house_family()) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_y_continuous(expand = expansion(mult = c(0.22, 0.24))) +\n labs(x = \"log2 mean expression\", y = \"log2 fold change\", caption = footnote) +\n theme_house() +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nif (isTRUE(show_labels) && n_label > 0) {\n lab <- df[df$direction != \"ns\", , drop = FALSE]\n lab <- lab[order(lab$pvalue, -abs(lab$log2fc)), , drop = FALSE]\n lab <- utils::head(lab, n_label)\n # Names are placed by hand (fixed coordinates, no repel solver), so the PDF and PNG\n # layouts are the same on every device. Each name sits beyond the point cloud and a\n # straight leader runs from the point to the near edge of the name. Positions are in\n # data units; a gene not listed below gets a default spot straight above or below it.\n pos <- data.frame(\n gene = c(\"G7133\", \"G1202\", \"G7004\", \"G5768\", \"G64\"),\n lx = c(-1.0, 6.5, 9.2, 13.3, 5.6),\n ly = c(7.5, 9.5, 7.0, 5.0, -7.0)\n )\n lab <- merge(lab, pos, by = \"gene\", all.x = TRUE, sort = FALSE)\n miss <- is.na(lab$lx)\n lab$lx[miss] <- lab$A[miss]\n lab$ly[miss] <- lab$log2fc[miss] + sign(lab$log2fc[miss]) * 3\n lab$vj <- ifelse(lab$ly > lab$log2fc, 0, 1) # name above (bottom-anchored) or below\n # leader stops a little short of the name\n gap <- 0.8\n lab$sy <- lab$ly - sign(lab$ly - lab$log2fc) * gap\n p <- p +\n geom_segment(data = lab, aes(x = A, y = log2fc, xend = lx, yend = sy), inherit.aes = FALSE,\n linewidth = 0.2, colour = grey[[\"dark\"]]) +\n # labelled genes get the house point outline\n geom_point(data = lab, aes(fill = direction), shape = HOUSE_POINT$shape, size = 1.2,\n stroke = HOUSE_POINT$stroke, colour = HOUSE_POINT$colour, show.legend = FALSE) +\n scale_fill_manual(values = cols, guide = \"none\") +\n geom_text(data = lab, aes(lx, ly, label = gene, vjust = vj), inherit.aes = FALSE,\n size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family())\n}\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "ma plot\nma 图\nma-plot\n\ndifferential-expression\n差异表达\nde\n差异表达\ndifferential expression\n要同时看平均表达和倍数变化、并标出显著基因时用。\nset `lfc_cut` (default 1) and `p_cut` (default 0.01) in `plot.r` to define significant genes, and toggle `show_labels` (default `true`) with `n_label` (default 5) to draw `geom_text` labels at fixed coordinates with straight leader lines and no `ggrepel`; supply `gene`, `base_mean`, `log2fc`, and `pvalue` columns in `data.csv`.\nma-plot differential-expression fold-change 差异基因\ngene 基因编号（字符串） base_mean 平均表达量（数值，正数） log2fc log2 倍数变化（数值） pvalue 原始 p 值（数值，0 到 1）"
},
{
"title": "Volcano plot",
"title_zh": "火山图",
"slug": "volcano",
"category": "differential-expression",
"tags": [
"volcano",
"differential-expression",
"fold-change",
"差异基因",
"log2FC"
],
"packages": [
"ggplot2"
],
"data_columns": {
"gene": "基因或特征编号（字符串）",
"log2_fold_change": "log2 倍数变化（数值）",
"pvalue": "原始 p 值（数值，0 到 1）"
},
"when_to_use": "两组比较要同时看倍数变化和显著性时用。",
"customize": "Modify `lfc_cut` (default 1) and `p_cut` (default 0.01) in `plot.R` and `plot.py` to set thresholds; supply `log2_fold_change` and `pvalue` columns in `data.csv` alongside `gene` (only as an identifier, not read by plotting code).",
"lang": "R",
"task": "de",
"task_zh": "差异表达",
"task_en": "Differential expression",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "lfc_cut",
"value": "1"
},
{
"name": "p_cut",
"value": "0.01"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/differential-expression/volcano/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/differential-expression/volcano/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/volcano/plot.R"
},
{
"name": "plot.py",
"path": "figures/differential-expression/volcano/plot.py",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/differential-expression/volcano/plot.py",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/volcano/plot.py"
},
{
"name": "data.csv",
"path": "figures/differential-expression/volcano/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/differential-expression/volcano/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/volcano/data.csv"
},
{
"name": "make_data.R",
"path": "figures/differential-expression/volcano/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/differential-expression/volcano/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/volcano/make_data.R"
}
],
"dir": "figures/differential-expression/volcano",
"preview": "figures/differential-expression/volcano/preview.png",
"docs_preview": "previews/volcano.png",
"code": "figures/differential-expression/volcano/plot.R",
"data": "figures/differential-expression/volcano/data.csv",
"data_files": [
"figures/differential-expression/volcano/data.csv"
],
"code_python": "figures/differential-expression/volcano/plot.py",
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/volcano/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/differential-expression/volcano/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/differential-expression/volcano",
"code_text": "# Volcano (house style). Up red, down blue, others light grey; counts written in the panel.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nlfc_cut <- 1\np_cut <- 0.01\nfootnote <- \"Simulated data;\\nnot biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$nlp <- -log10(df$pvalue)\ndf$direction <- ifelse(\n df$pvalue >= p_cut | abs(df$log2_fold_change) < lfc_cut, \"ns\",\n ifelse(df$log2_fold_change > 0, \"up\", \"down\")\n)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\ncols <- c(ns = grey[[\"light\"]], up = hp[[\"red\"]], down = hp[[\"blue\"]])\ndf <- df[order(df$direction != \"ns\"), , drop = FALSE] # significant points on top\nn_up <- sum(df$direction == \"up\"); n_down <- sum(df$direction == \"down\")\n\np <- ggplot(df, aes(log2_fold_change, nlp, colour = direction)) +\n geom_vline(xintercept = c(-lfc_cut, lfc_cut), linetype = \"dashed\",\n linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_hline(yintercept = -log10(p_cut), linetype = \"dashed\",\n linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_point(size = 0.7, shape = 16) +\n annotate(\"text\", x = -Inf, y = Inf, hjust = -0.08, vjust = 1.3, label = paste(\"Down\", n_down),\n colour = hp[[\"blue\"]], size = pv_pt2size(7), family = house_family()) +\n annotate(\"text\", x = Inf, y = Inf, hjust = 1.08, vjust = 1.3, label = paste(\"Up\", n_up),\n colour = hp[[\"red\"]], size = pv_pt2size(7), family = house_family()) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_y_continuous(expand = expansion(mult = c(0.02, 0.20))) +\n labs(x = \"log2 fold change\", y = \"-log10(p)\", caption = footnote) +\n theme_house() +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "volcano plot\n火山图\nvolcano\n\ndifferential-expression\n差异表达\nde\n差异表达\ndifferential expression\n两组比较要同时看倍数变化和显著性时用。\nmodify `lfc_cut` (default 1) and `p_cut` (default 0.01) in `plot.r` and `plot.py` to set thresholds; supply `log2_fold_change` and `pvalue` columns in `data.csv` alongside `gene` (only as an identifier, not read by plotting code).\nvolcano differential-expression fold-change 差异基因 log2fc\ngene 基因或特征编号（字符串） log2_fold_change log2 倍数变化（数值） pvalue 原始 p 值（数值，0 到 1）"
},
{
"title": "NMDS",
"title_zh": "非度量多维标度",
"slug": "nmds",
"category": "dimension-reduction",
"tags": [
"nmds",
"ordination",
"bray-curtis"
],
"packages": [
"ggplot2",
"MASS",
"ggrepel"
],
"data_columns": {
"sample": "样本编号（字符串）",
"group": "分组（字符串）",
"taxon": "分类单元（字符串）",
"abundance": "非负丰度（数值）"
},
"when_to_use": "距离矩阵不适合线性主坐标、只要看样本远近时用。",
"customize": "Replace the local `bray()` function in `plot.R` to change the distance metric; `data.csv` requires `sample`, `group`, `taxon`, and `abundance` columns, with group names drawn using `ggrepel` with a fixed seed.",
"lang": "R",
"task": "ordination",
"task_zh": "降维",
"task_en": "Dimension reduction",
"variant_of": "pca-biplot",
"variant_label": "NMDS",
"variants": [],
"parameters": [
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/dimension-reduction/nmds/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/nmds/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/nmds/plot.R"
},
{
"name": "data.csv",
"path": "figures/dimension-reduction/nmds/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/nmds/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/nmds/data.csv"
},
{
"name": "make_data.R",
"path": "figures/dimension-reduction/nmds/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/nmds/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/nmds/make_data.R"
}
],
"dir": "figures/dimension-reduction/nmds",
"preview": "figures/dimension-reduction/nmds/preview.png",
"docs_preview": "previews/nmds.png",
"code": "figures/dimension-reduction/nmds/plot.R",
"data": "figures/dimension-reduction/nmds/data.csv",
"data_files": [
"figures/dimension-reduction/nmds/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/nmds/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/nmds/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/dimension-reduction/nmds",
"code_text": "# NMDS from a Bray-Curtis matrix (house style). Group names written next to each group; the\n# stress value sits in the panel corner. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nfootnote <- \"Simulated data;\\nnot biological results\"\n\nbray <- function(x) {\n n <- nrow(x)\n d <- matrix(0, n, n)\n for (i in seq_len(n - 1)) {\n for (j in (i + 1):n) {\n num <- sum(abs(x[i, ] - x[j, ]))\n den <- sum(x[i, ] + x[j, ])\n d[i, j] <- d[j, i] <- num / den\n }\n }\n stats::as.dist(d)\n}\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nsamples <- unique(df$sample)\ntaxa <- unique(df$taxon)\nmat <- matrix(0, length(samples), length(taxa), dimnames = list(samples, taxa))\nmat[cbind(match(df$sample, samples), match(df$taxon, taxa))] <- df$abundance\ngroup <- df$group[match(samples, df$sample)]\nnm <- MASS::isoMDS(bray(mat), k = 2, trace = FALSE)\nplot_df <- data.frame(x = nm$points[, 1], y = nm$points[, 2], group = group)\nstress <- nm$stress / 100 # isoMDS reports stress in percent\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nlv <- unique(as.character(plot_df$group))\nplot_df$group <- factor(plot_df$group, levels = lv)\ncols <- stats::setNames(unname(hp[seq_along(lv)]), lv)\n# group names written on white: the group colour when it is >= 3:1 on white, else #1A1A1A\nname_cols <- stats::setNames(ifelse(cols %in% hp[c(\"orange\", \"sky\", \"gold\")], \"#1A1A1A\", cols), names(cols))\n# direct labels: each name sits centred just above its group's highest point\n# Each name starts above or below its group, whichever side has fewer points of the\n# other groups nearby; ggrepel then clears it from every point.\nyr <- diff(range(plot_df$y)); xr <- diff(range(plot_df$x))\nlabs_df <- do.call(rbind, lapply(lv, function(g) {\n s <- plot_df[plot_df$group == g, , drop = FALSE]\n o <- plot_df[plot_df$group != g, , drop = FALSE]\n top <- s[which.max(s$y), ]; bot <- s[which.min(s$y), ]\n crowd <- function(px, py) sum(abs(o$x - px) < 0.15 * xr & abs(o$y - py) < 0.15 * yr)\n up <- crowd(top$x, top$y + 0.1 * yr) <= crowd(bot$x, bot$y - 0.1 * yr)\n a <- if (up) top else bot\n data.frame(group = g, x = a$x, y = a$y, dir = if (up) 1 else -1)\n}))\nrep_df <- rbind(\n data.frame(x = labs_df$x, y = labs_df$y, lab = labs_df$group, col = unname(name_cols[labs_df$group]),\n ny = 0.07 * yr * labs_df$dir),\n data.frame(x = plot_df$x, y = plot_df$y, lab = \"\", col = \"#1A1A1A\", ny = 0)\n)\n\np <- ggplot(plot_df, aes(x, y, fill = group)) +\n geom_point(shape = HOUSE_POINT$shape, size = HOUSE_POINT$size, stroke = HOUSE_POINT$stroke,\n colour = HOUSE_POINT$colour) +\n # Names repel from every point (blank labels are obstacles), starting just above the group.\n # Fixed seed and iteration cap, no time cap (ggrepel defaults max.time to 0.5 s),\n # so the layout does not depend on machine speed.\n ggrepel::geom_text_repel(\n data = rep_df, aes(x, y, label = lab), inherit.aes = FALSE, colour = rep_df$col,\n size = pv_pt2size(7), family = house_family(), point.size = HOUSE_POINT$size,\n nudge_y = rep_df$ny, min.segment.length = Inf, box.padding = 0.2, point.padding = 0.15,\n force = 2, max.overlaps = Inf, max.iter = 20000, max.time = Inf, seed = 1, show.legend = FALSE\n ) +\n annotate(\"text\", x = Inf, y = Inf, hjust = 1.06, vjust = 1.3, label = sprintf(\"Stress %.3f\", stress),\n colour = \"#1A1A1A\", size = pv_pt2size(7), family = house_family()) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_y_continuous(expand = expansion(mult = c(0.16, 0.16))) +\n scale_x_continuous(expand = expansion(mult = 0.08)) +\n labs(x = \"NMDS1\", y = \"NMDS2\", caption = footnote) +\n theme_house() +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "nmds\n非度量多维标度\nnmds\nnmds\ndimension-reduction\n降维\nordination\n降维\ndimension reduction\n距离矩阵不适合线性主坐标、只要看样本远近时用。\nreplace the local `bray()` function in `plot.r` to change the distance metric; `data.csv` requires `sample`, `group`, `taxon`, and `abundance` columns, with group names drawn using `ggrepel` with a fixed seed.\nnmds ordination bray-curtis\nsample 样本编号（字符串） group 分组（字符串） taxon 分类单元（字符串） abundance 非负丰度（数值）"
},
{
"title": "OPLS-DA scores",
"title_zh": "OPLS-DA 得分图",
"slug": "opls-da",
"category": "dimension-reduction",
"tags": [
"opls-da",
"scores",
"permutation"
],
"packages": [
"ggplot2",
"patchwork",
"ggrepel"
],
"data_columns": {
"sample": "样本编号（字符串）",
"group": "分组（字符串）",
"pred": "预测成分得分（数值）",
"ortho": "正交成分得分（数值）",
"perm": "data_perm.csv 中的置换序号，1 为未置换模型（整数）",
"q2": "data_perm.csv 中的 Q2（数值）"
},
"when_to_use": "两组代谢或表型数据要看监督分离是否高于置换空分布时用。",
"customize": "Toggle `show_scores` (default `TRUE`), `show_permutation` (default `TRUE`), and `show_ellipse` (default `TRUE`) in `plot.R` to control panel assembly; supply `group`, `pred`, and `ortho` columns in `data.csv` alongside `sample` (only as an identifier, not read by plotting code), plus `perm` and `q2` columns in `data_perm.csv`.",
"lang": "R",
"task": "ordination",
"task_zh": "降维",
"task_en": "Dimension reduction",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_scores",
"value": "TRUE"
},
{
"name": "show_permutation",
"value": "TRUE"
},
{
"name": "show_ellipse",
"value": "TRUE"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/dimension-reduction/opls-da/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/opls-da/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/opls-da/plot.R"
},
{
"name": "data.csv",
"path": "figures/dimension-reduction/opls-da/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/opls-da/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/opls-da/data.csv"
},
{
"name": "make_data.R",
"path": "figures/dimension-reduction/opls-da/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/opls-da/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/opls-da/make_data.R"
},
{
"name": "data_perm.csv",
"path": "figures/dimension-reduction/opls-da/data_perm.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/opls-da/data_perm.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/opls-da/data_perm.csv"
}
],
"dir": "figures/dimension-reduction/opls-da",
"preview": "figures/dimension-reduction/opls-da/preview.png",
"docs_preview": "previews/opls-da.png",
"code": "figures/dimension-reduction/opls-da/plot.R",
"data": "figures/dimension-reduction/opls-da/data.csv",
"data_files": [
"figures/dimension-reduction/opls-da/data.csv",
"figures/dimension-reduction/opls-da/data_perm.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/opls-da/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/opls-da/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/dimension-reduction/opls-da",
"code_text": "# OPLS-DA scores and permutation diagnostic (house style). Group names written next to each\n# group; the permutation panel marks the observed Q2 and its permutation p. Panels joined with\n# patchwork. Reads data.csv and data_perm.csv. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# --- adjustable ---\nshow_scores <- TRUE\nshow_permutation <- TRUE\nshow_ellipse <- TRUE\n# ------------------\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nscores <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nperm <- utils::read.csv(\"data_perm.csv\", stringsAsFactors = FALSE)\nscores$group <- factor(scores$group, levels = unique(scores$group))\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\ncols <- stats::setNames(unname(hp[seq_len(nlevels(scores$group))]), levels(scores$group))\nname_cols <- stats::setNames(ifelse(cols %in% hp[c(\"orange\", \"sky\", \"gold\")], \"#1A1A1A\", cols), names(cols))\n\npanels <- list()\n\nif (isTRUE(show_scores)) {\n # Ellipse outlines (when drawn) are obstacles too: sample them from a throwaway build.\n ell <- NULL\n if (isTRUE(show_ellipse)) {\n eb <- ggplot_build(ggplot(scores, aes(pred, ortho, group = group)) + stat_ellipse(level = 0.8))$data[[1]]\n ell <- data.frame(pred = eb$x, ortho = eb$y, group = levels(scores$group)[eb$group])\n }\n labs_df <- do.call(rbind, lapply(levels(scores$group), function(g) {\n s <- scores[scores$group == g, , drop = FALSE]\n top <- max(c(s$ortho, ell$ortho[ell$group == g]))\n data.frame(group = g, pred = mean(range(s$pred)), ortho = top)\n }))\n oy <- diff(range(c(scores$ortho, ell$ortho)))\n rep_df <- rbind(\n data.frame(pred = labs_df$pred, ortho = labs_df$ortho, lab = labs_df$group,\n col = unname(name_cols[labs_df$group]), ny = 0.06 * oy),\n data.frame(pred = scores$pred, ortho = scores$ortho, lab = \"\", col = \"#1A1A1A\", ny = 0),\n if (!is.null(ell)) data.frame(pred = ell$pred, ortho = ell$ortho, lab = \"\", col = \"#1A1A1A\", ny = 0),\n # the two zero reference lines, sampled inside the data range as obstacles\n data.frame(pred = 0, ortho = seq(min(c(scores$ortho, ell$ortho)), max(c(scores$ortho, ell$ortho)), length.out = 60),\n lab = \"\", col = \"#1A1A1A\", ny = 0),\n data.frame(pred = seq(min(c(scores$pred, ell$pred)), max(c(scores$pred, ell$pred)), length.out = 60), ortho = 0,\n lab = \"\", col = \"#1A1A1A\", ny = 0)\n )\n p_scores <- ggplot(scores, aes(pred, ortho)) +\n geom_hline(yintercept = 0, linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_vline(xintercept = 0, linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_point(aes(fill = group), shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = HOUSE_POINT$colour) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_y_continuous(expand = expansion(mult = c(0.06, 0.22))) +\n labs(x = \"Predictive component\", y = \"Orthogonal component\") +\n theme_house()\n if (isTRUE(show_ellipse)) {\n p_scores <- p_scores + stat_ellipse(aes(colour = group), linewidth = pv_house_lw(\"main\"),\n level = 0.8, show.legend = FALSE)\n }\n p_scores <- p_scores +\n # names repel from every score point (blank labels are obstacles), starting above the group\n # Fixed seed and iteration cap, no time cap (ggrepel defaults max.time to 0.5 s),\n # so the layout does not depend on machine speed.\n ggrepel::geom_text_repel(data = rep_df, aes(pred, ortho, label = lab), inherit.aes = FALSE,\n colour = rep_df$col, size = pv_pt2size(7), family = house_family(),\n point.size = HOUSE_POINT$size, nudge_y = rep_df$ny, min.segment.length = Inf,\n box.padding = 0.4, point.padding = 0.3, force = 2, max.overlaps = Inf,\n max.iter = 20000, max.time = Inf, seed = 1, show.legend = FALSE)\n panels <- c(panels, list(p_scores))\n}\n\nif (isTRUE(show_permutation)) {\n obs <- perm$q2[perm$perm == 1]\n null <- perm[perm$perm != 1, , drop = FALSE]\n p_val <- (sum(null$q2 >= obs) + 1) / (nrow(null) + 1)\n p_perm <- ggplot(null, aes(q2)) +\n geom_histogram(bins = 18, fill = grey[[\"ci\"]], colour = \"white\", linewidth = 0.15) +\n geom_vline(xintercept = obs, linetype = \"dashed\", linewidth = pv_house_lw(\"main\"),\n colour = hp[[\"red\"]]) +\n annotate(\"text\", x = obs, y = Inf, vjust = 1.3, hjust = 1.08, size = pv_pt2size(7),\n colour = hp[[\"red\"]], family = house_family(),\n label = sprintf(\"Observed Q2 %.2f\\np = %s\", obs, format(signif(p_val, 2)))) +\n scale_x_continuous(expand = expansion(mult = c(0.08, 0.12))) +\n scale_y_continuous(expand = expansion(mult = c(0, 0.25))) +\n labs(x = \"Q2 (permuted labels)\", y = \"Permutations\") +\n theme_house()\n panels <- c(panels, list(p_perm))\n}\n\nif (length(panels) == 0) stop(\"enable show_scores or show_permutation\")\np <- wrap_plots(panels, nrow = 1) +\n plot_annotation(\n caption = footnote,\n theme = theme(text = element_text(family = house_family()),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n )\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "opls-da scores\nopls-da 得分图\nopls-da\n\ndimension-reduction\n降维\nordination\n降维\ndimension reduction\n两组代谢或表型数据要看监督分离是否高于置换空分布时用。\ntoggle `show_scores` (default `true`), `show_permutation` (default `true`), and `show_ellipse` (default `true`) in `plot.r` to control panel assembly; supply `group`, `pred`, and `ortho` columns in `data.csv` alongside `sample` (only as an identifier, not read by plotting code), plus `perm` and `q2` columns in `data_perm.csv`.\nopls-da scores permutation\nsample 样本编号（字符串） group 分组（字符串） pred 预测成分得分（数值） ortho 正交成分得分（数值） perm data_perm.csv 中的置换序号，1 为未置换模型（整数） q2 data_perm.csv 中的 q2（数值）"
},
{
"title": "PCA score plot",
"title_zh": "PCA 得分散点",
"slug": "pca-biplot",
"category": "dimension-reduction",
"tags": [
"pca",
"ordination",
"biplot"
],
"packages": [
"ggplot2",
"ggrepel"
],
"data_columns": {
"sample": "样本编号（字符串）",
"group": "分组（字符串）",
"pc1": "第一主成分得分（数值）",
"pc2": "第二主成分得分（数值）"
},
"when_to_use": "已有样本的主成分坐标、要按组看分离时用。",
"customize": "Adjust `point_size` (default 2.2) and `point_alpha` (default 0.85) in `plot.R`; supply `group`, `pc1`, and `pc2` columns in `data.csv` alongside `sample` (only as an identifier, not read by plotting code), drawing group names using `ggrepel` with a fixed seed.",
"lang": "R",
"task": "ordination",
"task_zh": "降维",
"task_en": "Dimension reduction",
"variant_of": null,
"variant_label": "PCA",
"variants": [
{
"slug": "pca-biplot",
"variant_label": "PCA",
"title": "PCA score plot",
"title_zh": "PCA 得分散点",
"docs_preview": "previews/pca-biplot.png"
},
{
"slug": "pcoa",
"variant_label": "PCoA",
"title": "PCoA",
"title_zh": "主坐标分析",
"docs_preview": "previews/pcoa.png"
},
{
"slug": "nmds",
"variant_label": "NMDS",
"title": "NMDS",
"title_zh": "非度量多维标度",
"docs_preview": "previews/nmds.png"
}
],
"parameters": [
{
"name": "point_size",
"value": "2.2"
},
{
"name": "point_alpha",
"value": "0.85"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/dimension-reduction/pca-biplot/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/pca-biplot/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/pca-biplot/plot.R"
},
{
"name": "data.csv",
"path": "figures/dimension-reduction/pca-biplot/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/pca-biplot/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/pca-biplot/data.csv"
},
{
"name": "make_data.R",
"path": "figures/dimension-reduction/pca-biplot/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/pca-biplot/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/pca-biplot/make_data.R"
}
],
"dir": "figures/dimension-reduction/pca-biplot",
"preview": "figures/dimension-reduction/pca-biplot/preview.png",
"docs_preview": "previews/pca-biplot.png",
"code": "figures/dimension-reduction/pca-biplot/plot.R",
"data": "figures/dimension-reduction/pca-biplot/data.csv",
"data_files": [
"figures/dimension-reduction/pca-biplot/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/pca-biplot/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/pca-biplot/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/dimension-reduction/pca-biplot",
"code_text": "# PCA score scatter (house style). House points filled by group; group names written next to\n# each group instead of a legend. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\npoint_size <- 2.2\npoint_alpha <- 0.85\nfootnote <- \"Simulated data;\\nnot biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nplot_df <- data.frame(x = df$pc1, y = df$pc2, group = df$group)\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nlv <- unique(as.character(plot_df$group))\nplot_df$group <- factor(plot_df$group, levels = lv)\ncols <- stats::setNames(unname(hp[seq_along(lv)]), lv)\n# group names written on white: the group colour when it is >= 3:1 on white, else #1A1A1A\nname_cols <- stats::setNames(ifelse(cols %in% hp[c(\"orange\", \"sky\", \"gold\")], \"#1A1A1A\", cols), names(cols))\n# direct labels: each name sits centred just above its group's highest point\n# Each name starts above or below its group, whichever side has fewer points of the\n# other groups nearby; ggrepel then clears it from every point.\nyr <- diff(range(plot_df$y)); xr <- diff(range(plot_df$x))\nlabs_df <- do.call(rbind, lapply(lv, function(g) {\n s <- plot_df[plot_df$group == g, , drop = FALSE]\n o <- plot_df[plot_df$group != g, , drop = FALSE]\n top <- s[which.max(s$y), ]; bot <- s[which.min(s$y), ]\n crowd <- function(px, py) sum(abs(o$x - px) < 0.15 * xr & abs(o$y - py) < 0.15 * yr)\n up <- crowd(top$x, top$y + 0.1 * yr) <= crowd(bot$x, bot$y - 0.1 * yr)\n a <- if (up) top else bot\n data.frame(group = g, x = a$x, y = a$y, dir = if (up) 1 else -1)\n}))\nrep_df <- rbind(\n data.frame(x = labs_df$x, y = labs_df$y, lab = labs_df$group, col = unname(name_cols[labs_df$group]),\n ny = 0.07 * yr * labs_df$dir),\n data.frame(x = plot_df$x, y = plot_df$y, lab = \"\", col = \"#1A1A1A\", ny = 0)\n)\n\np <- ggplot(plot_df, aes(x, y, fill = group)) +\n geom_point(shape = HOUSE_POINT$shape, size = point_size, stroke = HOUSE_POINT$stroke,\n colour = HOUSE_POINT$colour, alpha = point_alpha) +\n # Names repel from every point (blank labels are obstacles), starting just above the group.\n # Fixed seed and iteration cap, no time cap (ggrepel defaults max.time to 0.5 s),\n # so the layout does not depend on machine speed.\n ggrepel::geom_text_repel(\n data = rep_df, aes(x, y, label = lab), inherit.aes = FALSE, colour = rep_df$col,\n size = pv_pt2size(7), family = house_family(), point.size = point_size,\n nudge_y = rep_df$ny, min.segment.length = Inf, box.padding = 0.2, point.padding = 0.15,\n force = 2, max.overlaps = Inf, max.iter = 20000, max.time = Inf, seed = 1, show.legend = FALSE\n ) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_y_continuous(expand = expansion(mult = c(0.16, 0.16))) +\n scale_x_continuous(expand = expansion(mult = 0.08)) +\n labs(x = \"PC1\", y = \"PC2\", caption = footnote) +\n theme_house() +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "pca score plot\npca 得分散点\npca-biplot\npca\ndimension-reduction\n降维\nordination\n降维\ndimension reduction\n已有样本的主成分坐标、要按组看分离时用。\nadjust `point_size` (default 2.2) and `point_alpha` (default 0.85) in `plot.r`; supply `group`, `pc1`, and `pc2` columns in `data.csv` alongside `sample` (only as an identifier, not read by plotting code), drawing group names using `ggrepel` with a fixed seed.\npca ordination biplot\nsample 样本编号（字符串） group 分组（字符串） pc1 第一主成分得分（数值） pc2 第二主成分得分（数值）"
},
{
"title": "PCoA",
"title_zh": "主坐标分析",
"slug": "pcoa",
"category": "dimension-reduction",
"tags": [
"pcoa",
"ordination",
"bray-curtis"
],
"packages": [
"ggplot2",
"ggrepel"
],
"data_columns": {
"sample": "样本编号（字符串）",
"group": "分组（字符串）",
"taxon": "分类单元（字符串）",
"abundance": "非负丰度（数值）"
},
"when_to_use": "有样本×分类单元的丰度、要用距离看组间分离时用。",
"customize": "Replace the `bray()` function in `plot.R` to apply a different distance metric; fill `sample`, `group`, `taxon`, and `abundance` columns in `data.csv`, drawing group names using `ggrepel` with a fixed seed.",
"lang": "R",
"task": "ordination",
"task_zh": "降维",
"task_en": "Dimension reduction",
"variant_of": "pca-biplot",
"variant_label": "PCoA",
"variants": [],
"parameters": [
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/dimension-reduction/pcoa/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/pcoa/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/pcoa/plot.R"
},
{
"name": "data.csv",
"path": "figures/dimension-reduction/pcoa/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/pcoa/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/pcoa/data.csv"
},
{
"name": "make_data.R",
"path": "figures/dimension-reduction/pcoa/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/pcoa/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/pcoa/make_data.R"
}
],
"dir": "figures/dimension-reduction/pcoa",
"preview": "figures/dimension-reduction/pcoa/preview.png",
"docs_preview": "previews/pcoa.png",
"code": "figures/dimension-reduction/pcoa/plot.R",
"data": "figures/dimension-reduction/pcoa/data.csv",
"data_files": [
"figures/dimension-reduction/pcoa/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/pcoa/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/pcoa/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/dimension-reduction/pcoa",
"code_text": "# PCoA from a Bray-Curtis matrix (house style). Axis titles carry the share of variation;\n# group names written next to each group. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nfootnote <- \"Simulated data;\\nnot biological results\"\n\nbray <- function(x) {\n n <- nrow(x)\n d <- matrix(0, n, n)\n for (i in seq_len(n - 1)) {\n for (j in (i + 1):n) {\n num <- sum(abs(x[i, ] - x[j, ]))\n den <- sum(x[i, ] + x[j, ])\n d[i, j] <- d[j, i] <- num / den\n }\n }\n stats::as.dist(d)\n}\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nsamples <- unique(df$sample)\ntaxa <- unique(df$taxon)\nmat <- matrix(0, length(samples), length(taxa), dimnames = list(samples, taxa))\nmat[cbind(match(df$sample, samples), match(df$taxon, taxa))] <- df$abundance\ngroup <- df$group[match(samples, df$sample)]\npc <- stats::cmdscale(bray(mat), k = 2, eig = TRUE)\nplot_df <- data.frame(x = pc$points[, 1], y = pc$points[, 2], group = group)\neig_pos <- pc$eig[pc$eig > 0]\npct <- round(100 * pc$eig[1:2] / sum(eig_pos), 1)\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nlv <- unique(as.character(plot_df$group))\nplot_df$group <- factor(plot_df$group, levels = lv)\ncols <- stats::setNames(unname(hp[seq_along(lv)]), lv)\n# group names written on white: the group colour when it is >= 3:1 on white, else #1A1A1A\nname_cols <- stats::setNames(ifelse(cols %in% hp[c(\"orange\", \"sky\", \"gold\")], \"#1A1A1A\", cols), names(cols))\n# direct labels: each name sits centred just above its group's highest point\n# Each name starts above or below its group, whichever side has fewer points of the\n# other groups nearby; ggrepel then clears it from every point.\nyr <- diff(range(plot_df$y)); xr <- diff(range(plot_df$x))\nlabs_df <- do.call(rbind, lapply(lv, function(g) {\n s <- plot_df[plot_df$group == g, , drop = FALSE]\n o <- plot_df[plot_df$group != g, , drop = FALSE]\n top <- s[which.max(s$y), ]; bot <- s[which.min(s$y), ]\n crowd <- function(px, py) sum(abs(o$x - px) < 0.15 * xr & abs(o$y - py) < 0.15 * yr)\n up <- crowd(top$x, top$y + 0.1 * yr) <= crowd(bot$x, bot$y - 0.1 * yr)\n a <- if (up) top else bot\n data.frame(group = g, x = a$x, y = a$y, dir = if (up) 1 else -1)\n}))\nrep_df <- rbind(\n data.frame(x = labs_df$x, y = labs_df$y, lab = labs_df$group, col = unname(name_cols[labs_df$group]),\n ny = 0.07 * yr * labs_df$dir),\n data.frame(x = plot_df$x, y = plot_df$y, lab = \"\", col = \"#1A1A1A\", ny = 0)\n)\n\np <- ggplot(plot_df, aes(x, y, fill = group)) +\n geom_point(shape = HOUSE_POINT$shape, size = HOUSE_POINT$size, stroke = HOUSE_POINT$stroke,\n colour = HOUSE_POINT$colour) +\n # Names repel from every point (blank labels are obstacles), starting just above the group.\n # Fixed seed and iteration cap, no time cap (ggrepel defaults max.time to 0.5 s),\n # so the layout does not depend on machine speed.\n ggrepel::geom_text_repel(\n data = rep_df, aes(x, y, label = lab), inherit.aes = FALSE, colour = rep_df$col,\n size = pv_pt2size(7), family = house_family(), point.size = HOUSE_POINT$size,\n nudge_y = rep_df$ny, min.segment.length = Inf, box.padding = 0.2, point.padding = 0.15,\n force = 2, max.overlaps = Inf, max.iter = 20000, max.time = Inf, seed = 1, show.legend = FALSE\n ) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_y_continuous(expand = expansion(mult = c(0.16, 0.16))) +\n scale_x_continuous(expand = expansion(mult = 0.08)) +\n labs(x = sprintf(\"PCoA1 (%.1f%%)\", pct[1]), y = sprintf(\"PCoA2 (%.1f%%)\", pct[2]), caption = footnote) +\n theme_house() +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "pcoa\n主坐标分析\npcoa\npcoa\ndimension-reduction\n降维\nordination\n降维\ndimension reduction\n有样本×分类单元的丰度、要用距离看组间分离时用。\nreplace the `bray()` function in `plot.r` to apply a different distance metric; fill `sample`, `group`, `taxon`, and `abundance` columns in `data.csv`, drawing group names using `ggrepel` with a fixed seed.\npcoa ordination bray-curtis\nsample 样本编号（字符串） group 分组（字符串） taxon 分类单元（字符串） abundance 非负丰度（数值）"
},
{
"title": "Pseudotime trajectory",
"title_zh": "拟时序轨迹",
"slug": "trajectory",
"category": "dimension-reduction",
"tags": [
"trajectory",
"pseudotime",
"single-cell"
],
"packages": [
"ggplot2"
],
"data_columns": {
"cell": "细胞编号（字符串）",
"dim1": "第一维坐标（数值）",
"dim2": "第二维坐标（数值）",
"pseudotime": "拟时序，0 到 1（数值）",
"branch": "分支，trunk、fate-a 或 fate-b（字符串）"
},
"when_to_use": "要在低维嵌入上看细胞沿拟时序如何分叉时用。",
"customize": "Change `color_by` (default \"pseudotime\") and `show_path` (default `TRUE`) in `plot.R` to color points or draw median paths; supply `dim1`, `dim2`, `pseudotime`, and `branch` columns in `data.csv` alongside `cell` (only as an identifier, not read by plotting code).",
"lang": "R",
"task": "ordination",
"task_zh": "降维",
"task_en": "Dimension reduction",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "color_by",
"value": "\"pseudotime\""
},
{
"name": "show_path",
"value": "TRUE"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/dimension-reduction/trajectory/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/trajectory/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/trajectory/plot.R"
},
{
"name": "data.csv",
"path": "figures/dimension-reduction/trajectory/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/trajectory/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/trajectory/data.csv"
},
{
"name": "make_data.R",
"path": "figures/dimension-reduction/trajectory/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/trajectory/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/trajectory/make_data.R"
}
],
"dir": "figures/dimension-reduction/trajectory",
"preview": "figures/dimension-reduction/trajectory/preview.png",
"docs_preview": "previews/trajectory.png",
"code": "figures/dimension-reduction/trajectory/plot.R",
"data": "figures/dimension-reduction/trajectory/data.csv",
"data_files": [
"figures/dimension-reduction/trajectory/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/trajectory/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/trajectory/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/dimension-reduction/trajectory",
"code_text": "# Pseudotime trajectory (house style). Cells coloured by pseudotime (house_warm) or by branch;\n# the median path per branch is drawn on top and each branch is named at its end.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# --- adjustable ---\ncolor_by <- \"pseudotime\" # \"pseudotime\" or \"branch\"\nshow_path <- TRUE\n# ------------------\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$branch <- factor(df$branch, levels = c(\"trunk\", \"fate-a\", \"fate-b\"))\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nbcols <- c(\"trunk\" = grey[[\"dark\"]], \"fate-a\" = hp[[\"blue\"]], \"fate-b\" = hp[[\"red\"]])\n\npath_df <- do.call(rbind, lapply(split(df, df$branch), function(d) {\n d <- d[order(d$pseudotime), , drop = FALSE]\n if (nrow(d) < 12) return(NULL)\n bins <- cut(d$pseudotime, breaks = 8, include.lowest = TRUE)\n agg <- stats::aggregate(cbind(dim1, dim2, pseudotime) ~ bins, d, stats::median)\n agg$branch <- d$branch[1]\n agg\n}))\n\np <- ggplot(df, aes(dim1, dim2))\n\nif (color_by == \"branch\") {\n p <- p +\n geom_point(aes(fill = branch), shape = HOUSE_POINT$shape, size = 1.6,\n stroke = 0.2, colour = \"white\") +\n scale_fill_manual(values = bcols, guide = \"none\")\n} else {\n p <- p +\n geom_point(aes(fill = pseudotime), shape = HOUSE_POINT$shape, size = 1.6,\n stroke = 0.2, colour = \"white\") +\n scale_fill_gradientn(colours = pv_palette(\"house_warm\"), name = \"Pseudotime\",\n limits = c(0, 1), breaks = c(0, 0.5, 1)) +\n guides(fill = guide_colourbar(title.position = \"top\", title.hjust = 0,\n barwidth = unit(14, \"mm\"), barheight = unit(2, \"mm\")))\n}\n\nif (isTRUE(show_path) && !is.null(path_df)) {\n ends <- do.call(rbind, lapply(split(path_df, path_df$branch), function(d) d[which.max(d$pseudotime), , drop = FALSE]))\n ends <- ends[ends$branch != \"trunk\", , drop = FALSE]\n # each branch name goes just outside its own cloud: above it when the branch ends high, else below\n start_y <- path_df$dim2[which.min(path_df$pseudotime)]\n cells_y <- split(df$dim2, df$branch)\n ends$up <- ends$dim2 >= start_y\n ends$dim2 <- ifelse(ends$up, vapply(as.character(ends$branch), function(b) max(cells_y[[b]]), 0),\n vapply(as.character(ends$branch), function(b) min(cells_y[[b]]), 0))\n ends$vj <- ifelse(ends$up, -0.8, 1.8)\n # branch names take the branch colour when it is >= 3:1 on white, else #1A1A1A\n contrast_ok <- function(h) {\n v <- grDevices::col2rgb(h)[, 1] / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n 1.05 / (sum(c(0.2126, 0.7152, 0.0722) * v) + 0.05) >= 3\n }\n ends$col <- vapply(as.character(ends$branch), function(b) {\n h <- bcols[[b]]; if (contrast_ok(h)) h else \"#1A1A1A\"\n }, \"\")\n p <- p + geom_path(data = path_df, aes(dim1, dim2, group = branch), colour = \"#1A1A1A\",\n linewidth = pv_house_lw(\"main\"), inherit.aes = FALSE) +\n geom_text(data = ends, aes(dim1, dim2, label = branch, vjust = vj), inherit.aes = FALSE,\n size = pv_pt2size(7), family = house_family(), colour = ends$col)\n}\n\np <- p +\n scale_y_continuous(expand = expansion(mult = c(0.1, 0.1))) +\n labs(x = \"Component 1\", y = \"Component 2\", caption = footnote) +\n theme_house() +\n theme(legend.position = \"inside\", legend.position.inside = c(0.02, 0.02),\n legend.justification.inside = c(0, 0), legend.direction = \"horizontal\",\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "pseudotime trajectory\n拟时序轨迹\ntrajectory\n\ndimension-reduction\n降维\nordination\n降维\ndimension reduction\n要在低维嵌入上看细胞沿拟时序如何分叉时用。\nchange `color_by` (default \"pseudotime\") and `show_path` (default `true`) in `plot.r` to color points or draw median paths; supply `dim1`, `dim2`, `pseudotime`, and `branch` columns in `data.csv` alongside `cell` (only as an identifier, not read by plotting code).\ntrajectory pseudotime single-cell\ncell 细胞编号（字符串） dim1 第一维坐标（数值） dim2 第二维坐标（数值） pseudotime 拟时序，0 到 1（数值） branch 分支，trunk、fate-a 或 fate-b（字符串）"
},
{
"title": "UMAP and t-SNE",
"title_zh": "UMAP / t-SNE",
"slug": "umap-tsne",
"category": "dimension-reduction",
"tags": [
"umap",
"tsne",
"embedding",
"single-cell"
],
"packages": [
"ggplot2",
"ggrepel"
],
"data_columns": {
"cell": "细胞或样本编号（字符串）",
"cluster": "聚类标签（字符串）",
"dim1": "第一维坐标（数值）",
"dim2": "第二维坐标（数值）",
"method": "嵌入方法，UMAP 或 t-SNE（字符串）"
},
"when_to_use": "要看非线性降维后的类群是否分开时用。",
"customize": "Modify `method_keep` (default \"both\") and toggle `show_labels` (default `TRUE`) in `plot.R` to filter embeddings and draw cluster names via `ggrepel` with a fixed seed; supply `cluster`, `dim1`, `dim2`, and `method` columns in `data.csv` alongside `cell` (only as an identifier, not read by plotting code).",
"lang": "R",
"task": "ordination",
"task_zh": "降维",
"task_en": "Dimension reduction",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "method_keep",
"value": "\"both\""
},
{
"name": "show_labels",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/dimension-reduction/umap-tsne/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/umap-tsne/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/umap-tsne/plot.R"
},
{
"name": "data.csv",
"path": "figures/dimension-reduction/umap-tsne/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/umap-tsne/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/umap-tsne/data.csv"
},
{
"name": "make_data.R",
"path": "figures/dimension-reduction/umap-tsne/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/dimension-reduction/umap-tsne/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/umap-tsne/make_data.R"
}
],
"dir": "figures/dimension-reduction/umap-tsne",
"preview": "figures/dimension-reduction/umap-tsne/preview.png",
"docs_preview": "previews/umap-tsne.png",
"code": "figures/dimension-reduction/umap-tsne/plot.R",
"data": "figures/dimension-reduction/umap-tsne/data.csv",
"data_files": [
"figures/dimension-reduction/umap-tsne/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/umap-tsne/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/dimension-reduction/umap-tsne/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/dimension-reduction/umap-tsne",
"code_text": "# UMAP / t-SNE (house style). Clusters in house colours; cluster names written next to each cloud\n# in the cluster colour (#1A1A1A when that colour is < 3:1 on white). Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# --- adjustable ---\nmethod_keep <- \"both\" # \"UMAP\", \"t-SNE\", or \"both\"\nshow_labels <- TRUE\n# ------------------\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nif (method_keep != \"both\") {\n df <- df[df$method == method_keep, , drop = FALSE]\n}\ndf$cluster <- factor(df$cluster, levels = unique(df$cluster))\ndf$method <- factor(df$method, levels = intersect(c(\"UMAP\", \"t-SNE\"), unique(df$method)))\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\ncols <- stats::setNames(unname(hp[seq_len(nlevels(df$cluster))]), levels(df$cluster))\nname_cols <- stats::setNames(ifelse(cols %in% hp[c(\"orange\", \"sky\", \"gold\")], \"#1A1A1A\", cols), names(cols))\nfootnote <- \"Simulated data for illustration; not biological results\"\n\np <- ggplot2::ggplot(df, ggplot2::aes(dim1, dim2, colour = cluster)) +\n ggplot2::geom_point(size = 0.8, shape = 16) +\n ggplot2::scale_colour_manual(values = cols, name = NULL) +\n ggplot2::labs(x = \"Dimension 1\", y = \"Dimension 2\", caption = footnote) +\n theme_house() +\n ggplot2::theme(\n legend.position = if (isTRUE(show_labels)) \"none\" else \"right\",\n legend.key.size = ggplot2::unit(3, \"mm\"),\n strip.background = ggplot2::element_blank(),\n plot.margin = ggplot2::margin(1, 2.5, 1, 1, \"mm\"),\n plot.caption = ggplot2::element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = ggplot2::margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\"\n )\n\nif (nlevels(df$method) > 1) {\n p <- p + ggplot2::facet_wrap(~method, scales = \"free\")\n}\n\nif (isTRUE(show_labels)) {\n centres <- stats::aggregate(cbind(dim1, dim2) ~ cluster + method, df, stats::median)\n centres$nudge_x <- 0\n centres$nudge_y <- 0\n # Place each label just outside its own cloud. Coordinates are method-specific.\n u_c1 <- centres$method == \"UMAP\" & centres$cluster == \"C1\"\n u_c2 <- centres$method == \"UMAP\" & centres$cluster == \"C2\"\n u_c3 <- centres$method == \"UMAP\" & centres$cluster == \"C3\"\n u_c4 <- centres$method == \"UMAP\" & centres$cluster == \"C4\"\n u_c5 <- centres$method == \"UMAP\" & centres$cluster == \"C5\"\n centres$nudge_x[u_c1] <- -1.1\n centres$nudge_y[u_c1] <- -2.0\n centres$nudge_y[u_c2] <- -2.8\n centres$nudge_x[u_c3] <- -2.2\n centres$nudge_y[u_c3] <- 0.9\n # Right of the cloud. An upward nudge lands back on the points once the\n # label is kept inside the panel.\n centres$nudge_x[u_c4] <- 1.8\n centres$nudge_y[u_c4] <- 0.15\n centres$nudge_x[u_c5] <- 1.7\n centres$nudge_y[u_c5] <- 0.55\n t_c1 <- centres$method == \"t-SNE\" & centres$cluster == \"C1\"\n t_c2 <- centres$method == \"t-SNE\" & centres$cluster == \"C2\"\n t_c3 <- centres$method == \"t-SNE\" & centres$cluster == \"C3\"\n t_c4 <- centres$method == \"t-SNE\" & centres$cluster == \"C4\"\n t_c5 <- centres$method == \"t-SNE\" & centres$cluster == \"C5\"\n centres$nudge_x[t_c1] <- -12\n centres$nudge_y[t_c2] <- 13\n centres$nudge_x[t_c3] <- -12\n centres$nudge_y[t_c3] <- 1.2\n centres$nudge_y[t_c4] <- -12\n centres$nudge_y[t_c5] <- -10\n # Every cell is a blank-label obstacle, so names keep clear of all points.\n rep_df <- rbind(\n data.frame(dim1 = centres$dim1, dim2 = centres$dim2, method = centres$method,\n lab = as.character(centres$cluster), col = unname(name_cols[as.character(centres$cluster)]),\n nudge_x = centres$nudge_x, nudge_y = centres$nudge_y),\n data.frame(dim1 = df$dim1, dim2 = df$dim2, method = df$method, lab = \"\", col = \"#1A1A1A\",\n nudge_x = 0, nudge_y = 0)\n )\n p <- p +\n ggplot2::scale_x_continuous(expand = ggplot2::expansion(mult = c(0.20, 0.28))) +\n ggplot2::scale_y_continuous(expand = ggplot2::expansion(mult = 0.20)) +\n # Fixed seed and iteration cap, no time cap (ggrepel defaults max.time to 0.5 s),\n # so the layout does not depend on machine speed.\n ggrepel::geom_text_repel(\n data = rep_df,\n ggplot2::aes(dim1, dim2, label = lab),\n colour = rep_df$col,\n point.size = 0.8,\n size = pv_pt2size(7),\n family = house_family(),\n inherit.aes = FALSE,\n nudge_x = rep_df$nudge_x,\n nudge_y = rep_df$nudge_y,\n min.segment.length = Inf,\n segment.size = 0.2,\n segment.colour = grey[[\"dark\"]],\n box.padding = 0.25,\n point.padding = 0.15,\n force = 1,\n force_pull = 0,\n max.iter = 20000, max.time = Inf,\n max.overlaps = Inf,\n seed = 11,\n show.legend = FALSE\n )\n}\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "umap and t-sne\numap / t-sne\numap-tsne\n\ndimension-reduction\n降维\nordination\n降维\ndimension reduction\n要看非线性降维后的类群是否分开时用。\nmodify `method_keep` (default \"both\") and toggle `show_labels` (default `true`) in `plot.r` to filter embeddings and draw cluster names via `ggrepel` with a fixed seed; supply `cluster`, `dim1`, `dim2`, and `method` columns in `data.csv` alongside `cell` (only as an identifier, not read by plotting code).\numap tsne embedding single-cell\ncell 细胞或样本编号（字符串） cluster 聚类标签（字符串） dim1 第一维坐标（数值） dim2 第二维坐标（数值） method 嵌入方法，umap 或 t-sne（字符串）"
},
{
"title": "Beeswarm plot",
"title_zh": "蜂群图",
"slug": "beeswarm",
"category": "distribution",
"tags": [
"beeswarm",
"distribution",
"significance"
],
"packages": [
"ggplot2",
"ggbeeswarm"
],
"data_columns": {
"sample": "样本编号（字符串）",
"group": "剂量组（字符串）",
"value": "响应值（数值）"
},
"when_to_use": "样本量中等、想看每个点又不想堆成一条线时用。",
"customize": "plot.R 顶部 show_signif 标差异，use_facet 开关分面，group_levels 定剂量组序，comparisons 选比较对。data.csv 提供 sample、group 和 value 列。点色用 pv_palette(\"house\")。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": "raincloud",
"variant_label": "Beeswarm",
"variants": [],
"parameters": [
{
"name": "show_signif",
"value": "TRUE"
},
{
"name": "use_facet",
"value": "FALSE"
},
{
"name": "group_levels",
"value": "c(\"Ctrl\", \"Dose1\", \"Dose2\", \"Dose3\")"
},
{
"name": "comparisons",
"value": "list(c(\"Ctrl\", \"Dose1\"), c(\"Dose2\", \"Dose3\"))"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/beeswarm/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/beeswarm/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/beeswarm/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/beeswarm/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/beeswarm/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/beeswarm/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/beeswarm/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/beeswarm/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/beeswarm/make_data.R"
}
],
"dir": "figures/distribution/beeswarm",
"preview": "figures/distribution/beeswarm/preview.png",
"docs_preview": "previews/beeswarm.png",
"code": "figures/distribution/beeswarm/plot.R",
"data": "figures/distribution/beeswarm/data.csv",
"data_files": [
"figures/distribution/beeswarm/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/beeswarm/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/beeswarm/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/beeswarm",
"code_text": "# Beeswarm (house style): quasirandom shape-21 points, median bar, Wilcoxon P over brackets,\n# n per group in the group colour. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nshow_signif <- TRUE\nuse_facet <- FALSE\ngroup_levels <- c(\"Ctrl\", \"Dose1\", \"Dose2\", \"Dose3\")\ncomparisons <- list(c(\"Ctrl\", \"Dose1\"), c(\"Dose2\", \"Dose3\"))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_levels)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue, red, green, purple: all >= 3:1 on white, so n labels keep the group colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]],\n hp[[\"brown\"]], hp[[\"magenta\"]])[seq_along(group_levels)], group_levels)\nfootnote <- \"Simulated data for illustration; not biological results\"\nraw_point <- utils::modifyList(HOUSE_POINT, list(size = 1.4))\npanel_of <- function(g) factor(ifelse(as.character(g) %in% group_levels[1:2], \"Low dose\", \"High dose\"),\n levels = c(\"Low dose\", \"High dose\"))\ndf$panel <- panel_of(df$group)\n\nrng <- range(df$value)\nstep <- diff(rng) * 0.1\nn_y <- rng[1] - 0.08 * diff(rng)\nst <- data.frame(group = factor(group_levels, levels = group_levels),\n n = as.integer(table(df$group)[group_levels]),\n med = vapply(group_levels, function(g) stats::median(df$value[df$group == g]), numeric(1)))\nst$panel <- panel_of(st$group)\n\np <- ggplot(df, aes(group, value)) +\n ggbeeswarm::geom_quasirandom(aes(fill = group), shape = raw_point$shape, size = raw_point$size,\n stroke = raw_point$stroke, colour = \"black\", alpha = 0.8, width = 0.3) +\n geom_errorbar(data = st, aes(x = group, ymin = med, ymax = med), inherit.aes = FALSE, width = 0.5,\n linewidth = pv_house_lw(\"emph\")) +\n geom_text(data = st, aes(x = group, y = n_y, label = paste0(\"n = \", n), colour = group),\n inherit.aes = FALSE) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_y_continuous(expand = c(0, 0)) +\n labs(x = NULL, y = \"Response\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\ny_top <- rng[2] + step\nif (isTRUE(show_signif)) {\n br <- do.call(rbind, lapply(comparisons, function(pair) {\n sub <- droplevels(df[df$group %in% pair, ])\n data.frame(x = match(pair[1], group_levels), xend = match(pair[2], group_levels),\n y = max(sub$value) + step * 0.6, panel = panel_of(pair[1]),\n label = pv_fmt_p(stats::wilcox.test(value ~ group, data = sub)$p.value))\n }))\n if (isTRUE(use_facet)) br[, c(\"x\", \"xend\")] <- br[, c(\"x\", \"xend\")] - 2 * (br$panel == \"High dose\")\n y_top <- max(br$y) + step * 1.6\n p <- p +\n geom_segment(data = br, aes(x = x, xend = xend, y = y, yend = y), inherit.aes = FALSE,\n linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = br, aes(x = x, xend = x, y = y, yend = y - step * 0.3), inherit.aes = FALSE,\n linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = br, aes(x = xend, xend = xend, y = y, yend = y - step * 0.3), inherit.aes = FALSE,\n linewidth = pv_house_lw(\"ref\")) +\n geom_text(data = br, aes(x = (x + xend) / 2, y = y + step * 0.25, label = label), parse = TRUE,\n vjust = 0, inherit.aes = FALSE)\n}\np <- p + coord_cartesian(ylim = c(n_y - 0.07 * diff(rng), y_top))\n\nif (isTRUE(use_facet)) {\n p <- p + facet_wrap(~panel, scales = \"free_x\")\n}\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "beeswarm plot\n蜂群图\nbeeswarm\nbeeswarm\ndistribution\n分布\ndistribution\n分布\ndistribution\n样本量中等、想看每个点又不想堆成一条线时用。\nplot.r 顶部 show_signif 标差异，use_facet 开关分面，group_levels 定剂量组序，comparisons 选比较对。data.csv 提供 sample、group 和 value 列。点色用 pv_palette(\"house\")。\nbeeswarm distribution significance\nsample 样本编号（字符串） group 剂量组（字符串） value 响应值（数值）"
},
{
"title": "Density plot",
"title_zh": "密度图",
"slug": "density",
"category": "distribution",
"tags": [
"density",
"distribution"
],
"packages": [
"ggplot2",
"ggrepel"
],
"data_columns": {
"group": "品系或组别（字符串）",
"value": "测量值（数值）"
},
"when_to_use": "要在同一坐标上比较几组平滑分布，并标出主峰位置时用。",
"customize": "plot.R 顶部 show_mode_labels 标主峰位置，group_levels 设品系或组别顺序，fill_alpha 调平滑分布透明度。data.csv 填入 group 与 value 列。色彩取自 pv_palette(\"house\")。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_mode_labels",
"value": "TRUE"
},
{
"name": "group_levels",
"value": "c(\"Line A\", \"Line B\", \"Line C\", \"Line D\")"
},
{
"name": "fill_alpha",
"value": "0.25"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/density/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/density/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/density/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/density/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/density/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/density/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/density/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/density/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/density/make_data.R"
}
],
"dir": "figures/distribution/density",
"preview": "figures/distribution/density/preview.png",
"docs_preview": "previews/density.png",
"code": "figures/distribution/density/plot.R",
"data": "figures/distribution/density/data.csv",
"data_files": [
"figures/distribution/density/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/density/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/density/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/density",
"code_text": "# Grouped densities (house style): filled curves, group names at the peaks in the group colour,\n# Kruskal-Wallis P in the panel. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nshow_mode_labels <- TRUE\ngroup_levels <- c(\"Line A\", \"Line B\", \"Line C\", \"Line D\")\nfill_alpha <- 0.25\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_levels)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue, red, green, purple: all >= 3:1 on white, so peak labels keep the group colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]])[seq_along(group_levels)],\n group_levels)\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nmodes <- do.call(rbind, lapply(group_levels, function(g) {\n d <- stats::density(df$value[df$group == g], n = 512)\n i <- which.max(d$y)\n data.frame(group = factor(g, levels = group_levels), x = d$x[i], y = d$y[i])\n}))\nkw <- stats::kruskal.test(value ~ group, data = df)$p.value\ny_top <- max(modes$y) * 1.22\n\np <- ggplot(df, aes(value, colour = group, fill = group)) +\n geom_density(alpha = fill_alpha, linewidth = pv_house_lw(1.4)) +\n annotate(\"text\", x = -Inf, y = Inf, hjust = -0.06, vjust = 1.4, parse = TRUE,\n label = paste0(\"'Kruskal-Wallis '*\", pv_fmt_p(kw))) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, y_top), expand = c(0, 0)) +\n labs(x = \"Measurement\", y = \"Density\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nif (isTRUE(show_mode_labels)) {\n # Fixed seed and iteration cap, no time cap (ggrepel defaults max.time to 0.5 s),\n # so the layout does not depend on machine speed.\n p <- p + ggrepel::geom_text_repel(data = modes, aes(x, y, label = group, colour = group),\n inherit.aes = FALSE, nudge_y = 0.04 * y_top, direction = \"x\",\n min.segment.length = Inf, box.padding = 0.15, seed = 45,\n max.iter = 10000, max.time = Inf,\n ylim = c(NA, y_top * 0.9))\n} else {\n key <- data.frame(group = factor(group_levels, levels = group_levels), i = seq_along(group_levels))\n p <- p + geom_text(data = key, aes(x = Inf, y = Inf, label = group, colour = group), hjust = 1.08,\n vjust = 1.4 * key$i, inherit.aes = FALSE)\n}\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "density plot\n密度图\ndensity\n\ndistribution\n分布\ndistribution\n分布\ndistribution\n要在同一坐标上比较几组平滑分布，并标出主峰位置时用。\nplot.r 顶部 show_mode_labels 标主峰位置，group_levels 设品系或组别顺序，fill_alpha 调平滑分布透明度。data.csv 填入 group 与 value 列。色彩取自 pv_palette(\"house\")。\ndensity distribution\ngroup 品系或组别（字符串） value 测量值（数值）"
},
{
"title": "Empirical CDF",
"title_zh": "经验累积分布",
"slug": "ecdf",
"category": "distribution",
"tags": [
"ecdf",
"cumulative",
"distribution"
],
"packages": [
"ggplot2"
],
"data_columns": {
"sample": "观测编号（字符串）",
"group": "组别（字符串）",
"value": "观测值（数值）"
},
"when_to_use": "要在同一坐标上比较多组累积分布、看整体偏移或尾部差异时用。",
"customize": "plot.R 顶部 line_width 改线条粗细，show_legend 开关面板内图例，group_levels 设定组别。data.csv 填入 sample、group 和 value 列。多组累积分布线取 pv_palette(\"house\")。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "line_width",
"value": "pv_house_lw(\"main\")"
},
{
"name": "show_legend",
"value": "TRUE"
},
{
"name": "group_levels",
"value": "c(\"Group A\", \"Group B\", \"Group C\")"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/ecdf/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/ecdf/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/ecdf/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/ecdf/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/ecdf/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/ecdf/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/ecdf/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/ecdf/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/ecdf/make_data.R"
}
],
"dir": "figures/distribution/ecdf",
"preview": "figures/distribution/ecdf/preview.png",
"docs_preview": "previews/ecdf.png",
"code": "figures/distribution/ecdf/plot.R",
"data": "figures/distribution/ecdf/data.csv",
"data_files": [
"figures/distribution/ecdf/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/ecdf/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/ecdf/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/ecdf",
"code_text": "# Multi-group ECDF (house style): step lines, dashed median guide, group names with medians as a\n# coloured key inside the panel. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nline_width <- pv_house_lw(\"main\") # 1.5 pt\nshow_legend <- TRUE # coloured key (group name + median) inside the panel\ngroup_levels <- c(\"Group A\", \"Group B\", \"Group C\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_levels)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue, red, green: all >= 3:1 on white, so the key keeps the group colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]])[seq_along(group_levels)],\n group_levels)\nfootnote <- \"Simulated data for illustration;\\nnot biological results\"\nmed <- data.frame(group = factor(group_levels, levels = group_levels), i = seq_along(group_levels),\n m = vapply(group_levels, function(g) stats::median(df$value[df$group == g]), numeric(1)))\nmed$lab <- sprintf(\"%s %.2f\", med$group, med$m)\n\np <- ggplot(df, aes(value, colour = group)) +\n geom_hline(yintercept = 0.5, linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n stat_ecdf(linewidth = line_width, pad = FALSE) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_y_continuous(limits = c(0, 1), breaks = c(0, 0.5, 1), expand = expansion(add = 0.02)) +\n labs(x = \"Value\", y = \"Cumulative fraction\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nx0 <- min(df$value)\nif (isTRUE(show_legend)) {\n p <- p +\n annotate(\"text\", x = x0, y = Inf, label = \"Median\", hjust = 0, vjust = 1.4) +\n geom_text(data = med, aes(x = x0, y = Inf, label = lab, colour = group), hjust = 0,\n vjust = 1.4 + 1.25 * med$i, inherit.aes = FALSE)\n}\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "empirical cdf\n经验累积分布\necdf\n\ndistribution\n分布\ndistribution\n分布\ndistribution\n要在同一坐标上比较多组累积分布、看整体偏移或尾部差异时用。\nplot.r 顶部 line_width 改线条粗细，show_legend 开关面板内图例，group_levels 设定组别。data.csv 填入 sample、group 和 value 列。多组累积分布线取 pv_palette(\"house\")。\necdf cumulative distribution\nsample 观测编号（字符串） group 组别（字符串） value 观测值（数值）"
},
{
"title": "Histogram",
"title_zh": "直方图",
"slug": "histogram",
"category": "distribution",
"tags": [
"histogram",
"distribution",
"density"
],
"packages": [
"ggplot2"
],
"data_columns": {
"group": "组别（字符串）",
"value": "测量值（数值）"
},
"when_to_use": "要看一两个组的取值频数，并对照分布形状时用。",
"customize": "plot.R 顶部 layout 选 mirrored 或 facet，show_density 加密度曲线，n_bins 调分箱数，group_levels 定组别。data.csv 提供 group 和 value 列。色彩取 pv_palette(\"house\")。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "layout",
"value": "\"mirrored\""
},
{
"name": "show_density",
"value": "TRUE"
},
{
"name": "n_bins",
"value": "26"
},
{
"name": "group_levels",
"value": "c(\"Control\", \"Case\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/histogram/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/histogram/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/histogram/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/histogram/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/histogram/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/histogram/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/histogram/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/histogram/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/histogram/make_data.R"
}
],
"dir": "figures/distribution/histogram",
"preview": "figures/distribution/histogram/preview.png",
"docs_preview": "previews/histogram.png",
"code": "figures/distribution/histogram/plot.R",
"data": "figures/distribution/histogram/data.csv",
"data_files": [
"figures/distribution/histogram/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/histogram/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/histogram/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/histogram",
"code_text": "# Mirrored or faceted histograms (house style), optional density overlay in the group colour,\n# group names and means written in the panel. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nlayout <- \"mirrored\" # mirrored | facet\nshow_density <- TRUE\nn_bins <- 26\ngroup_levels <- c(\"Control\", \"Case\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_levels)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue and red: both >= 3:1 on white, so the labels keep the group colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]]), group_levels)\nfootnote <- \"Simulated data for illustration; not biological results\"\nbreaks <- seq(min(df$value) - 0.2, max(df$value) + 0.2, length.out = n_bins + 1)\nbin_w <- diff(breaks)[1]\n\nhist_one <- function(values, group) {\n h <- graphics::hist(values, breaks = breaks, plot = FALSE)\n data.frame(group = group, x = h$mids, count = h$counts, stringsAsFactors = FALSE)\n}\ntabs <- do.call(rbind, lapply(group_levels, function(g) hist_one(df$value[df$group == g], g)))\ntabs$group <- factor(tabs$group, levels = group_levels)\ndens_one <- function(values, group, sign = 1) {\n d <- stats::density(values, n = 200)\n data.frame(group = group, x = d$x, y = sign * d$y * length(values) * bin_w, stringsAsFactors = FALSE)\n}\ninfo <- data.frame(group = factor(group_levels, levels = group_levels),\n m = vapply(group_levels, function(g) mean(df$value[df$group == g]), numeric(1)),\n s = vapply(group_levels, function(g) stats::sd(df$value[df$group == g]), numeric(1)),\n n = as.integer(table(df$group)[group_levels]))\ninfo$lab <- sprintf(\"%s: mean %.2f \\u00b1 %.2f (n = %d)\", info$group, info$m, info$s, info$n)\npw <- stats::wilcox.test(value ~ group, data = df)$p.value\ncap_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nif (layout == \"mirrored\") {\n tabs$y <- ifelse(tabs$group == group_levels[2], -tabs$count, tabs$count)\n ymax <- max(abs(tabs$y)) * 1.25\n info$y <- c(ymax, -ymax) * 0.97\n p <- ggplot(tabs, aes(x, y, fill = group)) +\n geom_col(width = bin_w, colour = \"white\", linewidth = pv_house_lw(0.3), alpha = 0.6) +\n geom_hline(yintercept = 0, linewidth = pv_house_lw(\"ref\"))\n if (isTRUE(show_density)) {\n dens <- rbind(dens_one(df$value[df$group == group_levels[1]], group_levels[1], 1),\n dens_one(df$value[df$group == group_levels[2]], group_levels[2], -1))\n p <- p + geom_line(data = dens, aes(x, y, colour = group), inherit.aes = FALSE,\n linewidth = pv_house_lw(1.2))\n }\n p <- p +\n geom_text(data = info, aes(x = -Inf, y = y, label = lab, colour = group), hjust = -0.03,\n vjust = c(1, 0), inherit.aes = FALSE) +\n annotate(\"text\", x = Inf, y = ymax * 0.97, hjust = 1.05, vjust = 1, parse = TRUE,\n label = paste0(\"'Wilcoxon '*\", pv_fmt_p(pw))) +\n scale_y_continuous(limits = c(-ymax, ymax), labels = function(b) format(abs(b)), expand = c(0, 0))\n} else {\n info$y <- max(tabs$count) * 1.3 * 0.97\n p <- ggplot(tabs, aes(x, count, fill = group)) +\n geom_col(width = bin_w, colour = \"white\", linewidth = pv_house_lw(0.3), alpha = 0.6) +\n facet_wrap(~group, ncol = 1) +\n theme(strip.text = element_blank())\n if (isTRUE(show_density)) {\n dens <- do.call(rbind, lapply(group_levels, function(g) dens_one(df$value[df$group == g], g, 1)))\n dens$group <- factor(dens$group, levels = group_levels)\n p <- p + geom_line(data = dens, aes(x, y, colour = group), inherit.aes = FALSE,\n linewidth = pv_house_lw(1.2))\n }\n p <- p +\n geom_text(data = info, aes(x = -Inf, y = y, label = lab, colour = group), hjust = -0.03, vjust = 1, inherit.aes = FALSE) +\n scale_y_continuous(limits = c(0, max(tabs$count) * 1.3), expand = c(0, 0))\n}\np <- p +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n labs(x = \"Measurement\", y = \"Count\", caption = footnote) +\n theme_house() + cap_theme\nif (layout == \"facet\") p <- p + theme(strip.text = element_blank())\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "histogram\n直方图\nhistogram\n\ndistribution\n分布\ndistribution\n分布\ndistribution\n要看一两个组的取值频数，并对照分布形状时用。\nplot.r 顶部 layout 选 mirrored 或 facet，show_density 加密度曲线，n_bins 调分箱数，group_levels 定组别。data.csv 提供 group 和 value 列。色彩取 pv_palette(\"house\")。\nhistogram distribution density\ngroup 组别（字符串） value 测量值（数值）"
},
{
"title": "Density curves with group means (house style)",
"title_zh": "分组密度曲线与均值（house 风格）",
"slug": "house-density",
"category": "distribution",
"tags": [
"density",
"distribution",
"kruskal-wallis",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"group": "分组（字符串，≤4 组）",
"days": "数值（此例为开花到转色天数）"
},
"when_to_use": "2–4 组连续数值比较分布形状时用；半透明填充 + 同色轮廓，均值用同色虚线并在线顶写组名和数值，Kruskal–Wallis P 写在角落。",
"customize": "plot.R 顶部 group_order 定组序与配色；bw_adjust 调平滑度；x_limits 调 x 范围。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 1×1 格（43 × 43 mm），字号保持 7/8 pt（只有单个 2×2 面板才由 pv_save_house() 自动 +2 pt）。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "group_order",
"value": "c(\"Wild\", \"Wine\", \"Table\")"
},
{
"name": "bw_adjust",
"value": "1.1"
},
{
"name": "x_limits",
"value": "c(38, 78)"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/house-density/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/house-density/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/house-density/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/house-density/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/house-density/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/house-density/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/house-density/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/house-density/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/house-density/make_data.R"
}
],
"dir": "figures/distribution/house-density",
"preview": "figures/distribution/house-density/preview.png",
"docs_preview": "previews/house-density.png",
"code": "figures/distribution/house-density/plot.R",
"data": "figures/distribution/house-density/data.csv",
"data_files": [
"figures/distribution/house-density/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/house-density/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/house-density/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/house-density",
"code_text": "# House-style density: filled curves, dashed group means with labels, Kruskal–Wallis P in the panel.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\ngroup_order <- c(\"Wild\", \"Wine\", \"Table\")\nbw_adjust <- 1.1\nx_limits <- c(38, 78)\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\npal <- pv_palette(\"house\")\ncols <- c(Wild = pal[[\"green\"]], Wine = pal[[\"red\"]], Table = pal[[\"blue\"]])\ndf$group <- factor(df$group, levels = group_order)\n\nmu <- data.frame(group = factor(group_order, levels = group_order),\n m = vapply(group_order, function(g) mean(df$days[df$group == g]), numeric(1)))\npeak <- vapply(group_order, function(g) {\n dd <- stats::density(df$days[df$group == g], adjust = bw_adjust); max(dd$y)\n}, numeric(1))\nmu$ly <- peak + 0.006\nord <- order(mu$m)\nmu$hj <- 0.5\nmu$hj[ord[1]] <- 1.08\nmu$hj[ord[length(ord)]] <- -0.08\nkw <- stats::kruskal.test(days ~ group, data = df)$p.value\ny_top <- ceiling((max(mu$ly) + 0.032) * 100) / 100\n\np <- ggplot(df, aes(days)) +\n geom_density(aes(colour = group, fill = group), linewidth = pv_house_lw(1.4), adjust = bw_adjust,\n alpha = 0.25) +\n geom_rug(aes(colour = group), length = unit(1.2, \"mm\"), linewidth = pv_house_lw(0.3), alpha = 0.3) +\n geom_segment(data = mu, aes(x = m, xend = m, y = 0, yend = ly - 0.002, colour = group), linetype = \"22\",\n linewidth = pv_house_lw(0.7)) +\n geom_text(data = mu, aes(x = m, y = ly, label = sprintf(\"%s\\n%.0f d\", group, m), colour = group,\n hjust = hj), vjust = 0, size = pv_pt2size(7), lineheight = 0.9,\n fontface = \"bold\") +\n annotate(\"text\", x = x_limits[1] + 1, y = y_top * 0.98, hjust = 0, vjust = 1, parse = TRUE,\n label = paste0(\"'Kruskal\\u2013Wallis '*\", pv_fmt_p(kw)), size = pv_pt2size(7)) +\n scale_colour_manual(values = cols) +\n scale_fill_manual(values = cols) +\n scale_x_continuous(limits = x_limits, breaks = seq(40, 75, 10), expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, y_top), breaks = seq(0, y_top, 0.05), expand = c(0, 0)) +\n labs(x = \"Flowering to v\\u00e9raison (d)\", y = \"Density\") +\n theme_house()\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "density curves with group means (house style)\n分组密度曲线与均值（house 风格）\nhouse-density\n\ndistribution\n分布\ndistribution\n分布\ndistribution\n2–4 组连续数值比较分布形状时用；半透明填充 + 同色轮廓，均值用同色虚线并在线顶写组名和数值，kruskal–wallis p 写在角落。\nplot.r 顶部 group_order 定组序与配色；bw_adjust 调平滑度；x_limits 调 x 范围。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 1×1 格（43 × 43 mm），字号保持 7/8 pt（只有单个 2×2 面板才由 pv_save_house() 自动 +2 pt）。\ndensity distribution kruskal-wallis house-style\ngroup 分组（字符串，≤4 组） days 数值（此例为开花到转色天数）"
},
{
"title": "Raincloud plot (house style)",
"title_zh": "雨云图（house 风格）",
"slug": "house-raincloud",
"category": "distribution",
"tags": [
"raincloud",
"violin",
"boxplot",
"wilcoxon",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"group": "分组（字符串）",
"heterozygosity_pct": "每个样品的数值（此例为杂合度 %）"
},
"when_to_use": "几组连续数值比较分布时用；半小提琴 + 窄箱 + 抖动点，相邻两组的 Wilcoxon P 用括号线写在上方，每组 n 写在底部。",
"customize": "plot.R 顶部 group_order 定组序与配色；violin_width 调半小提琴宽；box_half_width 调箱宽；box_alpha 为箱体透明度（0.5–0.7）；tail_cut 为半小提琴尾部延伸的带宽倍数；raw_point 为抖动点规格（HOUSE_POINT 改 size 为 1.6，范围 1.2–1.6）。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 1×1 格（43 × 43 mm），字号保持 7/8 pt（只有单个 2×2 面板才由 pv_save_house() 自动 +2 pt）。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "group_order",
"value": "c(\"Wild\", \"Wine\", \"Table\")"
},
{
"name": "violin_width",
"value": "0.42"
},
{
"name": "box_half_width",
"value": "0.055"
},
{
"name": "box_alpha",
"value": "0.6"
},
{
"name": "tail_cut",
"value": "1.5"
},
{
"name": "raw_point",
"value": "utils::modifyList(HOUSE_POINT, list(size = 1.6))"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/house-raincloud/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/house-raincloud/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/house-raincloud/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/house-raincloud/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/house-raincloud/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/house-raincloud/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/house-raincloud/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/house-raincloud/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/house-raincloud/make_data.R"
}
],
"dir": "figures/distribution/house-raincloud",
"preview": "figures/distribution/house-raincloud/preview.png",
"docs_preview": "previews/house-raincloud.png",
"code": "figures/distribution/house-raincloud/plot.R",
"data": "figures/distribution/house-raincloud/data.csv",
"data_files": [
"figures/distribution/house-raincloud/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/house-raincloud/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/house-raincloud/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/house-raincloud",
"code_text": "# House-style raincloud: half violin + narrow box + jittered points, Wilcoxon P between neighbours.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\ngroup_order <- c(\"Wild\", \"Wine\", \"Table\")\nviolin_width <- 0.42\nbox_half_width <- 0.055\nbox_alpha <- 0.6 # box fill alpha 0.5–0.7\ntail_cut <- 1.5 # density tails run tail_cut bandwidths past the data (tapered, not trimmed flat)\n# jitter overlay (style-contract.md, points): HOUSE_POINT with size 1.6 (1.2–1.6), alpha 0.7\nraw_point <- utils::modifyList(HOUSE_POINT, list(size = 1.6))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\npal <- pv_palette(\"house\")\ncols <- c(Wild = pal[[\"green\"]], Wine = pal[[\"red\"]], Table = pal[[\"blue\"]])\ndf$x <- match(df$group, group_order)\n\nhv <- do.call(rbind, lapply(group_order, function(g) {\n y <- df$heterozygosity_pct[df$group == g]\n dd <- stats::density(y, n = 256, cut = tail_cut)\n data.frame(group = g, y = c(dd$x, rev(dd$x)),\n x = c(dd$y / max(dd$y) * violin_width, rep(0, 256)) + match(g, group_order) + 0.08)\n}))\nset.seed(7)\ndf$xj <- df$x - 0.22 + stats::runif(nrow(df), -0.09, 0.09)\nst <- do.call(rbind, lapply(group_order, function(g) {\n y <- df$heterozygosity_pct[df$group == g]\n q <- stats::quantile(y, c(0.25, 0.5, 0.75)); iqr <- q[3] - q[1]\n data.frame(group = g, x = match(g, group_order), q1 = q[1], q2 = q[2], q3 = q[3],\n lo = max(min(y), q[1] - 1.5 * iqr), hi = min(max(y), q[3] + 1.5 * iqr), n = length(y))\n}))\n# y range follows the full density tails, so no half violin is cut flat by the limits\n# n labels get their own band under the lowest tail, centred on the group ticks\ny_lo <- floor(min(hv$y)) - 3.5\nn_y <- y_lo + 1.4\npw <- function(a, b) stats::wilcox.test(df$heterozygosity_pct[df$group == a],\n df$heterozygosity_pct[df$group == b])$p.value\ntop_of <- function(g) max(hv$y[hv$group %in% g], df$heterozygosity_pct[df$group %in% g])\nbr_y2 <- top_of(c(\"Wine\", \"Table\")) + 1.6\nbr_y1 <- max(top_of(c(\"Wild\", \"Wine\")) + 1.6, br_y2 + 3.4)\nbr <- data.frame(x0 = c(1, 2), x1 = c(2, 3), y = c(br_y1, br_y2),\n lab = c(pv_fmt_p(pw(\"Wild\", \"Wine\")), pv_fmt_p(pw(\"Wine\", \"Table\"))))\n\np <- ggplot() +\n geom_polygon(data = hv, aes(x, y, group = group, fill = group), alpha = 0.6, colour = NA) +\n geom_point(data = df, aes(xj, heterozygosity_pct, fill = group), shape = raw_point$shape,\n size = raw_point$size, stroke = raw_point$stroke, colour = \"black\", alpha = 0.7) +\n geom_segment(data = st, aes(x = x, xend = x, y = lo, yend = hi), linewidth = pv_house_lw(\"ref\")) +\n geom_rect(data = st, aes(xmin = x - box_half_width, xmax = x + box_half_width, ymin = q1, ymax = q3,\n fill = group), alpha = box_alpha, colour = \"black\",\n linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = st, aes(x = x - box_half_width, xend = x + box_half_width, y = q2, yend = q2),\n linewidth = pv_house_lw(0.8), colour = \"black\") +\n geom_segment(data = br, aes(x = x0, xend = x1, y = y, yend = y), linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = br, aes(x = x0, xend = x0, y = y, yend = y - 0.8), linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = br, aes(x = x1, xend = x1, y = y, yend = y - 0.8), linewidth = pv_house_lw(\"ref\")) +\n geom_text(data = br, aes(x = (x0 + x1) / 2, y = y + 0.5, label = lab), parse = TRUE, vjust = 0,\n size = pv_pt2size(7)) +\n geom_text(data = st, aes(x = x, y = n_y, label = paste0(\"n = \", n), colour = group),\n size = pv_pt2size(6)) +\n scale_colour_manual(values = cols) +\n scale_fill_manual(values = cols) +\n scale_x_continuous(breaks = seq_along(group_order), labels = group_order, limits = c(0.55, 3.62),\n expand = c(0, 0)) +\n scale_y_continuous(limits = c(y_lo, br_y1 + 3.6), breaks = seq(15, 45, 10), expand = c(0, 0)) +\n labs(x = NULL, y = \"Heterozygosity (%)\") +\n theme_house()\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "raincloud plot (house style)\n雨云图（house 风格）\nhouse-raincloud\n\ndistribution\n分布\ndistribution\n分布\ndistribution\n几组连续数值比较分布时用；半小提琴 + 窄箱 + 抖动点，相邻两组的 wilcoxon p 用括号线写在上方，每组 n 写在底部。\nplot.r 顶部 group_order 定组序与配色；violin_width 调半小提琴宽；box_half_width 调箱宽；box_alpha 为箱体透明度（0.5–0.7）；tail_cut 为半小提琴尾部延伸的带宽倍数；raw_point 为抖动点规格（house_point 改 size 为 1.6，范围 1.2–1.6）。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 1×1 格（43 × 43 mm），字号保持 7/8 pt（只有单个 2×2 面板才由 pv_save_house() 自动 +2 pt）。\nraincloud violin boxplot wilcoxon house-style\ngroup 分组（字符串） heterozygosity_pct 每个样品的数值（此例为杂合度 %）"
},
{
"title": "Normal QQ plot",
"title_zh": "正态 QQ 图",
"slug": "qq-plot",
"category": "distribution",
"tags": [
"qq",
"normality",
"diagnostic",
"distribution"
],
"packages": [
"ggplot2"
],
"data_columns": {
"sample": "观测编号（字符串）",
"value": "观测值（数值）"
},
"when_to_use": "检查单变量是否近似正态、或看尾部偏离时用。",
"customize": "plot.R 顶部 point_size 和 point_alpha 调点的大小和透明度，show_ref_line 开关正态参考线。data.csv 填 sample 与 value 观测值。单变量点形 HOUSE_POINT，取 pv_palette(\"house\") 蓝。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "point_size",
"value": "1.6"
},
{
"name": "point_alpha",
"value": "0.7"
},
{
"name": "show_ref_line",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/qq-plot/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/qq-plot/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/qq-plot/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/qq-plot/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/qq-plot/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/qq-plot/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/qq-plot/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/qq-plot/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/qq-plot/make_data.R"
}
],
"dir": "figures/distribution/qq-plot",
"preview": "figures/distribution/qq-plot/preview.png",
"docs_preview": "previews/qq-plot.png",
"code": "figures/distribution/qq-plot/plot.R",
"data": "figures/distribution/qq-plot/data.csv",
"data_files": [
"figures/distribution/qq-plot/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/qq-plot/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/qq-plot/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/qq-plot",
"code_text": "# Normal QQ plot (house style): shape-21 points, dashed quartile reference line,\n# Shapiro-Wilk P and n in the panel. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\npoint_size <- 1.6 # 400 points: smaller shape-21 points\npoint_alpha <- 0.7 # STYLE §5: 200-2000 points -> alpha 0.6-0.8\nshow_ref_line <- TRUE\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nx <- sort(as.numeric(df$value))\nn <- length(x)\n# Blom plotting positions\nprob <- (seq_len(n) - 0.375) / (n + 0.25)\nqq <- data.frame(theoretical = stats::qnorm(prob), sample = x)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration;\\nnot biological results\"\nsw <- stats::shapiro.test(x)$p.value\n\np <- ggplot(qq, aes(theoretical, sample))\nif (isTRUE(show_ref_line)) {\n qy <- stats::quantile(x, c(0.25, 0.75), names = FALSE, type = 7)\n qx <- stats::qnorm(c(0.25, 0.75))\n slope <- diff(qy) / diff(qx)\n p <- p + geom_abline(intercept = qy[1] - slope * qx[1], slope = slope, linetype = \"22\",\n linewidth = pv_house_lw(\"ref\"), colour = \"black\")\n}\np <- p +\n geom_point(shape = HOUSE_POINT$shape, size = point_size, stroke = HOUSE_POINT$stroke,\n colour = \"black\", fill = hp[[\"blue\"]], alpha = point_alpha) +\n annotate(\"text\", x = min(qq$theoretical), y = Inf, hjust = 0, vjust = 1.25, parse = TRUE,\n label = paste0(\"'Shapiro-Wilk '*\", pv_fmt_p(sw))) +\n annotate(\"text\", x = min(qq$theoretical), y = Inf, hjust = 0, vjust = 2.6, label = sprintf(\"n = %d\", n)) +\n scale_y_continuous(expand = expansion(mult = c(0.04, 0.2))) +\n labs(x = \"Theoretical quantiles\", y = \"Sample quantiles\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "normal qq plot\n正态 qq 图\nqq-plot\n\ndistribution\n分布\ndistribution\n分布\ndistribution\n检查单变量是否近似正态、或看尾部偏离时用。\nplot.r 顶部 point_size 和 point_alpha 调点的大小和透明度，show_ref_line 开关正态参考线。data.csv 填 sample 与 value 观测值。单变量点形 house_point，取 pv_palette(\"house\") 蓝。\nqq normality diagnostic distribution\nsample 观测编号（字符串） value 观测值（数值）"
},
{
"title": "Raincloud plot",
"title_zh": "云雨图",
"slug": "raincloud",
"category": "distribution",
"tags": [
"raincloud",
"distribution",
"boxplot"
],
"packages": [
"ggplot2"
],
"data_columns": {
"sample": "样本编号（字符串）",
"group": "剂量或处理组（字符串）",
"value": "响应分数（数值）"
},
"when_to_use": "要在同一张图里看原始点、箱线摘要和分布形状时用。",
"customize": "plot.R 顶部 show_signif 标比较对，use_facet 定分面，group_levels 设剂量组序，comparisons 选比较列表。data.csv 给 sample、group 和 value 列。云雨组色取 pv_palette(\"house\")。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": null,
"variant_label": "Raincloud",
"variants": [
{
"slug": "raincloud",
"variant_label": "Raincloud",
"title": "Raincloud plot",
"title_zh": "云雨图",
"docs_preview": "previews/raincloud.png"
},
{
"slug": "violin",
"variant_label": "Violin",
"title": "Violin plot",
"title_zh": "小提琴图",
"docs_preview": "previews/violin.png"
},
{
"slug": "beeswarm",
"variant_label": "Beeswarm",
"title": "Beeswarm plot",
"title_zh": "蜂群图",
"docs_preview": "previews/beeswarm.png"
},
{
"slug": "grouped-boxplot-signif",
"variant_label": "Boxplot",
"title": "Grouped boxplot with significance",
"title_zh": "分组箱线图与显著性",
"docs_preview": "previews/grouped-boxplot-signif.png"
},
{
"slug": "split-violin",
"variant_label": "Split",
"title": "Split violin",
"title_zh": "分半小提琴图",
"docs_preview": "previews/split-violin.png"
}
],
"parameters": [
{
"name": "show_signif",
"value": "TRUE"
},
{
"name": "use_facet",
"value": "FALSE"
},
{
"name": "group_levels",
"value": "c(\"Ctrl\", \"Low\", \"Mid\", \"High\")"
},
{
"name": "comparisons",
"value": "list(c(\"Ctrl\", \"Low\"), c(\"Mid\", \"High\"))"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/raincloud/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/raincloud/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/raincloud/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/raincloud/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/raincloud/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/raincloud/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/raincloud/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/raincloud/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/raincloud/make_data.R"
}
],
"dir": "figures/distribution/raincloud",
"preview": "figures/distribution/raincloud/preview.png",
"docs_preview": "previews/raincloud.png",
"code": "figures/distribution/raincloud/plot.R",
"data": "figures/distribution/raincloud/data.csv",
"data_files": [
"figures/distribution/raincloud/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/raincloud/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/raincloud/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/raincloud",
"code_text": "# Raincloud (house style): half density + narrow box + jittered shape-21 points, Wilcoxon P over\n# brackets, n per group in the group colour. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nshow_signif <- TRUE\nuse_facet <- FALSE\ngroup_levels <- c(\"Ctrl\", \"Low\", \"Mid\", \"High\")\ncomparisons <- list(c(\"Ctrl\", \"Low\"), c(\"Mid\", \"High\"))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_levels)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue, red, green, purple: all >= 3:1 on white, so n labels keep the group colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]],\n hp[[\"brown\"]], hp[[\"magenta\"]])[seq_along(group_levels)], group_levels)\nfootnote <- \"Simulated data for illustration; not biological results\"\nraw_point <- utils::modifyList(HOUSE_POINT, list(size = 1.4))\ndf$x <- as.numeric(df$group)\nset.seed(42)\ndf$x_pt <- df$x - 0.2 + stats::runif(nrow(df), -0.07, 0.07)\n\nhalf_poly <- function(values, x0, width = 0.36, id = \"a\") {\n d <- stats::density(values, n = 128, cut = 1.5)\n data.frame(x = c(x0 + d$y / max(d$y) * width, rep(x0, 128)), y = c(d$x, rev(d$x)), id = id)\n}\npoly_df <- do.call(rbind, lapply(seq_along(group_levels), function(i) {\n poly <- half_poly(df$value[df$group == group_levels[i]], i + 0.07, id = group_levels[i])\n poly$group <- factor(group_levels[i], levels = group_levels)\n poly\n}))\nst <- do.call(rbind, lapply(seq_along(group_levels), function(i) {\n y <- df$value[df$group == group_levels[i]]\n q <- stats::quantile(y, c(0.25, 0.5, 0.75)); iqr <- q[3] - q[1]\n data.frame(group = factor(group_levels[i], levels = group_levels), x = i, q1 = q[1], q2 = q[2],\n q3 = q[3], lo = max(min(y), q[1] - 1.5 * iqr), hi = min(max(y), q[3] + 1.5 * iqr),\n n = length(y))\n}))\npanel_of <- function(g) factor(ifelse(as.character(g) %in% group_levels[1:2], \"Lower doses\", \"Higher doses\"),\n levels = c(\"Lower doses\", \"Higher doses\"))\ndf$panel <- panel_of(df$group); poly_df$panel <- panel_of(poly_df$group); st$panel <- panel_of(st$group)\ny_rng <- range(poly_df$y)\nn_y <- y_rng[1] - 0.05 * diff(y_rng)\nbw <- 0.05\n\np <- ggplot() +\n geom_polygon(data = poly_df, aes(x, y, group = id, fill = group), colour = NA, alpha = 0.6) +\n geom_point(data = df, aes(x_pt, value, fill = group), shape = raw_point$shape, size = raw_point$size,\n stroke = raw_point$stroke, colour = \"black\", alpha = 0.7) +\n geom_segment(data = st, aes(x = x, xend = x, y = lo, yend = hi), linewidth = pv_house_lw(\"ref\")) +\n geom_rect(data = st, aes(xmin = x - bw, xmax = x + bw, ymin = q1, ymax = q3, fill = group),\n alpha = 0.6, colour = \"black\", linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = st, aes(x = x - bw, xend = x + bw, y = q2, yend = q2), linewidth = pv_house_lw(0.8)) +\n geom_text(data = st, aes(x = x, y = n_y, label = paste0(\"n = \", n), colour = group), vjust = 0.5) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(breaks = seq_along(group_levels), labels = group_levels,\n expand = expansion(add = c(0.45, 0.5))) +\n labs(x = NULL, y = \"Response score\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\ny_top <- y_rng[2]\nif (isTRUE(show_signif)) {\n step <- diff(y_rng) * 0.1\n br <- do.call(rbind, lapply(seq_along(comparisons), function(i) {\n pair <- comparisons[[i]]\n sub <- df[df$group %in% pair, ]\n top <- max(poly_df$y[poly_df$group %in% pair])\n data.frame(x = match(pair[1], group_levels), xend = match(pair[2], group_levels), y = top + step * 0.6,\n panel = panel_of(pair[1]), label = pv_fmt_p(stats::wilcox.test(value ~ group, data = droplevels(sub))$p.value))\n }))\n y_top <- max(br$y) + step * 1.6\n p <- p +\n geom_segment(data = br, aes(x = x, xend = xend, y = y, yend = y), linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = br, aes(x = x, xend = x, y = y, yend = y - step * 0.3), linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = br, aes(x = xend, xend = xend, y = y, yend = y - step * 0.3),\n linewidth = pv_house_lw(\"ref\")) +\n geom_text(data = br, aes(x = (x + xend) / 2, y = y + step * 0.25, label = label), parse = TRUE,\n vjust = 0)\n}\np <- p + scale_y_continuous(expand = c(0, 0)) +\n coord_cartesian(ylim = c(n_y - 0.06 * diff(y_rng), y_top))\n\nif (isTRUE(use_facet)) {\n p <- p + facet_wrap(~panel, scales = \"free_x\")\n}\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "raincloud plot\n云雨图\nraincloud\nraincloud\ndistribution\n分布\ndistribution\n分布\ndistribution\n要在同一张图里看原始点、箱线摘要和分布形状时用。\nplot.r 顶部 show_signif 标比较对，use_facet 定分面，group_levels 设剂量组序，comparisons 选比较列表。data.csv 给 sample、group 和 value 列。云雨组色取 pv_palette(\"house\")。\nraincloud distribution boxplot\nsample 样本编号（字符串） group 剂量或处理组（字符串） value 响应分数（数值）"
},
{
"title": "Ridgeline plot",
"title_zh": "山脊图",
"slug": "ridgeline",
"category": "distribution",
"tags": [
"ridgeline",
"density",
"distribution"
],
"packages": [
"ggplot2",
"ggridges"
],
"data_columns": {
"group": "队列或分组（字符串）",
"value": "得分（数值）"
},
"when_to_use": "组数较多、要比较多条分布的位置和重叠时用。",
"customize": "plot.R 顶部 ridge_scale 调分布重叠，show_quantile 与 quantiles 画分位数，sort_by_median 控制中位数排序。data.csv 填 group 队列和 value 列。填充用 pv_palette(\"house\") 蓝色。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "ridge_scale",
"value": "1.35"
},
{
"name": "show_quantile",
"value": "TRUE"
},
{
"name": "quantiles",
"value": "0.5"
},
{
"name": "sort_by_median",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "89",
"label": "43 × 89 mm (1×2 cells)",
"cells": "1x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/ridgeline/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/ridgeline/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/ridgeline/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/ridgeline/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/ridgeline/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/ridgeline/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/ridgeline/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/ridgeline/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/ridgeline/make_data.R"
}
],
"dir": "figures/distribution/ridgeline",
"preview": "figures/distribution/ridgeline/preview.png",
"docs_preview": "previews/ridgeline.png",
"code": "figures/distribution/ridgeline/plot.R",
"data": "figures/distribution/ridgeline/data.csv",
"data_files": [
"figures/distribution/ridgeline/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/ridgeline/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/ridgeline/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/ridgeline",
"code_text": "# Overlapping ridgelines (house style) for more than four groups: one fill colour, white outline,\n# median line in each ridge, median value printed at the right. Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nridge_scale <- 1.35\nshow_quantile <- TRUE\nquantiles <- 0.5\nsort_by_median <- TRUE\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nif (sort_by_median) {\n med <- tapply(df$value, df$group, stats::median)\n df$group <- factor(df$group, levels = names(sort(med)))\n} else {\n df$group <- factor(df$group, levels = unique(df$group))\n}\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for\\nillustration; not\\nbiological results\"\nmeds <- data.frame(group = levels(df$group),\n m = vapply(levels(df$group), function(g) stats::median(df$value[df$group == g]), numeric(1)))\nmeds$y <- seq_len(nrow(meds))\nx_hi <- max(df$value) + 1.3\nbw <- mean(vapply(split(df$value, df$group), stats::bw.nrd0, numeric(1))) # one joint bandwidth\n\np <- ggplot(df, aes(value, group)) +\n ggridges::geom_density_ridges(scale = ridge_scale, bandwidth = bw, rel_min_height = 0.01, quantile_lines = show_quantile,\n quantiles = quantiles, fill = hp[[\"blue\"]], alpha = 0.55, colour = \"white\",\n linewidth = pv_house_lw(\"ref\"), vline_colour = \"black\",\n vline_width = pv_house_lw(0.8)) +\n geom_text(data = meds, aes(x = x_hi, y = y + 0.25, label = sprintf(\"%.2f\", m)), hjust = 1, vjust = 0) +\n annotate(\"text\", x = x_hi, y = nrow(meds) + 0.85, hjust = 1, vjust = 0, label = \"Median\") +\n scale_x_continuous(expand = c(0, 0)) +\n scale_y_discrete(expand = expansion(add = c(0.2, 1.25))) +\n coord_cartesian(xlim = c(min(df$value) - 0.2, x_hi + 0.1)) +\n labs(x = \"Score\", y = NULL, caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "ridgeline plot\n山脊图\nridgeline\n\ndistribution\n分布\ndistribution\n分布\ndistribution\n组数较多、要比较多条分布的位置和重叠时用。\nplot.r 顶部 ridge_scale 调分布重叠，show_quantile 与 quantiles 画分位数，sort_by_median 控制中位数排序。data.csv 填 group 队列和 value 列。填充用 pv_palette(\"house\") 蓝色。\nridgeline density distribution\ngroup 队列或分组（字符串） value 得分（数值）"
},
{
"title": "Split violin",
"title_zh": "分半小提琴图",
"slug": "split-violin",
"category": "distribution",
"tags": [
"violin",
"split",
"distribution"
],
"packages": [
"ggplot2"
],
"data_columns": {
"sample": "样本编号（字符串）",
"group": "组织或分组，横轴一类一根（字符串）",
"condition": "两个条件，左半为第一水平，右半为第二水平（字符串）",
"value": "表达量，log2 尺度（数值）"
},
"when_to_use": "每个分组里都有两个条件，要并排比较分布形状和中位数时用。Use when each group has two conditions and the two density shapes should share one axis position.",
"customize": "plot.R 顶部 group_levels 设横轴组织顺序，condition_levels 定并排两条件，half_width 调分半提琴宽。data.csv 给 sample、group、condition 和 value 列。组色取 pv_palette(\"house\")。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": "raincloud",
"variant_label": "Split",
"variants": [],
"parameters": [
{
"name": "group_levels",
"value": "c(\"Liver\", \"Lung\", \"Kidney\", \"Spleen\")"
},
{
"name": "condition_levels",
"value": "c(\"Control\", \"Treated\")"
},
{
"name": "half_width",
"value": "0.36"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/split-violin/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/split-violin/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/split-violin/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/split-violin/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/split-violin/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/split-violin/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/split-violin/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/split-violin/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/split-violin/make_data.R"
}
],
"dir": "figures/distribution/split-violin",
"preview": "figures/distribution/split-violin/preview.png",
"docs_preview": "previews/split-violin.png",
"code": "figures/distribution/split-violin/plot.R",
"data": "figures/distribution/split-violin/data.csv",
"data_files": [
"figures/distribution/split-violin/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/split-violin/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/split-violin/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/split-violin",
"code_text": "# Split violin (house style): two conditions as mirrored half densities with a median mark,\n# condition names written over the first group in their colour, Wilcoxon P per group.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\ngroup_levels <- c(\"Liver\", \"Lung\", \"Kidney\", \"Spleen\")\ncondition_levels <- c(\"Control\", \"Treated\")\nhalf_width <- 0.36\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_levels)\ndf$condition <- factor(df$condition, levels = condition_levels)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue (left) and red (right): both >= 3:1 on white, so the labels keep the condition colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]]), condition_levels)\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nhalf_poly <- function(values, x0, side, width, id) {\n pad <- 0.25 * stats::sd(values)\n d <- stats::density(values, n = 128, from = min(values) - pad, to = max(values) + pad)\n dens <- d$y / max(d$y) * width\n poly <- data.frame(x = c(x0, x0 + side * dens, x0), y = c(d$x[1], d$x, d$x[length(d$x)]), id = id,\n stringsAsFactors = FALSE)\n med <- stats::median(values)\n hw <- stats::approx(d$x, dens, xout = med, rule = 2)$y\n list(poly = poly, med = data.frame(x = x0, xend = x0 + side * hw * 0.92, y = med))\n}\n\npolys <- list()\nmeds <- list()\nfor (i in seq_along(group_levels)) {\n for (j in seq_along(condition_levels)) {\n sub <- df$value[df$group == group_levels[[i]] & df$condition == condition_levels[[j]]]\n pid <- paste(group_levels[[i]], condition_levels[[j]], sep = \"|\")\n built <- half_poly(sub, i, if (j == 1L) -1 else 1, half_width, pid)\n built$poly$condition <- condition_levels[[j]]\n polys[[pid]] <- built$poly\n meds[[pid]] <- built$med\n }\n}\npoly_df <- do.call(rbind, polys)\npoly_df$condition <- factor(poly_df$condition, levels = condition_levels)\nmed_df <- do.call(rbind, meds)\ny_rng <- range(poly_df$y)\npv <- do.call(rbind, lapply(seq_along(group_levels), function(i) {\n sub <- droplevels(df[df$group == group_levels[i], ])\n data.frame(x = i, y = max(poly_df$y[startsWith(poly_df$id, paste0(group_levels[i], \"|\"))]),\n lab = pv_fmt_p(stats::wilcox.test(value ~ condition, data = sub, exact = FALSE)$p.value))\n}))\ny_top <- y_rng[2] + 0.2 * diff(y_rng)\ncond_lab <- data.frame(condition = factor(condition_levels, levels = condition_levels),\n x = 1 + c(-0.06, 0.06), hj = c(1, 0))\n\np <- ggplot() +\n geom_polygon(data = poly_df, aes(x = x, y = y, group = id, fill = condition), colour = NA, alpha = 0.7) +\n geom_segment(data = med_df, aes(x = x, xend = xend, y = y, yend = y), linewidth = pv_house_lw(0.8),\n colour = \"black\", lineend = \"butt\") +\n geom_text(data = pv, aes(x = x, y = pmin(y + 0.04 * diff(y_rng), y_top - 0.13 * diff(y_rng)), label = lab),\n parse = TRUE, vjust = 0) +\n geom_text(data = cond_lab, aes(x = x, y = y_top - 0.02 * diff(y_rng), label = condition, colour = condition,\n hjust = hj), vjust = 1, fontface = \"bold\") +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(breaks = seq_along(group_levels), labels = group_levels,\n expand = expansion(add = 0.5)) +\n scale_y_continuous(expand = c(0, 0)) +\n coord_cartesian(ylim = c(y_rng[1] - 0.03 * diff(y_rng), y_top)) +\n labs(x = NULL, y = \"Expression (log2)\", caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "split violin\n分半小提琴图\nsplit-violin\nsplit\ndistribution\n分布\ndistribution\n分布\ndistribution\n每个分组里都有两个条件，要并排比较分布形状和中位数时用。use when each group has two conditions and the two density shapes should share one axis position.\nplot.r 顶部 group_levels 设横轴组织顺序，condition_levels 定并排两条件，half_width 调分半提琴宽。data.csv 给 sample、group、condition 和 value 列。组色取 pv_palette(\"house\")。\nviolin split distribution\nsample 样本编号（字符串） group 组织或分组，横轴一类一根（字符串） condition 两个条件，左半为第一水平，右半为第二水平（字符串） value 表达量，log2 尺度（数值）"
},
{
"title": "Violin plot",
"title_zh": "小提琴图",
"slug": "violin",
"category": "distribution",
"tags": [
"violin",
"distribution",
"significance"
],
"packages": [
"ggplot2"
],
"data_columns": {
"sample": "样本编号（字符串）",
"group": "处理组（字符串）",
"facet": "组织或分面（字符串）",
"value": "表达量，log2 尺度（数值）"
},
"when_to_use": "要同时看组间位置和分布形状，并标两两比较时用。",
"customize": "plot.R 顶部 layout 选 split 或 facet，show_signif 标组间差异，group_levels 设处理组，facet_levels 定组织分面。data.csv 填 sample、group、facet 和 value 列。取 pv_palette(\"house\")。",
"lang": "R",
"task": "distribution",
"task_zh": "分布",
"task_en": "Distribution",
"variant_of": "raincloud",
"variant_label": "Violin",
"variants": [],
"parameters": [
{
"name": "layout",
"value": "\"split\""
},
{
"name": "show_signif",
"value": "TRUE"
},
{
"name": "group_levels",
"value": "c(\"Control\", \"Treated\")"
},
{
"name": "facet_levels",
"value": "c(\"Adjacent\", \"Tumor\")"
}
],
"canvas": null,
"downloads": [
{
"name": "plot.R",
"path": "figures/distribution/violin/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/violin/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/violin/plot.R"
},
{
"name": "data.csv",
"path": "figures/distribution/violin/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/violin/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/violin/data.csv"
},
{
"name": "make_data.R",
"path": "figures/distribution/violin/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/distribution/violin/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/violin/make_data.R"
}
],
"dir": "figures/distribution/violin",
"preview": "figures/distribution/violin/preview.png",
"docs_preview": "previews/violin.png",
"code": "figures/distribution/violin/plot.R",
"data": "figures/distribution/violin/data.csv",
"data_files": [
"figures/distribution/violin/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/violin/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/distribution/violin/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/distribution/violin",
"code_text": "# Split or faceted violins (house style) with Wilcoxon P over brackets; group names written\n# in their colour instead of a legend. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数\nlayout <- \"split\" # split | facet\nshow_signif <- TRUE\ngroup_levels <- c(\"Control\", \"Treated\")\nfacet_levels <- c(\"Adjacent\", \"Tumor\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_levels)\ndf$facet <- factor(df$facet, levels = facet_levels)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# blue and red: both >= 3:1 on white, so the labels keep the group colour\ncols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]]), group_levels)\nfootnote <- \"Simulated data for illustration;\\nnot biological results\"\ncap_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\npw <- vapply(facet_levels, function(f) {\n stats::wilcox.test(value ~ group, data = droplevels(df[df$facet == f, ]))$p.value\n}, numeric(1))\ny_rng <- range(df$value) + c(-0.5, 0.45) # room for the density tails\ny_br <- y_rng[2] + 0.06 * diff(y_rng)\ny_top <- y_rng[2] + 0.32 * diff(y_rng)\n\nhalf_poly <- function(values, x0, side, width = 0.36, id = \"a\") {\n d <- stats::density(values, n = 128, from = min(values) - 0.2, to = max(values) + 0.2)\n y <- d$y / max(d$y) * width\n data.frame(x = c(x0, x0 + side * y, x0), y = c(d$x[1], d$x, d$x[length(d$x)]), id = id,\n stringsAsFactors = FALSE)\n}\n\nif (layout == \"split\") {\n polys <- list(); meds <- list()\n for (i in seq_along(facet_levels)) {\n for (j in seq_along(group_levels)) {\n sub <- df[df$facet == facet_levels[i] & df$group == group_levels[j], ]\n side <- if (j == 1) -1 else 1\n pid <- paste(facet_levels[i], group_levels[j])\n poly <- half_poly(sub$value, i, side, id = pid)\n poly$group <- group_levels[j]\n polys[[pid]] <- poly\n qs <- stats::quantile(sub$value, c(0.25, 0.5, 0.75))\n meds[[pid]] <- data.frame(x = i, xend = i + side * 0.16, y = qs, w = c(0.5, 0.8, 0.5))\n }\n }\n poly_df <- do.call(rbind, polys)\n poly_df$group <- factor(poly_df$group, levels = group_levels)\n med_df <- do.call(rbind, meds)\n med_df$w <- pv_house_lw(med_df$w) # 0.5 pt quartiles, 0.8 pt median\n br <- data.frame(x = seq_along(facet_levels) - 0.28, xend = seq_along(facet_levels) + 0.28, y = y_br,\n lab = vapply(pw, pv_fmt_p, character(1)))\n glab <- data.frame(group = factor(group_levels, levels = group_levels), x = 1.5 + c(-0.05, 0.05),\n hj = c(1, 0))\n p <- ggplot() +\n geom_polygon(data = poly_df, aes(x, y, group = id, fill = group), colour = NA, alpha = 0.7) +\n geom_segment(data = med_df, aes(x = x, xend = xend, y = y, yend = y, linewidth = w), colour = \"black\") +\n scale_linewidth_identity() +\n geom_text(data = glab, aes(x = x, y = y_top, label = group, colour = group, hjust = hj), vjust = 1.2,\n fontface = \"bold\") +\n scale_x_continuous(breaks = seq_along(facet_levels), labels = facet_levels,\n expand = expansion(add = 0.5))\n} else {\n br <- data.frame(facet = factor(facet_levels, levels = facet_levels), x = 1, xend = 2, y = y_br,\n lab = vapply(pw, pv_fmt_p, character(1)))\n p <- ggplot(df, aes(group, value, fill = group)) +\n geom_violin(scale = \"width\", trim = FALSE, colour = NA, alpha = 0.7) +\n geom_boxplot(width = 0.12, outlier.shape = NA, fill = \"white\", linewidth = pv_house_lw(\"ref\")) +\n facet_wrap(~facet)\n}\nif (isTRUE(show_signif)) {\n p <- p +\n geom_segment(data = br, aes(x = x, xend = xend, y = y, yend = y), inherit.aes = FALSE,\n linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = br, aes(x = x, xend = x, y = y, yend = y - 0.04 * diff(y_rng)), inherit.aes = FALSE,\n linewidth = pv_house_lw(\"ref\")) +\n geom_segment(data = br, aes(x = xend, xend = xend, y = y, yend = y - 0.04 * diff(y_rng)), inherit.aes = FALSE,\n linewidth = pv_house_lw(\"ref\")) +\n geom_text(data = br, aes(x = (x + xend) / 2, y = y + 0.025 * diff(y_rng), label = lab), parse = TRUE,\n vjust = 0, inherit.aes = FALSE)\n}\np <- p +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_y_continuous(expand = c(0, 0)) +\n coord_cartesian(ylim = c(y_rng[1], y_top)) +\n labs(x = NULL, y = \"Expression (log2)\", caption = footnote) +\n theme_house() + cap_theme\n\npv_save_house(p, \"figure\", cells = if (layout == \"split\") \"1x1\" else \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "violin plot\n小提琴图\nviolin\nviolin\ndistribution\n分布\ndistribution\n分布\ndistribution\n要同时看组间位置和分布形状，并标两两比较时用。\nplot.r 顶部 layout 选 split 或 facet，show_signif 标组间差异，group_levels 设处理组，facet_levels 定组织分面。data.csv 填 sample、group、facet 和 value 列。取 pv_palette(\"house\")。\nviolin distribution significance\nsample 样本编号（字符串） group 处理组（字符串） facet 组织或分面（字符串） value 表达量，log2 尺度（数值）"
},
{
"title": "Enrichment bar",
"title_zh": "富集柱状图",
"slug": "enrichment-bar",
"category": "enrichment",
"tags": [
"enrichment",
"bar",
"gene-ontology"
],
"packages": [
"ggplot2"
],
"data_columns": {
"term": "通路或 GO 条目名（字符串）",
"ontology": "本体，BP / MF / CC（字符串）",
"fold": "富集倍数（数值）",
"p": "富集 p 值（数值，0 到 1）",
"count": "命中基因数（整数）"
},
"when_to_use": "少量显著通路要按倍数或 p 值排开比较时用。",
"customize": "Edit `horizontal` (default `TRUE`), `facet_ontology` (default `TRUE`), and `bar_stat` (default \"nlp\") in `plot.R` to control layout and axis statistics; supply `term`, `ontology`, `fold`, `p`, and `count` columns in `data.csv`.",
"lang": "R",
"task": "enrichment",
"task_zh": "富集",
"task_en": "Enrichment",
"variant_of": "enrichment-dot",
"variant_label": "Bar",
"variants": [],
"parameters": [
{
"name": "horizontal",
"value": "TRUE"
},
{
"name": "facet_ontology",
"value": "TRUE"
},
{
"name": "bar_stat",
"value": "\"nlp\""
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/enrichment/enrichment-bar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/enrichment/enrichment-bar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/enrichment-bar/plot.R"
},
{
"name": "data.csv",
"path": "figures/enrichment/enrichment-bar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/enrichment/enrichment-bar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/enrichment-bar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/enrichment/enrichment-bar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/enrichment/enrichment-bar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/enrichment-bar/make_data.R"
}
],
"dir": "figures/enrichment/enrichment-bar",
"preview": "figures/enrichment/enrichment-bar/preview.png",
"docs_preview": "previews/enrichment-bar.png",
"code": "figures/enrichment/enrichment-bar/plot.R",
"data": "figures/enrichment/enrichment-bar/data.csv",
"data_files": [
"figures/enrichment/enrichment-bar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/enrichment-bar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/enrichment-bar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/enrichment/enrichment-bar",
"code_text": "# Enrichment bars (house style). Horizontal layout and ontology facets are switches; the hit count\n# is written at the end of each bar and the facet strips name the ontology.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nhorizontal <- TRUE\nfacet_ontology <- TRUE\nbar_stat <- \"nlp\"\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$nlp <- -log10(df$p)\ndf$ontology <- factor(df$ontology, levels = c(\"BP\", \"MF\", \"CC\"))\ndf$term <- factor(df$term, levels = df$term[order(df$ontology, df$nlp)])\nstat <- if (bar_stat == \"fold\") df$fold else df$nlp\ndf$stat <- stat\nxlab <- if (bar_stat == \"fold\") \"Fold enrichment\" else \"-log10(p)\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npal <- c(BP = hp[[\"blue\"]], MF = hp[[\"purple\"]], CC = hp[[\"green\"]])\ndf$n_lab <- paste0(\"n = \", df$count)\n\nif (isTRUE(horizontal)) {\n p <- ggplot(df, aes(stat, term, fill = ontology)) +\n geom_col(width = 0.72) +\n geom_text(aes(label = n_lab), hjust = -0.12, size = pv_pt2size(7), colour = \"#1A1A1A\",\n family = house_family()) +\n scale_x_continuous(expand = expansion(mult = c(0, 0.22))) +\n labs(x = xlab, y = NULL)\n} else {\n p <- ggplot(df, aes(term, stat, fill = ontology)) +\n geom_col(width = 0.72) +\n geom_text(aes(label = count), vjust = -0.4, size = pv_pt2size(7), colour = \"#1A1A1A\",\n family = house_family()) +\n scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +\n labs(x = NULL, y = xlab) +\n theme(axis.text.x = element_text(angle = 45, hjust = 1))\n}\np <- p +\n scale_fill_manual(values = pal, guide = \"none\") +\n labs(caption = footnote) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\nif (!isTRUE(horizontal)) p <- p + theme(axis.text.x = element_text(angle = 45, hjust = 1))\nif (isTRUE(facet_ontology)) {\n p <- p + (if (isTRUE(horizontal)) facet_grid(ontology ~ ., scales = \"free_y\", space = \"free_y\")\n else facet_grid(. ~ ontology, scales = \"free_x\", space = \"free_x\")) +\n theme(strip.background = element_blank(), strip.text.y = element_text(angle = 0, hjust = 0),\n panel.spacing = unit(1, \"mm\"))\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "enrichment bar\n富集柱状图\nenrichment-bar\nbar\nenrichment\n富集\nenrichment\n富集\nenrichment\n少量显著通路要按倍数或 p 值排开比较时用。\nedit `horizontal` (default `true`), `facet_ontology` (default `true`), and `bar_stat` (default \"nlp\") in `plot.r` to control layout and axis statistics; supply `term`, `ontology`, `fold`, `p`, and `count` columns in `data.csv`.\nenrichment bar gene-ontology\nterm 通路或 go 条目名（字符串） ontology 本体，bp / mf / cc（字符串） fold 富集倍数（数值） p 富集 p 值（数值，0 到 1） count 命中基因数（整数）"
},
{
"title": "Enrichment dot plot",
"title_zh": "富集气泡图",
"slug": "enrichment-dot",
"category": "enrichment",
"tags": [
"enrichment",
"dotplot",
"gene-ontology"
],
"packages": [
"ggplot2"
],
"data_columns": {
"term": "通路名（字符串）",
"ontology": "本体，BP / MF / CC（字符串）",
"ratio": "基因比例（数值，0 到 1）",
"count": "命中基因数（整数）",
"p": "富集 p 值（数值）"
},
"when_to_use": "通路要同时看基因比例、命中数和显著性时用。",
"customize": "Toggle `size_maps_count` (default `TRUE`), `colour_maps_p` (default `TRUE`), and `facet_by_ontology` (default `TRUE`) in `plot.R` to configure point mapping; provide `term`, `ontology`, `ratio`, `count`, and `p` columns in `data.csv`.",
"lang": "R",
"task": "enrichment",
"task_zh": "富集",
"task_en": "Enrichment",
"variant_of": null,
"variant_label": "Dot",
"variants": [
{
"slug": "enrichment-dot",
"variant_label": "Dot",
"title": "Enrichment dot plot",
"title_zh": "富集气泡图",
"docs_preview": "previews/enrichment-dot.png"
},
{
"slug": "enrichment-bar",
"variant_label": "Bar",
"title": "Enrichment bar",
"title_zh": "富集柱状图",
"docs_preview": "previews/enrichment-bar.png"
}
],
"parameters": [
{
"name": "size_maps_count",
"value": "TRUE"
},
{
"name": "colour_maps_p",
"value": "TRUE"
},
{
"name": "facet_by_ontology",
"value": "TRUE"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/enrichment/enrichment-dot/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/enrichment/enrichment-dot/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/enrichment-dot/plot.R"
},
{
"name": "data.csv",
"path": "figures/enrichment/enrichment-dot/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/enrichment/enrichment-dot/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/enrichment-dot/data.csv"
},
{
"name": "make_data.R",
"path": "figures/enrichment/enrichment-dot/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/enrichment/enrichment-dot/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/enrichment-dot/make_data.R"
}
],
"dir": "figures/enrichment/enrichment-dot",
"preview": "figures/enrichment/enrichment-dot/preview.png",
"docs_preview": "previews/enrichment-dot.png",
"code": "figures/enrichment/enrichment-dot/plot.R",
"data": "figures/enrichment/enrichment-dot/data.csv",
"data_files": [
"figures/enrichment/enrichment-dot/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/enrichment-dot/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/enrichment-dot/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/enrichment/enrichment-dot",
"code_text": "# Enrichment dot plot (house style). Size is count, colour is -log10(p) on house_warm; optional\n# ontology facets named on the strips. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nsize_maps_count <- TRUE\ncolour_maps_p <- TRUE\nfacet_by_ontology <- TRUE\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$ontology <- factor(df$ontology, levels = c(\"BP\", \"MF\", \"CC\"))\ndf$nlp <- -log10(df$p)\ndf$term <- factor(df$term, levels = df$term[order(df$ontology, df$ratio)])\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n\npt <- list(shape = HOUSE_POINT$shape, stroke = HOUSE_POINT$stroke, colour = HOUSE_POINT$colour)\np <- ggplot(df, aes(ratio, term))\nif (isTRUE(size_maps_count) && isTRUE(colour_maps_p)) {\n p <- p + geom_point(aes(size = count, fill = nlp), shape = pt$shape, stroke = pt$stroke, colour = pt$colour)\n} else if (isTRUE(size_maps_count)) {\n p <- p + geom_point(aes(size = count), fill = hp[[\"blue\"]], shape = pt$shape, stroke = pt$stroke, colour = pt$colour)\n} else {\n p <- p + geom_point(aes(fill = nlp), size = HOUSE_POINT$size, shape = pt$shape, stroke = pt$stroke, colour = pt$colour)\n}\np <- p +\n scale_size_area(max_size = 4.5, name = \"Count\") +\n scale_fill_gradientn(colours = pv_palette(\"house_warm\"), name = \"-log10(p)\",\n breaks = function(l) pretty(l, n = 3)) +\n scale_x_continuous(expand = expansion(mult = 0.08)) +\n labs(x = \"Gene ratio\", y = NULL, caption = footnote) +\n theme_house() +\n theme(legend.position = \"bottom\", legend.box = \"horizontal\", legend.justification = \"left\",\n legend.margin = margin(0, 0, 0, 0), legend.box.spacing = unit(1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\") +\n guides(fill = guide_colourbar(barwidth = unit(22, \"mm\"), barheight = unit(2, \"mm\"), title.position = \"top\", order = 1),\n size = guide_legend(order = 2, title.position = \"top\", override.aes = list(fill = grey[[\"ci\"]])))\nif (isTRUE(facet_by_ontology)) {\n p <- p + facet_grid(ontology ~ ., scales = \"free_y\", space = \"free_y\") +\n theme(strip.background = element_blank(), strip.text.y = element_text(angle = 0, hjust = 0),\n panel.spacing = unit(1, \"mm\"))\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "enrichment dot plot\n富集气泡图\nenrichment-dot\ndot\nenrichment\n富集\nenrichment\n富集\nenrichment\n通路要同时看基因比例、命中数和显著性时用。\ntoggle `size_maps_count` (default `true`), `colour_maps_p` (default `true`), and `facet_by_ontology` (default `true`) in `plot.r` to configure point mapping; provide `term`, `ontology`, `ratio`, `count`, and `p` columns in `data.csv`.\nenrichment dotplot gene-ontology\nterm 通路名（字符串） ontology 本体，bp / mf / cc（字符串） ratio 基因比例（数值，0 到 1） count 命中基因数（整数） p 富集 p 值（数值）"
},
{
"title": "GSEA running score",
"title_zh": "GSEA 富集图",
"slug": "gsea",
"category": "enrichment",
"tags": [
"gsea",
"enrichment",
"rank"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"set": "基因集名称（字符串）",
"rank": "排序名次，1 为最高（整数）",
"es": "走到该名次的 running enrichment score（数值）",
"hit": "该名次是否命中基因集，1 或 0（整数）",
"metric": "排序统计量，两套基因集相同（数值）"
},
"when_to_use": "要看一个基因集在排序列表的哪一头富集时用。",
"customize": "Modify `sets_keep` (default c(\"Interferon response\", \"Oxidative phosphorylation\")) to select sets and toggle `show_ranked_bar` (default `TRUE`) in `plot.R`; fill `set`, `rank`, `es`, `hit`, and `metric` columns in `data.csv`.",
"lang": "R",
"task": "enrichment",
"task_zh": "富集",
"task_en": "Enrichment",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "sets_keep",
"value": "c(\"Interferon response\", \"Oxidative phosphorylation\")"
},
{
"name": "show_ranked_bar",
"value": "TRUE"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/enrichment/gsea/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/enrichment/gsea/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/gsea/plot.R"
},
{
"name": "data.csv",
"path": "figures/enrichment/gsea/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/enrichment/gsea/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/gsea/data.csv"
},
{
"name": "make_data.R",
"path": "figures/enrichment/gsea/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/enrichment/gsea/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/gsea/make_data.R"
}
],
"dir": "figures/enrichment/gsea",
"preview": "figures/enrichment/gsea/preview.png",
"docs_preview": "previews/gsea.png",
"code": "figures/enrichment/gsea/plot.R",
"data": "figures/enrichment/gsea/data.csv",
"data_files": [
"figures/enrichment/gsea/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/gsea/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/enrichment/gsea/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/enrichment/gsea",
"code_text": "# GSEA running-score curves with an optional ranked-list bar (house style). Each set is named in\n# its colour at its peak score, with the peak ES written beside it. Panels joined with patchwork.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\nsets_keep <- c(\"Interferon response\", \"Oxidative phosphorylation\")\nshow_ranked_bar <- TRUE\nfootnote <- \"Simulated data for illustration; not biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$set %in% sets_keep, , drop = FALSE]\ndf$set <- factor(df$set, levels = sets_keep)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\npal <- stats::setNames(unname(hp[c(\"blue\", \"red\", \"green\", \"purple\", \"magenta\", \"brown\")][seq_along(sets_keep)]),\n sets_keep)\n\n# peak (largest |ES|) per set, labelled in the set colour\npeaks <- do.call(rbind, lapply(split(df, df$set), function(d) d[which.max(abs(d$es)), , drop = FALSE]))\npeaks$lab <- sprintf(\"%s\\nES %.2f\", peaks$set, peaks$es)\npeaks$vj <- ifelse(peaks$es >= 0, -0.25, 1.25)\npeaks$hj <- ifelse(peaks$rank > max(df$rank) / 2, 1, 0)\n\ncurve <- ggplot(df, aes(rank, es, colour = set)) +\n geom_hline(yintercept = 0, linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_line(linewidth = pv_house_lw(\"main\")) +\n geom_text(data = peaks, aes(label = lab, vjust = vj, hjust = hj), size = pv_pt2size(7),\n lineheight = 0.9, family = house_family(), show.legend = FALSE) +\n scale_colour_manual(values = pal, guide = \"none\") +\n scale_y_continuous(expand = expansion(mult = 0.3)) +\n labs(x = NULL, y = \"Enrichment score\") +\n theme_house() +\n theme(axis.text.x = element_blank(), axis.ticks.x = element_blank())\n\nhits <- df[df$hit == 1, , drop = FALSE]\nhits$y <- as.numeric(hits$set)\nrug <- ggplot(hits, aes(colour = set)) +\n geom_segment(aes(x = rank, xend = rank, y = y - 0.32, yend = y + 0.32), linewidth = 0.25) +\n scale_colour_manual(values = pal, guide = \"none\") +\n scale_y_continuous(breaks = NULL, limits = c(0.4, length(sets_keep) + 0.6)) +\n labs(x = NULL, y = \"Hits\") +\n theme_house() +\n theme(axis.text.x = element_blank(), axis.ticks.x = element_blank())\n\nmet <- df[df$set == sets_keep[[1]], , drop = FALSE]\nlim <- max(abs(met$metric))\nbar <- ggplot(met, aes(rank, metric, fill = metric)) +\n geom_col(width = 1, colour = NA) +\n scale_fill_gradientn(colours = pv_palette(\"house_div\"), limits = c(-lim, lim), guide = \"none\") +\n labs(x = \"Rank in ordered gene list\", y = \"Rank metric\") +\n theme_house()\n\nif (isTRUE(show_ranked_bar) && length(sets_keep) > 1) {\n p <- curve / rug / bar + plot_layout(heights = c(1.4, 0.35, 0.55))\n} else if (isTRUE(show_ranked_bar)) {\n p <- curve / bar + plot_layout(heights = c(1.4, 0.5))\n} else {\n p <- curve\n}\np <- p + plot_annotation(\n caption = footnote,\n theme = theme(text = element_text(family = house_family()),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\"))\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "gsea running score\ngsea 富集图\ngsea\n\nenrichment\n富集\nenrichment\n富集\nenrichment\n要看一个基因集在排序列表的哪一头富集时用。\nmodify `sets_keep` (default c(\"interferon response\", \"oxidative phosphorylation\")) to select sets and toggle `show_ranked_bar` (default `true`) in `plot.r`; fill `set`, `rank`, `es`, `hit`, and `metric` columns in `data.csv`.\ngsea enrichment rank\nset 基因集名称（字符串） rank 排序名次，1 为最高（整数） es 走到该名次的 running enrichment score（数值） hit 该名次是否命中基因集，1 或 0（整数） metric 排序统计量，两套基因集相同（数值）"
},
{
"title": "BUSCO stacked bar",
"title_zh": "BUSCO 堆积条形",
"slug": "busco-bar",
"category": "genome",
"tags": [
"busco",
"assembly-quality"
],
"packages": [
"ggplot2"
],
"data_columns": {
"assembly": "组装名（字符串）",
"status": "Complete single-copy、Complete duplicated、Fragmented 或 Missing（字符串）",
"percent": "该类别占 BUSCO 基因的百分比（数值）"
},
"when_to_use": "比较多份基因组组装的完整度、重复、碎片和缺失比例时用。",
"customize": "sort_by_completeness 为 TRUE 时按单拷贝与重复之和的完整度将最优组装排在顶部，FALSE 则按名称排序；show_percent 在单拷贝块内以白字写出完整度百分比；分类名称列于条形上方且无图例。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "sort_by_completeness",
"value": "TRUE"
},
{
"name": "show_percent",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/busco-bar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/busco-bar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/busco-bar/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/busco-bar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/busco-bar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/busco-bar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/busco-bar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/busco-bar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/busco-bar/make_data.R"
}
],
"dir": "figures/genome/busco-bar",
"preview": "figures/genome/busco-bar/preview.png",
"docs_preview": "previews/busco-bar.png",
"code": "figures/genome/busco-bar/plot.R",
"data": "figures/genome/busco-bar/data.csv",
"data_files": [
"figures/genome/busco-bar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/busco-bar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/busco-bar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/busco-bar",
"code_text": "# BUSCO stacked bars (house style), sorted by complete (single-copy + duplicated) percent; the four\n# classes are named in a key row above the bars. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nsort_by_completeness <- TRUE\nshow_percent <- TRUE\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nstatus_order <- c(\"Complete single-copy\", \"Complete duplicated\", \"Fragmented\", \"Missing\")\ndf$status <- factor(df$status, levels = status_order)\nbusco_cols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"sky\"]], hp[[\"gold\"]], grey[[\"light\"]]), status_order)\n\nwide_s <- tapply(df$percent, list(df$assembly, df$status), sum)\ncomplete <- wide_s[, \"Complete single-copy\"] + wide_s[, \"Complete duplicated\"]\nord <- if (isTRUE(sort_by_completeness)) names(sort(complete, decreasing = FALSE)) else rev(sort(unique(df$assembly)))\ndf$assembly <- factor(df$assembly, levels = ord)\n\nlab <- data.frame(assembly = factor(names(complete), levels = ord), complete = as.numeric(complete),\n single = as.numeric(wide_s[names(complete), \"Complete single-copy\"]))\nlab$y <- as.numeric(lab$assembly)\n\ndf <- df[order(df$assembly, df$status), , drop = FALSE]\ndf$xmax <- ave(df$percent, df$assembly, FUN = cumsum)\ndf$xmin <- df$xmax - df$percent\ndf$y <- as.numeric(df$assembly)\nn <- nlevels(df$assembly)\n\n# key row above the bars: swatch + class name, at fixed x positions\nkey <- data.frame(status = factor(status_order, levels = status_order),\n x = c(0, 30, 59, 81), lab = c(\"Single-copy\", \"Duplicated\", \"Fragmented\", \"Missing\"))\nkey_y <- n + 1.05\n\np <- ggplot(df) +\n geom_rect(aes(ymin = y - 0.38, ymax = y + 0.38, xmin = xmin, xmax = xmax, fill = status), colour = NA) +\n geom_rect(data = key, aes(xmin = x, xmax = x + 2.6, ymin = key_y - 0.3, ymax = key_y + 0.3, fill = status), colour = NA) +\n geom_text(data = key, aes(x = x + 3.6, y = key_y, label = lab), hjust = 0, size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family()) +\n scale_fill_manual(values = busco_cols, guide = \"none\") +\n scale_x_continuous(limits = c(0, 100), expand = c(0, 0), breaks = seq(0, 100, 25)) +\n scale_y_continuous(breaks = seq_len(n), labels = levels(df$assembly),\n expand = expansion(add = c(0.5, 0.3))) +\n coord_cartesian(ylim = c(1, key_y + 0.3), clip = \"off\") +\n labs(x = \"BUSCO genes (%)\", y = NULL, caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 2, 1, 1, \"mm\")) + caption_theme\n\nif (isTRUE(show_percent)) {\n # complete percent 1 point inside the single-copy block, white on the blue\n p <- p + geom_text(data = lab, aes(x = single - 1, y = y, label = sprintf(\"%.1f\", complete)),\n hjust = 1, size = pv_pt2size(7), colour = \"white\", family = house_family())\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "busco stacked bar\nbusco 堆积条形\nbusco-bar\n\ngenome\n基因组\ngenome\n基因组\ngenome\n比较多份基因组组装的完整度、重复、碎片和缺失比例时用。\nsort_by_completeness 为 true 时按单拷贝与重复之和的完整度将最优组装排在顶部，false 则按名称排序；show_percent 在单拷贝块内以白字写出完整度百分比；分类名称列于条形上方且无图例。\nbusco assembly-quality\nassembly 组装名（字符串） status complete single-copy、complete duplicated、fragmented 或 missing（字符串） percent 该类别占 busco 基因的百分比（数值）"
},
{
"title": "Chromosome ideogram",
"title_zh": "染色体示意图与密度",
"slug": "chromosome-ideogram",
"category": "genome",
"tags": [
"ideogram",
"karyotype",
"gene-density"
],
"packages": [
"ggplot2"
],
"data_columns": {
"chr": "染色体名（字符串）",
"start": "区间起点，bp（整数）",
"end": "区间终点，bp（整数）",
"feature": "chromosome、centromere、nor 或 density（字符串）",
"value": "基因密度，genes/Mb；非密度行可空（数值）"
},
"when_to_use": "展示植物染色体相对长度、着丝粒与短臂 NOR，并叠加基因密度时用。",
"customize": "show_density 控制在右下角空白处放置基因密度水平色条和全基因组均值；show_band_labels 在着丝粒下方标注 CEN 并在 NOR 上方标注 NOR；染色体从上至下为 Chr1 到 Chr8。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_density",
"value": "TRUE"
},
{
"name": "show_band_labels",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/chromosome-ideogram/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/chromosome-ideogram/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/chromosome-ideogram/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/chromosome-ideogram/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/chromosome-ideogram/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/chromosome-ideogram/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/chromosome-ideogram/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/chromosome-ideogram/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/chromosome-ideogram/make_data.R"
}
],
"dir": "figures/genome/chromosome-ideogram",
"preview": "figures/genome/chromosome-ideogram/preview.png",
"docs_preview": "previews/chromosome-ideogram.png",
"code": "figures/genome/chromosome-ideogram/plot.R",
"data": "figures/genome/chromosome-ideogram/data.csv",
"data_files": [
"figures/genome/chromosome-ideogram/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/chromosome-ideogram/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/chromosome-ideogram/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/chromosome-ideogram",
"code_text": "# Plant chromosome ideogram with gene-density track (house style): density on the warm house ramp,\n# centromeres black, NORs blue; colour bar and genome-wide mean density inside the empty lower right.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_density <- TRUE\nshow_band_labels <- TRUE\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nchr_levels <- sprintf(\"Chr%d\", 8:1)\ndf$chr <- factor(df$chr, levels = chr_levels)\ndf$y <- as.numeric(df$chr) * 1.45\n\nideo <- df[df$feature == \"chromosome\", , drop = FALSE]\ncen <- df[df$feature == \"centromere\", , drop = FALSE]\nnor <- df[df$feature == \"nor\", , drop = FALSE]\ndens <- df[df$feature == \"density\", , drop = FALSE]\nh <- 0.3\nnor_col <- hp[[\"blue\"]]\n\np <- ggplot() +\n geom_rect(data = ideo, aes(xmin = start / 1e6, xmax = end / 1e6, ymin = y - h, ymax = y + h),\n fill = grey[[\"bg\"]], colour = NA)\nif (isTRUE(show_density)) {\n p <- p + geom_rect(data = dens, aes(xmin = start / 1e6, xmax = end / 1e6, ymin = y - h, ymax = y + h, fill = value),\n colour = NA)\n}\np <- p +\n geom_rect(data = ideo, aes(xmin = start / 1e6, xmax = end / 1e6, ymin = y - h, ymax = y + h),\n fill = NA, colour = grey[[\"text\"]], linewidth = pv_house_lw(\"frame\")) +\n geom_rect(data = cen, aes(xmin = start / 1e6, xmax = end / 1e6, ymin = y - h, ymax = y + h),\n fill = grey[[\"text\"]], colour = NA) +\n geom_rect(data = nor, aes(xmin = start / 1e6, xmax = end / 1e6, ymin = y + h * 0.15, ymax = y + h),\n fill = nor_col, colour = NA)\n\nif (isTRUE(show_band_labels)) {\n lab <- rbind(\n data.frame(x = (cen$start + cen$end) / 2 / 1e6, y = cen$y - h - 0.08, label = \"CEN\", vj = 1, col = \"#1A1A1A\"),\n data.frame(x = (nor$start + nor$end) / 2 / 1e6, y = nor$y + h + 0.08, label = \"NOR\", vj = 0,\n col = text_col(nor_col))\n )\n p <- p + geom_text(data = lab, aes(x, y, label = label, vjust = vj, colour = col), size = pv_pt2size(7),\n family = house_family()) + scale_colour_identity()\n}\n\nxmax <- max(ideo$end) / 1e6\nif (isTRUE(show_density)) {\n p <- p + annotate(\"text\", x = xmax, y = 1.45 * 1 - h, hjust = 1, vjust = 0,\n label = sprintf(\"Mean %.1f genes/Mb\", mean(dens$value, na.rm = TRUE)),\n colour = \"#1A1A1A\", size = pv_pt2size(7), family = house_family()) +\n scale_fill_gradientn(colours = pv_palette(\"house_warm\"), name = \"Genes / Mb\") +\n guides(fill = guide_colourbar(direction = \"horizontal\", title.position = \"top\", ticks = FALSE,\n barwidth = unit(24, \"mm\"), barheight = unit(2, \"mm\")))\n}\n\np <- p +\n scale_y_continuous(breaks = seq_along(chr_levels) * 1.45, labels = chr_levels,\n expand = expansion(add = 0.45)) +\n scale_x_continuous(expand = expansion(mult = c(0.01, 0.02))) +\n labs(x = \"Position (Mb)\", y = NULL, caption = footnote) +\n theme_house() +\n theme(legend.position = \"inside\", legend.position.inside = c(1, 0.42),\n legend.justification.inside = c(1, 0.5), legend.background = element_blank(),\n legend.title = element_text(size = 7), legend.text = element_text(size = 7),\n axis.ticks.y = element_blank(), plot.margin = margin(1, 2, 1, 1, \"mm\")) +\n caption_theme\n\npv_save_house(p, \"figure\", cells = \"4x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "chromosome ideogram\n染色体示意图与密度\nchromosome-ideogram\n\ngenome\n基因组\ngenome\n基因组\ngenome\n展示植物染色体相对长度、着丝粒与短臂 nor，并叠加基因密度时用。\nshow_density 控制在右下角空白处放置基因密度水平色条和全基因组均值；show_band_labels 在着丝粒下方标注 cen 并在 nor 上方标注 nor；染色体从上至下为 chr1 到 chr8。\nideogram karyotype gene-density\nchr 染色体名（字符串） start 区间起点，bp（整数） end 区间终点，bp（整数） feature chromosome、centromere、nor 或 density（字符串） value 基因密度，genes/mb；非密度行可空（数值）"
},
{
"title": "Circos plot",
"title_zh": "基因组圈图",
"slug": "circos",
"category": "genome",
"tags": [
"circos",
"genome",
"synteny"
],
"packages": [
"circlize",
"ggplot2",
"ggplotify"
],
"data_columns": {
"chr": "染色体名（字符串）",
"start": "区间起点，bp（整数）",
"end": "区间终点，bp（整数）",
"value": "密度或柱高；连线行留空（数值）",
"link_to": "连线终点，格式 ChrN:start-end；密度行留空（字符串）"
},
"when_to_use": "在一张圈图里同时看染色体密度和区间之间的连线时用。",
"customize": "show_heatmap 用 house_warm 颜色画密度环；show_bars 画蓝色密度柱；show_links 画紫色条带；link_alpha 调整条带透明度；左上角显示环形图例和条带计数，染色体名称朝内。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_heatmap",
"value": "TRUE"
},
{
"name": "show_bars",
"value": "TRUE"
},
{
"name": "show_links",
"value": "TRUE"
},
{
"name": "link_alpha",
"value": "0.35"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/circos/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/circos/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/circos/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/circos/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/circos/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/circos/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/circos/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/circos/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/circos/make_data.R"
}
],
"dir": "figures/genome/circos",
"preview": "figures/genome/circos/preview.png",
"docs_preview": "previews/circos.png",
"code": "figures/genome/circos/plot.R",
"data": "figures/genome/circos/data.csv",
"data_files": [
"figures/genome/circos/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/circos/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/circos/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/circos",
"code_text": "# Circos (house style): ideogram ring with chromosome names, density heatmap ring (warm house ramp),\n# bar ring and link ribbons. circlize base graphics, wrapped with ggplotify for pv_save_house(); text is\n# Arial 7 pt via cex = pt / 12 (ggplotify replays on a 12 pt device). Ring key and link count sit in\n# the hole. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_heatmap <- TRUE\nshow_bars <- TRUE\nshow_links <- TRUE\nlink_alpha <- 0.35\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nbins <- df[!is.na(df$value), , drop = FALSE]\nlinks <- df[is.na(df$value) & nzchar(df$link_to), , drop = FALSE]\n\nfam <- house_family()\n# ggplotify measures text on an off-screen pdf device, which only knows the PostScript font list; give\n# it Helvetica metrics for the house family so that step does not warn (output devices use real Arial)\nif (is.null(grDevices::pdfFonts()[[fam]])) {\n do.call(grDevices::pdfFonts, stats::setNames(list(grDevices::pdfFonts()$Helvetica), fam))\n}\ncex_pt <- function(pt) pt / 12\nheat_cols <- grDevices::colorRampPalette(pv_palette(\"house_warm\"))(64)\nbar_col <- hp[[\"blue\"]]\nlink_col <- hp[[\"purple\"]]\n\nparse_link <- function(x) {\n parts <- strsplit(x, \":\", fixed = TRUE)[[1]]\n se <- strsplit(parts[2], \"-\", fixed = TRUE)[[1]]\n data.frame(chr = parts[1], start = as.numeric(se[1]), end = as.numeric(se[2]), stringsAsFactors = FALSE)\n}\n\ndraw <- function() {\n graphics::par(bg = \"white\", mar = c(0, 0, 0, 0), family = fam)\n ideo <- stats::aggregate(end ~ chr, bins, max)\n ideo$start <- 0\n ideo <- ideo[, c(\"chr\", \"start\", \"end\")]\n circlize::circos.clear()\n circlize::circos.par(cell.padding = c(0, 0, 0, 0), track.margin = c(0.006, 0.006), gap.degree = 2,\n start.degree = 90, points.overflow.warning = FALSE, canvas.xlim = c(-1.12, 1.12),\n canvas.ylim = c(-1.12, 1.12))\n circlize::circos.genomicInitialize(ideo, plotType = NULL, tickLabelsStartFromZero = FALSE)\n circlize::circos.track(\n ylim = c(0, 1), track.height = 0.07, bg.border = NA,\n panel.fun = function(x, y) {\n chr <- circlize::get.cell.meta.data(\"sector.index\")\n xlim <- circlize::get.cell.meta.data(\"xlim\")\n circlize::circos.rect(xlim[1], 0, xlim[2], 1, col = grey[[\"light\"]], border = grey[[\"text\"]],\n lwd = 0.5 / 0.75)\n circlize::circos.text(mean(xlim), 1.5, chr, cex = cex_pt(7), col = \"#1A1A1A\",\n facing = \"inside\", niceFacing = TRUE, adj = c(0.5, 0))\n }\n )\n if (isTRUE(show_heatmap)) {\n brk <- seq(min(bins$value), max(bins$value), length.out = length(heat_cols) + 1L)\n circlize::circos.genomicTrack(\n bins[, c(\"chr\", \"start\", \"end\", \"value\")], ylim = c(0, 1), track.height = 0.11, bg.border = NA,\n panel.fun = function(region, value, ...) {\n idx <- findInterval(value[[1]], brk, all.inside = TRUE)\n circlize::circos.genomicRect(region, value, ytop = 1, ybottom = 0, col = heat_cols[idx], border = NA)\n }\n )\n }\n if (isTRUE(show_bars)) {\n ymax <- max(bins$value) * 1.05\n circlize::circos.genomicTrack(\n bins[, c(\"chr\", \"start\", \"end\", \"value\")], ylim = c(0, ymax), track.height = 0.15,\n bg.border = grey[[\"light\"]],\n panel.fun = function(region, value, ...) {\n circlize::circos.genomicRect(region, value, ytop = value[[1]], ybottom = 0, col = bar_col, border = NA)\n }\n )\n }\n if (isTRUE(show_links) && nrow(links)) {\n to <- do.call(rbind, lapply(links$link_to, parse_link))\n circlize::circos.genomicLink(links[, c(\"chr\", \"start\", \"end\")], to,\n col = grDevices::adjustcolor(link_col, alpha.f = link_alpha), border = NA)\n }\n circlize::circos.clear()\n}\n# ring key + stat in the top-left corner, outside the circle\nkey <- c(if (isTRUE(show_heatmap)) sprintf(\"Heat ring: density\\n(%.0f-%.0f)\", min(bins$value), max(bins$value)),\n if (isTRUE(show_bars)) \"Bar ring: density\",\n if (isTRUE(show_links) && nrow(links)) sprintf(\"%d links\", nrow(links)))\nkey_col <- c(if (isTRUE(show_heatmap)) \"#1A1A1A\", if (isTRUE(show_bars)) text_col(c(b = bar_col))[[1]],\n if (isTRUE(show_links) && nrow(links)) text_col(c(l = link_col))[[1]])\nkey_y <- 0.985 - c(0, cumsum(ifelse(grepl(\"\\n\", key), 0.075, 0.042)))[seq_along(key)]\n\np <- ggplotify::as.ggplot(draw) +\n annotate(\"text\", x = 0, y = key_y, label = key, colour = key_col, hjust = 0, vjust = 1, lineheight = 0.9,\n size = pv_pt2size(7), family = fam) +\n coord_fixed(xlim = c(0, 1), ylim = c(0, 1), expand = FALSE) +\n labs(caption = footnote) +\n theme(text = element_text(family = fam), plot.background = element_rect(fill = \"white\", colour = NA)) +\n caption_theme\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "circos plot\n基因组圈图\ncircos\n\ngenome\n基因组\ngenome\n基因组\ngenome\n在一张圈图里同时看染色体密度和区间之间的连线时用。\nshow_heatmap 用 house_warm 颜色画密度环；show_bars 画蓝色密度柱；show_links 画紫色条带；link_alpha 调整条带透明度；左上角显示环形图例和条带计数，染色体名称朝内。\ncircos genome synteny\nchr 染色体名（字符串） start 区间起点，bp（整数） end 区间终点，bp（整数） value 密度或柱高；连线行留空（数值） link_to 连线终点，格式 chrn:start-end；密度行留空（字符串）"
},
{
"title": "Coverage and signal tracks",
"title_zh": "覆盖度与信号轨道",
"slug": "coverage-track",
"category": "genome",
"tags": [
"coverage",
"atac",
"cnv"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"track": "Depth、ATAC、RNA 或 CNV（字符串）",
"pos": "位点坐标，bp（数值）",
"value": "该轨道的信号；CNV 为拷贝数（数值）"
},
"when_to_use": "在同一 2 Mb 位点上对照测序深度、ATAC、RNA 和拷贝数变化时用。",
"customize": "show_depth，show_atac，show_rna 和 show_cnv 各自控制一个轨道，仅最底层轨道有 X 轴；轨道名与统计量写在内部；非二倍体片段标注拷贝数增减并在 CN 2 处画虚线。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_depth",
"value": "TRUE"
},
{
"name": "show_atac",
"value": "TRUE"
},
{
"name": "show_rna",
"value": "TRUE"
},
{
"name": "show_cnv",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/coverage-track/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/coverage-track/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/coverage-track/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/coverage-track/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/coverage-track/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/coverage-track/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/coverage-track/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/coverage-track/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/coverage-track/make_data.R"
}
],
"dir": "figures/genome/coverage-track",
"preview": "figures/genome/coverage-track/preview.png",
"docs_preview": "previews/coverage-track.png",
"code": "figures/genome/coverage-track/plot.R",
"data": "figures/genome/coverage-track/data.csv",
"data_files": [
"figures/genome/coverage-track/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/coverage-track/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/coverage-track/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/coverage-track",
"code_text": "# Stacked locus tracks (house style): depth, ATAC, RNA and copy-number segments, track names inside the\n# panels, CN written on each non-diploid segment. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# 可调参数 -----------------------------------------------------------------\nshow_depth <- TRUE\nshow_atac <- TRUE\nshow_rna <- TRUE\nshow_cnv <- TRUE\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$mb <- df$pos / 1e6\nxr <- range(df$mb)\ntrack_cols <- c(Depth = hp[[\"blue\"]], ATAC = hp[[\"purple\"]], RNA = hp[[\"green\"]])\n\ntrack_theme <- function(bottom = FALSE) {\n th <- theme_house() + theme(plot.margin = margin(0.6, 1.5, 0.6, 1, \"mm\"))\n if (!bottom) th <- th + theme(axis.title.x = element_blank(), axis.text.x = element_blank())\n th\n}\nx_scale <- list(scale_x_continuous(expand = c(0, 0)), coord_cartesian(xlim = xr))\n\nsignal_panel <- function(trk, ylab, stat, bottom) {\n sub <- df[df$track == trk, , drop = FALSE]\n ggplot(sub, aes(mb, value)) +\n geom_area(fill = track_cols[[trk]], alpha = 0.35, colour = NA) +\n geom_line(colour = track_cols[[trk]], linewidth = pv_house_lw(\"minor\")) +\n annotate(\"text\", x = xr[1] + 0.01 * diff(xr), y = Inf, hjust = 0, vjust = 1.3,\n label = sprintf(\"%s %s\", trk, stat(sub$value)), colour = text_col(track_cols)[[trk]],\n size = pv_pt2size(7), family = house_family()) +\n x_scale + scale_y_continuous(expand = expansion(mult = c(0, 0.35))) +\n labs(x = \"Position on Chr5 (Mb)\", y = ylab) + track_theme(bottom)\n}\n\npanels <- list(); heights <- numeric()\nif (isTRUE(show_depth)) {\n panels[[length(panels) + 1L]] <- signal_panel(\"Depth\", \"Depth (x)\", function(v) sprintf(\"(mean %.0fx)\", mean(v)),\n !isTRUE(show_atac) && !isTRUE(show_rna) && !isTRUE(show_cnv))\n heights <- c(heights, 1)\n}\nif (isTRUE(show_atac)) {\n panels[[length(panels) + 1L]] <- signal_panel(\"ATAC\", \"Signal\", function(v) sprintf(\"(max %.0f)\", max(v)),\n !isTRUE(show_rna) && !isTRUE(show_cnv))\n heights <- c(heights, 1)\n}\nif (isTRUE(show_rna)) {\n panels[[length(panels) + 1L]] <- signal_panel(\"RNA\", \"Signal\", function(v) sprintf(\"(max %.0f)\", max(v)),\n !isTRUE(show_cnv))\n heights <- c(heights, 1)\n}\nif (isTRUE(show_cnv)) {\n sub <- df[df$track == \"CNV\", , drop = FALSE]\n sub <- sub[order(sub$mb), , drop = FALSE]\n runs <- rle(sub$value)\n end_ix <- cumsum(runs$lengths); start_ix <- end_ix - runs$lengths + 1L\n half <- diff(sub$mb)[1] / 2\n seg <- data.frame(xmin = sub$mb[start_ix] - half, xmax = sub$mb[end_ix] + half, cn = runs$values)\n cn_all <- c(\"0\" = hp[[\"red\"]], \"1\" = hp[[\"orange\"]], \"2\" = grey[[\"light\"]], \"3\" = hp[[\"sky\"]], \"4\" = hp[[\"blue\"]])\n seg$fill <- cn_all[as.character(seg$cn)]\n gain_loss <- seg[seg$cn != 2, ]\n gain_loss$lab <- ifelse(gain_loss$cn < 2, sprintf(\"loss CN %d\", gain_loss$cn), sprintf(\"gain CN %d\", gain_loss$cn))\n panels[[length(panels) + 1L]] <- ggplot(seg) +\n geom_rect(aes(xmin = xmin, xmax = xmax, ymin = 0, ymax = cn, fill = fill)) +\n geom_hline(yintercept = 2, linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"dark\"]]) +\n geom_text(data = gain_loss, aes(x = (xmin + xmax) / 2, y = cn + 0.25, label = lab), vjust = 0,\n colour = \"#1A1A1A\", size = pv_pt2size(7), family = house_family()) +\n annotate(\"text\", x = xr[1] + 0.01 * diff(xr), y = Inf, hjust = 0, vjust = 1.3, label = \"Copy number\",\n colour = \"#1A1A1A\", size = pv_pt2size(7), family = house_family()) +\n scale_fill_identity() +\n x_scale + scale_y_continuous(breaks = 0:4, limits = c(0, 4.9), expand = c(0, 0)) +\n labs(x = \"Position on Chr5 (Mb)\", y = \"CN\") + track_theme(TRUE)\n heights <- c(heights, 1.2)\n}\n\np <- wrap_plots(panels, ncol = 1, heights = heights) +\n plot_annotation(caption = footnote, theme = theme_house() + caption_theme +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")))\n\npv_save_house(p, \"figure\", cells = \"4x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "coverage and signal tracks\n覆盖度与信号轨道\ncoverage-track\n\ngenome\n基因组\ngenome\n基因组\ngenome\n在同一 2 mb 位点上对照测序深度、atac、rna 和拷贝数变化时用。\nshow_depth，show_atac，show_rna 和 show_cnv 各自控制一个轨道，仅最底层轨道有 x 轴；轨道名与统计量写在内部；非二倍体片段标注拷贝数增减并在 cn 2 处画虚线。\ncoverage atac cnv\ntrack depth、atac、rna 或 cnv（字符串） pos 位点坐标，bp（数值） value 该轨道的信号；cnv 为拷贝数（数值）"
},
{
"title": "aDNA damage curve",
"title_zh": "古 DNA 损伤曲线",
"slug": "damage-curve",
"category": "genome",
"tags": [
"ancient-dna",
"damage",
"misincorporation"
],
"packages": [
"ggplot2"
],
"data_columns": {
"library": "文库，no-UDG 或 half-UDG（字符串）",
"end": "读段末端，5' 或 3'（字符串）",
"pos": "距该末端的碱基位置，1 为末端（整数）",
"rate": "替代频率（数值）",
"substitution": "C>T 或 G>A（字符串）"
},
"when_to_use": "检查古 DNA 是否表现为 5' 端 C→T、3' 端 G→A 的末端损伤时用。",
"customize": "show_ct 与 show_ga 开启对应曲线；libraries_keep 选择 no-UDG 和 half-UDG，每库一行且行名在右；曲线名写在顶行，各面板右上角标出 5' 端第 1 个碱基发生 C>T 以及 3' 端第 1 个碱基发生 G>A 的替换率。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_ct",
"value": "TRUE"
},
{
"name": "show_ga",
"value": "TRUE"
},
{
"name": "libraries_keep",
"value": "c(\"no-UDG\", \"half-UDG\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/damage-curve/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/damage-curve/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/damage-curve/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/damage-curve/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/damage-curve/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/damage-curve/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/damage-curve/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/damage-curve/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/damage-curve/make_data.R"
}
],
"dir": "figures/genome/damage-curve",
"preview": "figures/genome/damage-curve/preview.png",
"docs_preview": "previews/damage-curve.png",
"code": "figures/genome/damage-curve/plot.R",
"data": "figures/genome/damage-curve/data.csv",
"data_files": [
"figures/genome/damage-curve/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/damage-curve/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/damage-curve/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/damage-curve",
"code_text": "# aDNA damage (house style): 5' C>T and 3' G>A by library, one panel per library and read end,\n# substitution names written next to their curves. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_ct <- TRUE\nshow_ga <- TRUE\nlibraries_keep <- c(\"no-UDG\", \"half-UDG\")\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$library %in% libraries_keep, , drop = FALSE]\nif (!isTRUE(show_ct)) df <- df[df$substitution != \"C>T\", , drop = FALSE]\nif (!isTRUE(show_ga)) df <- df[df$substitution != \"G>A\", , drop = FALSE]\n\ndf$end <- factor(df$end, levels = c(\"5'\", \"3'\"), labels = c(\"5' end\", \"3' end\"))\ndf$library <- factor(df$library, levels = libraries_keep)\nsub_cols <- c(\"C>T\" = hp[[\"red\"]], \"G>A\" = hp[[\"blue\"]])\n\n# in-panel stat: terminal-base C>T rate (5' end) and G>A rate (3' end) per library\nterm <- df[df$pos == 1, , drop = FALSE]\nterm <- term[(term$substitution == \"C>T\" & term$end == \"5' end\") |\n (term$substitution == \"G>A\" & term$end == \"3' end\"), , drop = FALSE]\nterm$lab <- sprintf(\"%s at base 1: %.2f\", term$substitution, term$rate)\n# curve names: where each curve sits at position 6, placed above (leading) or below (trailing)\n# (top library only; the panels below use the same colours)\nnm <- df[df$pos == 6 & df$library == levels(df$library)[1], , drop = FALSE]\nnm <- do.call(rbind, lapply(split(nm, interaction(nm$library, nm$end, drop = TRUE)), function(s) {\n s <- s[order(-s$rate), , drop = FALSE]\n s[1, , drop = FALSE]\n}))\n\np <- ggplot(df, aes(pos, rate, colour = substitution)) +\n geom_line(linewidth = pv_house_lw(\"main\")) +\n geom_point(shape = 21, size = 1.2, stroke = 0.3, colour = \"black\", aes(fill = substitution)) +\n geom_text(data = nm, aes(label = substitution), hjust = 0, vjust = -0.6, nudge_x = 0.6,\n size = pv_pt2size(7), family = house_family(), show.legend = FALSE) +\n geom_text(data = term, aes(label = lab), x = Inf, y = Inf, hjust = 1.05, vjust = 1.5,\n colour = grey[[\"dark\"]], size = pv_pt2size(7), family = house_family(), inherit.aes = FALSE) +\n facet_grid(library ~ end) +\n scale_colour_manual(values = text_col(sub_cols), guide = \"none\") +\n scale_fill_manual(values = sub_cols, guide = \"none\") +\n scale_x_continuous(breaks = c(1, 5, 10, 15, 20, 25)) +\n scale_y_continuous(limits = c(0, 0.4), expand = expansion(mult = c(0, 0.04))) +\n labs(x = \"Position from read end (bp)\", y = \"Substitution frequency\", caption = footnote) +\n theme_house() +\n theme(strip.background = element_blank(), strip.text = element_text(size = 7),\n plot.margin = margin(1, 1.5, 1, 1, \"mm\")) +\n caption_theme\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "adna damage curve\n古 dna 损伤曲线\ndamage-curve\n\ngenome\n基因组\ngenome\n基因组\ngenome\n检查古 dna 是否表现为 5' 端 c→t、3' 端 g→a 的末端损伤时用。\nshow_ct 与 show_ga 开启对应曲线；libraries_keep 选择 no-udg 和 half-udg，每库一行且行名在右；曲线名写在顶行，各面板右上角标出 5' 端第 1 个碱基发生 c>t 以及 3' 端第 1 个碱基发生 g>a 的替换率。\nancient-dna damage misincorporation\nlibrary 文库，no-udg 或 half-udg（字符串） end 读段末端，5' 或 3'（字符串） pos 距该末端的碱基位置，1 为末端（整数） rate 替代频率（数值） substitution c>t 或 g>a（字符串）"
},
{
"title": "Fragment length distribution",
"title_zh": "片段长度分布",
"slug": "fragment-length",
"category": "genome",
"tags": [
"ancient-dna",
"fragment-length"
],
"packages": [
"ggplot2"
],
"data_columns": {
"library": "文库，Ancient、Nucleosome 或 Modern（字符串）",
"length_bp": "插入片段长度，bp（整数）"
},
"when_to_use": "比较古 DNA 短片段、核小体保护峰和现代文库插入长度时用。",
"customize": "binwidth 设为 5 且 xmax 设为 500；facet_by_library 为 TRUE 时单库独立分面，右上角写名称与中值并画虚线；FALSE 时三库叠加在一处并在密度峰值处标记。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "binwidth",
"value": "5"
},
{
"name": "xmax",
"value": "500"
},
{
"name": "facet_by_library",
"value": "TRUE"
}
],
"canvas": null,
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/fragment-length/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/fragment-length/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/fragment-length/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/fragment-length/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/fragment-length/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/fragment-length/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/fragment-length/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/fragment-length/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/fragment-length/make_data.R"
}
],
"dir": "figures/genome/fragment-length",
"preview": "figures/genome/fragment-length/preview.png",
"docs_preview": "previews/fragment-length.png",
"code": "figures/genome/fragment-length/plot.R",
"data": "figures/genome/fragment-length/data.csv",
"data_files": [
"figures/genome/fragment-length/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/fragment-length/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/fragment-length/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/fragment-length",
"code_text": "# Fragment-length histograms with density (house style), one stacked panel per library with its name\n# and median length inside (or all libraries overlaid, names at the density peaks). Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nbinwidth <- 5\nxmax <- 500\nfacet_by_library <- TRUE # FALSE: libraries overlaid in one panel (2x1)\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nlibs <- c(\"Ancient\", \"Nucleosome\", \"Modern\")\ndf$library <- factor(df$library, levels = libs)\nlib_cols <- c(Ancient = hp[[\"red\"]], Nucleosome = hp[[\"green\"]], Modern = hp[[\"blue\"]])\nlab_cols <- text_col(lib_cols)\n\nmed <- stats::aggregate(length_bp ~ library, df, stats::median)\n# density peak of each library (for the name position when the libraries share one panel)\npk <- do.call(rbind, lapply(split(df$length_bp, df$library), function(v) {\n d <- stats::density(v, from = 0, to = xmax)\n data.frame(x = d$x[which.max(d$y)], y = max(d$y))\n}))\npk$library <- factor(rownames(pk), levels = libs)\n\np <- ggplot(df, aes(length_bp, fill = library, colour = library)) +\n geom_histogram(aes(y = after_stat(density)), binwidth = binwidth, boundary = 0,\n alpha = 0.35, colour = NA) +\n geom_density(linewidth = pv_house_lw(\"main\"), fill = NA) +\n scale_fill_manual(values = lib_cols, guide = \"none\") +\n scale_colour_manual(values = lib_cols, guide = \"none\") +\n scale_x_continuous(limits = c(0, xmax), breaks = seq(0, xmax, 100), expand = c(0, 0)) +\n scale_y_continuous(expand = expansion(mult = c(0, 0.12))) +\n labs(x = \"Fragment length (bp)\", y = \"Density\", caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 2.5, 1, 1, \"mm\")) + caption_theme\n\nif (isTRUE(facet_by_library)) {\n med$lab <- sprintf(\"%s\\nmedian %d bp\", med$library, round(med$length_bp))\n p <- p +\n geom_vline(data = med, aes(xintercept = length_bp), linetype = \"22\",\n linewidth = pv_house_lw(\"ref\"), colour = grey[[\"dark\"]]) +\n lapply(levels(med$library), function(l) {\n geom_text(data = med[med$library == l, ], aes(label = lab), x = Inf, y = Inf, hjust = 1.05,\n vjust = 1.3, lineheight = 0.95, colour = lab_cols[[l]], size = pv_pt2size(7),\n family = house_family(), inherit.aes = FALSE)\n }) +\n facet_wrap(~library, ncol = 1, scales = \"free_y\") +\n theme(strip.text = element_blank(), panel.spacing.y = unit(2, \"mm\"))\n cells <- \"2x2\"\n} else {\n pk$lab <- sprintf(\"%s (median %d bp)\", pk$library, round(med$length_bp[match(pk$library, med$library)]))\n p <- p + annotate(\"text\", x = pk$x + 12, y = pk$y, label = pk$lab, hjust = 0, vjust = 0.2,\n colour = lab_cols[as.character(pk$library)], size = pv_pt2size(7),\n family = house_family())\n cells <- \"2x1\"\n}\n\npv_save_house(p, \"figure\", cells = cells, bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "fragment length distribution\n片段长度分布\nfragment-length\n\ngenome\n基因组\ngenome\n基因组\ngenome\n比较古 dna 短片段、核小体保护峰和现代文库插入长度时用。\nbinwidth 设为 5 且 xmax 设为 500；facet_by_library 为 true 时单库独立分面，右上角写名称与中值并画虚线；false 时三库叠加在一处并在密度峰值处标记。\nancient-dna fragment-length\nlibrary 文库，ancient、nucleosome 或 modern（字符串） length_bp 插入片段长度，bp（整数）"
},
{
"title": "Gene structure",
"title_zh": "基因结构图",
"slug": "gene-structure",
"category": "genome",
"tags": [
"gene-structure",
"exon",
"isoform"
],
"packages": [
"ggplot2"
],
"data_columns": {
"gene": "基因或转录本名（字符串）",
"feature": "exon、utr、domain 或 mutation（字符串）",
"start": "位点内起点，bp（整数）",
"end": "位点内终点，bp（整数）",
"strand": "链方向，+ 或 -（字符串）"
},
"when_to_use": "比较转录本外显子、UTR、结构域和点突变位置时用。",
"customize": "show_domains，show_isoforms 和 show_mutations 开启对应元素；突变以红三角画在模型上方；图例行及包含总数的统计列于右上角；链方向用 3' 端箭头表示并在行名中标出。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_domains",
"value": "TRUE"
},
{
"name": "show_isoforms",
"value": "TRUE"
},
{
"name": "show_mutations",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/gene-structure/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/gene-structure/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/gene-structure/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/gene-structure/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/gene-structure/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/gene-structure/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/gene-structure/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/gene-structure/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/gene-structure/make_data.R"
}
],
"dir": "figures/genome/gene-structure",
"preview": "figures/genome/gene-structure/preview.png",
"docs_preview": "previews/gene-structure.png",
"code": "figures/genome/gene-structure/plot.R",
"data": "figures/genome/gene-structure/data.csv",
"data_files": [
"figures/genome/gene-structure/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/gene-structure/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/gene-structure/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/gene-structure",
"code_text": "# Gene models (house style) with optional domains, isoform track and mutation marks; the parts are named\n# in a key row above the models, counts as the in-panel stat. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_domains <- TRUE\nshow_isoforms <- TRUE\nshow_mutations <- TRUE\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nif (!isTRUE(show_isoforms)) df <- df[df$gene != \"Gene2.2\", , drop = FALSE]\nif (!isTRUE(show_domains)) df <- df[df$feature != \"domain\", , drop = FALSE]\nif (!isTRUE(show_mutations)) df <- df[df$feature != \"mutation\", , drop = FALSE]\n\npreferred <- c(\"Gene1\", \"Gene2.1\", \"Gene2.2\", \"Gene3\", \"Gene4\", \"Gene5\", \"Gene6\")\ngene_order <- c(preferred[preferred %in% unique(df$gene)], setdiff(unique(df$gene), preferred))\ndf$gene <- factor(df$gene, levels = rev(gene_order))\ndf$y <- as.numeric(df$gene)\nng <- nlevels(df$gene)\n\nbody <- df[df$feature %in% c(\"exon\", \"utr\"), , drop = FALSE]\nspan <- do.call(rbind, lapply(split(body, body$gene), function(d) {\n data.frame(gene = d$gene[1], y = d$y[1], strand = d$strand[1], start = min(d$start), end = max(d$end))\n}))\nexons <- df[df$feature == \"exon\", , drop = FALSE]\nutrs <- df[df$feature == \"utr\", , drop = FALSE]\ndoms <- df[df$feature == \"domain\", , drop = FALSE]\nmuts <- df[df$feature == \"mutation\", , drop = FALSE]\npart_cols <- c(CDS = hp[[\"blue\"]], UTR = hp[[\"sky\"]], Domain = hp[[\"orange\"]], Mutation = hp[[\"red\"]])\nxmax <- max(span$end)\nspan$x_tip <- ifelse(span$strand == \"+\", span$end, span$start)\nspan$x_end <- ifelse(span$strand == \"+\", span$end + 0.025 * xmax, span$start - 0.025 * xmax)\nline_col <- grey[[\"dark\"]]\n\np <- ggplot() +\n geom_segment(data = span, aes(x = start, xend = end, y = y, yend = y), linewidth = pv_house_lw(\"ref\"),\n colour = line_col) +\n geom_segment(data = span, aes(x = x_tip, xend = x_end, y = y, yend = y), linewidth = pv_house_lw(\"ref\"),\n colour = line_col, arrow = arrow(length = unit(1.1, \"mm\"), type = \"closed\")) +\n geom_rect(data = exons, aes(xmin = start, xmax = end, ymin = y - 0.2, ymax = y + 0.2), fill = part_cols[[\"CDS\"]]) +\n geom_rect(data = utrs, aes(xmin = start, xmax = end, ymin = y - 0.11, ymax = y + 0.11), fill = part_cols[[\"UTR\"]])\nif (nrow(doms)) {\n p <- p + geom_rect(data = doms, aes(xmin = start, xmax = end, ymin = y - 0.1, ymax = y + 0.1),\n fill = part_cols[[\"Domain\"]])\n}\nif (nrow(muts)) {\n p <- p + geom_point(data = muts, aes(x = start, y = y + 0.38), shape = 25, size = 1.3, stroke = 0.3,\n fill = part_cols[[\"Mutation\"]], colour = \"black\")\n}\n\n# key row above the top model: swatch + name at fixed x positions (only the parts that are drawn)\nkey <- data.frame(part = names(part_cols), x = c(-0.02, 0.07, 0.16, 0.28) * xmax)\nkey <- key[c(TRUE, TRUE, nrow(doms) > 0, nrow(muts) > 0), ]\nky <- ng + 0.95\np <- p +\n geom_rect(data = key[key$part != \"Mutation\", ], aes(xmin = x, xmax = x + 0.022 * xmax, ymin = ky - 0.16, ymax = ky + 0.16,\n fill = part)) +\n scale_fill_manual(values = part_cols, guide = \"none\") +\n geom_text(data = key, aes(x = x + 0.03 * xmax, y = ky, label = part), hjust = 0, size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family())\nif (nrow(muts)) {\n p <- p + geom_point(data = key[key$part == \"Mutation\", ], aes(x = x + 0.011 * xmax, y = ky), shape = 25,\n size = 1.3, stroke = 0.3, fill = part_cols[[\"Mutation\"]], colour = \"black\")\n}\nstat <- sprintf(\"%d models, %d exons%s\", ng, nrow(exons), if (nrow(muts)) sprintf(\", %d mutations\", nrow(muts)) else \"\")\n\ny_labs <- sprintf(\"%s (%s)\", span$gene, span$strand)\np <- p +\n annotate(\"text\", x = xmax * 1.06, y = ky, label = stat, hjust = 1, size = pv_pt2size(7), colour = grey[[\"dark\"]],\n family = house_family()) +\n scale_y_continuous(breaks = span$y, labels = y_labs, expand = expansion(add = c(0.45, 0.3))) +\n scale_x_continuous(expand = expansion(mult = c(0.02, 0.01))) +\n coord_cartesian(xlim = c(-0.03 * xmax, xmax * 1.06), ylim = c(1, ky)) +\n labs(x = \"Position within locus (bp)\", y = NULL, caption = footnote) +\n theme_house() + theme(axis.ticks.y = element_blank(), plot.margin = margin(1, 2, 1, 1, \"mm\")) + caption_theme\n\npv_save_house(p, \"figure\", cells = \"4x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "gene structure\n基因结构图\ngene-structure\n\ngenome\n基因组\ngenome\n基因组\ngenome\n比较转录本外显子、utr、结构域和点突变位置时用。\nshow_domains，show_isoforms 和 show_mutations 开启对应元素；突变以红三角画在模型上方；图例行及包含总数的统计列于右上角；链方向用 3' 端箭头表示并在行名中标出。\ngene-structure exon isoform\ngene 基因或转录本名（字符串） feature exon、utr、domain 或 mutation（字符串） start 位点内起点，bp（整数） end 位点内终点，bp（整数） strand 链方向，+ 或 -（字符串）"
},
{
"title": "GWAS Manhattan and QQ",
"title_zh": "GWAS 曼哈顿与 QQ",
"slug": "gwas-manhattan",
"category": "genome",
"tags": [
"gwas",
"manhattan",
"qq-plot"
],
"packages": [
"ggplot2",
"ggrepel",
"patchwork"
],
"data_columns": {
"chr": "染色体编号（整数）",
"pos": "染色体位置，bp（整数）",
"p": "关联 p 值（数值）",
"snp": "位点名（字符串）",
"highlight": "1 为要高亮的 QTL，0 为背景（整数）"
},
"when_to_use": "全基因组关联要同时看染色体峰和 p 值校准（QQ）时用。",
"customize": "sig_threshold 画红虚线并在左端标记，sug_threshold 画灰点线；show_qq 显示带有基因组膨胀系数的 QQ 面板；show_labels 结合 n_label 标记顶部 QTL 位点；红色菱形框黑边标出命中点。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "sig_threshold",
"value": "5e-8"
},
{
"name": "sug_threshold",
"value": "1e-5"
},
{
"name": "show_qq",
"value": "TRUE"
},
{
"name": "show_labels",
"value": "TRUE"
},
{
"name": "n_label",
"value": "3L"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "43",
"label": "183 × 43 mm (4×1 cells)",
"cells": "4x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/gwas-manhattan/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/gwas-manhattan/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/gwas-manhattan/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/gwas-manhattan/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/gwas-manhattan/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/gwas-manhattan/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/gwas-manhattan/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/gwas-manhattan/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/gwas-manhattan/make_data.R"
}
],
"dir": "figures/genome/gwas-manhattan",
"preview": "figures/genome/gwas-manhattan/preview.png",
"docs_preview": "previews/gwas-manhattan.png",
"code": "figures/genome/gwas-manhattan/plot.R",
"data": "figures/genome/gwas-manhattan/data.csv",
"data_files": [
"figures/genome/gwas-manhattan/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/gwas-manhattan/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/gwas-manhattan/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/gwas-manhattan",
"code_text": "# Manhattan plus QQ (house style): 12 chromosomes in chrom12 colours (light / dark alternate), QTL hits in\n# red diamonds with repelled SNP labels, genome-wide line at 5e-8, genomic inflation (lambda) in the QQ panel.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# 可调参数 -----------------------------------------------------------------\nsig_threshold <- 5e-8\nsug_threshold <- 1e-5\nshow_qq <- TRUE\nshow_labels <- TRUE\nn_label <- 3L\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[order(df$chr, df$pos), , drop = FALSE]\nchr_max <- tapply(df$pos, df$chr, max)\ngap <- 1.5e6\nchr_ids <- sort(unique(df$chr))\noffset <- stats::setNames(cumsum(c(0, utils::head(chr_max[as.character(chr_ids)] + gap, -1))), chr_ids)\ndf$cum <- df$pos + offset[as.character(df$chr)]\ncenters <- tapply(df$cum, df$chr, function(z) mean(range(z)))\nchr_cols <- stats::setNames(rep(pv_palette(\"chrom12\"), length.out = length(chr_ids)), chr_ids)\nhit_col <- hp[[\"red\"]]\ndf$col <- ifelse(df$highlight == 1L, hit_col, chr_cols[as.character(df$chr)])\nref_col <- grey[[\"dark\"]]\nxmax <- max(df$cum) / 1e6\n\np_man <- ggplot(df, aes(cum / 1e6, -log10(p))) +\n geom_point(data = df[df$highlight != 1L, ], aes(colour = col), size = 0.5, shape = 16) +\n # QTL hits: red diamonds with a black outline, so they stand out from the red chrom12 pair\n geom_point(data = df[df$highlight == 1L, ], shape = 23, size = 1.6, stroke = 0.3, fill = hit_col,\n colour = \"black\") +\n scale_colour_identity() +\n geom_hline(yintercept = -log10(sig_threshold), linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = hit_col) +\n geom_hline(yintercept = -log10(sug_threshold), linetype = \"12\", linewidth = pv_house_lw(\"ref\"), colour = ref_col) +\n annotate(\"text\", x = xmax * 0.008, y = -log10(sig_threshold), hjust = 0, vjust = -0.7,\n label = sprintf(\"genome-wide %s\", sub(\"e-0\", \"e-\", format(sig_threshold))), size = pv_pt2size(7),\n colour = text_col(c(x = hit_col))[[1]], family = house_family()) +\n annotate(\"text\", x = xmax * 0.008, y = -log10(sug_threshold), hjust = 0, vjust = -0.7,\n label = sprintf(\"suggestive %s\", sub(\"e-0\", \"e-\", format(sug_threshold))), size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family()) +\n scale_x_continuous(breaks = centers / 1e6, labels = chr_ids, expand = expansion(mult = c(0.01, 0.01))) +\n scale_y_continuous(expand = expansion(mult = c(0, 0.08))) +\n labs(x = \"Chromosome\", y = \"-log10 P\") +\n theme_house()\n\nif (isTRUE(show_labels)) {\n lab <- df[df$highlight == 1L, , drop = FALSE]\n lab <- utils::head(lab[order(lab$p), , drop = FALSE], n_label)\n # Fixed seed and iteration cap, no time cap (ggrepel defaults max.time to 0.5 s),\n # so the layout does not depend on machine speed.\n p_man <- p_man + ggrepel::geom_text_repel(\n data = lab, aes(label = snp),\n size = pv_pt2size(7), colour = \"#1A1A1A\",\n segment.size = pv_house_lw(\"ref\"), segment.colour = ref_col, min.segment.length = 0,\n box.padding = 0.4, point.padding = 0.3, nudge_x = 40, nudge_y = 1,\n max.overlaps = 20, seed = 1, max.iter = 10000, max.time = Inf,\n family = house_family()\n )\n}\n\nobs <- sort(-log10(df$p))\nexp_lp <- -log10(rev(stats::ppoints(length(obs))))\nqq <- data.frame(expected = exp_lp, observed = obs)\nlambda <- stats::median(stats::qchisq(df$p, 1, lower.tail = FALSE)) / stats::qchisq(0.5, 1)\np_qq <- ggplot(qq, aes(expected, observed)) +\n geom_abline(slope = 1, intercept = 0, linewidth = pv_house_lw(\"ref\"), colour = ref_col) +\n geom_point(size = 0.6, shape = 16, colour = hp[[\"blue\"]]) +\n annotate(\"text\", x = 0, y = Inf, hjust = 0, vjust = 1.4, label = sprintf(\"lambda = %.3f\", lambda),\n size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family()) +\n labs(x = \"Expected -log10 P\", y = \"Observed -log10 P\") +\n theme_house()\n\nnote <- plot_annotation(caption = footnote, theme = theme_house() + caption_theme +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")))\nif (isTRUE(show_qq)) {\n p <- (p_man | p_qq) + plot_layout(widths = c(3, 1)) + note\n} else {\n p <- p_man + note\n}\n\npv_save_house(p, \"figure\", cells = \"4x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "gwas manhattan and qq\ngwas 曼哈顿与 qq\ngwas-manhattan\n\ngenome\n基因组\ngenome\n基因组\ngenome\n全基因组关联要同时看染色体峰和 p 值校准（qq）时用。\nsig_threshold 画红虚线并在左端标记，sug_threshold 画灰点线；show_qq 显示带有基因组膨胀系数的 qq 面板；show_labels 结合 n_label 标记顶部 qtl 位点；红色菱形框黑边标出命中点。\ngwas manhattan qq-plot\nchr 染色体编号（整数） pos 染色体位置，bp（整数） p 关联 p 值（数值） snp 位点名（字符串） highlight 1 为要高亮的 qtl，0 为背景（整数）"
},
{
"title": "Hi-C contact map",
"title_zh": "Hi-C 接触图",
"slug": "hic-contact",
"category": "genome",
"tags": [
"hic",
"contact-map",
"chromosome-conformation"
],
"packages": [
"ggplot2"
],
"data_columns": {
"bin_i": "行 bin，全基因组顺序编号（整数）",
"bin_j": "列 bin（整数）",
"chr": "bin_i 所在染色体（字符串）",
"count": "接触次数（整数）"
},
"when_to_use": "查看染色体领地、距离衰减，以及植物中着丝粒之间的 Rabl 接触时用。",
"customize": "log_color 为 TRUE 时对计数加一后取对数，FALSE 用原始计数；show_chr_split 用灰线显示染色体边界；色条位于地图右下方，左下角显示顺式互作比例。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "log_color",
"value": "TRUE"
},
{
"name": "show_chr_split",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/hic-contact/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/hic-contact/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/hic-contact/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/hic-contact/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/hic-contact/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/hic-contact/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/hic-contact/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/hic-contact/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/hic-contact/make_data.R"
}
],
"dir": "figures/genome/hic-contact",
"preview": "figures/genome/hic-contact/preview.png",
"docs_preview": "previews/hic-contact.png",
"code": "figures/genome/hic-contact/plot.R",
"data": "figures/genome/hic-contact/data.csv",
"data_files": [
"figures/genome/hic-contact/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/hic-contact/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/hic-contact/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/hic-contact",
"code_text": "# Hi-C contact map (house style): log colour on the warm house ramp, chromosome boundaries, share of\n# intra-chromosomal (cis) contacts as the in-panel stat. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nlog_color <- TRUE\nshow_chr_split <- TRUE\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nchr_of <- tapply(df$chr, df$bin_i, function(z) z[1])\nchr_names <- unique(chr_of[order(as.integer(names(chr_of)))])\nbin_n <- tapply(df$bin_i, df$chr, function(z) length(unique(z)))[chr_names]\nbounds <- cumsum(bin_n)\nmids <- (c(0, utils::head(bounds, -1)) + bounds) / 2\nnb <- max(bounds)\n\ndf$fill <- if (isTRUE(log_color)) log10(df$count + 1) else df$count\nleg <- if (isTRUE(log_color)) \"log10(count + 1)\" else \"Count\"\ncis <- sum(df$count[chr_of[as.character(df$bin_i)] == chr_of[as.character(df$bin_j)]]) / sum(df$count)\n\np <- ggplot(df, aes(bin_j, bin_i, fill = fill)) +\n geom_raster() +\n scale_fill_gradientn(colours = pv_palette(\"house_warm\"), name = leg) +\n scale_x_continuous(breaks = mids, labels = chr_names, expand = c(0, 0), position = \"top\") +\n scale_y_reverse(breaks = mids, labels = chr_names, expand = c(0, 0)) +\n coord_fixed(xlim = c(0.5, nb + 0.5), ylim = c(0.5, nb + 0.5), expand = FALSE, clip = \"off\") +\n annotate(\"text\", x = 0.5, y = nb + 0.5 + nb * 0.035, label = sprintf(\"cis contacts %.0f%%\", 100 * cis),\n hjust = 0, vjust = 1, colour = \"#1A1A1A\", size = pv_pt2size(7), family = house_family()) +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() +\n theme(legend.position = \"bottom\", legend.justification = \"right\",\n legend.title = element_text(size = 7, vjust = 0.85), legend.text = element_text(size = 7),\n legend.margin = margin(0, 0, 0, 0), legend.box.spacing = unit(1, \"mm\"),\n plot.margin = margin(1, 2, 1, 1, \"mm\")) +\n guides(fill = guide_colourbar(barwidth = unit(28, \"mm\"), barheight = unit(2.2, \"mm\"), ticks = FALSE)) +\n caption_theme\n\nif (isTRUE(show_chr_split)) {\n edges <- utils::head(bounds, -1) + 0.5\n p <- p + geom_hline(yintercept = edges, linewidth = pv_house_lw(\"ref\"), colour = grey[[\"dark\"]]) +\n geom_vline(xintercept = edges, linewidth = pv_house_lw(\"ref\"), colour = grey[[\"dark\"]])\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "hi-c contact map\nhi-c 接触图\nhic-contact\n\ngenome\n基因组\ngenome\n基因组\ngenome\n查看染色体领地、距离衰减，以及植物中着丝粒之间的 rabl 接触时用。\nlog_color 为 true 时对计数加一后取对数，false 用原始计数；show_chr_split 用灰线显示染色体边界；色条位于地图右下方，左下角显示顺式互作比例。\nhic contact-map chromosome-conformation\nbin_i 行 bin，全基因组顺序编号（整数） bin_j 列 bin（整数） chr bin_i 所在染色体（字符串） count 接触次数（整数）"
},
{
"title": "Manhattan plot with chrom12 colours (house style)",
"title_zh": "chrom12 配色曼哈顿图（house 风格）",
"slug": "house-manhattan",
"category": "genome",
"tags": [
"gwas",
"manhattan",
"bonferroni",
"chrom12-palette",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"chr": "染色体编号（整数，1–12）",
"pos_mb": "位置（Mb）",
"neg_log10_p": "−log10 P"
},
"when_to_use": "Use this for a 4x1 layout measuring 183 x 43 mm with 7 or 8 pt text. The dataset includes 12 chromosomes and 6,000 SNPs. The Bonferroni threshold is 0.05 / 6,000, which equals 8.33 x 10^-6. The -log10 P threshold is 5.079, displayed as -log10 P = 5.08. There are 47 significant SNPs, with peaks on chr3 and chr8. Place the threshold label above the left end of the dashed line. The upper y limit is the highest peak plus 0.8. Place a single-line footnote inside the figure, below the plot box. The lead SNP is a red diamond with a black outline, about twice the significant point size (1.9 vs 0.9). Label the lead SNP as \"chrN lead SNP\". The data represents a simulated 12-chromosome genome like rice or tomato. The in-plot footnote uses 7 pt text. The footnote reads: \"Simulated 12-chromosome genome (rice/tomato-like). Simulated data for illustration; not biological results\". The data.csv file is 88 KB, remaining well under the 200 KB limit.",
"customize": "The threshold is calculated dynamically from the data.csv row count. This ensures the threshold updates automatically when data changes. Adjust inter-chromosome spacing using the GAP_MB variable. Map colors by chromosome number using pv_palette(\"chrom12\"). Using more than 12 chromosomes throws an error and requires a different color scheme.",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "SIM_NOTE",
"value": "\"Simulated 12-chromosome genome (rice/tomato-like). Simulated data for illustration; not biological results\""
},
{
"name": "GAP_MB",
"value": "6"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "43",
"label": "183 × 43 mm (4×1 cells)",
"cells": "4x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/house-manhattan/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/house-manhattan/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/house-manhattan/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/house-manhattan/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/house-manhattan/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/house-manhattan/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/house-manhattan/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/house-manhattan/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/house-manhattan/make_data.R"
}
],
"dir": "figures/genome/house-manhattan",
"preview": "figures/genome/house-manhattan/preview.png",
"docs_preview": "previews/house-manhattan.png",
"code": "figures/genome/house-manhattan/plot.R",
"data": "figures/genome/house-manhattan/data.csv",
"data_files": [
"figures/genome/house-manhattan/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/house-manhattan/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/house-manhattan/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/house-manhattan",
"code_text": "# House-style Manhattan plot, 12 chromosomes coloured with pv_palette(\"chrom12\") (light/dark pairs, so\n# neighbouring chromosomes always alternate light and dark). Bonferroni threshold = 0.05 / N SNPs, with N\n# taken from data.csv. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nSIM_NOTE <- \"Simulated 12-chromosome genome (rice/tomato-like). Simulated data for illustration; not biological results\"\nGAP_MB <- 6 # gap between chromosomes on the x axis\n\nd <- utils::read.csv(\"data.csv\")\nn_snp <- nrow(d)\nthr <- -log10(0.05 / n_snp) # Bonferroni on -log10 scale\nchr_ids <- sort(unique(d$chr))\ncols <- stats::setNames(pv_palette(\"chrom12\"), chr_ids)\nstopifnot(length(chr_ids) == 12, length(cols) == 12)\n\nlen <- tapply(d$pos_mb, d$chr, max)\noff <- stats::setNames(c(0, cumsum(len + GAP_MB))[seq_along(len)], names(len))\nd$x <- d$pos_mb + off[as.character(d$chr)]\nmid <- off + len / 2\nd$chr_f <- factor(d$chr, levels = chr_ids)\nd$sig <- d$neg_log10_p > thr\n\n# lead SNP of each significant chromosome\nlead <- do.call(rbind, lapply(split(d[d$sig, ], d$chr[d$sig]), function(s) s[which.max(s$neg_log10_p), ]))\nlead$lab <- sprintf(\"chr%d lead SNP\", lead$chr)\nstopifnot(nrow(lead) >= 1, all(lead$neg_log10_p > thr))\n\nymax <- max(d$neg_log10_p) + 0.8 # just above the highest peak\nthr_lab <- sprintf(\"Bonferroni (0.05/%s)\\n%s = %.2f\", format(n_snp, big.mark = \",\"), \"-log10 P\", thr)\nxr <- range(d$x)\n\np <- ggplot(d, aes(x, neg_log10_p)) +\n geom_point(data = d[!d$sig, ], aes(colour = chr_f), size = 0.55, stroke = 0) +\n geom_point(data = d[d$sig, ], aes(colour = chr_f), size = 0.9, stroke = 0) +\n geom_hline(yintercept = thr, linetype = \"22\", linewidth = pv_house_lw(0.5),\n colour = pv_palette(\"house_grey\")[[\"mid\"]]) +\n annotate(\"text\", x = xr[1], y = thr + 0.25, label = thr_lab, hjust = 0, vjust = 0, lineheight = 0.95, size = pv_pt2size(7),\n colour = pv_palette(\"house_grey\")[[\"dark\"]]) +\n # lead SNPs: red diamond with black outline, about twice a normal point, so they stand out from the\n # red / brown-red chrom12 colours\n geom_point(data = lead, shape = 23, size = 1.9, stroke = 0.35, fill = pv_palette(\"house\")[[\"red\"]],\n colour = \"black\") +\n geom_text(data = lead, aes(label = lab), nudge_x = 11, hjust = 0, vjust = 0.5, size = pv_pt2size(7)) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(breaks = mid, labels = chr_ids, expand = c(0.005, 0)) +\n scale_y_continuous(limits = c(0, ymax), breaks = seq(0, 12, 4), expand = c(0, 0)) +\n labs(x = \"Chromosome\", y = \"-log10 P\", caption = SIM_NOTE) +\n theme_house() +\n theme(plot.caption = element_text(size = 7, hjust = 1, colour = pv_palette(\"house_grey\")[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"4x1\")\nmessage(sprintf(\"N SNPs = %d, threshold -log10 P = %.3f, significant = %d\", n_snp, thr, sum(d$sig)))\nmessage(\"wrote preview.png\")\n",
"search_text": "manhattan plot with chrom12 colours (house style)\nchrom12 配色曼哈顿图（house 风格）\nhouse-manhattan\n\ngenome\n基因组\ngenome\n基因组\ngenome\nuse this for a 4x1 layout measuring 183 x 43 mm with 7 or 8 pt text. the dataset includes 12 chromosomes and 6,000 snps. the bonferroni threshold is 0.05 / 6,000, which equals 8.33 x 10^-6. the -log10 p threshold is 5.079, displayed as -log10 p = 5.08. there are 47 significant snps, with peaks on chr3 and chr8. place the threshold label above the left end of the dashed line. the upper y limit is the highest peak plus 0.8. place a single-line footnote inside the figure, below the plot box. the lead snp is a red diamond with a black outline, about twice the significant point size (1.9 vs 0.9). label the lead snp as \"chrn lead snp\". the data represents a simulated 12-chromosome genome like rice or tomato. the in-plot footnote uses 7 pt text. the footnote reads: \"simulated 12-chromosome genome (rice/tomato-like). simulated data for illustration; not biological results\". the data.csv file is 88 kb, remaining well under the 200 kb limit.\nthe threshold is calculated dynamically from the data.csv row count. this ensures the threshold updates automatically when data changes. adjust inter-chromosome spacing using the gap_mb variable. map colors by chromosome number using pv_palette(\"chrom12\"). using more than 12 chromosomes throws an error and requires a different color scheme.\ngwas manhattan bonferroni chrom12-palette house-style\nchr 染色体编号（整数，1–12） pos_mb 位置（mb） neg_log10_p −log10 p"
},
{
"title": "k-mer spectrum",
"title_zh": "k-mer 频谱",
"slug": "kmer-spectrum",
"category": "genome",
"tags": [
"kmer",
"heterozygosity",
"genomescope"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"library": "文库，High-het 或 Low-het（字符串）",
"multiplicity": "k-mer 覆盖次数（整数）",
"count": "该覆盖次数上的不同 k-mer 数（数值）",
"model": "无噪声的负二项加误差模型（数值）",
"lambda": "该文库纯合峰覆盖度 λ（数值）"
},
"when_to_use": "从 k-mer 频谱看错误峰、杂合 1n 峰和纯合 2n 峰，判断植物基因组杂合度时用。",
"customize": "log_y 控制 Y 轴；label_peaks 在曲线正上方短引线上标记 1n 和 2n；show_model 画拟合虚线；show_trunc_note 在文库名下注记截断；peak_headroom 设为 1.8 留出空间；文库并排且 Y 轴单位为千。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "log_y",
"value": "FALSE"
},
{
"name": "label_peaks",
"value": "TRUE"
},
{
"name": "show_model",
"value": "TRUE"
},
{
"name": "show_trunc_note",
"value": "TRUE"
},
{
"name": "peak_headroom",
"value": "1.8"
},
{
"name": "x_coverage_mult",
"value": "3"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/kmer-spectrum/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/kmer-spectrum/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/kmer-spectrum/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/kmer-spectrum/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/kmer-spectrum/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/kmer-spectrum/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/kmer-spectrum/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/kmer-spectrum/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/kmer-spectrum/make_data.R"
}
],
"dir": "figures/genome/kmer-spectrum",
"preview": "figures/genome/kmer-spectrum/preview.png",
"docs_preview": "previews/kmer-spectrum.png",
"code": "figures/genome/kmer-spectrum/plot.R",
"data": "figures/genome/kmer-spectrum/data.csv",
"data_files": [
"figures/genome/kmer-spectrum/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/kmer-spectrum/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/kmer-spectrum/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/kmer-spectrum",
"code_text": "# GenomeScope-style linear k-mer spectra (house style), one panel per library side by side; the error\n# spike is clipped by the viewport. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# 可调参数 -----------------------------------------------------------------\nlog_y <- FALSE\nlabel_peaks <- TRUE\nshow_model <- TRUE\nshow_trunc_note <- TRUE\npeak_headroom <- 1.8\nx_coverage_mult <- 3\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nlibraries_keep <- c(\"High-het\", \"Low-het\")\ndf <- df[df$library %in% libraries_keep, , drop = FALSE]\ndf <- df[df$multiplicity <= df$lambda * x_coverage_mult, , drop = FALSE]\ndf$library <- factor(df$library, levels = libraries_keep)\nlib_cols <- stats::setNames(c(hp[[\"blue\"]], pv_palette(\"chrom12\")[[12]]), libraries_keep)\nlab_cols <- text_col(lib_cols)\n\none_panel <- function(d, first) {\n lib <- as.character(d$library[1])\n lam <- d$lambda[1]\n peak_h <- max(d$count[d$multiplicity > 6])\n ymax <- peak_h * peak_headroom\n y_at <- function(m) d$count[which.min(abs(d$multiplicity - m))]\n pk <- data.frame(multiplicity = c(lam / 2, lam), count = c(y_at(lam / 2), y_at(lam)), peak = c(\"1n\", \"2n\"))\n p <- ggplot(d, aes(multiplicity, count)) +\n geom_line(linewidth = pv_house_lw(\"main\"), colour = unname(lib_cols[lib]))\n if (isTRUE(show_model)) {\n p <- p + geom_line(aes(y = model), linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"dark\"]])\n }\n if (isTRUE(label_peaks)) {\n # peak name on a short vertical leader above the curve\n pk$y_lab <- pk$count + ymax * 0.2\n p <- p + geom_segment(data = pk, aes(xend = multiplicity, y = count + ymax * 0.03, yend = y_lab - ymax * 0.03),\n linewidth = pv_house_lw(\"ref\"), colour = grey[[\"dark\"]]) +\n geom_text(data = pk, aes(y = y_lab, label = peak), size = pv_pt2size(7), family = house_family(),\n colour = \"#1A1A1A\", vjust = 0)\n }\n # library name + homozygous peak coverage (in-panel stat), top right\n p <- p + annotate(\"text\", x = Inf, y = Inf, hjust = 1.07, vjust = 1.45, lineheight = 0.95,\n label = sprintf(\"%s\\n2n peak %dx\", lib, round(lam)), colour = lab_cols[[lib]],\n size = pv_pt2size(7), family = house_family())\n if (isTRUE(show_trunc_note)) {\n p <- p + annotate(\"text\", x = Inf, y = Inf, label = \"\\n\\nerror peak\\ntruncated\",\n hjust = 1.04, vjust = 1.3, lineheight = 0.95, size = pv_pt2size(7), family = house_family(),\n colour = grey[[\"mid\"]])\n }\n p <- p + coord_cartesian(ylim = c(if (isTRUE(log_y)) NA else 0, ymax)) +\n scale_y_continuous(labels = function(v) sprintf(\"%g\", v / 1e3), expand = c(0, 0)) +\n labs(x = \"k-mer multiplicity\", y = if (first) \"Distinct k-mers (k)\" else NULL) +\n theme_house()\n if (isTRUE(log_y)) p <- p + scale_y_log10(labels = function(v) sprintf(\"%g\", v / 1e3))\n p\n}\n\nlst <- split(df, df$library)\npanels <- Map(one_panel, lst, seq_along(lst) == 1)\np <- wrap_plots(panels, nrow = 1) +\n plot_annotation(caption = footnote, theme = theme_house() + caption_theme +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")))\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "k-mer spectrum\nk-mer 频谱\nkmer-spectrum\n\ngenome\n基因组\ngenome\n基因组\ngenome\n从 k-mer 频谱看错误峰、杂合 1n 峰和纯合 2n 峰，判断植物基因组杂合度时用。\nlog_y 控制 y 轴；label_peaks 在曲线正上方短引线上标记 1n 和 2n；show_model 画拟合虚线；show_trunc_note 在文库名下注记截断；peak_headroom 设为 1.8 留出空间；文库并排且 y 轴单位为千。\nkmer heterozygosity genomescope\nlibrary 文库，high-het 或 low-het（字符串） multiplicity k-mer 覆盖次数（整数） count 该覆盖次数上的不同 k-mer 数（数值） model 无噪声的负二项加误差模型（数值） lambda 该文库纯合峰覆盖度 λ（数值）"
},
{
"title": "Multiple sequence alignment",
"title_zh": "多序列比对",
"slug": "msa",
"category": "genome",
"tags": [
"msa",
"alignment",
"protein"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"seq": "序列名称（字符串）",
"pos": "比对位点，从 1 起（整数）",
"base": "该位点氨基酸单字母（字符串）"
},
"when_to_use": "短蛋白片段要同时看残基差异和逐位保守性时用。",
"customize": "show_conservation 在比对下方加色带写明平均保守度；highlight_diff 用黑框标出与列一致性不同的残基；各类残基名称位于上方图例行。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_conservation",
"value": "TRUE"
},
{
"name": "highlight_diff",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/msa/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/msa/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/msa/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/msa/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/msa/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/msa/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/msa/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/msa/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/msa/make_data.R"
}
],
"dir": "figures/genome/msa",
"preview": "figures/genome/msa/preview.png",
"docs_preview": "previews/msa.png",
"code": "figures/genome/msa/plot.R",
"data": "figures/genome/msa/data.csv",
"data_files": [
"figures/genome/msa/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/msa/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/msa/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/msa",
"code_text": "# Multiple sequence alignment (house style) with a conservation bar: residues tinted by class (class names\n# in a key row above), residues that differ from the consensus outlined, mean conservation as the stat.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# 可调参数 -----------------------------------------------------------------\nshow_conservation <- TRUE\nhighlight_diff <- TRUE\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$seq <- factor(df$seq, levels = rev(unique(df$seq)))\nclass_of <- function(b) {\n ifelse(b %in% c(\"A\", \"V\", \"L\", \"I\", \"M\", \"F\", \"P\", \"W\"), \"hydrophobic\",\n ifelse(b %in% c(\"S\", \"T\", \"N\", \"Q\", \"Y\", \"C\"), \"polar\",\n ifelse(b %in% c(\"K\", \"R\", \"H\"), \"positive\",\n ifelse(b %in% c(\"D\", \"E\"), \"negative\", \"other\"))))\n}\ncls <- c(\"hydrophobic\", \"polar\", \"positive\", \"negative\", \"other\")\ndf$class <- factor(class_of(df$base), levels = cls)\nclass_cols <- c(hydrophobic = hp[[\"blue\"]], polar = hp[[\"green\"]], positive = hp[[\"purple\"]],\n negative = hp[[\"red\"]], other = hp[[\"gold\"]])\ntint <- 0.45 # tile alpha, so black residue letters stay readable on every class colour\n\ncons_base <- tapply(df$base, df$pos, function(x) names(sort(table(x), decreasing = TRUE))[1])\ndf$differs <- df$base != cons_base[as.character(df$pos)]\ncons <- stats::aggregate(differs ~ pos, df, function(x) 1 - mean(x))\nnames(cons)[2] <- \"conservation\"\nnpos <- max(df$pos); nseq <- nlevels(df$seq)\n\n# key row above the alignment: tinted swatch + class name\nkey <- data.frame(class = factor(cls, levels = cls), x = c(0.5, 7.5, 12.5, 18.5, 24.5))\np_aln <- ggplot(df, aes(pos, seq)) +\n geom_tile(aes(fill = class), alpha = tint, width = 1, height = 1) +\n geom_text(aes(label = base), size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family()) +\n geom_tile(data = key, aes(x = x + 0.5, y = nseq + 1.1, fill = class), width = 0.9, height = 0.7,\n alpha = tint, inherit.aes = FALSE) +\n geom_text(data = key, aes(x = x + 1.25, y = nseq + 1.1, label = class), hjust = 0, size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family(), inherit.aes = FALSE) +\n scale_fill_manual(values = class_cols, guide = \"none\") +\n scale_x_continuous(breaks = seq(5, npos, by = 5), expand = c(0, 0)) +\n scale_y_discrete(expand = expansion(add = c(0.5, 0))) +\n coord_cartesian(ylim = c(0.5, nseq + 1.6), clip = \"off\") +\n labs(x = NULL, y = NULL) +\n theme_house() + theme(axis.ticks.y = element_blank(), panel.border = element_blank())\nif (isTRUE(highlight_diff)) {\n p_aln <- p_aln + geom_tile(data = df[df$differs, ], fill = NA, colour = grey[[\"text\"]],\n linewidth = pv_house_lw(\"ref\"), width = 0.94, height = 0.94)\n key_d <- data.frame(x = 31.5, y = nseq + 1.1)\n p_aln <- p_aln + geom_tile(data = key_d, aes(x, y), width = 0.9, height = 0.7, fill = NA,\n colour = grey[[\"text\"]], linewidth = pv_house_lw(\"ref\"), inherit.aes = FALSE) +\n annotate(\"text\", x = 32.25, y = nseq + 1.1, label = \"differs from consensus\", hjust = 0,\n size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family())\n}\n\nnote <- plot_annotation(caption = footnote, theme = theme_house() + caption_theme +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")))\nif (!isTRUE(show_conservation)) {\n p <- p_aln + labs(x = \"Position\") + note\n} else {\n p_aln <- p_aln + theme(axis.text.x = element_blank(), axis.ticks.x = element_blank())\n p_bar <- ggplot(cons, aes(pos, conservation)) +\n geom_col(width = 0.9, fill = grey[[\"dark\"]]) +\n annotate(\"text\", x = npos + 0.4, y = 1.12, hjust = 1, vjust = 0,\n label = sprintf(\"mean conservation %.2f\", mean(cons$conservation)),\n size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family()) +\n scale_x_continuous(breaks = seq(5, npos, by = 5), expand = c(0, 0), limits = c(0.5, npos + 0.5)) +\n scale_y_continuous(limits = c(0, 1.45), breaks = c(0, 1), expand = c(0, 0)) +\n labs(x = \"Position\", y = \"Conservation\") +\n theme_house()\n p <- (p_aln / p_bar) + plot_layout(heights = c(3, 1)) + note\n}\n\npv_save_house(p, \"figure\", cells = \"4x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "multiple sequence alignment\n多序列比对\nmsa\n\ngenome\n基因组\ngenome\n基因组\ngenome\n短蛋白片段要同时看残基差异和逐位保守性时用。\nshow_conservation 在比对下方加色带写明平均保守度；highlight_diff 用黑框标出与列一致性不同的残基；各类残基名称位于上方图例行。\nmsa alignment protein\nseq 序列名称（字符串） pos 比对位点，从 1 起（整数） base 该位点氨基酸单字母（字符串）"
},
{
"title": "Mutation spectrum",
"title_zh": "突变频谱",
"slug": "mutation-spectrum",
"category": "genome",
"tags": [
"mutation-spectrum",
"sbs96",
"genome"
],
"packages": [
"ggplot2"
],
"data_columns": {
"context": "三核苷酸上下文（字符串，中间为嘧啶参考碱基）",
"substitution": "替换类型，嘧啶归一的六类（字符串）",
"count": "该通道的突变计数（整数）"
},
"when_to_use": "按 SBS96 展示 6 类替换乘 16 种三核苷酸上下文的突变计数或比例时用。",
"customize": "as_proportion 为 TRUE 时显示总突变占比；sub_levels 设定 C>A 等六种替换类型；图例色块及名称在面板上方，下方写出对应的百分比。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "as_proportion",
"value": "FALSE"
},
{
"name": "sub_levels",
"value": "c(\"C>A\", \"C>G\", \"C>T\", \"T>A\", \"T>G\", \"T>C\")"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "43",
"label": "183 × 43 mm (4×1 cells)",
"cells": "4x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/mutation-spectrum/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/mutation-spectrum/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/mutation-spectrum/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/mutation-spectrum/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/mutation-spectrum/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/mutation-spectrum/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/mutation-spectrum/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/mutation-spectrum/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/mutation-spectrum/make_data.R"
}
],
"dir": "figures/genome/mutation-spectrum",
"preview": "figures/genome/mutation-spectrum/preview.png",
"docs_preview": "previews/mutation-spectrum.png",
"code": "figures/genome/mutation-spectrum/plot.R",
"data": "figures/genome/mutation-spectrum/data.csv",
"data_files": [
"figures/genome/mutation-spectrum/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/mutation-spectrum/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/mutation-spectrum/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/mutation-spectrum",
"code_text": "# SBS96 spectrum (house style): six substitution classes of sixteen trinucleotide contexts each,\n# class names on coloured bars above the panel, class shares as the in-panel stat. Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nas_proportion <- FALSE\nsub_levels <- c(\"C>A\", \"C>G\", \"C>T\", \"T>A\", \"T>G\", \"T>C\")\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# six classes in the usual SBS order of hues (blue, black, red, grey, green, pink -> house magenta)\nsbs_cols <- stats::setNames(c(hp[[\"sky\"]], grey[[\"text\"]], hp[[\"red\"]], grey[[\"ci\"]], hp[[\"green\"]], hp[[\"magenta\"]]),\n sub_levels)\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$substitution <- factor(df$substitution, levels = sub_levels)\nflank <- c(\"A\", \"C\", \"G\", \"T\")\nctx_of <- function(mid) paste0(rep(flank, each = 4), mid, rep(flank, times = 4))\ndf$context <- factor(df$context, levels = c(ctx_of(\"C\"), ctx_of(\"T\")))\ndf <- df[order(df$substitution, df$context), , drop = FALSE]\ndf$x <- seq_len(nrow(df))\ndf$y <- if (isTRUE(as_proportion)) df$count / sum(df$count) else df$count\ny_lab <- if (isTRUE(as_proportion)) \"Proportion of mutations\" else \"Mutation count\"\n\nshare <- tapply(df$count, df$substitution, sum) / sum(df$count)\nann <- data.frame(substitution = factor(sub_levels, levels = sub_levels),\n xmin = (seq_along(sub_levels) - 1) * 16 + 0.6, xmax = seq_along(sub_levels) * 16 + 0.4)\nann$x <- (ann$xmin + ann$xmax) / 2\nann$share <- sprintf(\"%.0f%%\", 100 * share[sub_levels])\nymax <- max(df$y)\ntop <- ymax * 1.16\n\np <- ggplot(df, aes(x, y, fill = substitution)) +\n geom_col(width = 0.8, colour = NA) +\n # class bar + name above it (outside the panel), share inside the panel under the bar\n geom_rect(data = ann, aes(xmin = xmin, xmax = xmax, ymin = top, ymax = top + ymax * 0.05, fill = substitution),\n inherit.aes = FALSE) +\n geom_text(data = ann, aes(x = x, y = top + ymax * 0.07, label = substitution), vjust = 0,\n inherit.aes = FALSE, size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family()) +\n geom_text(data = ann, aes(x = x, y = top - ymax * 0.03, label = share), vjust = 1,\n inherit.aes = FALSE, size = pv_pt2size(7), colour = grey[[\"dark\"]], family = house_family()) +\n scale_fill_manual(values = sbs_cols, guide = \"none\") +\n scale_x_continuous(expand = c(0.005, 0.005)) +\n scale_y_continuous(expand = c(0, 0)) +\n coord_cartesian(ylim = c(0, top), clip = \"off\") +\n labs(x = \"Trinucleotide context (16 per class)\", y = y_lab, caption = footnote) +\n theme_house() +\n theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(),\n plot.margin = margin(6, 1.5, 1, 1, \"mm\")) +\n caption_theme\n\npv_save_house(p, \"figure\", cells = \"4x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "mutation spectrum\n突变频谱\nmutation-spectrum\n\ngenome\n基因组\ngenome\n基因组\ngenome\n按 sbs96 展示 6 类替换乘 16 种三核苷酸上下文的突变计数或比例时用。\nas_proportion 为 true 时显示总突变占比；sub_levels 设定 c>a 等六种替换类型；图例色块及名称在面板上方，下方写出对应的百分比。\nmutation-spectrum sbs96 genome\ncontext 三核苷酸上下文（字符串，中间为嘧啶参考碱基） substitution 替换类型，嘧啶归一的六类（字符串） count 该通道的突变计数（整数）"
},
{
"title": "Oncoplot",
"title_zh": "突变景观图",
"slug": "oncoplot",
"category": "genome",
"tags": [
"oncoplot",
"mutation",
"genome"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"sample": "样品编号（字符串）",
"gene": "基因名（字符串）",
"variant_class": "Missense_Ti、Missense_Tv、Nonsense、Frameshift 或 Splice（字符串）",
"cohort": "样品队列，用于注释条（字符串）"
},
"when_to_use": "展示多样品、多基因的突变类型，并在上方汇总转换与颠换时用。",
"customize": "show_titv 在顶部画错义 Ti/Tv 条并写出整体 Ti/Tv 比值；show_sample_lane 显示队列通道；cohort_order 设定 A 与 B 的顺序；图例行位于矩阵下方，右侧列出各个基因突变百分比。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_titv",
"value": "TRUE"
},
{
"name": "show_sample_lane",
"value": "TRUE"
},
{
"name": "cohort_order",
"value": "c(\"A\", \"B\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/oncoplot/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/oncoplot/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/oncoplot/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/oncoplot/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/oncoplot/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/oncoplot/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/oncoplot/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/oncoplot/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/oncoplot/make_data.R"
}
],
"dir": "figures/genome/oncoplot",
"preview": "figures/genome/oncoplot/preview.png",
"docs_preview": "previews/oncoplot.png",
"code": "figures/genome/oncoplot/plot.R",
"data": "figures/genome/oncoplot/data.csv",
"data_files": [
"figures/genome/oncoplot/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/oncoplot/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/oncoplot/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/oncoplot",
"code_text": "# Oncoplot (house style) with a Ti/Tv bar and a cohort lane: genes by mutation frequency (share written\n# at the right), samples by burden, key rows under the matrix. Drawn with ggplot2 + patchwork.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# 可调参数 -----------------------------------------------------------------\nshow_titv <- TRUE\nshow_sample_lane <- TRUE\ncohort_order <- c(\"A\", \"B\")\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ngenes <- unique(df$gene)\nsamples <- unique(df$sample)\nclasses <- c(\"Missense_Ti\", \"Missense_Tv\", \"Nonsense\", \"Frameshift\", \"Splice\")\ncol <- c(Missense_Ti = hp[[\"blue\"]], Missense_Tv = hp[[\"sky\"]], Nonsense = hp[[\"red\"]],\n Frameshift = hp[[\"orange\"]], Splice = hp[[\"purple\"]])\ncohort_cols <- stats::setNames(c(hp[[\"green\"]], hp[[\"gold\"]]), cohort_order)\n\nmat <- matrix(\"\", nrow = length(genes), ncol = length(samples), dimnames = list(genes, samples))\nfor (i in seq_len(nrow(df))) mat[df$gene[i], df$sample[i]] <- df$variant_class[i]\ncohort <- tapply(df$cohort, df$sample, function(z) z[[1]])[samples]\nti <- colSums(mat == \"Missense_Ti\"); tv <- colSums(mat == \"Missense_Tv\")\n\ngene_n <- rowSums(mat != \"\")\ngene_ord <- names(sort(gene_n, decreasing = TRUE))\nsample_ord <- names(sort(colSums(mat != \"\"), decreasing = TRUE))\ngene_f <- factor(gene_ord, levels = rev(gene_ord))\nsample_f <- factor(sample_ord, levels = sample_ord)\nns <- length(sample_ord); ng <- length(gene_ord)\n\nbg <- expand.grid(gene = gene_f, sample = sample_f, KEEP.OUT.ATTRS = FALSE, stringsAsFactors = FALSE)\nlong <- as.data.frame(as.table(mat), stringsAsFactors = FALSE)\nnames(long) <- c(\"gene\", \"sample\", \"variant_class\")\nlong <- long[long$variant_class != \"\", , drop = FALSE]\nlong$gene <- factor(long$gene, levels = levels(gene_f))\nlong$sample <- factor(long$sample, levels = levels(sample_f))\nlong$variant_class <- factor(long$variant_class, levels = classes)\npct <- data.frame(gene = gene_f, label = sprintf(\"%d%%\", round(100 * gene_n[gene_ord] / ns)))\n\nx_sc <- scale_x_discrete(expand = c(0, 0.5))\nblank_x <- theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(), axis.title.x = element_blank())\np_mat <- ggplot() +\n geom_tile(data = bg, aes(sample, gene), fill = grey[[\"bg\"]], width = 0.9, height = 0.78) +\n geom_tile(data = long, aes(sample, gene, fill = variant_class), width = 0.9, height = 0.78) +\n geom_text(data = pct, aes(x = ns + 0.9, y = gene, label = label), hjust = 0, size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family()) +\n scale_fill_manual(values = col, guide = \"none\", drop = FALSE) +\n x_sc + coord_cartesian(clip = \"off\") +\n labs(x = sprintf(\"%d samples, sorted by burden\", ns), y = NULL) +\n theme_house() +\n theme(panel.border = element_blank(), axis.ticks = element_blank(), axis.text.x = element_blank(),\n axis.text.y = element_text(face = \"italic\"), plot.margin = margin(0.5, 7, 0.5, 1, \"mm\"))\n\npanels <- list(); heights <- numeric()\nif (isTRUE(show_titv)) {\n tv_long <- rbind(data.frame(sample = sample_f, class = \"Missense_Ti\", n = as.numeric(ti[sample_ord])),\n data.frame(sample = sample_f, class = \"Missense_Tv\", n = as.numeric(tv[sample_ord])))\n p_tv <- ggplot(tv_long, aes(sample, n, fill = class)) +\n geom_col(width = 0.9, colour = NA) +\n annotate(\"text\", x = ns, y = Inf, hjust = 1, vjust = 1.2, size = pv_pt2size(7), colour = \"#1A1A1A\",\n family = house_family(), label = sprintf(\"Ti/Tv = %.2f\", sum(ti) / max(1, sum(tv)))) +\n scale_fill_manual(values = col, guide = \"none\") + x_sc +\n scale_y_continuous(breaks = function(l) unique(floor(pretty(l, 2))), expand = expansion(mult = c(0, 0.25))) +\n labs(y = \"Missense\") + theme_house() + blank_x + theme(plot.margin = margin(1, 7, 0.5, 1, \"mm\"))\n panels <- c(panels, list(p_tv)); heights <- c(heights, 0.25)\n}\nif (isTRUE(show_sample_lane)) {\n coh <- data.frame(sample = sample_f, cohort = factor(cohort[sample_ord], levels = cohort_order))\n p_coh <- ggplot(coh, aes(sample, \"Cohort\", fill = cohort)) +\n geom_tile(height = 0.8, width = 0.9) +\n scale_fill_manual(values = cohort_cols, guide = \"none\") + x_sc + labs(y = NULL) +\n theme_house() + blank_x + theme(panel.border = element_blank(), axis.ticks.y = element_blank(),\n plot.margin = margin(0.5, 7, 0.5, 1, \"mm\"))\n panels <- c(panels, list(p_coh)); heights <- c(heights, 0.06)\n}\n\n# key rows: variant classes, then cohorts (only when the lane is shown)\nkey <- data.frame(lab = c(\"Missense Ti\", \"Missense Tv\", \"Nonsense\", \"Frameshift\", \"Splice\"),\n fill = unname(col[classes]), x = c(0, 1.6, 3.2, 0, 1.6), y = c(3, 3, 3, 2, 2))\nif (isTRUE(show_sample_lane)) {\n key <- rbind(key, data.frame(lab = sprintf(\"Cohort %s\", cohort_order), fill = unname(cohort_cols),\n x = c(3.2, 4.4), y = 2))\n}\np_key <- ggplot(key) +\n geom_tile(aes(x = x, y = y, fill = fill), width = 0.12, height = 0.6) +\n geom_text(aes(x = x + 0.1, y = y, label = lab), hjust = 0, size = pv_pt2size(7), colour = \"#1A1A1A\",\n family = house_family()) +\n scale_fill_identity() +\n coord_cartesian(xlim = c(-0.1, 5.2), ylim = c(1.5, 3.5), expand = FALSE, clip = \"off\") +\n theme_void() + theme(plot.margin = margin(0.5, 1, 0, 1, \"mm\"))\n\npanels <- c(panels, list(p_mat), list(p_key))\nheights <- c(heights, 1, 0.1)\np <- wrap_plots(panels, ncol = 1, heights = heights) +\n plot_annotation(caption = footnote, theme = theme_house() + caption_theme +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")))\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "oncoplot\n突变景观图\noncoplot\n\ngenome\n基因组\ngenome\n基因组\ngenome\n展示多样品、多基因的突变类型，并在上方汇总转换与颠换时用。\nshow_titv 在顶部画错义 ti/tv 条并写出整体 ti/tv 比值；show_sample_lane 显示队列通道；cohort_order 设定 a 与 b 的顺序；图例行位于矩阵下方，右侧列出各个基因突变百分比。\noncoplot mutation genome\nsample 样品编号（字符串） gene 基因名（字符串） variant_class missense_ti、missense_tv、nonsense、frameshift 或 splice（字符串） cohort 样品队列，用于注释条（字符串）"
},
{
"title": "Pangenome pie and growth",
"title_zh": "泛基因组组成与累积曲线",
"slug": "pangenome-curve",
"category": "genome",
"tags": [
"pangenome",
"core-genome",
"heaps-law"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"compartment": "Core、Shell 或 Cloud（data_compartment.csv）",
"n_families": "该区室基因家族数（整数）",
"step": "加入顺序（data_growth.csv，整数）",
"n_genomes": "已加入基因组数（整数）",
"pan": "泛基因组家族数（整数）",
"core": "核心基因组家族数（整数）"
},
"when_to_use": "概括植物泛基因组的 core/shell/cloud 组成，并看 pan 与 core 随基因组数的饱和时用。",
"customize": "show_pie 控制饼图在扇区顺时针写明名称和占比；show_accumulation 在线端写名称且 Y 轴单位为千；show_heaps 画拟合虚线并注记 alpha 值；compartment_order 设定隔室顺序。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_pie",
"value": "TRUE"
},
{
"name": "show_accumulation",
"value": "TRUE"
},
{
"name": "show_heaps",
"value": "TRUE"
},
{
"name": "compartment_order",
"value": "c(\"Core\", \"Shell\", \"Cloud\")"
}
],
"canvas": null,
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/pangenome-curve/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/pangenome-curve/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pangenome-curve/plot.R"
},
{
"name": "make_data.R",
"path": "figures/genome/pangenome-curve/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/pangenome-curve/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pangenome-curve/make_data.R"
},
{
"name": "data_compartment.csv",
"path": "figures/genome/pangenome-curve/data_compartment.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/pangenome-curve/data_compartment.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pangenome-curve/data_compartment.csv"
},
{
"name": "data_growth.csv",
"path": "figures/genome/pangenome-curve/data_growth.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/pangenome-curve/data_growth.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pangenome-curve/data_growth.csv"
}
],
"dir": "figures/genome/pangenome-curve",
"preview": "figures/genome/pangenome-curve/preview.png",
"docs_preview": "previews/pangenome-curve.png",
"code": "figures/genome/pangenome-curve/plot.R",
"data": "figures/genome/pangenome-curve/data_compartment.csv",
"data_files": [
"figures/genome/pangenome-curve/data_compartment.csv",
"figures/genome/pangenome-curve/data_growth.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pangenome-curve/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pangenome-curve/data_compartment.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/pangenome-curve",
"code_text": "# Pangenome (house style): core / shell / cloud shares as a pie with names on the slices, and pan / core\n# accumulation curves with a Heaps-law fit (alpha as the in-panel stat), curve names at the line ends.\n# Reads data_compartment.csv and data_growth.csv. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# 可调参数 -----------------------------------------------------------------\nshow_pie <- TRUE\nshow_accumulation <- TRUE\nshow_heaps <- TRUE\ncompartment_order <- c(\"Core\", \"Shell\", \"Cloud\")\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ncomp <- utils::read.csv(\"data_compartment.csv\", stringsAsFactors = FALSE)\ngrowth <- utils::read.csv(\"data_growth.csv\", stringsAsFactors = FALSE)\ncomp$compartment <- factor(comp$compartment, levels = compartment_order)\ncomp <- comp[order(comp$compartment), , drop = FALSE]\ncomp_cols <- c(Core = hp[[\"blue\"]], Shell = hp[[\"sky\"]], Cloud = hp[[\"gold\"]])\n\ncomp$frac <- comp$n_families / sum(comp$n_families)\nend <- cumsum(comp$frac); start <- c(0, utils::head(end, -1))\n# slices clockwise from 12 o'clock\nslice_poly <- function(a0, a1, lab) {\n ang <- pi / 2 - seq(a0, a1, length.out = 80) * 2 * pi\n data.frame(x = c(0, cos(ang)), y = c(0, sin(ang)), compartment = lab)\n}\npoly <- do.call(rbind, Map(slice_poly, start, end, as.character(comp$compartment)))\nmid <- pi / 2 - (start + end) / 2 * 2 * pi\ncomp$lx <- 0.6 * cos(mid); comp$ly <- 0.6 * sin(mid)\ncomp$slice_lab <- sprintf(\"%s\\n%s\\n%.0f%%\", comp$compartment, format(comp$n_families, big.mark = \",\"), 100 * comp$frac)\n# label colour on the slice: white on the dark blue, #1A1A1A on the light slices\ncomp$lab_col <- ifelse(comp$compartment == \"Core\", \"white\", \"#1A1A1A\")\n\np_pie <- ggplot(poly, aes(x, y, fill = compartment)) +\n geom_polygon(colour = \"white\", linewidth = pv_house_lw(\"ref\")) +\n geom_text(data = comp, aes(lx, ly, label = slice_lab, colour = lab_col), inherit.aes = FALSE,\n size = pv_pt2size(7), lineheight = 0.9, family = house_family()) +\n scale_colour_identity() +\n coord_equal(xlim = c(-1.02, 1.02), ylim = c(-1.02, 1.02)) +\n scale_fill_manual(values = comp_cols, guide = \"none\") +\n theme_void(base_family = house_family()) + theme(plot.margin = margin(1, 1, 1, 1, \"mm\"))\n\nfit <- stats::lm(log(pan) ~ log(n_genomes), data = growth)\nalpha <- unname(stats::coef(fit)[2])\ngrowth$heaps <- exp(unname(stats::coef(fit)[1])) * growth$n_genomes^alpha\nlong <- rbind(data.frame(n_genomes = growth$n_genomes, families = growth$pan, curve = \"Pan\"),\n data.frame(n_genomes = growth$n_genomes, families = growth$core, curve = \"Core\"))\ncurve_cols <- c(Pan = hp[[\"red\"]], Core = hp[[\"blue\"]])\nends <- long[long$n_genomes == max(long$n_genomes), ]\nnmax <- max(long$n_genomes)\n\np_acc <- ggplot(long, aes(n_genomes, families / 1e3, colour = curve)) +\n geom_line(linewidth = pv_house_lw(\"main\")) +\n geom_text(data = ends, aes(x = nmax * 1.06, label = curve), hjust = 0, size = pv_pt2size(7),\n family = house_family(), show.legend = FALSE) +\n scale_colour_manual(values = text_col(curve_cols), guide = \"none\") +\n scale_x_continuous(expand = expansion(mult = c(0.02, 0.22))) +\n scale_y_continuous(expand = expansion(mult = c(0.05, 0.1))) +\n labs(x = \"Genomes added\", y = \"Gene families (k)\") +\n theme_house()\nif (isTRUE(show_heaps)) {\n p_acc <- p_acc +\n geom_line(data = growth, aes(n_genomes, heaps / 1e3), inherit.aes = FALSE, linetype = \"22\",\n linewidth = pv_house_lw(\"ref\"), colour = grey[[\"dark\"]]) +\n annotate(\"text\", x = nmax * 0.98, y = mean(range(long$families)) / 1e3, hjust = 1,\n label = sprintf(\"Heaps fit (dashed)\\nalpha = %.2f\", alpha), lineheight = 0.95,\n size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family())\n}\n\nnote <- plot_annotation(caption = footnote, theme = theme_house() + caption_theme +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")))\nif (isTRUE(show_pie) && isTRUE(show_accumulation)) {\n p <- (p_pie | p_acc) + plot_layout(widths = c(1, 1.5)) + note\n cells <- \"2x1\"\n} else if (isTRUE(show_pie)) {\n p <- p_pie + note\n cells <- \"1x1\"\n} else {\n p <- p_acc + note\n cells <- \"1x1\"\n}\n\npv_save_house(p, \"figure\", cells = cells)\nmessage(\"wrote preview.png\")\n",
"search_text": "pangenome pie and growth\n泛基因组组成与累积曲线\npangenome-curve\n\ngenome\n基因组\ngenome\n基因组\ngenome\n概括植物泛基因组的 core/shell/cloud 组成，并看 pan 与 core 随基因组数的饱和时用。\nshow_pie 控制饼图在扇区顺时针写明名称和占比；show_accumulation 在线端写名称且 y 轴单位为千；show_heaps 画拟合虚线并注记 alpha 值；compartment_order 设定隔室顺序。\npangenome core-genome heaps-law\ncompartment core、shell 或 cloud（data_compartment.csv） n_families 该区室基因家族数（整数） step 加入顺序（data_growth.csv，整数） n_genomes 已加入基因组数（整数） pan 泛基因组家族数（整数） core 核心基因组家族数（整数）"
},
{
"title": "PAV heatmap",
"title_zh": "基因存在缺失热图",
"slug": "pav-heatmap",
"category": "genome",
"tags": [
"pav",
"pangenome",
"heatmap"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"genome": "基因组编号（字符串）",
"family": "基因家族编号（字符串）",
"present": "1 存在，0 缺失（整数）",
"compartment": "core、shell 或 cloud（字符串）"
},
"when_to_use": "比较多个基因组里基因家族的有无，并按核心、外壳和云基因查看时用。",
"customize": "cluster_genomes 按二元距离聚类对行排序；show_compartment 在顶部画出含家族计数的隔室色带；家族按隔室和频率排序，X 轴标题包含平均家族数。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "cluster_genomes",
"value": "TRUE"
},
{
"name": "show_compartment",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/pav-heatmap/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/pav-heatmap/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pav-heatmap/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/pav-heatmap/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/pav-heatmap/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pav-heatmap/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/pav-heatmap/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/pav-heatmap/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pav-heatmap/make_data.R"
}
],
"dir": "figures/genome/pav-heatmap",
"preview": "figures/genome/pav-heatmap/preview.png",
"docs_preview": "previews/pav-heatmap.png",
"code": "figures/genome/pav-heatmap/plot.R",
"data": "figures/genome/pav-heatmap/data.csv",
"data_files": [
"figures/genome/pav-heatmap/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pav-heatmap/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/pav-heatmap/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/pav-heatmap",
"code_text": "# PAV heatmap (house style): genomes x gene families, present blue / absent grey, families grouped by\n# compartment (core / shell / cloud named with their counts on the band above), mean families per\n# genome as the stat. Drawn with ggplot2 + patchwork. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# 可调参数 -----------------------------------------------------------------\ncluster_genomes <- TRUE\nshow_compartment <- TRUE\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ngenomes <- unique(df$genome)\nfamilies <- unique(df$family)\nmat <- matrix(0L, nrow = length(genomes), ncol = length(families), dimnames = list(genomes, families))\nfor (i in seq_len(nrow(df))) mat[df$genome[i], df$family[i]] <- df$present[i]\ncomp <- tapply(df$compartment, df$family, function(z) z[[1]])[families]\ncomp <- factor(comp, levels = c(\"core\", \"shell\", \"cloud\"))\n# order families by compartment, then by how often they are present\nord <- order(comp, -colMeans(mat))\nmat <- mat[, ord, drop = FALSE]\ncomp <- comp[ord]\nif (isTRUE(cluster_genomes)) {\n hc <- stats::hclust(stats::dist(mat, method = \"binary\"))\n mat <- mat[hc$order, , drop = FALSE]\n}\ncomp_cols <- c(core = hp[[\"blue\"]], shell = hp[[\"sky\"]], cloud = hp[[\"gold\"]])\ncell_cols <- c(\"0\" = grey[[\"light\"]], \"1\" = hp[[\"blue\"]])\nnf <- ncol(mat)\n\nlong <- data.frame(genome = rownames(mat)[row(mat)], family = colnames(mat)[col(mat)],\n present = factor(as.vector(mat), levels = c(\"0\", \"1\")), stringsAsFactors = FALSE)\nlong$genome <- factor(long$genome, levels = rev(rownames(mat)))\nlong$family <- factor(long$family, levels = colnames(mat))\n\np_heat <- ggplot(long, aes(family, genome, fill = present)) +\n geom_tile(colour = \"white\", linewidth = pv_house_lw(0.25)) +\n scale_fill_manual(values = cell_cols, guide = \"none\") +\n scale_x_discrete(expand = c(0, 0)) +\n labs(x = sprintf(\"%d gene families (blue present, grey absent); mean %.0f per genome\", nf, mean(rowSums(mat))),\n y = \"Genome\") +\n theme_house() + theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(),\n axis.title.x = element_text(size = 7), panel.border = element_blank())\n\nnote <- plot_annotation(caption = footnote, theme = theme_house() + caption_theme +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")))\nif (isTRUE(show_compartment)) {\n ann <- data.frame(family = factor(names(comp), levels = colnames(mat)), compartment = comp)\n rng <- do.call(rbind, lapply(split(seq_len(nf), comp), function(ix)\n data.frame(mid = mean(range(ix)), n = length(ix))))\n rng$compartment <- rownames(rng)\n rng$lab <- sprintf(\"%s (%d)\", rng$compartment, rng$n)\n rng$col <- ifelse(rng$compartment == \"core\", \"white\", \"#1A1A1A\")\n p_ann <- ggplot(ann, aes(as.integer(family), y = 1, fill = compartment)) +\n geom_tile(height = 1, width = 1) +\n geom_text(data = rng, aes(x = mid, y = 1, label = lab, colour = col), inherit.aes = FALSE,\n size = pv_pt2size(7), family = house_family()) +\n scale_colour_identity() +\n scale_fill_manual(values = comp_cols, guide = \"none\") +\n scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) +\n theme_void() + theme(plot.margin = margin(1, 0, 0.6, 0, \"mm\"))\n p <- (p_ann / p_heat) + plot_layout(heights = c(0.07, 1)) + note\n} else {\n p <- p_heat + note\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "pav heatmap\n基因存在缺失热图\npav-heatmap\n\ngenome\n基因组\ngenome\n基因组\ngenome\n比较多个基因组里基因家族的有无，并按核心、外壳和云基因查看时用。\ncluster_genomes 按二元距离聚类对行排序；show_compartment 在顶部画出含家族计数的隔室色带；家族按隔室和频率排序，x 轴标题包含平均家族数。\npav pangenome heatmap\ngenome 基因组编号（字符串） family 基因家族编号（字符串） present 1 存在，0 缺失（整数） compartment core、shell 或 cloud（字符串）"
},
{
"title": "Protein lollipop",
"title_zh": "蛋白突变棒棒糖图",
"slug": "protein-lollipop",
"category": "genome",
"tags": [
"lollipop",
"protein",
"mutation",
"genome"
],
"packages": [
"ggplot2"
],
"data_columns": {
"pos": "突变的氨基酸位置（整数）",
"class": "突变类型（字符串）",
"n": "携带该突变的样本数（整数）",
"domain": "结构域名称，见 data_domains.csv（字符串）",
"start": "结构域起点（整数，氨基酸）",
"end": "结构域终点（整数，氨基酸）"
},
"when_to_use": "把突变位点标在蛋白结构域上、并用高度表示复发次数时用。",
"customize": "show_domains 在主干下方用一条灰带标注所有结构域；class_levels 设定四种类型且计数图例位于左上角；突变热点标注在针头旁。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_domains",
"value": "TRUE"
},
{
"name": "class_levels",
"value": "c(\"Missense\", \"Nonsense\", \"Frameshift\", \"Inframe\")"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "43",
"label": "183 × 43 mm (4×1 cells)",
"cells": "4x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/protein-lollipop/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/protein-lollipop/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/protein-lollipop/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/protein-lollipop/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/protein-lollipop/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/protein-lollipop/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/protein-lollipop/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/protein-lollipop/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/protein-lollipop/make_data.R"
},
{
"name": "data_domains.csv",
"path": "figures/genome/protein-lollipop/data_domains.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/protein-lollipop/data_domains.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/protein-lollipop/data_domains.csv"
}
],
"dir": "figures/genome/protein-lollipop",
"preview": "figures/genome/protein-lollipop/preview.png",
"docs_preview": "previews/protein-lollipop.png",
"code": "figures/genome/protein-lollipop/plot.R",
"data": "figures/genome/protein-lollipop/data.csv",
"data_files": [
"figures/genome/protein-lollipop/data.csv",
"figures/genome/protein-lollipop/data_domains.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/protein-lollipop/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/protein-lollipop/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/protein-lollipop",
"code_text": "# Protein lollipop (house style): stems coloured by mutation class, class names in a key row, domains\n# named on a grey band under the stems, hotspot as the in-panel stat. Reads data.csv and data_domains.csv.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_domains <- TRUE\nclass_levels <- c(\"Missense\", \"Nonsense\", \"Frameshift\", \"Inframe\")\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\nclass_cols <- c(Missense = hp[[\"blue\"]], Nonsense = hp[[\"red\"]], Frameshift = hp[[\"purple\"]],\n Inframe = hp[[\"orange\"]])[class_levels]\n\nmut <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndom <- utils::read.csv(\"data_domains.csv\", stringsAsFactors = FALSE)\nmut$class <- factor(mut$class, levels = class_levels)\nprot_end <- max(c(dom$end, mut$pos))\nymax <- max(mut$n)\nhot <- mut[which.max(mut$n), ]\n\n# key row: point + class name with its count, top left\ncnt <- table(mut$class)\nkey <- data.frame(class = factor(class_levels, levels = class_levels),\n x = prot_end * c(0.02, 0.16, 0.3, 0.46), y = ymax * 1.18)\nkey$lab <- sprintf(\"%s (%d)\", class_levels, as.integer(cnt[class_levels]))\n\np <- ggplot() +\n geom_segment(data = mut, aes(x = pos, xend = pos, y = 0, yend = n), linewidth = pv_house_lw(\"ref\"),\n colour = grey[[\"dark\"]]) +\n geom_point(data = mut, aes(pos, n, fill = class), shape = 21, size = 1.8, stroke = 0.3, colour = \"black\") +\n geom_point(data = key, aes(x, y, fill = class), shape = 21, size = 1.8, stroke = 0.3, colour = \"black\") +\n geom_text(data = key, aes(x = x + prot_end * 0.008, y = y, label = lab), hjust = 0, size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family()) +\n annotate(\"text\", x = hot$pos + prot_end * 0.012, y = hot$n, hjust = 0,\n label = sprintf(\"Hotspot p.%d, %d samples\", hot$pos, hot$n), size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family()) +\n scale_fill_manual(values = class_cols, guide = \"none\") +\n scale_x_continuous(limits = c(0, prot_end), expand = c(0, 0), breaks = seq(0, prot_end, by = 100)) +\n scale_y_continuous(breaks = seq(0, ymax + 2, by = 4), expand = expansion(mult = c(0.02, 0.04))) +\n labs(x = \"Amino acid position\", y = \"Mutated samples\", caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 2.5, 1, 1, \"mm\")) + caption_theme\n\nif (isTRUE(show_domains)) {\n p <- p +\n geom_rect(data = dom, aes(xmin = start, xmax = end, ymin = -0.3 * ymax, ymax = -0.06 * ymax),\n fill = grey[[\"light\"]], colour = grey[[\"dark\"]], linewidth = pv_house_lw(\"ref\")) +\n geom_text(data = dom, aes(x = (start + end) / 2, y = -0.18 * ymax, label = domain), size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family()) +\n coord_cartesian(ylim = c(-0.32 * ymax, ymax * 1.24), clip = \"off\")\n} else {\n p <- p + coord_cartesian(ylim = c(0, ymax * 1.24))\n}\n\npv_save_house(p, \"figure\", cells = \"4x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "protein lollipop\n蛋白突变棒棒糖图\nprotein-lollipop\n\ngenome\n基因组\ngenome\n基因组\ngenome\n把突变位点标在蛋白结构域上、并用高度表示复发次数时用。\nshow_domains 在主干下方用一条灰带标注所有结构域；class_levels 设定四种类型且计数图例位于左上角；突变热点标注在针头旁。\nlollipop protein mutation genome\npos 突变的氨基酸位置（整数） class 突变类型（字符串） n 携带该突变的样本数（整数） domain 结构域名称，见 data_domains.csv（字符串） start 结构域起点（整数，氨基酸） end 结构域终点（整数，氨基酸）"
},
{
"title": "Sequence logo",
"title_zh": "序列模体图",
"slug": "sequence-logo",
"category": "genome",
"tags": [
"sequence-logo",
"motif",
"genome"
],
"packages": [
"ggplot2",
"ggseqlogo"
],
"data_columns": {
"pos": "模体位置（整数，从 1 起）",
"base": "碱基（A、C、G、T）",
"bits": "该碱基的信息量高度，频率乘以该位总信息量（bit，非负）",
"prob": "该位置碱基频率（0 到 1）",
"count": "该碱基的计数（整数，列和为序列条数）"
},
"when_to_use": "展示一个 DNA 模体各位置的保守性和碱基偏好时用。",
"customize": "method 为 bits 时字母高度等于频率乘信息量，为 prob 时代表概率；base_levels 设定四种碱基；右上角显示总信息量，不读取 count 列。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "method",
"value": "\"bits\""
},
{
"name": "base_levels",
"value": "c(\"A\", \"C\", \"G\", \"T\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/sequence-logo/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/sequence-logo/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/sequence-logo/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/sequence-logo/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/sequence-logo/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/sequence-logo/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/sequence-logo/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/sequence-logo/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/sequence-logo/make_data.R"
}
],
"dir": "figures/genome/sequence-logo",
"preview": "figures/genome/sequence-logo/preview.png",
"docs_preview": "previews/sequence-logo.png",
"code": "figures/genome/sequence-logo/plot.R",
"data": "figures/genome/sequence-logo/data.csv",
"data_files": [
"figures/genome/sequence-logo/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/sequence-logo/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/sequence-logo/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/sequence-logo",
"code_text": "# Sequence logo (house style): letter height is frequency times information, stacked small to large;\n# total information content as the in-panel stat. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nmethod <- \"bits\"\nbase_levels <- c(\"A\", \"C\", \"G\", \"T\")\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# usual nucleotide hues taken from the house palette: A green, C blue, G orange, T red\nbase_cols <- stats::setNames(c(hp[[\"green\"]], hp[[\"blue\"]], hp[[\"orange\"]], hp[[\"red\"]]), base_levels)\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$base <- factor(df$base, levels = base_levels)\nif (method == \"prob\") {\n logo_mat <- xtabs(prob ~ base + pos, df)\n logo_mat <- logo_mat[base_levels, , drop = FALSE]\n y_top <- 1.05\n y_lab <- \"Probability\"\n} else {\n logo_mat <- xtabs(bits ~ base + pos, df)\n logo_mat <- logo_mat[base_levels, , drop = FALSE]\n logo_mat[logo_mat < 0.15] <- 0\n y_top <- max(colSums(logo_mat)) + 0.15\n y_lab <- \"Information (bits)\"\n}\n# Glyphs from the logo font, then refit into each letter's own height band\n# so a tall curve cannot spill into the letter stacked under it.\nraw <- ggseqlogo:::logo_data(\n logo_mat, method = \"custom\", seq_type = \"dna\",\n font = \"helvetica_bold\", stack_width = 0.85\n)\nraw <- raw[raw$letter %in% rownames(logo_mat)[rowSums(logo_mat) >= 0], , drop = FALSE]\npieces <- split(raw, paste(raw$position, raw$letter))\nfit_letter <- function(g) {\n g <- g[order(g$order), , drop = FALSE]\n pos <- g$position[1]\n let <- as.character(g$letter[1])\n h <- logo_mat[let, as.character(pos)]\n if (!length(h) || is.na(h) || h <= 0) return(NULL)\n col_h <- logo_mat[, as.character(pos)]\n col_h <- sort(col_h[col_h > 0])\n below <- sum(col_h[seq_len(match(let, names(col_h)) - 1L)])\n if (match(let, names(col_h)) == 1L) below <- 0\n pad <- 0.14 * h\n yr <- range(g$y)\n xr <- range(g$x)\n gy <- if (diff(yr) < 1e-6) 0.5 else (g$y - yr[1]) / diff(yr)\n gx <- if (diff(xr) < 1e-6) 0.5 else (g$x - xr[1]) / diff(xr)\n g$y <- below + pad + gy * (h - 2 * pad)\n g$x <- (pos - 0.32) + gx * 0.64\n g\n}\nfitted <- lapply(pieces, fit_letter)\nfitted <- fitted[!vapply(fitted, is.null, logical(1))]\nletters_df <- do.call(rbind, fitted)\nletters_df$gid <- paste(letters_df$position, letters_df$letter)\n\nic <- sum(logo_mat)\nstat <- if (method == \"prob\") sprintf(\"%d positions\", ncol(logo_mat)) else sprintf(\"Total information %.1f bits\", ic)\np <- ggplot(letters_df) +\n geom_polygon(aes(x, y, group = gid, fill = letter), colour = NA) +\n annotate(\"text\", x = Inf, y = Inf, hjust = 1.03, vjust = 1.4, label = stat, size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family()) +\n scale_fill_manual(values = base_cols, guide = \"none\") +\n scale_x_continuous(breaks = sort(unique(df$pos)), expand = expansion(add = 0.4)) +\n scale_y_continuous(limits = c(0, y_top * 1.15), expand = expansion(mult = c(0, 0.02))) +\n labs(x = \"Position in motif\", y = y_lab, caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")) + caption_theme\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "sequence logo\n序列模体图\nsequence-logo\n\ngenome\n基因组\ngenome\n基因组\ngenome\n展示一个 dna 模体各位置的保守性和碱基偏好时用。\nmethod 为 bits 时字母高度等于频率乘信息量，为 prob 时代表概率；base_levels 设定四种碱基；右上角显示总信息量，不读取 count 列。\nsequence-logo motif genome\npos 模体位置（整数，从 1 起） base 碱基（a、c、g、t） bits 该碱基的信息量高度，频率乘以该位总信息量（bit，非负） prob 该位置碱基频率（0 到 1） count 该碱基的计数（整数，列和为序列条数）"
},
{
"title": "SV size distribution",
"title_zh": "结构变异大小分布",
"slug": "sv-size",
"category": "genome",
"tags": [
"structural-variant",
"indel"
],
"packages": [
"ggplot2"
],
"data_columns": {
"sv_type": "DEL、INS、DUP 或 INV（字符串）",
"size_bp": "变异长度，bp，至少 50（整数）"
},
"when_to_use": "比较缺失、插入、重复和倒位的长度谱，尤其是植物 LTR 尺度的插入峰时用。",
"customize": "log_x 控制对数 X 轴；sv_keep 选择保留四种结构变异；各密度峰值处标记类型和中值大小；log_x 为 FALSE 时名称在右上角。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "log_x",
"value": "TRUE"
},
{
"name": "sv_keep",
"value": "c(\"DEL\", \"INS\", \"DUP\", \"INV\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/sv-size/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/sv-size/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/sv-size/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/sv-size/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/sv-size/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/sv-size/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/sv-size/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/sv-size/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/sv-size/make_data.R"
}
],
"dir": "figures/genome/sv-size",
"preview": "figures/genome/sv-size/preview.png",
"docs_preview": "previews/sv-size.png",
"code": "figures/genome/sv-size/plot.R",
"data": "figures/genome/sv-size/data.csv",
"data_files": [
"figures/genome/sv-size/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/sv-size/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/sv-size/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/sv-size",
"code_text": "# SV size densities on a log10 axis (house style), coloured by SV type, type names written at the\n# density peaks; median size per type as the in-panel stat. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nlog_x <- TRUE\nsv_keep <- c(\"DEL\", \"INS\", \"DUP\", \"INV\")\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$sv_type %in% sv_keep, , drop = FALSE]\ndf$sv_type <- factor(df$sv_type, levels = sv_keep)\ncols <- stats::setNames(c(hp[[\"blue\"]], pv_palette(\"chrom12\")[[12]], hp[[\"green\"]], hp[[\"purple\"]])[seq_along(sv_keep)], sv_keep)\nlab_cols <- text_col(cols)\n\nfmt_bp <- function(b) ifelse(b >= 1e6, sprintf(\"%.1f Mb\", b / 1e6), ifelse(b >= 1e3, sprintf(\"%.1f kb\", b / 1e3),\n sprintf(\"%d bp\", round(b))))\n# density peak of each type on the plotted scale -> name position\ntr <- if (isTRUE(log_x)) log10 else identity\nitr <- if (isTRUE(log_x)) function(v) 10^v else identity\npk <- do.call(rbind, lapply(split(df$size_bp, df$sv_type), function(v) {\n d <- stats::density(tr(v))\n data.frame(x = itr(d$x[which.max(d$y)]), y = max(d$y), med = stats::median(v))\n}))\npk$sv_type <- rownames(pk)\npk$lab <- sprintf(\"%s\\n%s\", pk$sv_type, fmt_bp(pk$med))\n\np <- ggplot(df, aes(size_bp, colour = sv_type, fill = sv_type)) +\n geom_density(alpha = 0.2, linewidth = pv_house_lw(\"main\")) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_y_continuous(expand = expansion(mult = c(0, 0.3))) +\n labs(x = \"SV size (label: median)\", y = \"Density\", caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 2, 1, 1, \"mm\")) + caption_theme\n# name side per type (0.5 above the peak, 1 to the left, 0 to the right), so neighbouring peaks do not collide\nlab_hjust <- c(DEL = 0.5, INS = 1, DUP = 0, INV = 0.5)\npk$hj <- ifelse(pk$sv_type %in% names(lab_hjust), lab_hjust[pk$sv_type], 0.5)\npk$xl <- if (isTRUE(log_x)) pk$x * 10^(0.18 * (0.5 - pk$hj) * 2) else pk$x\nif (!isTRUE(log_x)) {\n # linear axis: the peaks crowd at the left, so the names go in a column at the top right\n pk$xl <- Inf; pk$hj <- 1.05\n pk$y <- max(pk$y) * (1.25 - 0.17 * (seq_len(nrow(pk)) - 1))\n pk$lab <- sprintf(\"%s %s\", pk$sv_type, fmt_bp(pk$med))\n}\nfor (i in seq_len(nrow(pk))) {\n p <- p + annotate(\"text\", x = pk$xl[i], y = pk$y[i], label = pk$lab[i], hjust = pk$hj[i],\n vjust = if (pk$hj[i] == 0.5) -0.25 else if (pk$hj[i] > 1) 1 else 0.2, lineheight = 0.9,\n colour = lab_cols[[pk$sv_type[i]]], size = pv_pt2size(7), family = house_family())\n}\nif (isTRUE(log_x)) {\n p <- p + scale_x_log10(breaks = c(100, 1e3, 1e4, 1e5, 1e6, 1e7),\n labels = c(\"100 bp\", \"1 kb\", \"10 kb\", \"100 kb\", \"1 Mb\", \"10 Mb\"))\n}\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "sv size distribution\n结构变异大小分布\nsv-size\n\ngenome\n基因组\ngenome\n基因组\ngenome\n比较缺失、插入、重复和倒位的长度谱，尤其是植物 ltr 尺度的插入峰时用。\nlog_x 控制对数 x 轴；sv_keep 选择保留四种结构变异；各密度峰值处标记类型和中值大小；log_x 为 false 时名称在右上角。\nstructural-variant indel\nsv_type del、ins、dup 或 inv（字符串） size_bp 变异长度，bp，至少 50（整数）"
},
{
"title": "Synteny ribbon and dotplot",
"title_zh": "共线性带与点图",
"slug": "synteny",
"category": "genome",
"tags": [
"synteny",
"ribbon",
"dotplot"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"genome": "基因组 A 或 B（字符串）",
"chr": "染色体名（字符串）",
"start": "起点 bp；反向区块终点小于起点；锚点 start 等于 end（整数）",
"end": "终点 bp（整数）",
"block": "共线性区块编号；染色体骨架行留空（字符串）",
"identity": "序列一致性（%）；骨架行留空（数值）"
},
"when_to_use": "比较两个基因组的共线性区块、方向和锚点一致性时用。",
"customize": "show_ribbon 开关整个条带面板，正向蓝色反向红色，并在左上角显示区块计数；show_dotplot 在左上角放色条并在右下角写锚点数与一致性中位数；chr_layout 为 all 时全显，pair 时仅保留 A1 点图。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_ribbon",
"value": "TRUE"
},
{
"name": "show_dotplot",
"value": "TRUE"
},
{
"name": "chr_layout",
"value": "\"all\""
},
{
"name": "pair_chr",
"value": "\"A1\""
}
],
"canvas": null,
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/synteny/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/synteny/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/synteny/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/synteny/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/synteny/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/synteny/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/synteny/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/synteny/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/synteny/make_data.R"
}
],
"dir": "figures/genome/synteny",
"preview": "figures/genome/synteny/preview.png",
"docs_preview": "previews/synteny.png",
"code": "figures/genome/synteny/plot.R",
"data": "figures/genome/synteny/data.csv",
"data_files": [
"figures/genome/synteny/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/synteny/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/synteny/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/synteny",
"code_text": "# Synteny (house style): ribbons between chromosome bars (forward blue, reversed red, named in the panel)\n# and an anchor dot plot coloured by identity on the warm house ramp. Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# 可调参数 -----------------------------------------------------------------\nshow_ribbon <- TRUE\nshow_dotplot <- TRUE\nchr_layout <- \"all\" # all | A1-B1 only when \"pair\"\npair_chr <- \"A1\"\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nchr_rows <- df[df$block == \"\", , drop = FALSE]\nfeat <- df[df$block != \"\", , drop = FALSE]\nis_anchor <- feat$start == feat$end\nblocks <- feat[!is_anchor, , drop = FALSE]\nanchors <- feat[is_anchor, , drop = FALSE]\n\nplace_genome <- function(chr_df) {\n chr_df <- chr_df[order(chr_df$chr), , drop = FALSE]\n gap <- 6e6\n off <- 0\n pos <- list()\n for (i in seq_len(nrow(chr_df))) {\n pos[[chr_df$chr[i]]] <- off\n off <- off + (chr_df$end[i] - chr_df$start[i]) + gap\n }\n pos\n}\n\noff_a <- place_genome(chr_rows[chr_rows$genome == \"A\", , drop = FALSE])\noff_b <- place_genome(chr_rows[chr_rows$genome == \"B\", , drop = FALSE])\n\nchr_bars <- function(chr_df, y, off) {\n chr_df$xmin <- vapply(chr_df$chr, function(z) off[[z]], numeric(1))\n chr_df$xmax <- chr_df$xmin + chr_df$end\n chr_df$ymin <- y - 0.08\n chr_df$ymax <- y + 0.08\n chr_df$lab_x <- (chr_df$xmin + chr_df$xmax) / 2\n chr_df\n}\n\nbars_a <- chr_bars(chr_rows[chr_rows$genome == \"A\", , drop = FALSE], 1, off_a)\nbars_b <- chr_bars(chr_rows[chr_rows$genome == \"B\", , drop = FALSE], 0, off_b)\n\nblk_ids <- unique(blocks$block)\npoly <- list()\nfor (b in blk_ids) {\n sub <- blocks[blocks$block == b, , drop = FALSE]\n ra <- sub[sub$genome == \"A\", , drop = FALSE]\n rb <- sub[sub$genome == \"B\", , drop = FALSE]\n if (!nrow(ra) || !nrow(rb)) next\n xa1 <- off_a[[ra$chr[1]]] + min(ra$start[1], ra$end[1])\n xa2 <- off_a[[ra$chr[1]]] + max(ra$start[1], ra$end[1])\n xb1 <- off_b[[rb$chr[1]]] + min(rb$start[1], rb$end[1])\n xb2 <- off_b[[rb$chr[1]]] + max(rb$start[1], rb$end[1])\n forward <- ra$end[1] > ra$start[1]\n # forward ribbon does not cross; reverse ribbon twists once\n xs <- if (forward) c(xa1, xa2, xb2, xb1) else c(xa1, xa2, xb1, xb2)\n orient <- if (forward) \"forward\" else \"reverse\"\n poly[[b]] <- data.frame(\n block = b,\n orient = orient,\n x = xs,\n y = c(0.92, 0.92, 0.08, 0.08),\n stringsAsFactors = FALSE\n )\n}\npoly <- do.call(rbind, poly)\n\norient_cols <- c(forward = hp[[\"blue\"]], reverse = hp[[\"red\"]])\nn_rev <- length(unique(poly$block[poly$orient == \"reverse\"]))\nn_blk <- length(unique(poly$block))\nxr_rib <- range(c(bars_a$xmin, bars_a$xmax, bars_b$xmin, bars_b$xmax)) / 1e6\nbars <- rbind(bars_a, bars_b)\n\np_rib <- ggplot() +\n geom_polygon(data = poly, aes(x = x / 1e6, y = y, group = block, fill = orient), alpha = 0.4, colour = NA) +\n geom_rect(data = bars, aes(xmin = xmin / 1e6, xmax = xmax / 1e6, ymin = ymin, ymax = ymax),\n fill = grey[[\"bg\"]], colour = grey[[\"text\"]], linewidth = pv_house_lw(\"frame\")) +\n geom_text(data = bars_a, aes(lab_x / 1e6, 1.13, label = chr), vjust = 0, size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family()) +\n geom_text(data = bars_b, aes(lab_x / 1e6, -0.13, label = chr), vjust = 1, size = pv_pt2size(7),\n colour = \"#1A1A1A\", family = house_family()) +\n annotate(\"text\", x = xr_rib[1] - 0.02 * diff(xr_rib), y = c(1, 0), label = c(\"Genome A\", \"Genome B\"),\n hjust = 1, size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family()) +\n # ribbon key + stat, stacked in the empty top left\n annotate(\"text\", x = xr_rib[1] - 0.2 * diff(xr_rib), y = c(1.5, 1.39, 1.28), hjust = 0, vjust = 1,\n label = c(sprintf(\"%d blocks\", n_blk), sprintf(\"forward %d\", n_blk - n_rev), sprintf(\"reversed %d\", n_rev)),\n colour = c(\"#1A1A1A\", text_col(orient_cols)[[\"forward\"]], text_col(orient_cols)[[\"reverse\"]]),\n size = pv_pt2size(7), family = house_family()) +\n scale_fill_manual(values = orient_cols, guide = \"none\") +\n scale_x_continuous(breaks = seq(0, 1000, 50), expand = expansion(mult = c(0.2, 0.02))) +\n scale_y_continuous(limits = c(-0.35, 1.55), expand = c(0, 0)) +\n labs(x = \"Position (Mb)\", y = NULL) +\n theme_house() +\n theme(axis.text.y = element_blank(), axis.ticks.y = element_blank())\n\n# anchors: pair rows that share block order\nanc_a <- anchors[anchors$genome == \"A\", , drop = FALSE]\nanc_b <- anchors[anchors$genome == \"B\", , drop = FALSE]\nanc_a <- anc_a[order(anc_a$block, anc_a$start), , drop = FALSE]\nanc_b <- anc_b[order(anc_b$block, seq_len(nrow(anc_b))), , drop = FALSE]\n# restore pair order from file order\nanc_a <- anchors[anchors$genome == \"A\", , drop = FALSE]\nanc_b <- anchors[anchors$genome == \"B\", , drop = FALSE]\nstopifnot(nrow(anc_a) == nrow(anc_b))\ndots <- data.frame(\n chr_a = anc_a$chr,\n chr_b = anc_b$chr,\n x = vapply(seq_len(nrow(anc_a)), function(i) off_a[[anc_a$chr[i]]] + anc_a$start[i], numeric(1)),\n y = vapply(seq_len(nrow(anc_b)), function(i) off_b[[anc_b$chr[i]]] + anc_b$start[i], numeric(1)),\n identity = anc_a$identity,\n stringsAsFactors = FALSE\n)\nif (chr_layout == \"pair\") {\n dots <- dots[dots$chr_a == pair_chr, , drop = FALSE]\n}\n\np_dot <- ggplot(dots, aes(x / 1e6, y / 1e6, fill = identity)) +\n geom_point(shape = 21, size = 1.2, stroke = 0.2, colour = grey[[\"dark\"]]) +\n annotate(\"text\", x = Inf, y = -Inf, hjust = 1.05, vjust = -0.6,\n label = sprintf(\"%d anchors\\nmedian identity %.1f%%\", nrow(dots), stats::median(dots$identity)),\n lineheight = 0.95, size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family()) +\n scale_fill_gradientn(colours = pv_palette(\"house_warm\"), name = \"Identity (%)\", breaks = c(80, 90)) +\n guides(fill = guide_colourbar(direction = \"horizontal\", title.position = \"top\", ticks = FALSE,\n barwidth = unit(16, \"mm\"), barheight = unit(2, \"mm\"))) +\n labs(x = \"Genome A (Mb)\", y = \"Genome B (Mb)\") +\n theme_house() +\n theme(legend.position = \"inside\", legend.position.inside = c(0.03, 0.97),\n legend.justification.inside = c(0, 1), legend.background = element_blank(),\n legend.title = element_text(size = 7), legend.text = element_text(size = 7))\n\nnote <- plot_annotation(caption = footnote, theme = theme_house() + caption_theme +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")))\nif (isTRUE(show_ribbon) && isTRUE(show_dotplot)) {\n p <- (p_rib | p_dot) + plot_layout(widths = c(1.45, 1)) + note\n cells <- \"4x2\"\n} else if (isTRUE(show_ribbon)) {\n p <- p_rib + note\n cells <- \"4x1\"\n} else {\n p <- p_dot + note\n cells <- \"2x2\"\n}\npv_save_house(p, \"figure\", cells = cells, bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "synteny ribbon and dotplot\n共线性带与点图\nsynteny\n\ngenome\n基因组\ngenome\n基因组\ngenome\n比较两个基因组的共线性区块、方向和锚点一致性时用。\nshow_ribbon 开关整个条带面板，正向蓝色反向红色，并在左上角显示区块计数；show_dotplot 在左上角放色条并在右下角写锚点数与一致性中位数；chr_layout 为 all 时全显，pair 时仅保留 a1 点图。\nsynteny ribbon dotplot\ngenome 基因组 a 或 b（字符串） chr 染色体名（字符串） start 起点 bp；反向区块终点小于起点；锚点 start 等于 end（整数） end 终点 bp（整数） block 共线性区块编号；染色体骨架行留空（字符串） identity 序列一致性（%）；骨架行留空（数值）"
},
{
"title": "TE composition",
"title_zh": "转座子组成",
"slug": "te-composition",
"category": "genome",
"tags": [
"transposable-element",
"repeat-landscape"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"genome": "基因组，以组装大小标记（字符串）",
"te_class": "Gypsy、Copia、LINE、TIR 或 Helitron（字符串）",
"divergence": "Kimura 分歧度，百分比（整数）",
"fraction": "该分歧度箱占基因组的比例（数值）"
},
"when_to_use": "比较植物基因组的 TE 类别占比，并看 Gypsy/Copia 等的分歧度（年龄）景观时用。",
"customize": "show_stacked 控制显示各基因组堆叠比例且名称在最末柱旁；show_landscape 画散度图并标注比例；class_order 设定五种类别的顺序，柱图位于散度图左侧。",
"lang": "R",
"task": "genome",
"task_zh": "基因组",
"task_en": "Genome",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_stacked",
"value": "TRUE"
},
{
"name": "show_landscape",
"value": "TRUE"
},
{
"name": "class_order",
"value": "c(\"Gypsy\", \"Copia\", \"TIR\", \"LINE\", \"Helitron\")"
}
],
"canvas": null,
"downloads": [
{
"name": "plot.R",
"path": "figures/genome/te-composition/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/te-composition/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/te-composition/plot.R"
},
{
"name": "data.csv",
"path": "figures/genome/te-composition/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/te-composition/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/te-composition/data.csv"
},
{
"name": "make_data.R",
"path": "figures/genome/te-composition/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/genome/te-composition/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/te-composition/make_data.R"
}
],
"dir": "figures/genome/te-composition",
"preview": "figures/genome/te-composition/preview.png",
"docs_preview": "previews/te-composition.png",
"code": "figures/genome/te-composition/plot.R",
"data": "figures/genome/te-composition/data.csv",
"data_files": [
"figures/genome/te-composition/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/te-composition/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/genome/te-composition/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/genome/te-composition",
"code_text": "# TE composition (house style): stacked TE share per genome (class names beside the last bar) and\n# Kimura divergence landscapes, one panel per genome with its total TE share. Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# 可调参数 -----------------------------------------------------------------\nshow_stacked <- TRUE\nshow_landscape <- TRUE\nclass_order <- c(\"Gypsy\", \"Copia\", \"TIR\", \"LINE\", \"Helitron\")\n\nset.seed(1) # fixed RNG state, so the figure never depends on the session\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# orange marks/labels use the darker chrom12 step of the same hue (#E17927, 3.01:1 on white)\nhp[[\"orange\"]] <- pv_palette(\"chrom12\")[[8]]\n# label text: the group colour if it reaches 3:1 contrast on white, else #1A1A1A (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n stats::setNames(ifelse(ratio >= 3, hex, \"#1A1A1A\"), names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ngenome_order <- unique(df$genome)\ndf$genome <- factor(df$genome, levels = genome_order)\ndf$te_class <- factor(df$te_class, levels = class_order)\ncols <- stats::setNames(c(hp[[\"blue\"]], pv_palette(\"chrom12\")[[12]], hp[[\"green\"]], hp[[\"purple\"]], hp[[\"gold\"]])[seq_along(class_order)],\n class_order)\nlab_cols <- text_col(cols)\ndf$percent <- df$fraction * 100\n\nbar <- stats::aggregate(percent ~ genome + te_class, df, sum)\ntot <- stats::aggregate(percent ~ genome, df, sum)\n\n# class names beside the last bar, at the middle of its segments (pushed apart to >= 4.5 points)\nlast <- bar[bar$genome == genome_order[length(genome_order)], ]\nlast <- last[order(last$te_class, decreasing = TRUE), ] # stacking order: first class on top\nlast$top <- cumsum(last$percent); last$mid <- last$top - last$percent / 2\nlast$y_lab <- spread(last$mid, 4.5)\nnx <- length(genome_order)\n\np_bar <- ggplot(bar, aes(genome, percent, fill = te_class)) +\n geom_col(width = 0.72, colour = NA) +\n geom_segment(data = last, aes(x = nx + 0.4, xend = nx + 0.6, y = mid, yend = y_lab), inherit.aes = FALSE,\n linewidth = pv_house_lw(\"ref\"), colour = grey[[\"dark\"]]) +\n geom_text(data = last, aes(x = nx + 0.68, y = y_lab, label = te_class, colour = te_class), hjust = 0,\n size = pv_pt2size(7), family = house_family(), inherit.aes = FALSE) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = lab_cols, guide = \"none\") +\n scale_x_discrete(labels = function(v) sub(\" \", \"\\n\", v), expand = expansion(add = c(0.6, 2.2))) +\n scale_y_continuous(expand = expansion(mult = c(0, 0.05))) +\n coord_cartesian(clip = \"off\") +\n labs(x = \"Genome size\", y = \"Genome (%)\") +\n theme_house() + theme(axis.text.x = element_text(angle = 0, hjust = 0.5, lineheight = 0.9, size = 7))\n\ntot$lab <- sprintf(\"%s\\nTE %.0f%%\", tot$genome, tot$percent)\np_land <- ggplot(df, aes(divergence, percent, fill = te_class)) +\n geom_area(position = \"stack\", colour = NA) +\n geom_text(data = tot, aes(label = lab), x = Inf, y = Inf, hjust = 1.08, vjust = 1.25, lineheight = 0.95,\n size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family(), inherit.aes = FALSE) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_y_continuous(expand = expansion(mult = c(0, 0.45))) +\n facet_wrap(~genome, ncol = 3) +\n labs(x = \"Kimura divergence (%)\", y = \"Genome (%)\") +\n theme_house() + theme(strip.text = element_blank(), panel.spacing = unit(2, \"mm\"))\n\nnote <- plot_annotation(caption = footnote, theme = theme_house() + caption_theme +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")))\nif (isTRUE(show_stacked) && isTRUE(show_landscape)) {\n p <- (p_bar | p_land) + plot_layout(widths = c(1, 2.2)) + note\n cells <- \"4x2\"\n} else if (isTRUE(show_stacked)) {\n p <- p_bar + note\n cells <- \"2x2\"\n} else {\n p <- p_land + note\n cells <- \"4x2\"\n}\n\npv_save_house(p, \"figure\", cells = cells, bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "te composition\n转座子组成\nte-composition\n\ngenome\n基因组\ngenome\n基因组\ngenome\n比较植物基因组的 te 类别占比，并看 gypsy/copia 等的分歧度（年龄）景观时用。\nshow_stacked 控制显示各基因组堆叠比例且名称在最末柱旁；show_landscape 画散度图并标注比例；class_order 设定五种类别的顺序，柱图位于散度图左侧。\ntransposable-element repeat-landscape\ngenome 基因组，以组装大小标记（字符串） te_class gypsy、copia、line、tir 或 helitron（字符串） divergence kimura 分歧度，百分比（整数） fraction 该分歧度箱占基因组的比例（数值）"
},
{
"title": "Circular heatmap",
"title_zh": "环状热图",
"slug": "circular-heatmap",
"category": "heatmap",
"tags": [
"heatmap",
"circular",
"circlize"
],
"packages": [
"circlize",
"ggplotify",
"ggplot2"
],
"data_columns": {
"row": "特征编号（字符串）",
"col": "样本编号（字符串）",
"module": "扇区模块（字符串）",
"value": "矩阵取值（数值）"
},
"when_to_use": "特征较多、又要按模块分成扇区并加一圈汇总轨道时用。",
"customize": "在 `plot.R` 控制 `split_sectors` 决定是否按模块切割扇区，控制 `show_track` 显隐汇总轨道，使用 `pv_palette(\"house_div\")` 调色；在 `data.csv` 填入 row、col、module 和 value 列。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": "heatmap",
"variant_label": "Circular",
"variants": [],
"parameters": [
{
"name": "split_sectors",
"value": "TRUE"
},
{
"name": "show_track",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/heatmap/circular-heatmap/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/circular-heatmap/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/circular-heatmap/plot.R"
},
{
"name": "data.csv",
"path": "figures/heatmap/circular-heatmap/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/circular-heatmap/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/circular-heatmap/data.csv"
},
{
"name": "make_data.R",
"path": "figures/heatmap/circular-heatmap/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/circular-heatmap/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/circular-heatmap/make_data.R"
}
],
"dir": "figures/heatmap/circular-heatmap",
"preview": "figures/heatmap/circular-heatmap/preview.png",
"docs_preview": "previews/circular-heatmap.png",
"code": "figures/heatmap/circular-heatmap/plot.R",
"data": "figures/heatmap/circular-heatmap/data.csv",
"data_files": [
"figures/heatmap/circular-heatmap/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/circular-heatmap/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/circular-heatmap/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/heatmap/circular-heatmap",
"code_text": "# Circular heatmap (house style): circlize draws in base graphics, so theme_house() cannot reach it;\n# the house look is set by hand (Arial, 7 pt via cex, 0.5 pt borders, house_div scale) and the\n# drawing is wrapped with ggplotify for pv_save_house(). Colour key and counts sit in the hole.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# --- adjustable ---\nsplit_sectors <- TRUE\nshow_track <- TRUE\n# ------------------\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nrows <- unique(df$row)\ncols <- unique(df$col)\nmat <- matrix(NA_real_, length(rows), length(cols), dimnames = list(rows, cols))\nmat[cbind(match(df$row, rows), match(df$col, cols))] <- df$value\nmodules <- df$module[match(rows, df$row)]\nsplit <- if (isTRUE(split_sectors)) factor(modules, levels = unique(modules)) else NULL\n\ndiv <- pv_palette(\"house_div\"); grey <- pv_palette(\"house_grey\")\ncol_fun <- circlize::colorRamp2(seq(-2, 2, length.out = length(div)), div)\nfam <- house_family()\nfootnote <- \"Simulated data for illustration; not biological results\"\nlwd_pt <- function(pt) pt / (72.27 / 96) # base lwd 1 = 1/96 inch\n# ggplotify replays the drawing on a 12 pt device, so text size is set as cex = pt / 12\ncex_pt <- function(pt) pt / 12\n\ndraw_heat <- function() {\n graphics::par(bg = \"white\", mar = c(0, 0, 0, 0), family = fam)\n circlize::circos.clear()\n circlize::circos.par(\n start.degree = 90,\n gap.degree = if (isTRUE(split_sectors)) 8 else 2,\n canvas.xlim = c(-1.25, 1.25),\n canvas.ylim = c(-1.25, 1.25),\n points.overflow.warning = FALSE\n )\n circlize::circos.heatmap(\n mat,\n split = split,\n col = col_fun,\n cluster = FALSE,\n rownames.side = \"outside\",\n rownames.cex = cex_pt(7),\n rownames.font = 1,\n show.sector.labels = FALSE,\n track.height = 0.26,\n bg.border = grey[[\"dark\"]],\n bg.lwd = lwd_pt(0.5),\n cell.border = \"white\",\n cell.lwd = 0.25\n )\n if (isTRUE(show_track)) {\n nc <- ncol(mat)\n left <- seq_len(max(1, nc %/% 3))\n right <- seq(nc - max(1, nc %/% 3) + 1, nc)\n score <- rowMeans(mat[, left, drop = FALSE]) - rowMeans(mat[, right, drop = FALSE])\n track <- cbind(score = score)\n rownames(track) <- rownames(mat)\n circlize::circos.heatmap(\n track,\n split = split,\n col = col_fun,\n cluster = FALSE,\n rownames.side = \"none\",\n track.height = 0.05,\n cell.border = NA\n )\n }\n if (isTRUE(split_sectors)) {\n for (s in circlize::get.all.sector.index()) {\n # circlize() returns polar coordinates (degrees, radius); module name goes outside the row names\n pol <- circlize::circlize(\n circlize::get.cell.meta.data(\"xcenter\", sector.index = s, track.index = 1), 0,\n sector.index = s, track.index = 1\n )\n ang <- pol[1, 1] * pi / 180\n graphics::text(1.19 * cos(ang), 1.19 * sin(ang), s, cex = cex_pt(8))\n }\n }\n # Same colorRamp2 scale as a ComplexHeatmap legend. Drawn in base graphics\n # so it stays inside the circos hole; a grid legend on this device hangs.\n n <- 80\n z <- seq(-2, 2, length.out = n)\n cols <- col_fun(z)\n xs <- seq(-0.46, 0.46, length.out = n)\n graphics::rect(utils::head(xs, -1), -0.07, xs[-1], 0.07, col = utils::head(cols, -1), border = NA)\n graphics::text(0, 0.17, \"z-score\", cex = cex_pt(7))\n graphics::text(c(-0.46, 0, 0.46), -0.17, c(\"-2\", \"0\", \"2\"), cex = cex_pt(7))\n graphics::text(0, -0.36, sprintf(\"%d features, %d samples\", nrow(mat), ncol(mat)), cex = cex_pt(7))\n circlize::circos.clear()\n}\n\np <- ggplotify::as.ggplot(draw_heat) +\n labs(caption = footnote) +\n theme(text = element_text(family = fam),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\", plot.background = element_rect(fill = \"white\", colour = NA),\n plot.margin = margin(0.4, 0.4, 0.9, 0.4, \"mm\"))\n# base-graphics text is set to 7/8 pt above; no +2 pt single-panel bump for the wrapped drawing\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "circular heatmap\n环状热图\ncircular-heatmap\ncircular\nheatmap\n热图\nrelationship\n相关/关系\nrelationship\n特征较多、又要按模块分成扇区并加一圈汇总轨道时用。\n在 `plot.r` 控制 `split_sectors` 决定是否按模块切割扇区，控制 `show_track` 显隐汇总轨道，使用 `pv_palette(\"house_div\")` 调色；在 `data.csv` 填入 row、col、module 和 value 列。\nheatmap circular circlize\nrow 特征编号（字符串） col 样本编号（字符串） module 扇区模块（字符串） value 矩阵取值（数值）"
},
{
"title": "Dot heatmap",
"title_zh": "点状热图",
"slug": "dot-heatmap",
"category": "heatmap",
"tags": [
"heatmap",
"dot",
"composition"
],
"packages": [
"ggplot2",
"scatterpie"
],
"data_columns": {
"row": "行名，这里是细胞类型（字符串）",
"col": "列名，这里是病人（字符串）",
"value": "连续得分（数值）",
"size": "检出比例，0 到 1（数值）"
},
"when_to_use": "格子要同时编码强度和比例，又不想用色块铺满时用。",
"customize": "plot.R 顶部 mode 取 dot 或 pie（pie 读 data_pie.csv，三份组成画成小饼）；map_size 是否把 size 映成点面积。颜色用 diverging 色板，不在数据里按阈值切开。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "mode",
"value": "\"dot\""
},
{
"name": "map_size",
"value": "TRUE"
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
},
{
"name": "cap_theme",
"value": "theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], margin = margin(t = 0.8, unit = \"mm\")), plot.caption.position = \"plot\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/heatmap/dot-heatmap/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/dot-heatmap/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/dot-heatmap/plot.R"
},
{
"name": "data.csv",
"path": "figures/heatmap/dot-heatmap/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/dot-heatmap/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/dot-heatmap/data.csv"
},
{
"name": "make_data.R",
"path": "figures/heatmap/dot-heatmap/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/dot-heatmap/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/dot-heatmap/make_data.R"
},
{
"name": "data_pie.csv",
"path": "figures/heatmap/dot-heatmap/data_pie.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/dot-heatmap/data_pie.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/dot-heatmap/data_pie.csv"
}
],
"dir": "figures/heatmap/dot-heatmap",
"preview": "figures/heatmap/dot-heatmap/preview.png",
"docs_preview": "previews/dot-heatmap.png",
"code": "figures/heatmap/dot-heatmap/plot.R",
"data": "figures/heatmap/dot-heatmap/data.csv",
"data_files": [
"figures/heatmap/dot-heatmap/data.csv",
"figures/heatmap/dot-heatmap/data_pie.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/dot-heatmap/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/dot-heatmap/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/heatmap/dot-heatmap",
"code_text": "# Dot heatmap (house style): fill = score on the house blue-red scale centred at 0, area = fraction;\n# or scatter pies of three components. Colour bar and size key sit just right of the panel,\n# the number of cells above and below 0 is written under the keys. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nmode <- \"dot\"\nmap_size <- TRUE\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\ncap_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nif (mode == \"pie\") {\n pie <- utils::read.csv(\"data_pie.csv\", stringsAsFactors = FALSE)\n comp <- c(\"Lymphoid\", \"Myeloid\", \"Stromal\")\n # blue, red, green: all >= 3:1 on white, so the component names keep the slice colour\n comp_cols <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]]), comp)\n cl <- unique(pie$col); rl <- unique(pie$row)\n pie$x <- as.numeric(factor(pie$col, levels = cl))\n pie$y <- as.numeric(factor(pie$row, levels = rev(rl)))\n key <- data.frame(comp = factor(comp, levels = comp), i = seq_along(comp))\n p <- ggplot() +\n scatterpie::geom_scatterpie(aes(x = x, y = y, r = 0.2 + 0.25 * size), data = pie, cols = comp,\n color = NA) +\n geom_text(data = key, aes(x = length(cl) + 0.75, y = length(rl) + 0.5 - (i - 1) * 0.9, label = comp,\n colour = comp), hjust = 0, vjust = 1, inherit.aes = FALSE) +\n annotate(\"text\", x = length(cl) + 0.75, y = length(rl) - 2.4, hjust = 0, vjust = 1, lineheight = 0.95,\n label = \"Radius shows\\ndetected\\nfraction\") +\n scale_fill_manual(values = comp_cols, guide = \"none\") +\n scale_colour_manual(values = comp_cols, guide = \"none\") +\n scale_x_continuous(breaks = seq_along(cl), labels = cl, limits = c(0.4, length(cl) + 4.6), expand = c(0, 0)) +\n scale_y_continuous(breaks = seq_along(rl), labels = rev(rl), limits = c(0.4, length(rl) + 0.6),\n expand = c(0, 0)) +\n coord_fixed() +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() + cap_theme +\n theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))\n pv_save_house(p, \"figure\", cells = \"2x2\")\n message(\"wrote preview.png\")\n quit(save = \"no\", status = 0)\n}\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$row <- factor(df$row, levels = rev(unique(df$row)))\ndf$col <- factor(df$col, levels = unique(df$col))\nlim <- ceiling(max(abs(df$value)) * 2) / 2\nstat_lab <- sprintf(\"Cells\\n%d > 0\\n%d < 0\", sum(df$value > 0), sum(df$value < 0))\np <- ggplot(df, aes(col, row, fill = value))\nif (isTRUE(map_size)) {\n p <- p + geom_point(aes(size = size), shape = 21, colour = grey[[\"dark\"]], stroke = 0.3) +\n scale_size_area(max_size = 3.6, name = \"Fraction\", limits = c(0, 1), breaks = c(0.25, 0.5, 1))\n} else {\n p <- p + geom_point(size = 3, shape = 21, colour = grey[[\"dark\"]], stroke = 0.3)\n}\np <- p +\n annotate(\"text\", x = nlevels(df$col) + 1.05, y = 0.6, hjust = 0, vjust = 0, lineheight = 0.95,\n label = stat_lab) +\n coord_cartesian(clip = \"off\") +\n scale_fill_gradientn(colours = pv_palette(\"house_div\"), limits = c(-lim, lim), name = \"Score\",\n guide = guide_colourbar(order = 1,\n theme = theme(legend.key.width = unit(2, \"mm\"),\n legend.key.height = unit(18, \"mm\")))) +\n guides(size = guide_legend(order = 2)) +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() + cap_theme +\n theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1),\n legend.position = \"right\", legend.box.spacing = unit(1, \"mm\"),\n legend.title = element_text(margin = margin(b = 1, unit = \"mm\")),\n legend.spacing.y = unit(3, \"mm\"))\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "dot heatmap\n点状热图\ndot-heatmap\n\nheatmap\n热图\nrelationship\n相关/关系\nrelationship\n格子要同时编码强度和比例，又不想用色块铺满时用。\nplot.r 顶部 mode 取 dot 或 pie（pie 读 data_pie.csv，三份组成画成小饼）；map_size 是否把 size 映成点面积。颜色用 diverging 色板，不在数据里按阈值切开。\nheatmap dot composition\nrow 行名，这里是细胞类型（字符串） col 列名，这里是病人（字符串） value 连续得分（数值） size 检出比例，0 到 1（数值）"
},
{
"title": "Clustered heatmap",
"title_zh": "聚类热图",
"slug": "heatmap",
"category": "heatmap",
"tags": [
"heatmap",
"clustering",
"expression"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"feature": "行名，基因或基因集（字符串）",
"sample": "列名（字符串）",
"value": "连续表达或得分（数值）",
"group": "样本分组，随样本重复（字符串）"
},
"when_to_use": "基因对样本的矩阵要同时看模块和组别时用。",
"customize": "plot.R 顶部 view 取 expression、geneset（读 data_geneset.csv）或 module-trait（读 data_module.csv）；show_annotation 打开样本色条；split_columns 在组间留空并只在组内聚类。z 分数在绑图时按行计算。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": "Clustered",
"variants": [
{
"slug": "heatmap",
"variant_label": "Clustered",
"title": "Clustered heatmap",
"title_zh": "聚类热图",
"docs_preview": "previews/heatmap.png"
},
{
"slug": "circular-heatmap",
"variant_label": "Circular",
"title": "Circular heatmap",
"title_zh": "环状热图",
"docs_preview": "previews/circular-heatmap.png"
}
],
"parameters": [
{
"name": "view",
"value": "\"expression\""
},
{
"name": "show_annotation",
"value": "TRUE"
},
{
"name": "split_columns",
"value": "TRUE"
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
},
{
"name": "cap_theme",
"value": "theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], margin = margin(t = 0.8, unit = \"mm\")), plot.caption.position = \"plot\")"
}
],
"canvas": {
"width_mm": "135",
"height_mm": "183",
"label": "135 × 183 mm (3×4 cells)",
"cells": "3x4"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/heatmap/heatmap/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/heatmap/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/heatmap/plot.R"
},
{
"name": "data.csv",
"path": "figures/heatmap/heatmap/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/heatmap/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/heatmap/data.csv"
},
{
"name": "make_data.R",
"path": "figures/heatmap/heatmap/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/heatmap/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/heatmap/make_data.R"
},
{
"name": "data_geneset.csv",
"path": "figures/heatmap/heatmap/data_geneset.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/heatmap/data_geneset.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/heatmap/data_geneset.csv"
},
{
"name": "data_module.csv",
"path": "figures/heatmap/heatmap/data_module.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/heatmap/data_module.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/heatmap/data_module.csv"
}
],
"dir": "figures/heatmap/heatmap",
"preview": "figures/heatmap/heatmap/preview.png",
"docs_preview": "previews/heatmap.png",
"code": "figures/heatmap/heatmap/plot.R",
"data": "figures/heatmap/heatmap/data.csv",
"data_files": [
"figures/heatmap/heatmap/data.csv",
"figures/heatmap/heatmap/data_geneset.csv",
"figures/heatmap/heatmap/data_module.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/heatmap/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/heatmap/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/heatmap/heatmap",
"code_text": "# Clustered heatmap (house style): z-scores on the house blue-red scale centred at 0, white cell\n# borders, sample groups as a coloured bar with the group names written above it (no legend),\n# colour bar just right of the panel. Views: expression, geneset or module-trait (r in each cell).\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\nview <- \"expression\"\nshow_annotation <- TRUE\nsplit_columns <- TRUE\n\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\ncap_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\ncbar <- function(h_mm) guide_colourbar(theme = theme(legend.key.width = unit(2, \"mm\"),\n legend.key.height = unit(h_mm, \"mm\")))\n\nif (view == \"module-trait\") {\n mt <- utils::read.csv(\"data_module.csv\", stringsAsFactors = FALSE)\n mt$module <- factor(mt$module, levels = rev(unique(mt$module)))\n mt$trait <- factor(mt$trait, levels = unique(mt$trait))\n mt$txt <- ifelse(abs(mt$r) > 0.6, \"white\", \"black\") # dark cells get white text\n p <- ggplot(mt, aes(trait, module, fill = r)) +\n geom_tile(colour = \"white\", linewidth = pv_house_lw(0.3)) +\n geom_text(aes(label = sprintf(\"%.2f\", r), colour = txt)) +\n scale_colour_identity() +\n scale_fill_gradientn(colours = pv_palette(\"house_div\"), limits = c(-1, 1), name = \"r\", guide = cbar(30)) +\n scale_x_discrete(expand = c(0, 0)) +\n scale_y_discrete(expand = c(0, 0)) +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() + cap_theme +\n theme(panel.border = element_blank(), axis.ticks = element_blank(), legend.position = \"right\",\n legend.box.spacing = unit(1, \"mm\"), legend.title = element_text(face = \"italic\"),\n axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1))\n pv_save_house(p, \"figure\", cells = \"2x2\")\n message(\"wrote preview.png\")\n quit(save = \"no\", status = 0)\n}\n\nsrc <- if (view == \"geneset\") \"data_geneset.csv\" else \"data.csv\"\ndf <- utils::read.csv(src, stringsAsFactors = FALSE)\nfeats <- unique(df$feature)\nsamps <- unique(df$sample)\nmat <- matrix(NA_real_, length(feats), length(samps), dimnames = list(feats, samps))\nmat[cbind(match(df$feature, feats), match(df$sample, samps))] <- df$value\nmat <- t(scale(t(mat)))\ngrp <- df$group[match(samps, df$sample)]\nnames(grp) <- samps\ngrp <- factor(grp, levels = c(\"Tumor\", \"Adjacent\", \"Normal\", \"Treated\"))\n\nif (isTRUE(split_columns)) {\n col_ord <- unlist(lapply(levels(grp), function(g) {\n cols <- samps[grp == g]\n if (length(cols) > 2) cols[stats::hclust(stats::dist(t(mat[, cols, drop = FALSE])))$order] else cols\n }), use.names = FALSE)\n} else {\n col_ord <- samps[stats::hclust(stats::dist(t(mat)))$order]\n}\nrow_ord <- feats[stats::hclust(stats::dist(mat))$order]\nmat <- mat[row_ord, col_ord, drop = FALSE]\n\nlevels_x <- character()\nfor (g in levels(grp)) {\n cols <- col_ord[grp[col_ord] == g]\n if (!length(cols)) next\n if (length(levels_x) && isTRUE(split_columns)) levels_x <- c(levels_x, paste0(\".gap.\", g))\n levels_x <- c(levels_x, cols)\n}\n\nlong <- data.frame(\n feature = factor(rownames(mat)[row(mat)], levels = rev(rownames(mat))),\n sample = factor(colnames(mat)[col(mat)], levels = levels_x),\n value = as.vector(mat)\n)\nann <- data.frame(\n sample = factor(col_ord, levels = levels_x),\n group = grp[col_ord]\n)\n# blue, red, green, purple: all >= 3:1 on white, so the group names keep the bar colour\nann_pal <- stats::setNames(c(hp[[\"blue\"]], hp[[\"red\"]], hp[[\"green\"]], hp[[\"purple\"]]), levels(grp))\nlim <- ceiling(max(abs(long$value), na.rm = TRUE))\nann_lab <- do.call(rbind, lapply(levels(grp), function(g) {\n x <- match(col_ord[grp[col_ord] == g], levels_x)\n if (!length(x)) return(NULL)\n data.frame(group = factor(g, levels = levels(grp)), x = mean(range(x)))\n}))\nstat_lab <- sprintf(\"%d features, %d samples, rows clustered\", nrow(mat), ncol(mat))\n\nheat <- ggplot(long, aes(sample, feature, fill = value)) +\n geom_tile(colour = \"white\", linewidth = pv_house_lw(0.3)) +\n scale_fill_gradientn(colours = pv_palette(\"house_div\"), limits = c(-lim, lim), name = \"z\",\n guide = cbar(40)) +\n scale_x_discrete(drop = FALSE, expand = c(0, 0), labels = function(x) ifelse(grepl(\"^\\\\.gap\", x), \"\", x)) +\n scale_y_discrete(expand = c(0, 0)) +\n labs(x = NULL, y = NULL) +\n theme_house() +\n theme(panel.border = element_blank(), axis.ticks = element_blank(),\n axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1),\n legend.position = \"right\", legend.box.spacing = unit(1, \"mm\"),\n legend.title = element_text(face = \"italic\", margin = margin(b = 1, unit = \"mm\")))\n\nif (isTRUE(show_annotation)) {\n bar <- ggplot(ann, aes(sample, 1, fill = group)) +\n geom_tile(colour = \"white\", linewidth = pv_house_lw(0.3)) +\n geom_text(data = ann_lab, aes(x = x, y = 1.75, label = group, colour = group), vjust = 0,\n inherit.aes = FALSE) +\n scale_fill_manual(values = ann_pal, guide = \"none\") +\n scale_colour_manual(values = ann_pal, guide = \"none\") +\n scale_x_discrete(drop = FALSE, expand = c(0, 0)) +\n coord_cartesian(ylim = c(0.5, 1.5), clip = \"off\") +\n labs(x = NULL, y = NULL, title = stat_lab) +\n theme_house() +\n theme(axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks = element_blank(),\n panel.border = element_blank(),\n plot.title = element_text(size = 7, margin = margin(b = 4.2, unit = \"mm\")),\n plot.margin = margin(1.2, 0.8, 0.6, 0.4, \"mm\"))\n p <- bar / heat + plot_layout(heights = c(0.035, 1), guides = \"collect\") +\n plot_annotation(caption = footnote,\n theme = cap_theme + theme(text = element_text(family = house_family()))) &\n theme(legend.position = \"right\")\n} else {\n p <- heat + labs(caption = footnote) + cap_theme\n}\n\npv_save_house(p, \"figure\", cells = c(3, 4))\nmessage(\"wrote preview.png\")\n",
"search_text": "clustered heatmap\n聚类热图\nheatmap\nclustered\nheatmap\n热图\nrelationship\n相关/关系\nrelationship\n基因对样本的矩阵要同时看模块和组别时用。\nplot.r 顶部 view 取 expression、geneset（读 data_geneset.csv）或 module-trait（读 data_module.csv）；show_annotation 打开样本色条；split_columns 在组间留空并只在组内聚类。z 分数在绑图时按行计算。\nheatmap clustering expression\nfeature 行名，基因或基因集（字符串） sample 列名（字符串） value 连续表达或得分（数值） group 样本分组，随样本重复（字符串）"
},
{
"title": "Annotated diverging heatmap (house style)",
"title_zh": "带数值的发散色热图（house 风格）",
"slug": "house-heatmap",
"category": "heatmap",
"tags": [
"heatmap",
"log2-fold-change",
"diverging",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"gene": "行名（字符串）",
"stress": "列分组（字符串）",
"day": "列内时间点（数值）",
"log2fc": "格内数值（log2 倍数变化，以 0 为中心）"
},
"when_to_use": "少量行 × 少量列、正负都有的数值矩阵时用；蓝–红发散色以 0 为中心，每格写数值（深底白字），行按聚类排序。",
"customize": "plot.R 顶部 limit 为色标对称上限；cluster_rows 开关行聚类；dark_cut 为格内改用白字的阈值；colourbar_mm 为色条长度（≤ 面板高 60%）。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 2×2 格（89 × 89 mm）单面板，由 pv_save_house() 自动 +2 pt（刻度 9 / 轴标题 10 pt）。",
"lang": "R",
"task": "relationship",
"task_zh": "相关/关系",
"task_en": "Relationship",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "limit",
"value": "3"
},
{
"name": "cluster_rows",
"value": "TRUE"
},
{
"name": "dark_cut",
"value": "1.6"
},
{
"name": "colourbar_mm",
"value": "27"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/heatmap/house-heatmap/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/house-heatmap/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/house-heatmap/plot.R"
},
{
"name": "data.csv",
"path": "figures/heatmap/house-heatmap/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/house-heatmap/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/house-heatmap/data.csv"
},
{
"name": "make_data.R",
"path": "figures/heatmap/house-heatmap/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/heatmap/house-heatmap/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/house-heatmap/make_data.R"
}
],
"dir": "figures/heatmap/house-heatmap",
"preview": "figures/heatmap/house-heatmap/preview.png",
"docs_preview": "previews/house-heatmap.png",
"code": "figures/heatmap/house-heatmap/plot.R",
"data": "figures/heatmap/house-heatmap/data.csv",
"data_files": [
"figures/heatmap/house-heatmap/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/house-heatmap/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/heatmap/house-heatmap/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/heatmap/house-heatmap",
"code_text": "# House-style heatmap: blue–red diverging around 0, values in every cell, rows ordered by clustering.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nlimit <- 3\ncluster_rows <- TRUE\ndark_cut <- 1.6\ncolourbar_mm <- 27\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nstress <- unique(df$stress)\ndays <- sort(unique(df$day))\ndf$col <- (match(df$stress, stress) - 1) * length(days) + match(df$day, days)\nwide <- tapply(df$log2fc, list(df$gene, df$col), mean)\ngenes <- if (isTRUE(cluster_rows)) rownames(wide)[stats::hclust(stats::dist(wide))$order] else unique(df$gene)\ndf$row <- match(df$gene, rev(genes))\ndf$txt <- ifelse(abs(df$log2fc) > dark_cut, \"white\", \"black\")\nncol_ <- length(stress) * length(days)\ngrp <- data.frame(x = (seq_along(stress) - 1) * length(days) + (length(days) + 1) / 2,\n lab = stress)\n\np <- ggplot(df, aes(col, row)) +\n geom_tile(aes(fill = pmax(pmin(log2fc, limit), -limit)), colour = \"white\", linewidth = pv_house_lw(0.3)) +\n geom_text(aes(label = gsub(\"-\", \"\\u2212\", sprintf(\"%.1f\", log2fc)), colour = txt), size = pv_pt2size(6)) +\n geom_vline(xintercept = length(days) + 0.5, colour = \"white\", linewidth = pv_house_lw(2)) +\n annotate(\"text\", x = grp$x, y = length(genes) + 0.75, label = grp$lab, vjust = 0, size = pv_pt2size(7)) +\n scale_colour_identity() +\n scale_fill_gradientn(colours = pv_palette(\"house_div\"), limits = c(-limit, limit),\n breaks = seq(-limit, limit, 1.5),\n labels = function(x) gsub(\"-\", \"\\u2212\", format(x)), name = expression(log[2]*\" FC\")) +\n scale_x_continuous(breaks = seq_len(ncol_), labels = rep(paste(days, \"d\"), length(stress)),\n expand = c(0, 0)) +\n scale_y_continuous(breaks = seq_along(genes), labels = rev(genes), expand = c(0, 0)) +\n guides(fill = guide_colourbar(theme = theme(legend.key.width = unit(2, \"mm\"),\n legend.key.height = unit(colourbar_mm, \"mm\")))) +\n coord_cartesian(clip = \"off\") +\n labs(x = \"Days of stress\", y = NULL) +\n theme_house() +\n theme(panel.border = element_blank(), axis.ticks = element_blank(),\n axis.text.y = element_text(face = \"italic\"),\n legend.position = \"right\", legend.title = element_text(size = 7, margin = margin(b = 2, unit = \"mm\")),\n legend.margin = margin(0, 0, 0, 1, \"mm\"), legend.box.spacing = unit(1, \"mm\"),\n plot.margin = margin(4.2, 0.8, 0.9, 0.4, \"mm\"))\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "annotated diverging heatmap (house style)\n带数值的发散色热图（house 风格）\nhouse-heatmap\n\nheatmap\n热图\nrelationship\n相关/关系\nrelationship\n少量行 × 少量列、正负都有的数值矩阵时用；蓝–红发散色以 0 为中心，每格写数值（深底白字），行按聚类排序。\nplot.r 顶部 limit 为色标对称上限；cluster_rows 开关行聚类；dark_cut 为格内改用白字的阈值；colourbar_mm 为色条长度（≤ 面板高 60%）。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），本图 2×2 格（89 × 89 mm）单面板，由 pv_save_house() 自动 +2 pt（刻度 9 / 轴标题 10 pt）。\nheatmap log2-fold-change diverging house-style\ngene 行名（字符串） stress 列分组（字符串） day 列内时间点（数值） log2fc 格内数值（log2 倍数变化，以 0 为中心）"
},
{
"title": "Composite figure",
"title_zh": "四面板拼图",
"slug": "composite-figure",
"category": "layout",
"tags": [
"composite",
"patchwork",
"multipanel"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"panel": "面板标记，A 散点、B 分组柱、C 时间曲线、D 热图（字符串）",
"group": "处理组 Control、Low、High；D 里是该样本所属处理（字符串）",
"x": "连续横坐标。A 是标志物 A，C 是天数；B 和 D 为空（数值）",
"y": "连续数值。A 是标志物 B，B 是响应，C 是信号，D 是标准化得分（数值）",
"class": "分类名。B 是组织，D 是基因；A 和 C 为空（字符串）",
"item": "D 的样本编号；其他面板为空（字符串）"
},
"when_to_use": "一张期刊图里要并排放散点、分组柱、时间曲线和小热图，并共用处理组图例时用。Use when a double-column figure should assemble those four panels in one font, palette, and legend.",
"customize": "在 `plot.R` 控制 `show_fit`（默认 `TRUE`）为分组添加拟合线，用 `base_size` 统一字号，设 `group_levels` 顺序；在 `data.csv` 填 `panel`、`group`、`x`、`y`、`class`、`item` 列。",
"lang": "R",
"task": "layout",
"task_zh": "拼图",
"task_en": "Layout",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_fit",
"value": "TRUE"
},
{
"name": "base_size",
"value": "7"
},
{
"name": "group_levels",
"value": "c(\"Control\", \"Low\", \"High\")"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/layout/composite-figure/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/composite-figure/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/composite-figure/plot.R"
},
{
"name": "data.csv",
"path": "figures/layout/composite-figure/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/composite-figure/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/composite-figure/data.csv"
},
{
"name": "make_data.R",
"path": "figures/layout/composite-figure/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/composite-figure/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/composite-figure/make_data.R"
}
],
"dir": "figures/layout/composite-figure",
"preview": "figures/layout/composite-figure/preview.png",
"docs_preview": "previews/composite-figure.png",
"code": "figures/layout/composite-figure/plot.R",
"data": "figures/layout/composite-figure/data.csv",
"data_files": [
"figures/layout/composite-figure/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/composite-figure/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/composite-figure/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/layout/composite-figure",
"code_text": "# Four-panel figure in house style: scatter with fits, grouped bars, time course, heatmap.\n# One row of four panels on the 4x2 grid; treatment legend and score bar collected at the bottom.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\nshow_fit <- TRUE\nbase_size <- 7\ngroup_levels <- c(\"Control\", \"Low\", \"High\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_levels)\npal <- stats::setNames(unname(pv_palette(\"house\")[seq_len(nlevels(df$group))]), group_levels)\ngrey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nscale_treat_fill <- function() {\n ggplot2::scale_fill_manual(values = pal, name = \"Treatment\")\n}\nscale_treat_colour <- function() {\n ggplot2::scale_colour_manual(values = pal, guide = \"none\")\n}\ntreat_guide <- function() {\n ggplot2::guides(\n fill = ggplot2::guide_legend(\n title.position = \"top\",\n nrow = 1,\n override.aes = list(\n shape = 21, colour = HOUSE_POINT$colour, alpha = 1, linewidth = 0, size = HOUSE_POINT$size\n )\n ),\n colour = \"none\"\n )\n}\n\npanel_theme <- theme_house(base_size = base_size) +\n ggplot2::theme(\n plot.margin = ggplot2::margin(1, 1.5, 0.5, 0.5, \"mm\"),\n plot.tag.position = \"topleft\",\n legend.position = \"bottom\",\n legend.box = \"horizontal\",\n legend.margin = ggplot2::margin(0, 3, 0, 3, \"mm\"),\n legend.box.margin = ggplot2::margin(0, 0, 0, 0)\n )\n\nA <- df[df$panel == \"A\", , drop = FALSE]\npA <- ggplot2::ggplot(A, ggplot2::aes(x, y))\nif (isTRUE(show_fit)) {\n pA <- pA + ggplot2::geom_smooth(\n ggplot2::aes(colour = group, fill = group),\n method = \"lm\", formula = y ~ x, se = TRUE,\n linewidth = pv_house_lw(\"main\"), alpha = 0.16\n )\n}\npA <- pA +\n ggplot2::geom_point(\n ggplot2::aes(fill = group),\n shape = HOUSE_POINT$shape, colour = HOUSE_POINT$colour, stroke = HOUSE_POINT$stroke, size = HOUSE_POINT$size\n ) +\n scale_treat_fill() +\n scale_treat_colour() +\n ggplot2::guides(fill = \"none\", colour = \"none\") +\n ggplot2::labs(x = \"Marker A\", y = \"Marker B\", tag = \"A\") +\n panel_theme\n\nB <- df[df$panel == \"B\", , drop = FALSE]\nB$class <- factor(B$class, levels = c(\"Liver\", \"Spleen\", \"Lung\", \"Kidney\"))\npB <- ggplot2::ggplot(B, ggplot2::aes(class, y, fill = group)) +\n ggplot2::geom_col(\n position = ggplot2::position_dodge(width = 0.72),\n width = 0.66\n ) +\n scale_treat_fill() +\n treat_guide() +\n ggplot2::scale_y_continuous(expand = ggplot2::expansion(mult = c(0, 0.08))) +\n ggplot2::labs(x = NULL, y = \"Response\", tag = \"B\") +\n panel_theme\n\nC <- df[df$panel == \"C\", , drop = FALSE]\npC <- ggplot2::ggplot(C, ggplot2::aes(x, y, group = group)) +\n ggplot2::geom_line(ggplot2::aes(colour = group), linewidth = pv_house_lw(\"main\")) +\n ggplot2::geom_point(\n ggplot2::aes(fill = group),\n shape = HOUSE_POINT$shape, colour = HOUSE_POINT$colour, stroke = HOUSE_POINT$stroke, size = HOUSE_POINT$size\n ) +\n scale_treat_fill() +\n scale_treat_colour() +\n ggplot2::guides(fill = \"none\", colour = \"none\") +\n ggplot2::scale_x_continuous(breaks = sort(unique(C$x))) +\n ggplot2::labs(x = \"Day\", y = \"Signal\", tag = \"C\") +\n panel_theme\n\nD <- df[df$panel == \"D\", , drop = FALSE]\nD$class <- factor(D$class, levels = rev(c(\"Actb\", \"Myc\", \"Tp53\", \"Vegfa\", \"Cdkn1a\")))\nD$item <- factor(D$item, levels = c(\"C1\", \"C2\", \"L1\", \"L2\", \"H1\", \"H2\"))\nlim <- max(abs(D$y), na.rm = TRUE)\npD <- ggplot2::ggplot(D, ggplot2::aes(item, class, fill = y)) +\n ggplot2::geom_tile(colour = \"white\", linewidth = 0.35) +\n ggplot2::scale_fill_gradientn(\n colours = pv_palette(\"house_div\"),\n limits = c(-lim, lim),\n name = \"Score\",\n breaks = c(-1, 0, 1),\n guide = ggplot2::guide_colourbar(\n title.position = \"top\",\n barwidth = ggplot2::unit(22, \"mm\"),\n barheight = ggplot2::unit(2.2, \"mm\")\n )\n ) +\n ggplot2::labs(x = NULL, y = NULL, tag = \"D\") +\n panel_theme\n\n# ggplot2 4 does not add a second ggplot with `+` until patchwork is attached.\np <- patchwork::wrap_plots(pA, pB, pC, pD, nrow = 1, guides = \"collect\") +\n patchwork::plot_annotation(\n caption = footnote,\n theme = ggplot2::theme(\n text = ggplot2::element_text(family = house_family()),\n plot.caption = ggplot2::element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = ggplot2::margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\",\n legend.position = \"bottom\",\n legend.box = \"horizontal\",\n legend.margin = ggplot2::margin(0, 4, 0, 4, \"mm\"),\n legend.box.spacing = ggplot2::unit(1, \"mm\")\n )\n )\n\npv_save_house(p, \"figure\", cells = \"4x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "composite figure\n四面板拼图\ncomposite-figure\n\nlayout\n拼图\nlayout\n拼图\nlayout\n一张期刊图里要并排放散点、分组柱、时间曲线和小热图，并共用处理组图例时用。use when a double-column figure should assemble those four panels in one font, palette, and legend.\n在 `plot.r` 控制 `show_fit`（默认 `true`）为分组添加拟合线，用 `base_size` 统一字号，设 `group_levels` 顺序；在 `data.csv` 填 `panel`、`group`、`x`、`y`、`class`、`item` 列。\ncomposite patchwork multipanel\npanel 面板标记，a 散点、b 分组柱、c 时间曲线、d 热图（字符串） group 处理组 control、low、high；d 里是该样本所属处理（字符串） x 连续横坐标。a 是标志物 a，c 是天数；b 和 d 为空（数值） y 连续数值。a 是标志物 b，b 是响应，c 是信号，d 是标准化得分（数值） class 分类名。b 是组织，d 是基因；a 和 c 为空（字符串） item d 的样本编号；其他面板为空（字符串）"
},
{
"title": "Ensemble small multiples with side boxes (house style)",
"title_zh": "集合成员小多图与侧边箱线（house 风格）",
"slug": "house-ensemble-multiples",
"category": "layout",
"tags": [
"small-multiples",
"ensemble",
"spaghetti",
"side-boxplot",
"trend",
"house-style"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"regime": "选择方案（10 个）",
"replicate": "重复系编号（整数）",
"g0 … g80": "第 0–80 代的性状偏移（表型 SD）"
},
"when_to_use": "适用于展示多个组的重复轨迹集合以强调分布与趋势，采用 4x4 183 × 183 mm 多面板及 7/8 pt Arial 字体，排布为 2 列 5 行小多图，使用 pv_palette(\"geo\", 10) 绘制模拟的 80 代性状偏移数据，包含灰色重复细线、彩色均值线、组名与计算斜率，以及展示最后 10 代分布的侧边箱线。",
"customize": "plot.R 将宽格式的 data.csv 重塑为长格式，面板顺序与颜色跟随 data.csv 顺序，y 轴限制按行设置并预留增加 32% 的文本空间，侧边箱线宽度比例由 widths = c(4.2, 0.9, 4.2, 0.9) 控制，x = 80 处无刻度以避免其与箱线分割线重叠，且需要 patchwork 包。",
"lang": "R",
"task": "layout",
"task_zh": "拼图",
"task_en": "Layout",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": {
"width_mm": "183",
"height_mm": "183",
"label": "183 × 183 mm (4×4 cells)",
"cells": "4x4"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/layout/house-ensemble-multiples/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-ensemble-multiples/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-ensemble-multiples/plot.R"
},
{
"name": "data.csv",
"path": "figures/layout/house-ensemble-multiples/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-ensemble-multiples/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-ensemble-multiples/data.csv"
},
{
"name": "make_data.R",
"path": "figures/layout/house-ensemble-multiples/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-ensemble-multiples/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-ensemble-multiples/make_data.R"
}
],
"dir": "figures/layout/house-ensemble-multiples",
"preview": "figures/layout/house-ensemble-multiples/preview.png",
"docs_preview": "previews/house-ensemble-multiples.png",
"code": "figures/layout/house-ensemble-multiples/plot.R",
"data": "figures/layout/house-ensemble-multiples/data.csv",
"data_files": [
"figures/layout/house-ensemble-multiples/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-ensemble-multiples/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-ensemble-multiples/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/layout/house-ensemble-multiples",
"code_text": "# House example: 2 x 5 small multiples. Each panel: every replicate as a thin grey line,\n# the regime mean in colour, regime name and n top-left, the trend (mean +- SE of per-replicate slopes)\n# top-right, and a narrow side box of the final values. Shared x; y shared within a row; only outer\n# x-axis labels; no strips.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\nw <- read.csv(\"data.csv\", check.names = FALSE) # wide: regime, replicate, g0..g80\ngcols <- grep(\"^g[0-9]+$\", names(w), value = TRUE)\nd <- data.frame(regime = rep(w$regime, length(gcols)), replicate = rep(w$replicate, length(gcols)),\n generation = rep(as.integer(sub(\"g\", \"\", gcols)), each = nrow(w)),\n shift_sd = unlist(w[gcols], use.names = FALSE))\ngrey <- pv_palette(\"house_grey\")\nregs <- unique(d$regime)\ncols <- setNames(pv_palette(\"geo\", length(regs)), regs)\nlw <- pv_house_lw(\"main\")\n\nstats <- do.call(rbind, lapply(regs, function(r) {\n x <- d[d$regime == r, ]\n sl <- vapply(split(x, x$replicate), function(z) 10 * coef(lm(shift_sd ~ generation, z))[[2]], 0)\n fin <- vapply(split(x, x$replicate), function(z) mean(z$shift_sd[z$generation >= 71]), 0)\n data.frame(regime = r, n = length(sl), slope = mean(sl), se = sd(sl) / sqrt(length(sl)),\n q1 = quantile(fin, .25), med = median(fin), q3 = quantile(fin, .75),\n lo = min(fin), hi = max(fin), mean_fin = mean(fin))\n}))\nstopifnot(all(stats$n == tapply(d$replicate, d$regime, max)[stats$regime]))\nmean_line <- aggregate(shift_sd ~ regime + generation, d, mean)\n\nrow_of <- setNames((seq_along(regs) - 1) %/% 2 + 1, regs)\nylims <- lapply(1:5, function(i) {\n v <- d$shift_sd[row_of[d$regime] == i]\n c(min(v) - 0.05 * diff(range(v)), max(v) + 0.32 * diff(range(v))) # headroom for the panel text\n})\n\npanel <- function(r) {\n i <- row_of[[r]]; s <- stats[stats$regime == r, ]; yl <- ylims[[i]]; bottom <- i == 5\n main <- ggplot(d[d$regime == r, ], aes(generation, shift_sd)) +\n geom_line(aes(group = replicate), colour = grey[[\"ci\"]], linewidth = pv_pt2lw(0.4)) +\n geom_line(data = mean_line[mean_line$regime == r, ], colour = cols[[r]], linewidth = lw) +\n annotate(\"text\", x = 3, y = yl[2], hjust = 0, vjust = 1.25, lineheight = 0.95,\n label = sprintf(\"%s\\nn = %d\", r, s$n)) +\n annotate(\"text\", x = 79, y = yl[2], hjust = 1, vjust = 1.25,\n label = sprintf(\"%+.3f \\u00b1 %.3f SD per 10 gen\", s$slope, s$se)) +\n scale_x_continuous(breaks = seq(0, 60, 20)) + # no tick at 80: it would sit on the box divider\n coord_cartesian(xlim = c(0, 80), ylim = yl, expand = FALSE) +\n labs(x = if (bottom) \"Generation\" else NULL, y = NULL) +\n theme_house() +\n theme(plot.margin = margin(0, 0, 0, 0),\n axis.ticks.length.y = unit(1, \"mm\"),\n axis.text.x = if (bottom) element_text() else element_blank(),\n axis.ticks.length.x = unit(if (bottom) 1 else 0.6, \"mm\"))\n box <- ggplot(s) +\n geom_segment(aes(x = 0.5, xend = 0.5, y = lo, yend = hi), linewidth = pv_pt2lw(0.5)) +\n geom_rect(aes(xmin = 0.25, xmax = 0.75, ymin = q1, ymax = q3), fill = cols[[r]],\n colour = \"black\", linewidth = pv_pt2lw(0.5)) +\n geom_segment(aes(x = 0.25, xend = 0.75, y = med, yend = med), linewidth = pv_pt2lw(0.8)) +\n geom_point(aes(0.5, mean_fin), size = 0.7) +\n coord_cartesian(xlim = c(0, 1), ylim = yl, expand = FALSE) +\n labs(x = NULL, y = NULL) +\n theme_house() +\n theme(axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks.x = element_blank(),\n axis.ticks.y = element_blank(), axis.ticks.length = unit(0, \"mm\"), plot.margin = margin(0, 0, 0, 0))\n list(main, box)\n}\ntiles <- unlist(lapply(regs, panel), recursive = FALSE)\ngrid <- wrap_plots(tiles, ncol = 4, widths = c(4.2, 0.9, 4.2, 0.9))\nytitle <- ggplot() + annotate(\"text\", x = 0, y = 0, angle = 90, size = pv_pt2size(8),\n family = house_family(), label = \"Trait shift (phenotypic SD)\") +\n theme_void() + theme(plot.margin = margin(0, 0, 0, 0))\nfig <- (ytitle | grid) + plot_layout(widths = c(0.3, 10.2)) +\n plot_annotation(caption = paste(\"Side box: last 10 generations (71\\u201380), one value per replicate;\",\n \"line = median, dot = mean. Simulated data for illustration; not biological results\"),\n theme = theme(plot.caption = element_text(hjust = 0, colour = grey[[\"mid\"]], size = 7,\n family = house_family()),\n plot.margin = margin(1, 1, 1, 0.5, \"mm\")))\npv_save_house(fig, \"figure\", cells = \"4x4\")\n",
"search_text": "ensemble small multiples with side boxes (house style)\n集合成员小多图与侧边箱线（house 风格）\nhouse-ensemble-multiples\n\nlayout\n拼图\nlayout\n拼图\nlayout\n适用于展示多个组的重复轨迹集合以强调分布与趋势，采用 4x4 183 × 183 mm 多面板及 7/8 pt arial 字体，排布为 2 列 5 行小多图，使用 pv_palette(\"geo\", 10) 绘制模拟的 80 代性状偏移数据，包含灰色重复细线、彩色均值线、组名与计算斜率，以及展示最后 10 代分布的侧边箱线。\nplot.r 将宽格式的 data.csv 重塑为长格式，面板顺序与颜色跟随 data.csv 顺序，y 轴限制按行设置并预留增加 32% 的文本空间，侧边箱线宽度比例由 widths = c(4.2, 0.9, 4.2, 0.9) 控制，x = 80 处无刻度以避免其与箱线分割线重叠，且需要 patchwork 包。\nsmall-multiples ensemble spaghetti side-boxplot trend house-style\nregime 选择方案（10 个） replicate 重复系编号（整数） g0 … g80 第 0–80 代的性状偏移（表型 sd）"
},
{
"title": "ABA kinetics page, single column (house mosaic, 2x4)",
"title_zh": "ABA 通路动态单栏拼版：时间曲线、小多图、雨云图、密度曲线（house 风格，2×4）",
"slug": "house-mosaic-aba-kinetics",
"category": "layout",
"tags": [
"multi-panel",
"mosaic",
"house-style",
"single-column",
"raincloud",
"small-multiples"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"hours": "停止浇水后的小时数（data.csv；x 轴 “Hours after withholding water”）",
"gene": "基因名（data.csv、data_psi.csv）",
"log2fc": "data.csv 为叶片 log2 FC（SD/WW）均值；data_fc.csv 为每个 DEG 的 log2 FC",
"se": "log2 FC 的标准误（data.csv）",
"vine": "植株编号（data_psi.csv）",
"psi": "茎水势 Ψstem（MPa，data_psi.csv）",
"expression": "表达量 log2 CPM（data_psi.csv、data_raincloud.csv）",
"treatment": "WW / SD（data_raincloud.csv）",
"tissue": "Leaf / Root（data_raincloud.csv、data_fc.csv）",
"jitter": "原始点在云下的纵向位置 0–1（data_raincloud.csv）"
},
"when_to_use": "模拟数据，仅作示意，不是生物学结果（Simulated data for illustration; not biological results）。单栏（89 mm 宽、整页高 183 mm）讲一条通路的动态：a 时间曲线（2×1）、b 四基因与水势的小多图（2×2）、c 横向雨云图与 d 密度曲线（各 1×1）。b 的标题写相关最强的基因及 Pearson r（由数据计算），并说明它所在位点也有最强的 GWAS 信号（Fig. 3a），不作因果推断；每个小图标 Pearson r 与 n。",
"customize": "page_cells = 2×4；a 2×1、b 2×2、c 与 d 各 1×1，块边都在网格线上；位置在 pv_house_mosaic() 的 at / cells 里改。b 的标题自动取 |r| 最大的基因，并检查它等于 gwas_top（拼版 house-mosaic-gwas 的头号位点）且在两位小数上领先第二名；a 与 b 的方向（干旱上调 ↔ r 为负）也由 stopifnot() 检查。data_fc.csv 的叶、根 DEG 数与 house-mosaic-transcriptome 的 data_deg.csv 一致。",
"lang": "R",
"task": "layout",
"task_zh": "拼图",
"task_en": "Layout",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": {
"width_mm": "89",
"height_mm": "183",
"label": "89 × 183 mm (2×4 cells)",
"cells": "2x4"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/layout/house-mosaic-aba-kinetics/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-aba-kinetics/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-aba-kinetics/plot.R"
},
{
"name": "data.csv",
"path": "figures/layout/house-mosaic-aba-kinetics/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-aba-kinetics/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-aba-kinetics/data.csv"
},
{
"name": "make_data.R",
"path": "figures/layout/house-mosaic-aba-kinetics/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-aba-kinetics/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-aba-kinetics/make_data.R"
},
{
"name": "data_fc.csv",
"path": "figures/layout/house-mosaic-aba-kinetics/data_fc.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-aba-kinetics/data_fc.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-aba-kinetics/data_fc.csv"
},
{
"name": "data_psi.csv",
"path": "figures/layout/house-mosaic-aba-kinetics/data_psi.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-aba-kinetics/data_psi.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-aba-kinetics/data_psi.csv"
},
{
"name": "data_raincloud.csv",
"path": "figures/layout/house-mosaic-aba-kinetics/data_raincloud.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-aba-kinetics/data_raincloud.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-aba-kinetics/data_raincloud.csv"
}
],
"dir": "figures/layout/house-mosaic-aba-kinetics",
"preview": "figures/layout/house-mosaic-aba-kinetics/preview.png",
"docs_preview": "previews/house-mosaic-aba-kinetics.png",
"code": "figures/layout/house-mosaic-aba-kinetics/plot.R",
"data": "figures/layout/house-mosaic-aba-kinetics/data.csv",
"data_files": [
"figures/layout/house-mosaic-aba-kinetics/data.csv",
"figures/layout/house-mosaic-aba-kinetics/data_fc.csv",
"figures/layout/house-mosaic-aba-kinetics/data_psi.csv",
"figures/layout/house-mosaic-aba-kinetics/data_raincloud.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-aba-kinetics/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-aba-kinetics/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/layout/house-mosaic-aba-kinetics",
"code_text": "# House mosaic, ABA kinetics: single-column 2x4 page (89 x 183 mm) of a simulated grapevine drought\n# trial: time course (line), expression vs stem water potential (small multiples), VvNCED3 by\n# tissue (raincloud) and log2 FC of DEGs (density). Reads data*.csv only. Run from this directory.\nsuppressPackageStartupMessages({ library(ggplot2); library(patchwork) })\nsource(\"../../../styles/r/theme_house.R\")\ngrDevices::cairo_pdf(tempfile(fileext = \".pdf\")) # Arial metrics while tiles are measured; closed at the end\npal <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\"); warm <- pv_palette(\"house_warm\")\nTAG_PT <- 10; T7 <- pv_pt2size(7)\nminus <- function(x) gsub(\"-\", \"\\u2212\", if (is.character(x)) x else format(x, trim = TRUE)) # no padding of strings\npt_layer <- function(...) geom_point(shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = \"black\", ...)\nth <- theme_house()\ntc <- c(WW = grey[[\"mid\"]], SD = pal[[\"red\"]]) # treatment colours (whole series)\ntis <- c(\"Leaf\", \"Root\", \"Shoot tip\", \"Berry skin\", \"Seed\")\ntis_c <- stats::setNames(unname(pal[c(\"green\", \"brown\", \"gold\", \"purple\", \"sky\")]), tis) # one colour per tissue\nrd <- function(f) utils::read.csv(f, stringsAsFactors = FALSE, check.names = FALSE)\n\n# --- tile helpers: every panel is a standalone ggplot placed on whole grid cells by\n# pv_house_mosaic(). tile() pins the outer bands so panel frames line up across tiles.\n# Fixed outer bands (mm) so panel frames line up across tiles in the same column/row:\n# left = y ticks + title, bottom = x ticks + title, top = room for the tag.\nBAND <- list(l = 11.5, b = 8.6, t = 4.2, r = 1.2)\n.mm <- function(u) as.numeric(grid::convertUnit(u, \"mm\", valueOnly = TRUE))\n.width_mm <- function(g, idx) if (length(idx)) sum(vapply(idx, function(i) .mm(grid::convertWidth(g$widths[i], \"mm\")), 0)) else 0\n.height_mm <- function(g, idx) if (length(idx)) sum(vapply(idx, function(i) .mm(grid::convertHeight(g$heights[i], \"mm\")), 0)) else 0\n\n# tile(): ggplot -> grob with fixed bands and a bold tag at the tile's top-left corner.\ntile <- function(p, tag = NULL, l = BAND$l, b = BAND$b, t = BAND$t, r = BAND$r) {\n p <- .pv_set_text_family(p + theme(plot.margin = margin(0, 0, 0, 0)))\n g <- ggplotGrob(p)\n pan <- g$layout[grepl(\"^panel\", g$layout$name), ]\n pl <- min(pan$l); pr <- max(pan$r); pt <- min(pan$t); pb <- max(pan$b)\n nc <- length(g$widths); nr <- length(g$heights)\n fit <- function(have, want, side) {\n if (have > want + 0.01) stop(sprintf(\"tile %s: %s band needs %.2f mm > %.2f\", tag, side, have, want))\n grid::unit(want - have, \"mm\")\n }\n g$widths[1] <- g$widths[1] + fit(.width_mm(g, seq_len(pl - 1)), l, \"left\")\n g$widths[nc] <- g$widths[nc] + fit(.width_mm(g, if (pr < nc) (pr + 1):nc else integer()), r, \"right\")\n g$heights[1] <- g$heights[1] + fit(.height_mm(g, seq_len(pt - 1)), t, \"top\")\n g$heights[nr] <- g$heights[nr] + fit(.height_mm(g, if (pb < nr) (pb + 1):nr else integer()), b, \"bottom\")\n if (!is.null(tag)) g <- add_tag(g, tag)\n g\n}\nadd_tag <- function(g, tag) {\n grid::grobTree(g, grid::textGrob(tag, x = grid::unit(0.3, \"mm\"), y = grid::unit(1, \"npc\") - grid::unit(0.2, \"mm\"),\n hjust = 0, vjust = 1, gp = grid::gpar(fontfamily = house_family(), fontface = \"bold\", fontsize = TAG_PT)))\n}\n# footnote(): small grey 7 pt note inside a tile's band (simulated data disclaimer)\nSIM_NOTE <- \"Simulated data for illustration; not biological results\"\nfootnote <- function(g, label = SIM_NOTE, x = 1, y = 1, hjust = 1, vjust = 1, dx = -1.2, dy = -0.6) {\n grid::grobTree(g, grid::textGrob(label, x = grid::unit(x, \"npc\") + grid::unit(dx, \"mm\"), y = grid::unit(y, \"npc\") + grid::unit(dy, \"mm\"),\n hjust = hjust, vjust = vjust, gp = grid::gpar(fontfamily = house_family(), fontsize = 7, col = grey[[\"mid\"]], lineheight = 0.95)))\n}\n# top_anchor(): cairo_pdf truncates the page to whole points (e.g. 183 mm = 518.74 pt -> 518 pt) and the\n# mosaic is placed from the bottom, so the top lost up to 0.26 mm. On PDF devices, shift the page down by\n# that fraction so blocks are laid out from the top edge; PNG devices are exact and need no shift.\ntop_anchor <- function(m, h_mm) structure(grid::gTree(children = grid::gList(m), h_mm = h_mm, cl = c(\"pv_top\", class(m))),\n pv_cells = attr(m, \"pv_cells\"))\nmakeContext.pv_top <- function(x) {\n h_pt <- x$h_mm / 25.4 * 72\n dy <- if (grepl(\"pdf\", names(grDevices::dev.cur()), ignore.case = TRUE)) h_pt - floor(h_pt) else 0\n x$vp <- grid::viewport(y = grid::unit(1, \"npc\") - grid::unit(dy, \"bigpts\"), height = grid::unit(1, \"npc\"), just = \"top\")\n x\n}\n# patchwork / composite tiles: tag only (they control their own inner layout)\ntile_pw <- function(p, tag) add_tag(patchwork::patchworkGrob(p), tag)\n\n# --- parameters ---------------------------------------------------------------------------\npage_cells <- c(2, 4)\ngwas_top <- \"VvNCED3\" # top hit of the companion GWAS figure (house-mosaic-gwas); the b title claims it\n\nkin <- rd(\"data.csv\"); sm <- rd(\"data_psi.csv\"); vi <- rd(\"data_raincloud.csv\"); fc <- rd(\"data_fc.csv\")\n\n# a time course ---------------------------------------------------------------------------------\ngenes <- c(VvNCED3 = pal[[\"red\"]], VvRD29B = pal[[\"orange\"]], \"VvPIP2;1\" = pal[[\"blue\"]])\nb2a <- ggplot(kin, aes(hours, log2fc, colour = gene, fill = gene)) +\n geom_hline(yintercept = 0, linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_ribbon(aes(ymin = log2fc - se, ymax = log2fc + se), colour = NA, alpha = 0.22) + geom_line(linewidth = pv_house_lw(\"main\")) + pt_layer() +\n geom_text(data = kin[kin$hours == max(kin$hours), ], aes(x = max(kin$hours) + 7, label = gene), hjust = 0, size = T7, fontface = \"bold.italic\") +\n scale_colour_manual(values = genes, guide = \"none\") + scale_fill_manual(values = genes, guide = \"none\") +\n scale_x_continuous(limits = c(-5, 214), breaks = c(0, 48, 96, 144), expand = c(0, 0)) +\n scale_y_continuous(limits = c(-3, 6), breaks = c(-2, 0, 2, 4), labels = minus, expand = c(0, 0)) +\n labs(x = \"Hours after withholding water\", y = \"log2 FC (SD/WW, leaf)\") + th\n\n# b small multiples: expression vs stem water potential -----------------------------------------\nsm$gene <- factor(sm$gene, levels = c(\"VvNCED3\", \"VvRD29B\", \"VvPIP2;1\", \"VvLEA4\"))\nrlab <- do.call(rbind, lapply(split(sm, sm$gene), function(s) data.frame(gene = s$gene[1], r = stats::cor(s$psi, s$expression))))\nn_vine <- as.integer(table(sm$gene)[as.character(rlab$gene)])\nrlab$lab <- sprintf(\"'Pearson '*italic(r)*' = %s, '*italic(n)*' = %d'\", minus(sprintf(\"%.2f\", rlab$r)), n_vine)\nr_top <- as.character(rlab$gene[which.max(abs(rlab$r))]) # gene with the tightest link\nrlab$col <- ifelse(rlab$gene == r_top, pal[[\"red\"]], \"#000000\")\nsm$hl <- ifelse(sm$gene == r_top, pal[[\"red\"]], pal[[\"sky\"]])\n# consistency: b's claim, and the sign of r vs the direction in a (up in drought <-> negative r)\nstopifnot(r_top == gwas_top, length(unique(n_vine)) == 1,\n diff(sort(round(abs(rlab$r), 2), decreasing = TRUE)[1:2]) <= -0.02, # \"tightest\" is visible at the printed 2 dp\n sign(rlab$r[rlab$gene == \"VvNCED3\"]) == -sign(kin$log2fc[kin$gene == \"VvNCED3\" & kin$hours == 48]),\n sign(rlab$r[rlab$gene == \"VvPIP2;1\"]) == -sign(kin$log2fc[kin$gene == \"VvPIP2;1\" & kin$hours == 48]))\nb2b <- ggplot(sm, aes(psi, expression)) +\n geom_smooth(aes(colour = I(ifelse(gene == r_top, pal[[\"red\"]], \"black\"))), method = \"lm\", formula = y ~ x, fill = grey[[\"ci\"]], linewidth = pv_house_lw(\"main\")) +\n geom_point(aes(fill = I(hl)), shape = 21, size = 1.5, stroke = HOUSE_POINT$stroke, colour = \"black\") + facet_wrap(~gene, nrow = 2) +\n geom_text(data = rlab, aes(x = -0.35, y = 10.6, label = lab, colour = I(col)), hjust = 1, vjust = 1, size = T7, parse = TRUE) +\n scale_x_continuous(limits = c(-1.8, -0.2), breaks = c(-1.5, -1, -0.5), labels = minus, expand = c(0, 0)) +\n scale_y_continuous(limits = c(1, 11), breaks = c(3, 6, 9), expand = c(0, 0)) +\n labs(x = \"\\u03a8stem (MPa)\", y = \"Expression (log2 CPM)\",\n title = bquote(\"Strongest correlation with \\u03a8stem: \"*italic(.(r_top))*\" (\"*italic(r)*\" = \"*.(minus(sprintf(\"%.2f\", rlab$r[rlab$gene == r_top])))*\");\"),\n subtitle = \"its locus also carries the top GWAS signal (Fig. 3a)\") + th +\n theme(panel.spacing = unit(2.5, \"mm\"), strip.text = element_text(face = \"italic\"),\n plot.title = element_text(size = 7, colour = pal[[\"red\"]], hjust = 0, margin = margin(b = 0.4, unit = \"mm\")),\n plot.subtitle = element_text(size = 7, colour = pal[[\"red\"]], hjust = 0, margin = margin(b = 1.2, unit = \"mm\")))\n\n# c horizontal raincloud: VvNCED3 by tissue x treatment ---------------------------------------\nvi$y0 <- ifelse(vi$tissue == \"Leaf\", 3.15, 1.05) + ifelse(vi$treatment == \"WW\", 0.45, -0.45)\ndens <- do.call(rbind, lapply(split(vi, list(vi$tissue, vi$treatment)), function(s) {\n d <- stats::density(s$expression, adjust = 1.1, n = 128)\n data.frame(x = d$x, h = d$y / max(d$y) * 0.55, y0 = s$y0[1], treatment = s$treatment[1]) }))\ndens <- dens[dens$x >= 2 & dens$x <= 10, ]\nqs <- do.call(rbind, lapply(split(vi, list(vi$tissue, vi$treatment)), function(s) data.frame(y0 = s$y0[1],\n q1 = stats::quantile(s$expression, .25), md = stats::median(s$expression), q3 = stats::quantile(s$expression, .75))))\nvi$yj <- vi$y0 - 0.08 - vi$jitter * 0.18\nb2c <- ggplot() +\n geom_ribbon(data = dens, aes(x, ymin = y0, ymax = y0 + h, fill = treatment, group = interaction(y0, treatment)), alpha = 0.7, colour = NA) +\n geom_segment(data = qs, aes(x = q1, xend = q3, y = y0, yend = y0), linewidth = pv_house_lw(\"emph\")) +\n geom_point(data = qs, aes(md, y0), shape = 21, size = 1.4, stroke = 0.3, fill = \"white\") +\n geom_point(data = vi, aes(expression, yj, fill = treatment), shape = 21, size = 0.8, stroke = 0.15, colour = \"black\") +\n scale_fill_manual(values = tc, guide = \"none\") +\n annotate(\"text\", x = c(5.75, 8.55), y = c(3.75, 2.85), label = c(\"WW\", \"SD\"), colour = tc[c(\"WW\", \"SD\")], fontface = \"bold\", hjust = 0, size = T7) +\n annotate(\"text\", x = 9.85, y = 4.45, label = \"VvNCED3\", fontface = \"italic\", hjust = 1, vjust = 1, size = T7) +\n scale_y_continuous(breaks = c(3.15, 1.05), labels = c(\"Leaf\", \"Root\"), limits = c(0.2, 4.55), expand = c(0, 0)) +\n scale_x_continuous(limits = c(2, 10), breaks = c(3, 6, 9), expand = c(0, 0)) +\n labs(x = \"Expression (log2 CPM)\", y = NULL) + th +\n theme(axis.text.y = element_text(colour = \"black\"))\n\n# d density of DEG log2 FC ----------------------------------------------------------------------\ndl <- do.call(rbind, lapply(c(\"Leaf\", \"Root\"), function(t) {\n d <- stats::density(fc$log2fc[fc$tissue == t], from = -5, to = 5, n = 256, adjust = 0.9); data.frame(tissue = t, x = d$x, y = d$y) }))\ntcol <- tis_c[c(\"Leaf\", \"Root\")]\nb2d <- ggplot(dl, aes(x, y, colour = tissue)) + geom_vline(xintercept = 0, linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_line(linewidth = pv_house_lw(\"main\")) +\n annotate(\"text\", x = c(-0.5, 2.9), y = c(0.3, 0.275), label = c(\"Leaf\", \"Root\"), colour = tcol, hjust = c(1, 0), fontface = \"bold\", size = T7) +\n scale_colour_manual(values = tcol, guide = \"none\") +\n scale_x_continuous(limits = c(-5, 5), breaks = c(-4, 0, 4), labels = minus, expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 0.35), breaks = c(0, 0.1, 0.2, 0.3), expand = c(0, 0)) +\n labs(x = \"log2 FC of DEGs\", y = \"Density\") + th\n\nmosaic <- pv_house_mosaic(list(\n list(plot = footnote(tile(b2a, \"a\")), at = c(1, 1), cells = c(2, 1)),\n list(plot = tile(b2b, \"b\", t = 11.4), at = c(1, 2), cells = c(2, 2)),\n list(plot = tile(b2c, \"c\"), at = c(1, 4), cells = c(1, 1)),\n list(plot = tile(b2d, \"d\"), at = c(2, 4), cells = c(1, 1))\n), cells = page_cells)\nmosaic <- top_anchor(mosaic, pv_grid_span(page_cells[2]) + if (page_cells[2] == 4) 2 else 0)\npv_save_house(mosaic, \"figure\", cells = page_cells)\n\ngrDevices::dev.off()\nmessage(\"wrote preview.png\")\n",
"search_text": "aba kinetics page, single column (house mosaic, 2x4)\naba 通路动态单栏拼版：时间曲线、小多图、雨云图、密度曲线（house 风格，2×4）\nhouse-mosaic-aba-kinetics\n\nlayout\n拼图\nlayout\n拼图\nlayout\n模拟数据，仅作示意，不是生物学结果（simulated data for illustration; not biological results）。单栏（89 mm 宽、整页高 183 mm）讲一条通路的动态：a 时间曲线（2×1）、b 四基因与水势的小多图（2×2）、c 横向雨云图与 d 密度曲线（各 1×1）。b 的标题写相关最强的基因及 pearson r（由数据计算），并说明它所在位点也有最强的 gwas 信号（fig. 3a），不作因果推断；每个小图标 pearson r 与 n。\npage_cells = 2×4；a 2×1、b 2×2、c 与 d 各 1×1，块边都在网格线上；位置在 pv_house_mosaic() 的 at / cells 里改。b 的标题自动取 |r| 最大的基因，并检查它等于 gwas_top（拼版 house-mosaic-gwas 的头号位点）且在两位小数上领先第二名；a 与 b 的方向（干旱上调 ↔ r 为负）也由 stopifnot() 检查。data_fc.csv 的叶、根 deg 数与 house-mosaic-transcriptome 的 data_deg.csv 一致。\nmulti-panel mosaic house-style single-column raincloud small-multiples\nhours 停止浇水后的小时数（data.csv；x 轴 “hours after withholding water”） gene 基因名（data.csv、data_psi.csv） log2fc data.csv 为叶片 log2 fc（sd/ww）均值；data_fc.csv 为每个 deg 的 log2 fc se log2 fc 的标准误（data.csv） vine 植株编号（data_psi.csv） psi 茎水势 ψstem（mpa，data_psi.csv） expression 表达量 log2 cpm（data_psi.csv、data_raincloud.csv） treatment ww / sd（data_raincloud.csv） tissue leaf / root（data_raincloud.csv、data_fc.csv） jitter 原始点在云下的纵向位置 0–1（data_raincloud.csv）"
},
{
"title": "GWAS page with a 4x1 Manhattan (house mosaic, 4x2)",
"title_zh": "GWAS 拼版：4×1 曼哈顿图、区域图、基因型效应、等位基因频率（house 风格，4×2）",
"slug": "house-mosaic-gwas",
"category": "layout",
"tags": [
"multi-panel",
"mosaic",
"house-style",
"gwas",
"manhattan"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"chr": "染色体编号 1–19（data.csv、data_chr.csv）",
"pos": "位置（Mb，data.csv）",
"p": "关联 P 值（data.csv）",
"r2": "与 chr 4 头号 SNP 的 r²，只在放大窗口内有值（data.csv）",
"length_mb": "染色体长度（Mb，data_chr.csv）",
"genotype": "头号 SNP 基因型 AA / AG / GG（data_genotype.csv）",
"dti": "耐旱指数 DTI（drought tolerance index，data_genotype.csv）",
"jitter": "原始点横向抖动 -1–1（data_genotype.csv）",
"population": "群体（data_allele.csv）",
"g_percent": "使 DTI 升高的等位基因 G 的频率 %（data_allele.csv）"
},
"when_to_use": "模拟数据，仅作示意，不是生物学结果（Simulated data for illustration; not biological results）。DTI = drought tolerance index（耐旱指数）。双栏半页讲一个 GWAS：a 是通栏 4×1 曼哈顿图，b 为头号位点区域图（2×1，按 r² 着色并画基因模型），c 头号 SNP 的基因型效应（箱线 + 原始点），d 各群体等位基因频率（堆叠条）。",
"customize": "page_cells = 4×2；lead_genes 给每个峰标候选基因，zoom 为 b 的窗口（Mb），阈值为 Bonferroni 0.05 / SNP 数（data.csv 行数），超过阈值的点标红；峰的标签写 “chrN lead SNP (near 基因)”，不把基因当作已确定的致病基因。stopifnot() 检查最强信号是 chr 4 上靠近 VvNCED3 的 lead SNP、且就是 b 窗口里的最高点（与 house-mosaic-aba-kinetics 的 b 标题一致）；b 注明致病基因未定。",
"lang": "R",
"task": "layout",
"task_zh": "拼图",
"task_en": "Layout",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/layout/house-mosaic-gwas/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-gwas/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-gwas/plot.R"
},
{
"name": "data.csv",
"path": "figures/layout/house-mosaic-gwas/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-gwas/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-gwas/data.csv"
},
{
"name": "make_data.R",
"path": "figures/layout/house-mosaic-gwas/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-gwas/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-gwas/make_data.R"
},
{
"name": "data_allele.csv",
"path": "figures/layout/house-mosaic-gwas/data_allele.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-gwas/data_allele.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-gwas/data_allele.csv"
},
{
"name": "data_chr.csv",
"path": "figures/layout/house-mosaic-gwas/data_chr.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-gwas/data_chr.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-gwas/data_chr.csv"
},
{
"name": "data_genotype.csv",
"path": "figures/layout/house-mosaic-gwas/data_genotype.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-gwas/data_genotype.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-gwas/data_genotype.csv"
}
],
"dir": "figures/layout/house-mosaic-gwas",
"preview": "figures/layout/house-mosaic-gwas/preview.png",
"docs_preview": "previews/house-mosaic-gwas.png",
"code": "figures/layout/house-mosaic-gwas/plot.R",
"data": "figures/layout/house-mosaic-gwas/data.csv",
"data_files": [
"figures/layout/house-mosaic-gwas/data.csv",
"figures/layout/house-mosaic-gwas/data_allele.csv",
"figures/layout/house-mosaic-gwas/data_chr.csv",
"figures/layout/house-mosaic-gwas/data_genotype.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-gwas/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-gwas/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/layout/house-mosaic-gwas",
"code_text": "# House mosaic, GWAS: double-column 4x2 page (183 x 89 mm) of a simulated drought tolerance GWAS in\n# grapevine: genome-wide Manhattan (4x1 long panel), regional plot of the top locus, effect of the\n# lead SNP (box + raw points) and allele frequency by population (stacked bars). Reads data*.csv only.\nsuppressPackageStartupMessages({ library(ggplot2); library(patchwork) })\nsource(\"../../../styles/r/theme_house.R\")\ngrDevices::cairo_pdf(tempfile(fileext = \".pdf\")) # Arial metrics while tiles are measured; closed at the end\npal <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\"); warm <- pv_palette(\"house_warm\")\nTAG_PT <- 10; T7 <- pv_pt2size(7)\nminus <- function(x) gsub(\"-\", \"\\u2212\", if (is.character(x)) x else format(x, trim = TRUE)) # no padding of strings\npt_layer <- function(...) geom_point(shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = \"black\", ...)\nth <- theme_house()\ntc <- c(WW = grey[[\"mid\"]], SD = pal[[\"red\"]]) # treatment colours (whole series)\ntis <- c(\"Leaf\", \"Root\", \"Shoot tip\", \"Berry skin\", \"Seed\")\ntis_c <- stats::setNames(unname(pal[c(\"green\", \"brown\", \"gold\", \"purple\", \"sky\")]), tis) # one colour per tissue\nrd <- function(f) utils::read.csv(f, stringsAsFactors = FALSE, check.names = FALSE)\n\n# --- tile helpers: every panel is a standalone ggplot placed on whole grid cells by\n# pv_house_mosaic(). tile() pins the outer bands so panel frames line up across tiles.\n# Fixed outer bands (mm) so panel frames line up across tiles in the same column/row:\n# left = y ticks + title, bottom = x ticks + title, top = room for the tag.\nBAND <- list(l = 11.5, b = 8.6, t = 4.2, r = 1.2)\n.mm <- function(u) as.numeric(grid::convertUnit(u, \"mm\", valueOnly = TRUE))\n.width_mm <- function(g, idx) if (length(idx)) sum(vapply(idx, function(i) .mm(grid::convertWidth(g$widths[i], \"mm\")), 0)) else 0\n.height_mm <- function(g, idx) if (length(idx)) sum(vapply(idx, function(i) .mm(grid::convertHeight(g$heights[i], \"mm\")), 0)) else 0\n\n# tile(): ggplot -> grob with fixed bands and a bold tag at the tile's top-left corner.\ntile <- function(p, tag = NULL, l = BAND$l, b = BAND$b, t = BAND$t, r = BAND$r) {\n p <- .pv_set_text_family(p + theme(plot.margin = margin(0, 0, 0, 0)))\n g <- ggplotGrob(p)\n pan <- g$layout[grepl(\"^panel\", g$layout$name), ]\n pl <- min(pan$l); pr <- max(pan$r); pt <- min(pan$t); pb <- max(pan$b)\n nc <- length(g$widths); nr <- length(g$heights)\n fit <- function(have, want, side) {\n if (have > want + 0.01) stop(sprintf(\"tile %s: %s band needs %.2f mm > %.2f\", tag, side, have, want))\n grid::unit(want - have, \"mm\")\n }\n g$widths[1] <- g$widths[1] + fit(.width_mm(g, seq_len(pl - 1)), l, \"left\")\n g$widths[nc] <- g$widths[nc] + fit(.width_mm(g, if (pr < nc) (pr + 1):nc else integer()), r, \"right\")\n g$heights[1] <- g$heights[1] + fit(.height_mm(g, seq_len(pt - 1)), t, \"top\")\n g$heights[nr] <- g$heights[nr] + fit(.height_mm(g, if (pb < nr) (pb + 1):nr else integer()), b, \"bottom\")\n if (!is.null(tag)) g <- add_tag(g, tag)\n g\n}\nadd_tag <- function(g, tag) {\n grid::grobTree(g, grid::textGrob(tag, x = grid::unit(0.3, \"mm\"), y = grid::unit(1, \"npc\") - grid::unit(0.2, \"mm\"),\n hjust = 0, vjust = 1, gp = grid::gpar(fontfamily = house_family(), fontface = \"bold\", fontsize = TAG_PT)))\n}\n# footnote(): small grey 7 pt note inside a tile's band (simulated data disclaimer)\nSIM_NOTE <- \"Simulated data for illustration; not biological results\"\nfootnote <- function(g, label = SIM_NOTE, x = 1, y = 1, hjust = 1, vjust = 1, dx = -1.2, dy = -0.6) {\n grid::grobTree(g, grid::textGrob(label, x = grid::unit(x, \"npc\") + grid::unit(dx, \"mm\"), y = grid::unit(y, \"npc\") + grid::unit(dy, \"mm\"),\n hjust = hjust, vjust = vjust, gp = grid::gpar(fontfamily = house_family(), fontsize = 7, col = grey[[\"mid\"]], lineheight = 0.95)))\n}\n# top_anchor(): cairo_pdf truncates the page to whole points (e.g. 183 mm = 518.74 pt -> 518 pt) and the\n# mosaic is placed from the bottom, so the top lost up to 0.26 mm. On PDF devices, shift the page down by\n# that fraction so blocks are laid out from the top edge; PNG devices are exact and need no shift.\ntop_anchor <- function(m, h_mm) structure(grid::gTree(children = grid::gList(m), h_mm = h_mm, cl = c(\"pv_top\", class(m))),\n pv_cells = attr(m, \"pv_cells\"))\nmakeContext.pv_top <- function(x) {\n h_pt <- x$h_mm / 25.4 * 72\n dy <- if (grepl(\"pdf\", names(grDevices::dev.cur()), ignore.case = TRUE)) h_pt - floor(h_pt) else 0\n x$vp <- grid::viewport(y = grid::unit(1, \"npc\") - grid::unit(dy, \"bigpts\"), height = grid::unit(1, \"npc\"), just = \"top\")\n x\n}\n# patchwork / composite tiles: tag only (they control their own inner layout)\ntile_pw <- function(p, tag) add_tag(patchwork::patchworkGrob(p), tag)\n\n# --- parameters ---------------------------------------------------------------------------\npage_cells <- c(4, 2)\nlead_genes <- data.frame(chr = c(4, 11, 17), lab = c(\"VvNCED3\", \"VvPIP2;1\", \"VvLEA4\")) # candidate gene per peak\nzoom <- c(10.8, 13.8) # b: chr 4 window (Mb)\nalpha <- 0.05 # Bonferroni: alpha / number of SNPs tested (rows of data.csv)\n\nsnp <- rd(\"data.csv\"); n_snp <- nrow(snp); thr <- -log10(alpha / n_snp)\n chrs <- rd(\"data_chr.csv\"); gt <- rd(\"data_genotype.csv\"); af <- rd(\"data_allele.csv\")\n\n# a Manhattan -----------------------------------------------------------------------------------\noff <- c(0, cumsum(chrs$length_mb + 1.2))[seq_len(nrow(chrs))]\nsnp$x <- snp$pos + off[snp$chr]; snp$lp <- -log10(snp$p)\nmid <- off + chrs$length_mb / 2\nleads <- do.call(rbind, lapply(lead_genes$chr, function(c) { s <- snp[snp$chr == c, ]; s[which.max(s$lp), ] }))\nleads$lab <- lead_genes$lab\n# peak labels name the SNP, not a gene: \"chrN lead SNP (near Gene)\", gene in italics (plotmath)\nleads$txt <- sprintf('\"chr%d lead SNP (near \"*italic(\"%s\")*\")\"', leads$chr, leads$lab)\nleads$side <- ifelse(leads$x > 0.5 * max(snp$x), -1, 1) # right-hand peaks: label on the left\nsnp$col <- ifelse(snp$lp > thr, pal[[\"red\"]], ifelse(snp$chr %% 2 == 1, pal[[\"blue\"]], pal[[\"sky\"]])) # significant = red\nb3a <- ggplot(snp, aes(x, lp)) + geom_point(aes(colour = I(col)), size = 0.35, shape = 16) +\n geom_hline(yintercept = thr, linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = pal[[\"red\"]]) +\n geom_point(data = leads, shape = 23, size = 1.9, stroke = 0.3, fill = pal[[\"red\"]], colour = \"black\") +\n geom_text(data = leads, aes(x = x + 6 * side, label = txt, hjust = ifelse(side > 0, 0, 1)), size = T7, parse = TRUE) +\n annotate(\"text\", x = 2, y = thr + 0.35, label = sprintf(\"Bonferroni (0.05/%s), \\u2212log10 P = %.1f\", format(n_snp, big.mark = \",\"), thr), hjust = 0, vjust = 0, size = T7, colour = pal[[\"red\"]]) +\n scale_x_continuous(breaks = mid, labels = chrs$chr, limits = c(-1, max(snp$x) + 1), expand = c(0, 0)) +\n scale_y_continuous(limits = c(0, 13), breaks = c(0, 4, 8, 12), expand = c(0, 0)) +\n labs(x = \"Chromosome\", y = \"\\u2212log10 P\") + th\n\n# b regional plot of the top locus, points coloured by r2 to the lead SNP ----------------------\nloc <- snp[snp$chr == 4 & snp$pos > zoom[1] & snp$pos < zoom[2], ]\nlead <- leads[leads$chr == 4, ]\n# consistency: the genome-wide top hit is VvNCED3 on chr 4 (house-mosaic-aba-kinetics b claims it)\n# and it is the lead SNP of the zoomed window\nstopifnot(leads$lab[which.max(leads$lp)] == \"VvNCED3\", all(leads$lp > thr), all(leads$lab != c(\"VvABF2\", \"VvHAI1\")[1]), lead$chr == 4, lead$lp == max(loc$lp), !anyNA(loc$r2))\nr2_cols <- c(pal[[\"blue\"]], pal[[\"sky\"]], pal[[\"green\"]], pal[[\"orange\"]], pal[[\"red\"]]) # r2 bins low -> high; labels use the same vector\nloc$bin <- cut(loc$r2, c(-0.01, 0.2, 0.4, 0.6, 0.8, 1.01), labels = FALSE)\ngm <- data.frame(s = c(11.1, 11.75, 12.15, 12.55, 13.05), e = c(11.5, 12.0, 12.45, 12.85, 13.5),\n g = c(\"VvABF2\", \"\", \"VvNCED3\", \"\", \"VvHAI1\"))\nb3b <- ggplot(loc, aes(pos, lp)) +\n geom_rect(data = gm, aes(xmin = s, xmax = e, ymin = -2.0, ymax = -1.0), fill = grey[[\"dark\"]], inherit.aes = FALSE) +\n annotate(\"segment\", x = zoom[1], xend = zoom[2], y = -1.5, yend = -1.5, linewidth = pv_house_lw(\"frame\")) +\n geom_text(data = gm[gm$g != \"\", ], aes(x = (s + e) / 2, y = -2.3, label = g), vjust = 1, size = T7, fontface = \"italic\", inherit.aes = FALSE) +\n geom_hline(yintercept = thr, linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = pal[[\"red\"]]) +\n geom_point(aes(fill = I(r2_cols[bin])), shape = 21, size = 1.3, stroke = 0.2, colour = \"black\") +\n geom_point(data = lead, shape = 23, size = 2.2, stroke = 0.3, fill = pal[[\"magenta\"]], colour = \"black\") +\n annotate(\"text\", x = zoom[1] + 0.05, y = c(12.9, 11.3), label = c(\"Lead SNP (magenta);\", \"causal gene not resolved\"),\n hjust = 0, size = T7, colour = c(pal[[\"magenta\"]], grey[[\"mid\"]])) +\n annotate(\"text\", x = zoom[2] - 0.05, y = c(12.9, 11.3, 9.7, 8.1, 6.5), label = c(\"r\\u00b2 > 0.8\", \"0.6\\u20130.8\", \"0.4\\u20130.6\", \"0.2\\u20130.4\", \"< 0.2\"),\n colour = rev(r2_cols), hjust = 1, size = T7) +\n scale_x_continuous(limits = zoom, breaks = c(11, 12, 13), expand = c(0, 0)) +\n scale_y_continuous(limits = c(-4.2, 14), breaks = c(0, 4, 8, 12), expand = c(0, 0)) +\n labs(x = \"Chr 4 position (Mb)\", y = \"\\u2212log10 P\") + th\n\n# c lead-SNP genotype effect --------------------------------------------------------------------\ngt$x <- match(gt$genotype, c(\"AA\", \"AG\", \"GG\"))\ngcol <- c(AA = grey[[\"mid\"]], AG = warm[3], GG = pal[[\"red\"]])\nb3c <- ggplot(gt, aes(x, dti, group = genotype)) +\n geom_point(aes(x = x + 0.16 * jitter, fill = genotype), shape = 21, size = 0.9, stroke = 0.15, alpha = 0.8) +\n geom_boxplot(fill = NA, width = 0.5, outlier.shape = NA, linewidth = pv_house_lw(0.6)) +\n scale_fill_manual(values = gcol, guide = \"none\") +\n scale_x_continuous(breaks = 1:3, labels = c(\"AA\", \"AG\", \"GG\"), limits = c(0.4, 3.6), expand = c(0, 0)) +\n scale_y_continuous(limits = c(0.15, 0.95), breaks = c(0.2, 0.5, 0.8), expand = c(0, 0)) +\n labs(x = \"Lead SNP genotype\", y = \"Drought tolerance index\") + th\n\n# d allele frequency per population (stacked to 100%) -----------------------------------------\npops <- af$population\naf <- rbind(data.frame(pop = pops, al = \"G\", f = af$g_percent), data.frame(pop = pops, al = \"A\", f = 100 - af$g_percent))\naf$pop <- factor(af$pop, levels = pops); af$al <- factor(af$al, levels = c(\"A\", \"G\"))\naf$yi <- length(pops) + 1 - as.integer(af$pop)\nb3d <- ggplot(af, aes(f, yi, fill = al)) + geom_col(width = 0.68, orientation = \"y\", colour = \"white\", linewidth = pv_house_lw(0.3)) +\n geom_text(data = af[af$al == \"G\", ], aes(x = f / 2, label = f), colour = \"white\", size = T7) +\n scale_fill_manual(values = c(A = grey[[\"light\"]], G = pal[[\"red\"]]), guide = \"none\") +\n annotate(\"text\", x = 1.5, y = length(pops) + 0.45, label = \"DTI-increasing\\nallele (G), %\", hjust = 0, vjust = 0, lineheight = 0.9, colour = pal[[\"red\"]], size = T7) +\n scale_y_continuous(breaks = rev(seq_along(pops)), labels = pops, limits = c(0.5, length(pops) + 1.55), expand = c(0, 0)) +\n scale_x_continuous(limits = c(0, 100), breaks = c(0, 50, 100), expand = c(0, 0)) +\n labs(x = \"Allele frequency (%)\", y = NULL) + th\n\nmosaic <- pv_house_mosaic(list(\n list(plot = footnote(tile(b3a, \"a\")), at = c(1, 1), cells = c(4, 1)),\n list(plot = tile(b3b, \"b\"), at = c(1, 2), cells = c(2, 1)),\n list(plot = tile(b3c, \"c\"), at = c(3, 2), cells = c(1, 1)),\n list(plot = tile(b3d, \"d\", r = 3), at = c(4, 2), cells = c(1, 1)) # r: half of \"100\" overhangs the frame\n), cells = page_cells)\nmosaic <- top_anchor(mosaic, pv_grid_span(page_cells[2]) + if (page_cells[2] == 4) 2 else 0)\npv_save_house(mosaic, \"figure\", cells = page_cells)\n\ngrDevices::dev.off()\nmessage(\"wrote preview.png\")\n",
"search_text": "gwas page with a 4x1 manhattan (house mosaic, 4x2)\ngwas 拼版：4×1 曼哈顿图、区域图、基因型效应、等位基因频率（house 风格，4×2）\nhouse-mosaic-gwas\n\nlayout\n拼图\nlayout\n拼图\nlayout\n模拟数据，仅作示意，不是生物学结果（simulated data for illustration; not biological results）。dti = drought tolerance index（耐旱指数）。双栏半页讲一个 gwas：a 是通栏 4×1 曼哈顿图，b 为头号位点区域图（2×1，按 r² 着色并画基因模型），c 头号 snp 的基因型效应（箱线 + 原始点），d 各群体等位基因频率（堆叠条）。\npage_cells = 4×2；lead_genes 给每个峰标候选基因，zoom 为 b 的窗口（mb），阈值为 bonferroni 0.05 / snp 数（data.csv 行数），超过阈值的点标红；峰的标签写 “chrn lead snp (near 基因)”，不把基因当作已确定的致病基因。stopifnot() 检查最强信号是 chr 4 上靠近 vvnced3 的 lead snp、且就是 b 窗口里的最高点（与 house-mosaic-aba-kinetics 的 b 标题一致）；b 注明致病基因未定。\nmulti-panel mosaic house-style gwas manhattan\nchr 染色体编号 1–19（data.csv、data_chr.csv） pos 位置（mb，data.csv） p 关联 p 值（data.csv） r2 与 chr 4 头号 snp 的 r²，只在放大窗口内有值（data.csv） length_mb 染色体长度（mb，data_chr.csv） genotype 头号 snp 基因型 aa / ag / gg（data_genotype.csv） dti 耐旱指数 dti（drought tolerance index，data_genotype.csv） jitter 原始点横向抖动 -1–1（data_genotype.csv） population 群体（data_allele.csv） g_percent 使 dti 升高的等位基因 g 的频率 %（data_allele.csv）"
},
{
"title": "Transcriptome overview page (house mosaic, 4x3)",
"title_zh": "转录组总览拼版：PCA、DEG 计数、热图、GO 森林图、UpSet、环图（house 风格，4×3）",
"slug": "house-mosaic-transcriptome",
"category": "layout",
"tags": [
"multi-panel",
"mosaic",
"house-style",
"rna-seq",
"upset",
"heatmap"
],
"packages": [
"ggplot2",
"patchwork"
],
"data_columns": {
"sample": "文库编号 1–16（data.csv；data_heatmap.csv 的 sample 列与之对应）",
"tissue": "组织（data.csv 为 Leaf / Root；data_deg.csv 为 5 种组织）",
"treatment": "处理 WW（充分灌溉）/ SD（重度干旱）",
"pc1": "PC1 得分（data.csv）",
"pc2": "PC2 得分（data.csv）",
"direction": "Up / Down，SD vs WW（data_deg.csv）",
"n": "该组织该方向的 DEG 数（正整数，data_deg.csv）",
"gene": "基因编号（data_heatmap.csv 为 1–40 的行号；data_upset.csv 为基因 ID）",
"cluster": "热图基因所属簇（data_heatmap.csv）",
"z": "表达 z-score，截到 ±2（data_heatmap.csv）",
"term": "GO 生物过程正式名称（data_go.csv；作图时 biosynthetic 缩写为 biosynth. 并折成 2 行）",
"or": "富集比值比（data_go.csv，lo / hi 为 95% CI）",
"Leaf / Root / Shoot tip / Berry skin / Seed": "0/1，该上调 DEG 是否属于该组织（data_upset.csv）"
},
"when_to_use": "模拟数据，仅作示意，不是生物学结果（Simulated data for illustration; not biological results）。DEG 定义：|log2FC| >= 1，padj < 0.05，SD vs WW，单一采样时间（不跨时间点取并集），写在图底一行脚注里；b、e、f 都按此计数，e/f 只算上调且去重（unique DEGs）。双栏一整页讲一个转录组结果：左上 PCA 与 DEG 计数是数据总览，中间热图是主结果，右侧 GO 森林图（10 个 GO 正式名称）是统计，底部 3×1 UpSet 看上调 DEG 在组织间的共享，旁边 1×1 环图把去重后的上调 DEG 按共享组织数（1 / 2 / 3+）分成 3 段。七种图型在一页上，面板框上下、左右对齐。",
"customize": "每个面板是独立的 ggplot，pv_house_mosaic() 的 at / cells 决定位置与格数（整格，page_cells = 4×3 = 183 × 135 mm）；tile() 的 l/t/b 固定外边带，使同一行或列的面板框对齐（BT、BB、LB）；n_show 为 UpSet 显示的交集数。UpSet 与环图都只算上调 DEG：UpSet 集合大小必须等于 data_deg.csv 的 Up 列；环图各段互不重叠，合计等于去重后的上调 DEG 数（中心写 “N unique upregulated genes”），也等于 UpSet 注释里的 “of N”，plot.R 里的 stopifnot() 会检查。环图以 mm 为坐标绘制，上下边与 e 的数据区对齐（F_T、F_B）。换数据时保持 data*.csv 的列名；组织颜色在 tis_c，处理颜色在 tc。",
"lang": "R",
"task": "layout",
"task_zh": "拼图",
"task_en": "Layout",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": {
"width_mm": "183",
"height_mm": "135",
"label": "183 × 135 mm (4×3 cells)",
"cells": "4x3"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/layout/house-mosaic-transcriptome/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-transcriptome/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-transcriptome/plot.R"
},
{
"name": "data.csv",
"path": "figures/layout/house-mosaic-transcriptome/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-transcriptome/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-transcriptome/data.csv"
},
{
"name": "make_data.R",
"path": "figures/layout/house-mosaic-transcriptome/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-transcriptome/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-transcriptome/make_data.R"
},
{
"name": "data_deg.csv",
"path": "figures/layout/house-mosaic-transcriptome/data_deg.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-transcriptome/data_deg.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-transcriptome/data_deg.csv"
},
{
"name": "data_go.csv",
"path": "figures/layout/house-mosaic-transcriptome/data_go.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-transcriptome/data_go.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-transcriptome/data_go.csv"
},
{
"name": "data_heatmap.csv",
"path": "figures/layout/house-mosaic-transcriptome/data_heatmap.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-transcriptome/data_heatmap.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-transcriptome/data_heatmap.csv"
},
{
"name": "data_upset.csv",
"path": "figures/layout/house-mosaic-transcriptome/data_upset.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-mosaic-transcriptome/data_upset.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-transcriptome/data_upset.csv"
}
],
"dir": "figures/layout/house-mosaic-transcriptome",
"preview": "figures/layout/house-mosaic-transcriptome/preview.png",
"docs_preview": "previews/house-mosaic-transcriptome.png",
"code": "figures/layout/house-mosaic-transcriptome/plot.R",
"data": "figures/layout/house-mosaic-transcriptome/data.csv",
"data_files": [
"figures/layout/house-mosaic-transcriptome/data.csv",
"figures/layout/house-mosaic-transcriptome/data_deg.csv",
"figures/layout/house-mosaic-transcriptome/data_go.csv",
"figures/layout/house-mosaic-transcriptome/data_heatmap.csv",
"figures/layout/house-mosaic-transcriptome/data_upset.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-transcriptome/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-mosaic-transcriptome/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/layout/house-mosaic-transcriptome",
"code_text": "# House mosaic, transcriptome: overview (PCA, DEG counts), main result (heatmap, UpSet of upregulated\n# DEGs) and statistics (GO forest, up/down share) of a simulated grapevine drought trial on a 4x3 page\n# (183 x 135 mm). Reads data*.csv only. Run from this directory.\nsuppressPackageStartupMessages({ library(ggplot2); library(patchwork) })\nsource(\"../../../styles/r/theme_house.R\")\ngrDevices::cairo_pdf(tempfile(fileext = \".pdf\")) # Arial metrics while tiles are measured; closed at the end\npal <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\"); warm <- pv_palette(\"house_warm\")\nTAG_PT <- 10; T7 <- pv_pt2size(7)\nminus <- function(x) gsub(\"-\", \"\\u2212\", if (is.character(x)) x else format(x, trim = TRUE)) # no padding of strings\npt_layer <- function(...) geom_point(shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = \"black\", ...)\nth <- theme_house()\ntc <- c(WW = grey[[\"mid\"]], SD = pal[[\"red\"]]) # treatment colours (whole series)\ntis <- c(\"Leaf\", \"Root\", \"Shoot tip\", \"Berry skin\", \"Seed\")\ntis_c <- stats::setNames(unname(pal[c(\"green\", \"brown\", \"gold\", \"purple\", \"sky\")]), tis) # one colour per tissue\nrd <- function(f) utils::read.csv(f, stringsAsFactors = FALSE, check.names = FALSE)\n\n# --- tile helpers: every panel is a standalone ggplot placed on whole grid cells by\n# pv_house_mosaic(). tile() pins the outer bands so panel frames line up across tiles.\n# Fixed outer bands (mm) so panel frames line up across tiles in the same column/row:\n# left = y ticks + title, bottom = x ticks + title, top = room for the tag.\nBAND <- list(l = 11.5, b = 8.6, t = 4.2, r = 1.2)\n.mm <- function(u) as.numeric(grid::convertUnit(u, \"mm\", valueOnly = TRUE))\n.width_mm <- function(g, idx) if (length(idx)) sum(vapply(idx, function(i) .mm(grid::convertWidth(g$widths[i], \"mm\")), 0)) else 0\n.height_mm <- function(g, idx) if (length(idx)) sum(vapply(idx, function(i) .mm(grid::convertHeight(g$heights[i], \"mm\")), 0)) else 0\n\n# tile(): ggplot -> grob with fixed bands and a bold tag at the tile's top-left corner.\ntile <- function(p, tag = NULL, l = BAND$l, b = BAND$b, t = BAND$t, r = BAND$r) {\n p <- .pv_set_text_family(p + theme(plot.margin = margin(0, 0, 0, 0)))\n g <- ggplotGrob(p)\n pan <- g$layout[grepl(\"^panel\", g$layout$name), ]\n pl <- min(pan$l); pr <- max(pan$r); pt <- min(pan$t); pb <- max(pan$b)\n nc <- length(g$widths); nr <- length(g$heights)\n fit <- function(have, want, side) {\n if (have > want + 0.01) stop(sprintf(\"tile %s: %s band needs %.2f mm > %.2f\", tag, side, have, want))\n grid::unit(want - have, \"mm\")\n }\n g$widths[1] <- g$widths[1] + fit(.width_mm(g, seq_len(pl - 1)), l, \"left\")\n g$widths[nc] <- g$widths[nc] + fit(.width_mm(g, if (pr < nc) (pr + 1):nc else integer()), r, \"right\")\n g$heights[1] <- g$heights[1] + fit(.height_mm(g, seq_len(pt - 1)), t, \"top\")\n g$heights[nr] <- g$heights[nr] + fit(.height_mm(g, if (pb < nr) (pb + 1):nr else integer()), b, \"bottom\")\n if (!is.null(tag)) g <- add_tag(g, tag)\n g\n}\nadd_tag <- function(g, tag) {\n grid::grobTree(g, grid::textGrob(tag, x = grid::unit(0.3, \"mm\"), y = grid::unit(1, \"npc\") - grid::unit(0.2, \"mm\"),\n hjust = 0, vjust = 1, gp = grid::gpar(fontfamily = house_family(), fontface = \"bold\", fontsize = TAG_PT)))\n}\n# footnote(): small grey 7 pt note inside a tile's band (simulated data disclaimer)\nSIM_NOTE <- \"Simulated data for illustration; not biological results\"\nfootnote <- function(g, label = SIM_NOTE, x = 1, y = 1, hjust = 1, vjust = 1, dx = -1.2, dy = -0.6) {\n grid::grobTree(g, grid::textGrob(label, x = grid::unit(x, \"npc\") + grid::unit(dx, \"mm\"), y = grid::unit(y, \"npc\") + grid::unit(dy, \"mm\"),\n hjust = hjust, vjust = vjust, gp = grid::gpar(fontfamily = house_family(), fontsize = 7, col = grey[[\"mid\"]], lineheight = 0.95)))\n}\n# top_anchor(): cairo_pdf truncates the page to whole points (e.g. 183 mm = 518.74 pt -> 518 pt) and the\n# mosaic is placed from the bottom, so the top lost up to 0.26 mm. On PDF devices, shift the page down by\n# that fraction so blocks are laid out from the top edge; PNG devices are exact and need no shift.\ntop_anchor <- function(m, h_mm) structure(grid::gTree(children = grid::gList(m), h_mm = h_mm, cl = c(\"pv_top\", class(m))),\n pv_cells = attr(m, \"pv_cells\"))\nmakeContext.pv_top <- function(x) {\n h_pt <- x$h_mm / 25.4 * 72\n dy <- if (grepl(\"pdf\", names(grDevices::dev.cur()), ignore.case = TRUE)) h_pt - floor(h_pt) else 0\n x$vp <- grid::viewport(y = grid::unit(1, \"npc\") - grid::unit(dy, \"bigpts\"), height = grid::unit(1, \"npc\"), just = \"top\")\n x\n}\n# patchwork / composite tiles: tag only (they control their own inner layout)\ntile_pw <- function(p, tag) add_tag(patchwork::patchworkGrob(p), tag)\n\n# Text colour on a filled shape (WCAG 2.x, as in house-upset #32): white if its contrast\n# reaches 4.5:1, otherwise near-black #1A1A1A.\nwcag_lum <- function(hex) { c <- grDevices::col2rgb(hex)[, 1] / 255\n c <- ifelse(c <= 0.04045, c / 12.92, ((c + 0.055) / 1.055)^2.4); sum(c(0.2126, 0.7152, 0.0722) * c) }\nwcag_contrast <- function(a, b) { l <- sort(c(wcag_lum(a), wcag_lum(b)), decreasing = TRUE); (l[1] + 0.05) / (l[2] + 0.05) }\non_fill_text <- function(fill) vapply(fill, function(f) if (wcag_contrast(\"#FFFFFF\", f) >= 4.5) \"#FFFFFF\" else \"#1A1A1A\", \"\", USE.NAMES = FALSE)\n\n# UpSet as one tile. m: logical matrix items x sets (colnames = set labels).\n# Layout: [note + key | intersection bars] over [set-size bars | set names | matrix]; the note\n# block fills the corner above the set bars. Set-size values: inside the bar end when they fit\n# with 1 mm either side (colour by on_fill_text), else just outside in the set colour.\nupset_tile <- function(m, cols, n_show, tag, set_w = c(22, 16), bar_frac = 0.5,\n ylab = \"Shared genes\", unit = \"genes\", dot = 1.8, head = NULL) {\n sets <- colnames(m); k <- length(sets)\n key <- apply(m, 1, function(r) paste(as.integer(r), collapse = \"\"))\n key <- key[grepl(\"1\", key)]\n tab_all <- sort(table(key), decreasing = TRUE); n_inter <- length(tab_all)\n tab <- tab_all[seq_len(min(n_show, n_inter))]\n bits <- do.call(rbind, lapply(strsplit(names(tab), \"\"), as.integer))\n inter <- data.frame(x = seq_along(tab), n = as.integer(tab), deg = rowSums(bits))\n inter$fill <- ifelse(inter$deg == 1, cols[apply(bits, 1, which.max)], \"#000000\")\n set_n <- data.frame(set = factor(sets, levels = sets), row = k:1, n = colSums(m), fill = cols)\n y_top <- ceiling(max(inter$n) * 1.3 / 50) * 50\n shade <- data.frame(x = seq(2, nrow(inter), 2))\n xs <- scale_x_continuous(limits = c(0.5, nrow(inter) + 0.5), expand = c(0, 0))\n ys <- scale_y_continuous(limits = c(0.5, k + 0.5), expand = c(0, 0))\n noax <- theme(axis.text.x = element_blank(), axis.ticks.x = element_blank(), axis.title.x = element_blank())\n blank_xy <- theme(axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks = element_blank(),\n axis.title.x = element_blank(), axis.title.y = element_blank())\n pb <- ggplot(inter) +\n geom_rect(data = shade, aes(xmin = x - 0.5, xmax = x + 0.5, ymin = -Inf, ymax = Inf), fill = grey[[\"bg\"]], inherit.aes = FALSE) +\n geom_col(aes(x, n, fill = I(fill)), width = 0.66) +\n geom_text(aes(x, n, label = n, colour = I(fill)), vjust = -0.35, size = T7) +\n xs + scale_y_continuous(limits = c(0, y_top), breaks = c(0, floor(y_top * 0.8 / 100) * 100), expand = c(0, 0)) +\n labs(y = ylab) + th + noax + theme(plot.margin = margin(4.2, 1.2, 0, 0, \"mm\"))\n dots <- do.call(rbind, lapply(seq_len(nrow(bits)), function(i)\n data.frame(x = i, row = k:1, on = bits[i, ] == 1, fill = ifelse(inter$deg[i] == 1, inter$fill[i], \"#000000\"))))\n segs <- do.call(rbind, lapply(seq_len(nrow(bits)), function(i) { r <- (k:1)[bits[i, ] == 1]\n data.frame(x = i, y0 = min(r), y1 = max(r)) }))\n pm <- ggplot() +\n geom_rect(data = shade, aes(xmin = x - 0.5, xmax = x + 0.5, ymin = -Inf, ymax = Inf), fill = grey[[\"bg\"]]) +\n geom_point(data = dots[!dots$on, ], aes(x, row), shape = 21, size = dot, stroke = HOUSE_POINT$stroke, fill = grey[[\"light\"]], colour = grey[[\"light\"]]) +\n geom_segment(data = segs, aes(x, y0, xend = x, yend = y1), linewidth = pv_house_lw(\"main\")) +\n geom_point(data = dots[dots$on, ], aes(x, row, fill = I(fill)), shape = 21, size = dot, stroke = HOUSE_POINT$stroke, colour = \"black\") +\n xs + ys + th + blank_xy + theme(plot.margin = margin(0.8, 1.2, 0, 0, \"mm\"))\n x_set <- ceiling(max(set_n$n) * 1.08 / 250) * 250\n dig <- 0.556 * 7 * 25.4 / 72; pad <- 1\n set_n$inside <- set_n$n / x_set * set_w[1] >= nchar(set_n$n) * dig + 2 * pad\n set_n$lab_col <- ifelse(set_n$inside, on_fill_text(set_n$fill), set_n$fill)\n set_n$lab_x <- set_n$n + ifelse(set_n$inside, -1, 1.2) * pad / set_w[1] * x_set\n set_n$lab_h <- ifelse(set_n$inside, 0, 1)\n ps <- ggplot(set_n, aes(n, row)) + geom_col(aes(fill = I(fill)), width = 0.74, orientation = \"y\") +\n geom_text(aes(x = lab_x, label = format(n, big.mark = \",\"), hjust = lab_h, colour = I(lab_col)), size = T7) +\n scale_x_reverse(limits = c(x_set, 0), breaks = c(x_set, 0), labels = function(v) format(v, big.mark = \",\"), expand = c(0, 0)) + ys +\n labs(x = \"Set size\") + th + theme(axis.text.y = element_blank(), axis.ticks.y = element_blank(), axis.title.y = element_blank(),\n plot.margin = margin(0.8, 1.5, 0, 0.4, \"mm\")) # 1.5 mm gap to the set names\n pl <- ggplot(set_n, aes(1.95, row, label = set, colour = I(fill))) + geom_text(size = T7, hjust = 1) + ys +\n scale_x_continuous(limits = c(0, 2), expand = c(0, 0)) + theme_void() + theme(plot.margin = margin(0.8, 0, 0, 0, \"mm\"))\n # two-line note at the top-left: what is shown out of what (tissue colour = one tissue, black = shared)\n nl <- data.frame(y = c(5.1, 4.05), x = 0,\n lab = c(sprintf(\"Top %d of %d intersections\", nrow(inter), n_inter),\n sprintf(\"%s of %s %s\", format(sum(tab), big.mark = \",\"), format(sum(tab_all), big.mark = \",\"), unit)),\n col = c(\"#000000\", grey[[\"mid\"]]))\n pn <- ggplot() + geom_text(data = nl, aes(x, y, label = lab, colour = I(col)), hjust = 0, size = T7) +\n scale_x_continuous(limits = c(0, 1), expand = c(0, 0)) + scale_y_continuous(limits = c(0.3, 5.6), expand = c(0, 0)) +\n coord_cartesian(clip = \"off\") + theme_void() + theme(plot.margin = margin(4.2, 0, 0.5, 0.6, \"mm\"))\n p <- pn + pb + ps + pl + pm + plot_layout(design = \"AAB\\nCDE\", widths = unit(c(set_w, 1), c(\"mm\", \"mm\", \"null\")),\n heights = c(bar_frac, 1 - bar_frac))\n tile_pw(p, tag)\n}\n# --- parameters ---------------------------------------------------------------------------\npage_cells <- c(4, 3)\n# One SD-vs-WW contrast per tissue at a single sampling time (make_data.R simulates no time course, so no union).\n# ASCII \">=\" keeps the PDF to Arial subsets only.\nDEG_DEF <- \"DEG: |log2FC| >= 1, padj < 0.05, SD vs WW, 1 time point; e, f: upregulated genes only.\"\nFOOT <- paste(DEG_DEF, \"Simulated data for illustration; not biological results\")\nFOOT_X <- 0.0 # right inset (mm): ends on the block edge at 182 mm, clear of e's \"Set size\" title\nn_show <- 12 # UpSet: intersections shown\nBT <- 7; BB <- 8.6 # shared top / bottom band of a, b, c, d so their frames line up\nLB <- 14.5 # left band of a, b: room for \"Berry skin\" / \"Shoot tip\"\n\nsmp <- rd(\"data.csv\"); deg <- rd(\"data_deg.csv\"); hm <- rd(\"data_heatmap.csv\"); go <- rd(\"data_go.csv\")\nup <- rd(\"data_upset.csv\")\ndeg$n <- ifelse(deg$direction == \"Down\", -deg$n, deg$n)\n\n# a PCA ---------------------------------------------------------------------------------------\nb1a <- ggplot(smp, aes(pc1, pc2)) +\n geom_point(aes(fill = treatment, shape = tissue), size = HOUSE_POINT$size, stroke = HOUSE_POINT$stroke, colour = \"black\") +\n scale_shape_manual(values = c(Leaf = 21, Root = 24), guide = \"none\") + scale_fill_manual(values = tc, guide = \"none\") +\n annotate(\"text\", x = c(-18, 20), y = -21, label = c(\"Leaf\", \"Root\"), size = T7, colour = tis_c[c(\"Leaf\", \"Root\")], fontface = \"bold\") +\n annotate(\"text\", x = 30, y = c(20.5, 15.5), label = c(\"SD\", \"WW\"), colour = tc[c(\"SD\", \"WW\")], fontface = \"bold\", size = T7, hjust = 1) +\n scale_x_continuous(limits = c(-32, 32), breaks = c(-20, 0, 20), labels = minus, expand = c(0, 0)) +\n scale_y_continuous(limits = c(-25, 24), breaks = c(-20, 0, 20), labels = minus, expand = c(0, 0)) +\n labs(x = \"PC1 (48%)\", y = \"PC2 (21%)\") + th\n\n# b DEG counts, diverging horizontal bars ----------------------------------------------------\ndeg$yi <- 6 - match(deg$tissue, tis)\nb1b <- ggplot(deg, aes(n, yi, fill = direction)) + geom_col(width = 0.68, orientation = \"y\") +\n geom_vline(xintercept = 0, linewidth = pv_house_lw(\"frame\")) +\n geom_text(aes(label = format(abs(n), big.mark = \",\"), hjust = ifelse(n > 0, -0.12, 1.12), colour = direction), size = T7) +\n scale_fill_manual(values = c(Up = pal[[\"red\"]], Down = pal[[\"blue\"]]), guide = \"none\") +\n scale_colour_manual(values = c(Up = pal[[\"red\"]], Down = pal[[\"blue\"]]), guide = \"none\") +\n annotate(\"text\", x = c(2150, -2150), y = 5.62, label = c(\"Up\", \"Down\"), hjust = c(1, 0), colour = c(pal[[\"red\"]], pal[[\"blue\"]]), fontface = \"bold\", size = T7) +\n scale_y_continuous(breaks = 5:1, labels = tis, limits = c(0.45, 6.0), expand = c(0, 0)) +\n scale_x_continuous(limits = c(-2200, 2200), breaks = c(-1000, 0, 1000), labels = c(\"1k\", \"0\", \"1k\"), expand = c(0, 0)) +\n labs(x = \"DEGs (SD vs WW)\", y = NULL) + th\n\n# c heatmap with a thin group strip ---------------------------------------------------------\nng <- max(hm$gene); ns <- max(hm$sample)\ncl <- unique(hm[order(hm$gene), c(\"gene\", \"cluster\")])$cluster\ncut_y <- ng + 1 - (cumsum(rle(cl)$lengths)[-length(rle(cl)$lengths)] + 0.5)\ncl_y <- data.frame(lab = sub(\" in \", \" in\\n\", rle(cl)$values), y = ng + 1 - c(8.5, 22.5, 31)) # 2 lines: stay inside the block\nstrip <- data.frame(x0 = c(0.5, 4.5, 8.5, 12.5), lab = c(\"WW\", \"SD\", \"WW\", \"SD\"), tis = c(\"Leaf\", \"Leaf\", \"Root\", \"Root\"))\nstrip$txt <- paste(strip$tis, strip$lab)\nb1c <- ggplot(hm, aes(sample, ng + 1 - gene, fill = z)) + geom_raster() +\n geom_hline(yintercept = cut_y, colour = \"white\", linewidth = pv_house_lw(1)) +\n geom_vline(xintercept = c(4.5, 8.5, 12.5), colour = \"white\", linewidth = pv_house_lw(c(0.6, 1.2, 0.6))) +\n geom_text(data = cl_y, aes(x = 16.8, y = y, label = lab), hjust = 0, size = T7, lineheight = 0.9, inherit.aes = FALSE) +\n geom_rect(data = strip, aes(xmin = x0 + 0.08, xmax = x0 + 3.92, ymin = ng + 0.75, ymax = ng + 1.45), fill = tc[strip$lab], inherit.aes = FALSE) +\n geom_text(data = strip, aes(x = x0 + 2, y = ng + 1.75, label = txt, colour = I(tc[lab])), fontface = \"bold\", size = T7, vjust = 0, inherit.aes = FALSE) +\n scale_fill_gradient2(low = pal[[\"blue\"]], mid = \"white\", high = pal[[\"red\"]], limits = c(-2, 2), guide = \"none\") +\n annotate(\"rect\", xmin = 16.8 + (0:19) * 0.13, xmax = 16.8 + (1:20) * 0.13, ymin = 2.2, ymax = 3.4,\n fill = scales::gradient_n_pal(c(pal[[\"blue\"]], \"white\", pal[[\"red\"]]))(seq(0, 1, length.out = 20))) +\n annotate(\"text\", x = c(16.8, 19.4), y = 1.7, label = c(minus(-2), \"2\"), size = T7, vjust = 1, hjust = c(0, 1)) +\n annotate(\"text\", x = 16.8, y = 3.9, label = \"z-score\", size = T7, vjust = 0, hjust = 0) +\n scale_x_continuous(expand = c(0, 0)) + scale_y_continuous(expand = c(0, 0)) +\n coord_cartesian(xlim = c(0.5, ns + 0.5), ylim = c(0.5, ng + 0.5), clip = \"off\") +\n labs(x = sprintf(\"%d libraries (%d per group)\", nrow(smp), max(table(paste(smp$tissue, smp$treatment)))),\n y = sprintf(\"%d top DEGs\", ng)) + th +\n theme(axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks = element_blank())\n\n# d GO forest -----------------------------------------------------------------------------------\ngo$lab <- vapply(go$term, function(t) paste(strwrap(sub(\"biosynthetic\", \"biosynth.\", t), 19), collapse = \"\\n\"), \"\")\ngo$y <- rev(seq_len(nrow(go))); go$col <- ifelse(go$or > 1, pal[[\"red\"]], pal[[\"blue\"]])\nb1d <- ggplot(go, aes(or, y)) + geom_vline(xintercept = 1, linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_errorbar(aes(xmin = lo, xmax = hi, colour = I(col)), width = 0, orientation = \"y\", linewidth = pv_house_lw(\"errorbar\")) +\n geom_point(aes(fill = I(col)), shape = 22, size = 2.1, stroke = 0.3) +\n annotate(\"text\", x = c(0.75, 1.35), y = nrow(go) + 0.85, label = c(\"Down\", \"Up\"), hjust = c(1, 0), vjust = 0, colour = c(pal[[\"blue\"]], pal[[\"red\"]]), fontface = \"bold\", size = T7) +\n scale_x_log10(limits = c(0.18, 8), oob = scales::oob_keep, breaks = c(0.25, 1, 4), labels = c(\"0.25\", \"1\", \"4\"), expand = c(0, 0)) +\n scale_y_continuous(breaks = go$y, labels = go$lab, expand = c(0, 0)) +\n coord_cartesian(ylim = c(0.4, nrow(go) + 0.6), clip = \"off\") +\n labs(x = \"Odds ratio (GO)\", y = NULL) + th\n\n# e UpSet of upregulated DEGs (set sizes must equal b's Up column) ---------------------------\nmm <- as.matrix(up[, tis]) == 1\nup_n <- stats::setNames(deg$n[deg$direction == \"Up\"], deg$tissue[deg$direction == \"Up\"])[tis]\nstopifnot(identical(as.numeric(colSums(mm)), as.numeric(up_n)))\n# UpSet column capacity (measured on house-mosaic-transcriptome e, 3x1 = 135 mm): everything outside the\n# intersection columns (set bars, set names, gaps, y-axis band, right margin) takes 59 mm; each column needs\n# >= 4.8 mm (three-digit label 4.23 mm + 0.6 mm). Limit = floor((width_mm - 59) / 4.8): 2x1 6, 3x1 15, 4x1 25.\nUPSET_OVERHEAD_MM <- 59; UPSET_COL_MM <- 4.8\nstopifnot(floor((pv_grid_span(3) - UPSET_OVERHEAD_MM) / UPSET_COL_MM) >= n_show) # e is 3 cells wide\nb1e <- upset_tile(mm, unname(tis_c), n_show = n_show, tag = \"e\", set_w = c(26, 15), bar_frac = 0.44,\n ylab = \"Up DEGs\", unit = \"upregulated genes\", dot = 1.5)\n\n# f donut: the same unique upregulated DEGs as e, split by how many tissues share each gene.\n# Sectors do not overlap (each gene counted once) and sum to e's unique total.\nk_tis <- rowSums(mm)\nud <- data.frame(lab = c(\"3+ tissues\", \"2 tissues\", \"1 tissue\"), # small sectors on the right half\n n = c(sum(k_tis >= 3), sum(k_tis == 2), sum(k_tis == 1)))\nud$f <- ud$n / sum(ud$n); ud$e <- cumsum(ud$f); ud$s <- ud$e - ud$f; ud$mid <- (ud$s + ud$e) / 2\nud$col <- warm[5:3] # house_warm: upregulated family\nn_unique <- sum(ud$n)\nstopifnot(sum(ud$n) == nrow(mm), n_unique == nrow(mm), # sectors == unique upregulated-gene total\n sum(ud$n) == sum(table(apply(mm, 1, paste, collapse = \"\"))), # == e's \"of N\" (all intersections)\n sum(up_n) == sum(deg$n[deg$n > 0]), # e set sizes == b Up column (total)\n go$or[go$term == \"water transport\"] < 1, go$or[go$term == \"response to desiccation\"] > 1)\nR0_FRAC <- 0.71 # inner radius: the centre text \"1,846 unique / upregulated / genes\" (7 pt bold, 2.5 mm line pitch) clears the ring by >= 1 mm\n# drawn in mm (1 unit = 1 mm): panel spans e's data block (top of the bars to the bottom of the matrix)\nF_T <- 6.13; F_B <- 10.43; f_h <- 43 - F_T - F_B # e bar area: top of the tallest bar to the bottom of the set-size bars (measured)\ncx <- 13.4; cy <- f_h / 2; R1 <- f_h / 2; R0 <- R1 * R0_FRAC\narc <- function(s, e, r) { a <- pi / 2 - 2 * pi * seq(s, e, length.out = max(3, ceiling(abs(e - s) * 120))); cbind(cx + r * cos(a), cy + r * sin(a)) }\nring <- do.call(rbind, lapply(seq_len(nrow(ud)), function(i) {\n p <- rbind(arc(ud$s[i], ud$e[i], R1), arc(ud$e[i], ud$s[i], R0)); data.frame(x = p[, 1], y = p[, 2], id = i, col = ud$col[i]) }))\n# leader anchor: the point of each sector nearest 3 o'clock (the label column), so no leader crosses the ring\nud$anc <- pmin(pmax(0.25, ud$s + 0.02), ud$e - 0.02)\nang <- pi / 2 - 2 * pi * ud$anc\nud$ex <- cx + R1 * cos(ang); ud$ey <- cy + R1 * sin(ang)\nud$ly <- seq(f_h - 4, 4, length.out = nrow(ud))[rank(-ud$ey)] # label column, same vertical order as the sectors\nud$lx <- 2 * cx + 1.2\nlo <- which.min(ud$ey); ud$ly[lo] <- min(ud$ly[lo], ud$ey[lo] - 0.5) # lowest leader slopes down off the ring bottom, never across a sector\nb1f <- ggplot() + geom_polygon(data = ring, aes(x, y, group = id, fill = I(col)), colour = \"white\", linewidth = pv_house_lw(0.6)) +\n geom_segment(data = ud, aes(x = ex, y = ey, xend = lx - 0.6, yend = ly, colour = I(col)), linewidth = pv_house_lw(\"ref\")) +\n geom_text(data = ud, aes(x = lx, y = ly, label = sprintf(\"%s\\n%s\", lab, format(n, big.mark = \",\")), colour = I(col)),\n hjust = 0, size = T7, lineheight = 0.9) +\n # three lines centred on the ring centre; the split keeps the widest line short so the ring can be thick\n annotate(\"text\", x = cx, y = cy + c(2.5, 0, -2.5), label = c(paste(format(n_unique, big.mark = \",\"), \"unique\"), \"upregulated\", \"genes\"),\n size = T7, fontface = \"bold\") +\n scale_x_continuous(limits = c(0, 43), expand = c(0, 0)) + scale_y_continuous(limits = c(0, f_h), oob = scales::oob_keep, expand = c(0, 0)) +\n coord_cartesian(clip = \"off\") + theme_void()\n\nmosaic <- pv_house_mosaic(list(\n list(plot = tile(b1a, \"a\", l = LB, t = BT, b = BB), at = c(1, 1), cells = c(1, 1)),\n list(plot = tile(b1b, \"b\", l = LB, t = BT, b = BB), at = c(1, 2), cells = c(1, 1)),\n list(plot = tile(b1c, \"c\", l = 6, r = 14, t = BT, b = BB), at = c(2, 1), cells = c(2, 2)),\n list(plot = tile(b1d, \"d\", l = 24, t = BT, b = BB), at = c(4, 1), cells = c(1, 2)),\n list(plot = b1e, at = c(1, 3), cells = c(3, 1)),\n list(plot = tile(b1f, \"f\", l = 0, b = F_B, t = F_T, r = 0), at = c(4, 3), cells = c(1, 1))\n), cells = page_cells)\n# page footnote: one 7 pt grey line on the bottom edge, right of e's set-size axis title\nmosaic <- structure(grid::gTree(children = grid::gList(mosaic, grid::textGrob(FOOT, x = grid::unit(1, \"npc\") - grid::unit(FOOT_X, \"mm\"),\n y = grid::unit(0.9, \"mm\"), hjust = 1, vjust = 0, gp = grid::gpar(fontfamily = house_family(), fontsize = 7, col = grey[[\"mid\"]]))),\n cl = class(mosaic)), pv_cells = attr(mosaic, \"pv_cells\"))\nmosaic <- top_anchor(mosaic, pv_grid_span(page_cells[2]) + if (page_cells[2] == 4) 2 else 0)\npv_save_house(mosaic, \"figure\", cells = page_cells)\n\ngrDevices::dev.off()\nmessage(\"wrote preview.png\")\n",
"search_text": "transcriptome overview page (house mosaic, 4x3)\n转录组总览拼版：pca、deg 计数、热图、go 森林图、upset、环图（house 风格，4×3）\nhouse-mosaic-transcriptome\n\nlayout\n拼图\nlayout\n拼图\nlayout\n模拟数据，仅作示意，不是生物学结果（simulated data for illustration; not biological results）。deg 定义：|log2fc| >= 1，padj < 0.05，sd vs ww，单一采样时间（不跨时间点取并集），写在图底一行脚注里；b、e、f 都按此计数，e/f 只算上调且去重（unique degs）。双栏一整页讲一个转录组结果：左上 pca 与 deg 计数是数据总览，中间热图是主结果，右侧 go 森林图（10 个 go 正式名称）是统计，底部 3×1 upset 看上调 deg 在组织间的共享，旁边 1×1 环图把去重后的上调 deg 按共享组织数（1 / 2 / 3+）分成 3 段。七种图型在一页上，面板框上下、左右对齐。\n每个面板是独立的 ggplot，pv_house_mosaic() 的 at / cells 决定位置与格数（整格，page_cells = 4×3 = 183 × 135 mm）；tile() 的 l/t/b 固定外边带，使同一行或列的面板框对齐（bt、bb、lb）；n_show 为 upset 显示的交集数。upset 与环图都只算上调 deg：upset 集合大小必须等于 data_deg.csv 的 up 列；环图各段互不重叠，合计等于去重后的上调 deg 数（中心写 “n unique upregulated genes”），也等于 upset 注释里的 “of n”，plot.r 里的 stopifnot() 会检查。环图以 mm 为坐标绘制，上下边与 e 的数据区对齐（f_t、f_b）。换数据时保持 data*.csv 的列名；组织颜色在 tis_c，处理颜色在 tc。\nmulti-panel mosaic house-style rna-seq upset heatmap\nsample 文库编号 1–16（data.csv；data_heatmap.csv 的 sample 列与之对应） tissue 组织（data.csv 为 leaf / root；data_deg.csv 为 5 种组织） treatment 处理 ww（充分灌溉）/ sd（重度干旱） pc1 pc1 得分（data.csv） pc2 pc2 得分（data.csv） direction up / down，sd vs ww（data_deg.csv） n 该组织该方向的 deg 数（正整数，data_deg.csv） gene 基因编号（data_heatmap.csv 为 1–40 的行号；data_upset.csv 为基因 id） cluster 热图基因所属簇（data_heatmap.csv） z 表达 z-score，截到 ±2（data_heatmap.csv） term go 生物过程正式名称（data_go.csv；作图时 biosynthetic 缩写为 biosynth. 并折成 2 行） or 富集比值比（data_go.csv，lo / hi 为 95% ci） leaf / root / shoot tip / berry skin / seed 0/1，该上调 deg 是否属于该组织（data_upset.csv）"
},
{
"title": "Small multiples with in-panel trends (house style)",
"title_zh": "小多图与面板内趋势（house 风格）",
"slug": "house-small-multiples",
"category": "layout",
"tags": [
"small-multiples",
"facet",
"trend",
"time-series",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"region": "面板分组（字符串）",
"year": "年份（x 轴）",
"anomaly_c": "数值（此例为温度距平 °C）"
},
"when_to_use": "同一指标在多个地区或类别上并排比较时用；共享坐标轴、只在外侧写刻度，每个面板左上写名称和线性趋势 ± s.e.（含显著性星号），显著上升红色、下降蓝色、不显著灰色。",
"customize": "plot.R 顶部 n_cols 为每行面板数；alpha_sig 为着色的显著性阈值。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），每个小面板约占 1 格，整图 4×2 格（183 × 89 mm），面板间距 3 mm 与网格间隔一致；多面板字号保持 7/8 pt。",
"lang": "R",
"task": "layout",
"task_zh": "拼图",
"task_en": "Layout",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "n_cols",
"value": "4"
},
{
"name": "alpha_sig",
"value": "0.05"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/layout/house-small-multiples/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-small-multiples/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-small-multiples/plot.R"
},
{
"name": "data.csv",
"path": "figures/layout/house-small-multiples/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-small-multiples/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-small-multiples/data.csv"
},
{
"name": "make_data.R",
"path": "figures/layout/house-small-multiples/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/layout/house-small-multiples/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-small-multiples/make_data.R"
}
],
"dir": "figures/layout/house-small-multiples",
"preview": "figures/layout/house-small-multiples/preview.png",
"docs_preview": "previews/house-small-multiples.png",
"code": "figures/layout/house-small-multiples/plot.R",
"data": "figures/layout/house-small-multiples/data.csv",
"data_files": [
"figures/layout/house-small-multiples/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-small-multiples/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/layout/house-small-multiples/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/layout/house-small-multiples",
"code_text": "# House-style small multiples: shared axes, one region per panel, trend ± s.e. per decade in the panel.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nn_cols <- 4\nalpha_sig <- 0.05\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nregions <- unique(df$region)\ndf$region <- factor(df$region, levels = regions)\npal <- pv_palette(\"house\")\ngrey <- pv_palette(\"house_grey\")\n\nstars <- function(p) if (p < 0.001) \"***\" else if (p < 0.01) \"**\" else if (p < 0.05) \"*\" else \" (n.s.)\"\ntr <- do.call(rbind, lapply(regions, function(r) {\n s <- summary(stats::lm(anomaly_c ~ I(year / 10), data = df[df$region == r, ]))\n b <- stats::coef(s)[2, ]\n data.frame(region = factor(r, levels = regions), slope = b[[1]], se = b[[2]], p = b[[4]])\n}))\ntr$col <- ifelse(tr$p >= alpha_sig, grey[[\"mid\"]], ifelse(tr$slope > 0, pal[[\"red\"]], pal[[\"blue\"]]))\n# sign of the slope as printed (2 decimals): no sign when it rounds to zero\nsign_of <- function(x) ifelse(round(x, 2) > 0, \"+\", ifelse(round(x, 2) < 0, \"\\u2212\", \"\"))\ntr$lab <- sprintf(\"%s%.2f \\u00b1 %.2f \\u00b0C per decade%s\", sign_of(tr$slope), abs(tr$slope),\n tr$se, vapply(tr$p, stars, character(1)))\ndf$col <- tr$col[match(df$region, tr$region)]\ny_lim <- c(floor(min(df$anomaly_c) * 2) / 2, ceiling(max(df$anomaly_c) * 2) / 2 + 0.9)\nx_lim <- range(df$year) + c(-1, 1)\n\np <- ggplot(df, aes(year, anomaly_c)) +\n geom_hline(yintercept = 0, linetype = \"22\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]]) +\n geom_line(colour = grey[[\"mid\"]], linewidth = pv_house_lw(\"minor\")) +\n geom_smooth(aes(colour = col, fill = col), method = \"lm\", formula = y ~ x, linewidth = pv_house_lw(\"emph\"),\n alpha = 0.2) +\n geom_text(data = tr, aes(x = x_lim[1] + 1.5, y = y_lim[2] - 0.1, label = region), hjust = 0, vjust = 1,\n size = pv_pt2size(7), fontface = \"bold\", colour = \"black\") +\n geom_text(data = tr, aes(x = x_lim[1] + 1.5, y = y_lim[2] - 0.5, label = lab, colour = col), hjust = 0,\n vjust = 1, size = pv_pt2size(7)) +\n facet_wrap(~region, ncol = n_cols) +\n scale_colour_identity() +\n scale_fill_identity() +\n scale_x_continuous(limits = x_lim, breaks = seq(1990, 2020, 10), expand = c(0, 0)) +\n scale_y_continuous(limits = y_lim, breaks = seq(-1, 2, 1), expand = c(0, 0),\n labels = function(x) gsub(\"-\", \"\\u2212\", format(x))) +\n labs(x = \"Year\", y = \"Temperature anomaly (\\u00b0C)\") +\n theme_house() +\n # same 0.5 pt black frame as the single-panel examples (stated here so a facet theme cannot drift)\n theme(panel.border = element_rect(fill = NA, colour = \"black\", linewidth = pv_house_lw(\"frame\")),\n strip.text = element_blank(), panel.spacing.x = unit(HOUSE_GAP_MM, \"mm\"), panel.spacing.y = unit(HOUSE_GAP_MM, \"mm\"))\n\npv_save_house(p, \"figure\", cells = \"4x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "small multiples with in-panel trends (house style)\n小多图与面板内趋势（house 风格）\nhouse-small-multiples\n\nlayout\n拼图\nlayout\n拼图\nlayout\n同一指标在多个地区或类别上并排比较时用；共享坐标轴、只在外侧写刻度，每个面板左上写名称和线性趋势 ± s.e.（含显著性星号），显著上升红色、下降蓝色、不显著灰色。\nplot.r 顶部 n_cols 为每行面板数；alpha_sig 为着色的显著性阈值。颜色取 pv_palette(\"house\")；文字字号写成印刷 pt（pv_pt2size），每个小面板约占 1 格，整图 4×2 格（183 × 89 mm），面板间距 3 mm 与网格间隔一致；多面板字号保持 7/8 pt。\nsmall-multiples facet trend time-series house-style\nregion 面板分组（字符串） year 年份（x 轴） anomaly_c 数值（此例为温度距平 °c）"
},
{
"title": "Mantel test plot",
"title_zh": "Mantel 检验图",
"slug": "mantel-plot",
"category": "microbiome-ecology",
"tags": [
"mantel",
"environment",
"correlation"
],
"packages": [
"ggplot2",
"vegan"
],
"data_columns": {
"var_a": "环境变量或组学距离名（字符串）",
"var_b": "配对的环境变量（字符串）",
"r": "环境变量之间的 Pearson 相关；Mantel 行留空（数值）",
"p": "相关或 Mantel 的 p 值（数值）",
"mantel_r": "Mantel r；环境相关行留空（数值）"
},
"when_to_use": "同时看环境因子之间的相关，以及它们与组学距离的 Mantel 关系时用。",
"customize": "Toggle `show_env_heatmap` (default `TRUE`) and `show_links` (default `TRUE`) in `plot.R`, setting `p_cut` (default 0.05) and `link_p_only` (default `TRUE`) to filter lines alongside a hard-coded absolute `mantel_r` threshold of 0.30; provide `var_a`, `var_b`, `r`, `p`, and `mantel_r` columns in `data.csv`.",
"lang": "R",
"task": "microbiome",
"task_zh": "微生物/生态",
"task_en": "Microbiome & ecology",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "p_cut",
"value": "0.05"
},
{
"name": "show_env_heatmap",
"value": "TRUE"
},
{
"name": "show_links",
"value": "TRUE"
},
{
"name": "link_p_only",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/microbiome-ecology/mantel-plot/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/mantel-plot/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/mantel-plot/plot.R"
},
{
"name": "data.csv",
"path": "figures/microbiome-ecology/mantel-plot/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/mantel-plot/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/mantel-plot/data.csv"
},
{
"name": "make_data.R",
"path": "figures/microbiome-ecology/mantel-plot/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/mantel-plot/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/mantel-plot/make_data.R"
}
],
"dir": "figures/microbiome-ecology/mantel-plot",
"preview": "figures/microbiome-ecology/mantel-plot/preview.png",
"docs_preview": "previews/mantel-plot.png",
"code": "figures/microbiome-ecology/mantel-plot/plot.R",
"data": "figures/microbiome-ecology/mantel-plot/data.csv",
"data_files": [
"figures/microbiome-ecology/mantel-plot/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/mantel-plot/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/mantel-plot/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/microbiome-ecology/mantel-plot",
"code_text": "# Environment correlation triangle with Mantel links to omics distances (house style).\n# Heatmap and links on house_div; omics names written at the link ends.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\np_cut <- 0.05\nshow_env_heatmap <- TRUE\nshow_links <- TRUE\nlink_p_only <- TRUE\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nenv <- df[is.na(df$mantel_r), , drop = FALSE]\nman <- df[!is.na(df$mantel_r), , drop = FALSE]\n\nenv_names <- unique(c(env$var_a, env$var_b))\n# keep first-seen order from the file\nenv_names <- unique(c(env$var_a, env$var_b))\nomics <- unique(man$var_a)\n\n# mirror the triangle\nswap <- env[env$var_a != env$var_b, ]\nswap <- data.frame(var_a = swap$var_b, var_b = swap$var_a, r = swap$r, p = swap$p, mantel_r = NA_real_, stringsAsFactors = FALSE)\nenv_full <- rbind(env, swap)\nenv_full$x <- match(env_full$var_b, env_names)\nenv_full$y <- match(env_full$var_a, env_names)\n# lower triangle including diagonal (y >= x in a flipped axis)\ntri <- env_full[env_full$y >= env_full$x, , drop = FALSE]\n\nif (isTRUE(link_p_only)) man <- man[man$p < p_cut, , drop = FALSE]\n# Significant Mantel r values are all positive, so a [-1, 1] scale piled every\n# link on the orange end. Keep the stronger links and stretch those colours\n# across the diverging palette so neighbouring curves can be told apart.\nif (nrow(man)) man <- man[abs(man$mantel_r) >= 0.30, , drop = FALSE]\nman$x <- length(env_names) + 0.35\nman$xend <- length(env_names) + 2.4\nman$y <- match(man$var_b, env_names)\nom_y <- seq(1, length(env_names), length.out = length(omics))\nnames(om_y) <- omics\nman$yend <- om_y[man$var_a]\nman$sig <- ifelse(man$p < 0.01, \"p < 0.01\", \"p < 0.05\")\n\ncols_div <- pv_palette(\"house_div\")\ngrey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\nmantel_lim <- if (nrow(man)) range(man$mantel_r) else c(-1, 1)\nmantel_breaks <- if (nrow(man)) signif(c(mantel_lim[1], mean(mantel_lim), mantel_lim[2]), 2) else c(-1, 0, 1)\n\np <- ggplot2::ggplot()\nif (isTRUE(show_env_heatmap)) {\n p <- p + ggplot2::geom_tile(\n data = tri,\n ggplot2::aes(x, y, fill = r),\n colour = \"white\", linewidth = 0.15\n )\n}\nif (isTRUE(show_links) && nrow(man)) {\n p <- p + ggplot2::geom_curve(\n data = man,\n ggplot2::aes(x = x, y = y, xend = xend, yend = yend, colour = mantel_r, linewidth = abs(mantel_r), linetype = sig),\n curvature = 0.12\n )\n}\nom_df <- data.frame(name = omics, x = length(env_names) + 2.55, y = om_y[omics], stringsAsFactors = FALSE)\np <- p +\n ggplot2::geom_point(data = om_df, ggplot2::aes(x, y), shape = HOUSE_POINT$shape, size = HOUSE_POINT$size,\n stroke = HOUSE_POINT$stroke, colour = HOUSE_POINT$colour, fill = grey[[\"dark\"]]) +\n ggplot2::geom_text(\n data = om_df, ggplot2::aes(x + 0.45, y, label = name),\n hjust = 0, size = pv_pt2size(7), colour = \"#1A1A1A\", family = house_family()\n ) +\n ggplot2::scale_fill_gradientn(\n colours = cols_div, limits = c(-1, 1), name = \"Pearson r\", na.value = grey[[\"light\"]],\n breaks = c(-1, 0, 1)\n ) +\n ggplot2::scale_colour_gradientn(\n colours = cols_div, limits = mantel_lim, name = \"Mantel r\",\n breaks = mantel_breaks\n ) +\n ggplot2::scale_linewidth(range = c(0.3, 1.0), guide = \"none\") +\n ggplot2::scale_linetype_manual(values = c(\"p < 0.01\" = \"solid\", \"p < 0.05\" = \"dashed\"), name = NULL) +\n ggplot2::scale_x_continuous(\n breaks = seq_along(env_names), labels = env_names,\n expand = ggplot2::expansion(add = c(0.55, 4.6))\n ) +\n ggplot2::scale_y_continuous(breaks = seq_along(env_names), labels = env_names, expand = ggplot2::expansion(add = 0.45)) +\n ggplot2::labs(x = NULL, y = NULL, caption = footnote) +\n ggplot2::guides(\n fill = ggplot2::guide_colourbar(\n title.position = \"top\", title.hjust = 0.5,\n barwidth = ggplot2::unit(20, \"mm\"), barheight = ggplot2::unit(2, \"mm\"),\n order = 1\n ),\n colour = ggplot2::guide_colourbar(\n title.position = \"top\", title.hjust = 0.5,\n barwidth = ggplot2::unit(20, \"mm\"), barheight = ggplot2::unit(2, \"mm\"),\n order = 2\n ),\n linetype = ggplot2::guide_legend(order = 3, nrow = 2)\n ) +\n theme_house() +\n ggplot2::theme(\n axis.text.x = ggplot2::element_text(angle = 90, hjust = 1, vjust = 0.5, size = 7),\n axis.text.y = ggplot2::element_text(size = 7),\n plot.margin = ggplot2::margin(1, 1, 1, 1, \"mm\"),\n legend.margin = ggplot2::margin(0, 0, 0, 0),\n plot.caption = ggplot2::element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = ggplot2::margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\",\n legend.position = \"bottom\",\n legend.box = \"horizontal\",\n legend.box.spacing = ggplot2::unit(2, \"mm\"),\n legend.spacing.x = ggplot2::unit(4, \"mm\"),\n panel.border = ggplot2::element_blank(),\n axis.line = ggplot2::element_blank(),\n axis.ticks = ggplot2::element_blank()\n ) +\n ggplot2::coord_fixed(clip = \"off\")\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "mantel test plot\nmantel 检验图\nmantel-plot\n\nmicrobiome-ecology\n微生物与生态\nmicrobiome\n微生物/生态\nmicrobiome & ecology\n同时看环境因子之间的相关，以及它们与组学距离的 mantel 关系时用。\ntoggle `show_env_heatmap` (default `true`) and `show_links` (default `true`) in `plot.r`, setting `p_cut` (default 0.05) and `link_p_only` (default `true`) to filter lines alongside a hard-coded absolute `mantel_r` threshold of 0.30; provide `var_a`, `var_b`, `r`, `p`, and `mantel_r` columns in `data.csv`.\nmantel environment correlation\nvar_a 环境变量或组学距离名（字符串） var_b 配对的环境变量（字符串） r 环境变量之间的 pearson 相关；mantel 行留空（数值） p 相关或 mantel 的 p 值（数值） mantel_r mantel r；环境相关行留空（数值）"
},
{
"title": "Rarefaction curve",
"title_zh": "稀释曲线",
"slug": "rarefaction",
"category": "microbiome-ecology",
"tags": [
"rarefaction",
"richness",
"microbiome"
],
"packages": [
"ggplot2",
"vegan"
],
"data_columns": {
"sample": "样品编号（字符串）",
"group": "生境或处理（字符串）",
"depth": "抽平深度，reads（整数）",
"richness": "该深度下的期望物种丰富度（数值）"
},
"when_to_use": "比较各组物种丰富度是否随测序深度趋于饱和时用。",
"customize": "Toggle `show_individuals` (default `TRUE`) and `show_ribbon` (default `TRUE`) in `plot.R`, modifying `group_order` (default c(\"Forest\", \"Cropland\", \"Grassland\", \"Wetland\")) to set colors; fill `sample`, `group`, `depth`, and `richness` columns in `data.csv`.",
"lang": "R",
"task": "microbiome",
"task_zh": "微生物/生态",
"task_en": "Microbiome & ecology",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_individuals",
"value": "TRUE"
},
{
"name": "show_ribbon",
"value": "TRUE"
},
{
"name": "group_order",
"value": "c(\"Forest\", \"Cropland\", \"Grassland\", \"Wetland\")"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/microbiome-ecology/rarefaction/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/rarefaction/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rarefaction/plot.R"
},
{
"name": "data.csv",
"path": "figures/microbiome-ecology/rarefaction/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/rarefaction/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rarefaction/data.csv"
},
{
"name": "make_data.R",
"path": "figures/microbiome-ecology/rarefaction/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/rarefaction/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rarefaction/make_data.R"
}
],
"dir": "figures/microbiome-ecology/rarefaction",
"preview": "figures/microbiome-ecology/rarefaction/preview.png",
"docs_preview": "previews/rarefaction.png",
"code": "figures/microbiome-ecology/rarefaction/plot.R",
"data": "figures/microbiome-ecology/rarefaction/data.csv",
"data_files": [
"figures/microbiome-ecology/rarefaction/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rarefaction/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rarefaction/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/microbiome-ecology/rarefaction",
"code_text": "# Rarefaction curves by group (house style), with a mean +/- SD ribbon. Group names written at the\n# right end of each mean curve, just outside the frame. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_individuals <- TRUE\nshow_ribbon <- TRUE\ngroup_order <- c(\"Forest\", \"Cropland\", \"Grassland\", \"Wetland\")\nfootnote <- \"Simulated data;\\nnot biological results\"\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_order)\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\ncols <- stats::setNames(unname(hp[seq_along(group_order)]), group_order)\nname_cols <- stats::setNames(ifelse(cols %in% hp[c(\"orange\", \"sky\", \"gold\")], \"#1A1A1A\", cols), names(cols))\n\nsumm <- stats::aggregate(richness ~ group + depth, df, function(z) c(mean = mean(z), sd = stats::sd(z)))\nsumm <- do.call(data.frame, summ)\nnames(summ)[3:4] <- c(\"mean\", \"sd\")\nsumm$ymin <- pmax(0, summ$mean - summ$sd)\nsumm$ymax <- summ$mean + summ$sd\nends <- summ[summ$depth == max(summ$depth), , drop = FALSE]\n\np <- ggplot()\nif (isTRUE(show_ribbon)) {\n p <- p + geom_ribbon(data = summ, aes(depth, ymin = ymin, ymax = ymax, fill = group),\n alpha = 0.18, colour = NA)\n}\nif (isTRUE(show_individuals)) {\n p <- p + geom_line(data = df, aes(depth, richness, group = sample, colour = group),\n linewidth = pv_house_lw(\"minor\"), alpha = 0.45)\n}\np <- p +\n geom_line(data = summ, aes(depth, mean, colour = group), linewidth = pv_house_lw(\"main\")) +\n geom_text(data = ends, aes(Inf, mean, label = group), hjust = -0.15, size = pv_pt2size(7),\n colour = name_cols[as.character(ends$group)], family = house_family()) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_x_continuous(breaks = function(l) pretty(l, n = 2),\n labels = function(x) format(x, big.mark = \",\", scientific = FALSE, trim = TRUE)) +\n coord_cartesian(clip = \"off\") +\n labs(x = \"Reads\", y = \"Expected richness\", caption = footnote) +\n theme_house() +\n theme(plot.margin = margin(1, 13, 1, 1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "rarefaction curve\n稀释曲线\nrarefaction\n\nmicrobiome-ecology\n微生物与生态\nmicrobiome\n微生物/生态\nmicrobiome & ecology\n比较各组物种丰富度是否随测序深度趋于饱和时用。\ntoggle `show_individuals` (default `true`) and `show_ribbon` (default `true`) in `plot.r`, modifying `group_order` (default c(\"forest\", \"cropland\", \"grassland\", \"wetland\")) to set colors; fill `sample`, `group`, `depth`, and `richness` columns in `data.csv`.\nrarefaction richness microbiome\nsample 样品编号（字符串） group 生境或处理（字符串） depth 抽平深度，reads（整数） richness 该深度下的期望物种丰富度（数值）"
},
{
"title": "RDA biplot",
"title_zh": "RDA 双序图",
"slug": "rda-biplot",
"category": "microbiome-ecology",
"tags": [
"rda",
"biplot",
"ordination",
"environment"
],
"packages": [
"ggplot2",
"vegan",
"ggrepel"
],
"data_columns": {
"sample": "样方编号（字符串）；data.csv 与 data_env.csv 用它对齐",
"group": "生境分组（字符串，只在 data.csv）",
"taxon": "物种名（字符串）",
"abundance": "该样方该物种的个体计数（非负整数）",
"pH": "土壤 pH（数值，data_env.csv）",
"Moisture": "土壤含水量，百分数（数值，data_env.csv）",
"Nitrogen": "全氮，g/kg（数值，data_env.csv）",
"Temp": "生长季均温，摄氏度（数值，data_env.csv）",
"OrganicC": "有机碳，百分数（数值，data_env.csv）"
},
"when_to_use": "样方群落要同时看生境分组和几个环境因子的方向时用。Use when sites should be ordinated with environmental arrows on the same RDA axes.",
"customize": "Adjust `scaling` (default 2) and `arrow_frac` (default 1.10) in `plot.R` to scale site points and arrow lengths; supply `sample`, `group`, `taxon`, and `abundance` columns in `data.csv`, and numeric environmental columns in `data_env.csv`, drawing labels via `ggrepel` with a fixed seed.",
"lang": "R",
"task": "microbiome",
"task_zh": "微生物/生态",
"task_en": "Microbiome & ecology",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
},
{
"name": "footnote",
"value": "\"Simulated data for illustration; not biological results\""
},
{
"name": "scaling",
"value": "2"
},
{
"name": "arrow_frac",
"value": "1.10"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/microbiome-ecology/rda-biplot/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/rda-biplot/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rda-biplot/plot.R"
},
{
"name": "data.csv",
"path": "figures/microbiome-ecology/rda-biplot/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/rda-biplot/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rda-biplot/data.csv"
},
{
"name": "make_data.R",
"path": "figures/microbiome-ecology/rda-biplot/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/rda-biplot/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rda-biplot/make_data.R"
},
{
"name": "data_env.csv",
"path": "figures/microbiome-ecology/rda-biplot/data_env.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/rda-biplot/data_env.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rda-biplot/data_env.csv"
}
],
"dir": "figures/microbiome-ecology/rda-biplot",
"preview": "figures/microbiome-ecology/rda-biplot/preview.png",
"docs_preview": "previews/rda-biplot.png",
"code": "figures/microbiome-ecology/rda-biplot/plot.R",
"data": "figures/microbiome-ecology/rda-biplot/data.csv",
"data_files": [
"figures/microbiome-ecology/rda-biplot/data.csv",
"figures/microbiome-ecology/rda-biplot/data_env.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rda-biplot/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/rda-biplot/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/microbiome-ecology/rda-biplot",
"code_text": "# RDA biplot of sites and environmental arrows. Reads the two CSVs only.\n# House style: sites filled by group, group names written above each group, black arrows.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\ngrey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\n\n# --- adjustable ---\nscaling <- 2\narrow_frac <- 1.10\n# ------------------\n\ncomm_df <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nenv_df <- utils::read.csv(\"data_env.csv\", stringsAsFactors = FALSE)\nsamples <- unique(comm_df$sample)\ntaxa <- unique(comm_df$taxon)\ncomm <- matrix(0, length(samples), length(taxa), dimnames = list(samples, taxa))\ncomm[cbind(match(comm_df$sample, samples), match(comm_df$taxon, taxa))] <- comm_df$abundance\nenv_df <- env_df[match(samples, env_df$sample), , drop = FALSE]\ngroup <- comm_df$group[match(samples, comm_df$sample)]\nenv <- env_df[, vapply(env_df, is.numeric, logical(1)), drop = FALSE]\n\ncomm_h <- vegan::decostand(comm, method = \"hellinger\")\nord <- vegan::rda(comm_h ~ ., data = env)\neig <- vegan::eigenvals(ord)\npct <- 100 * eig[seq_len(2)] / sum(eig)\nstopifnot(all(is.finite(pct)))\n\nsite_sc <- as.data.frame(vegan::scores(ord, display = \"sites\", choices = 1:2, scaling = scaling))\nbp_sc <- as.data.frame(vegan::scores(ord, display = \"bp\", choices = 1:2, scaling = scaling))\nnames(site_sc) <- c(\"RDA1\", \"RDA2\")\nnames(bp_sc) <- c(\"RDA1\", \"RDA2\")\nsite_sc$group <- factor(stats::setNames(group, samples)[rownames(site_sc)],\n levels = c(\"Forest\", \"Meadow\", \"Marsh\"))\nsite_r <- max(sqrt(site_sc$RDA1^2 + site_sc$RDA2^2))\nbp_r <- max(sqrt(bp_sc$RDA1^2 + bp_sc$RDA2^2))\narrow_mul <- arrow_frac * site_r / bp_r\npretty <- c(pH = \"pH\", Moisture = \"Moisture\", Nitrogen = \"Nitrogen\", Temp = \"Temp\", OrganicC = \"Organic C\")\narrows <- data.frame(\n lab = unname(pretty[rownames(bp_sc)]),\n x = bp_sc$RDA1 * arrow_mul,\n y = bp_sc$RDA2 * arrow_mul,\n stringsAsFactors = FALSE\n)\n# Label anchor sits just past the tip; hjust/vjust push the glyphs further outward.\nlab_size <- pv_pt2size(7)\nstretch <- 1.10\narrows$lx <- arrows$x * stretch\narrows$ly <- arrows$y * stretch\narrows$hjust <- ifelse(arrows$x >= 0, 0, 1)\narrows$vjust <- ifelse(arrows$y >= 0, 0, 1)\n# Temp's label sits on the arrowhead. Shift it down-left, off the tip.\n# Nitrogen is left where it is.\ntemp_pull <- arrows$lab == \"Temp\"\narrows$lx[temp_pull] <- arrows$lx[temp_pull] - 0.11\narrows$ly[temp_pull] <- arrows$ly[temp_pull] - 0.08\npanel_mm <- 47\nlim <- max(abs(c(site_sc$RDA1, site_sc$RDA2, arrows$lx, arrows$ly))) * 1.15\nfor (step in seq_len(5)) {\n mm_per <- panel_mm / (2 * lim)\n tw <- 0.52 * nchar(arrows$lab) * lab_size / mm_per\n th <- lab_size / mm_per\n xmin <- ifelse(arrows$hjust == 0, arrows$lx, arrows$lx - tw)\n xmax <- ifelse(arrows$hjust == 0, arrows$lx + tw, arrows$lx)\n ymin <- ifelse(arrows$vjust == 0, arrows$ly, arrows$ly - th)\n ymax <- ifelse(arrows$vjust == 0, arrows$ly + th, arrows$ly)\n lim <- max(abs(c(\n site_sc$RDA1, site_sc$RDA2, arrows$x, arrows$y, xmin, xmax, ymin, ymax\n ))) * 1.08\n}\npad <- 1 / (panel_mm / (2 * lim))\ncollide <- FALSE\nn_lab <- nrow(arrows)\nif (n_lab > 1) {\n for (i in seq_len(n_lab - 1)) {\n for (j in (i + 1):n_lab) {\n hit <- xmax[i] + pad > xmin[j] - pad && xmax[j] + pad > xmin[i] - pad &&\n ymax[i] + pad > ymin[j] - pad && ymax[j] + pad > ymin[i] - pad\n if (hit) collide <- TRUE\n }\n }\n}\nif (collide) lim <- lim * 1.06\n# Fixed square window: arrows reach past the site clouds, labels sit beyond the tips.\nlim <- max(abs(c(site_sc$RDA1, site_sc$RDA2, arrows$x, arrows$y))) * 1.6\nif (collide) {\n # Fixed seed and iteration cap, no time cap (ggrepel defaults max.time to 0.5 s),\n # so the layout does not depend on machine speed.\n label_layer <- ggrepel::geom_text_repel(\n data = arrows,\n ggplot2::aes(x = x, y = y, label = lab, hjust = hjust, vjust = vjust),\n nudge_x = arrows$lx - arrows$x,\n nudge_y = arrows$ly - arrows$y,\n size = lab_size, family = house_family(),\n colour = \"#1A1A1A\",\n min.segment.length = 0,\n segment.size = 0.25,\n segment.colour = \"#1A1A1A\",\n force = 0.4,\n force_pull = 0.2,\n box.padding = 0.2,\n point.padding = 0.05,\n max.overlaps = Inf,\n max.iter = 5000, max.time = Inf,\n seed = 4,\n xlim = c(-lim, lim),\n ylim = c(-lim, lim),\n show.legend = FALSE\n )\n} else {\n label_layer <- ggplot2::geom_text(\n data = arrows,\n ggplot2::aes(x = lx, y = ly, label = lab, hjust = hjust, vjust = vjust),\n size = lab_size, family = house_family(),\n colour = \"#1A1A1A\"\n )\n}\npal <- stats::setNames(pv_palette(\"house\")[seq_len(nlevels(site_sc$group))], levels(site_sc$group))\n# Group text keeps its colour only at >= 3:1 contrast on white.\nlab_col <- stats::setNames(ifelse(vapply(pal, function(h) {\n v <- grDevices::col2rgb(h)[, 1] / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n 1.05 / (sum(c(0.2126, 0.7152, 0.0722) * v) + 0.05) < 3\n }, logical(1)), \"#1A1A1A\", pal), names(pal))\ngrp_lab <- do.call(rbind, lapply(split(site_sc, site_sc$group), function(d) {\n # Groups centred below the origin are named under their lowest point.\n up <- mean(d$RDA2) >= 0\n i <- if (up) which.max(d$RDA2) else which.min(d$RDA2)\n data.frame(group = d$group[i], x = d$RDA1[i], y = d$RDA2[i], vj = if (up) -0.9 else 0.5)\n}))\ngrp_lab$col <- lab_col[as.character(grp_lab$group)]\n# Fixed text, no repel: arrow names sit just past their tips, pushed outward.\n# Two tips on the same side closer than 0.3 in y split above and below.\narrows$tx <- arrows$x * 1.06\narrows$ty <- arrows$y * 1.06\narrows$hj <- ifelse(arrows$x >= 0, -0.05, 1.05)\narrows$vj <- 0.5\n# Near-vertical arrows put their name to the right of the tip, clear of the arrow and\n# beyond the vertical zero line (group names below the origin run left instead).\nsteep <- abs(arrows$x) < 0.25 * abs(arrows$y)\narrows$hj[steep] <- -0.15\narrows$vj[steep] <- 0.5\nfor (i in seq_len(nrow(arrows))) {\n for (j in seq_len(nrow(arrows))) {\n if (i != j && !steep[i] && !steep[j] && sign(arrows$x[i]) == sign(arrows$x[j]) && abs(arrows$y[i] - arrows$y[j]) < 0.3 * lim) {\n arrows$vj[i] <- if (arrows$y[i] > arrows$y[j]) 0 else 1\n }\n }\n}\n# Names above a group run away from the vertical zero line, ending at the top point.\ngrp_lab$hj <- ifelse(grp_lab$x <= 0, 1, 0)\nlow <- grp_lab$vj >= 0\ngrp_lab$hj[low] <- ifelse(grp_lab$x[low] <= 0, 1.15, -0.15)\n# Equal axes in a 2x1 cell: y spans the data, x widens on each side until the\n# arrow names (fixed size in mm, ~36 mm panel height) fit inside the panel.\nylim_v <- c(-1, 1) * max(abs(c(site_sc$RDA2, arrows$ty))) * 1.35\nu <- diff(ylim_v) / 36\nw_u <- 0.62 * nchar(arrows$lab) * 2.47 * u\nleft_ext <- ifelse(arrows$hj == 0.5, arrows$tx - w_u / 2, ifelse(arrows$hj > 0.5, arrows$tx - w_u, arrows$tx))\nright_ext <- ifelse(arrows$hj == 0.5, arrows$tx + w_u / 2, ifelse(arrows$hj > 0.5, arrows$tx, arrows$tx + w_u))\nxlim_v <- c(min(c(site_sc$RDA1, left_ext)) - 0.04 * diff(ylim_v), max(c(site_sc$RDA1, right_ext)) + 0.04 * diff(ylim_v))\n# Pad x evenly so the equal-axis panel fills the 2x1 cell instead of leaving side margins.\nx_target <- 2.1 * diff(ylim_v)\nif (diff(xlim_v) < x_target) xlim_v <- xlim_v + c(-1, 1) * (x_target - diff(xlim_v)) / 2\nall_lab_layer <- list(\n ggplot2::geom_text(data = arrows, ggplot2::aes(tx, ty, label = lab, hjust = hj, vjust = vj),\n size = lab_size, colour = \"#1A1A1A\", family = house_family()),\n ggplot2::geom_text(data = grp_lab, ggplot2::aes(x, y, label = group, hjust = hj, vjust = vj),\n size = lab_size, colour = grp_lab$col, family = house_family())\n)\n\np <- ggplot2::ggplot() +\n ggplot2::geom_hline(yintercept = 0, linewidth = pv_house_lw(\"ref\"), colour = grey[[\"light\"]]) +\n ggplot2::geom_vline(xintercept = 0, linewidth = pv_house_lw(\"ref\"), colour = grey[[\"light\"]]) +\n ggplot2::geom_segment(\n data = arrows,\n ggplot2::aes(x = 0, y = 0, xend = x, yend = y),\n arrow = grid::arrow(angle = 22, length = grid::unit(1.5, \"mm\"), type = \"closed\"),\n linewidth = pv_house_lw(\"main\"),\n colour = \"#1A1A1A\"\n ) +\n ggplot2::geom_point(\n data = site_sc,\n ggplot2::aes(RDA1, RDA2, fill = group),\n shape = HOUSE_POINT$shape, size = 1.6,\n stroke = HOUSE_POINT$stroke, colour = HOUSE_POINT$colour\n ) +\n all_lab_layer +\n ggplot2::scale_fill_manual(values = pal, guide = \"none\") +\n ggplot2::coord_equal(xlim = xlim_v, ylim = ylim_v, expand = FALSE) +\n ggplot2::scale_x_continuous(breaks = scales::breaks_pretty(n = 5)) +\n ggplot2::scale_y_continuous(breaks = scales::breaks_pretty(n = 3)) +\n ggplot2::labs(\n x = sprintf(\"RDA1 (%.1f%%)\", pct[[1]]),\n y = sprintf(\"RDA2 (%.1f%%)\", pct[[2]]),\n caption = footnote\n ) +\n theme_house() +\n ggplot2::theme(\n plot.caption = ggplot2::element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = ggplot2::margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\"\n )\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(sprintf(\"RDA1 %.1f%% RDA2 %.1f%%\", pct[[1]], pct[[2]]))\nmessage(\"wrote preview.png\")\n",
"search_text": "rda biplot\nrda 双序图\nrda-biplot\n\nmicrobiome-ecology\n微生物与生态\nmicrobiome\n微生物/生态\nmicrobiome & ecology\n样方群落要同时看生境分组和几个环境因子的方向时用。use when sites should be ordinated with environmental arrows on the same rda axes.\nadjust `scaling` (default 2) and `arrow_frac` (default 1.10) in `plot.r` to scale site points and arrow lengths; supply `sample`, `group`, `taxon`, and `abundance` columns in `data.csv`, and numeric environmental columns in `data_env.csv`, drawing labels via `ggrepel` with a fixed seed.\nrda biplot ordination environment\nsample 样方编号（字符串）；data.csv 与 data_env.csv 用它对齐 group 生境分组（字符串，只在 data.csv） taxon 物种名（字符串） abundance 该样方该物种的个体计数（非负整数） ph 土壤 ph（数值，data_env.csv） moisture 土壤含水量，百分数（数值，data_env.csv） nitrogen 全氮，g/kg（数值，data_env.csv） temp 生长季均温，摄氏度（数值，data_env.csv） organicc 有机碳，百分数（数值，data_env.csv）"
},
{
"title": "STAMP difference bar",
"title_zh": "STAMP 差异条形",
"slug": "stamp-diffbar",
"category": "microbiome-ecology",
"tags": [
"stamp",
"microbiome",
"difference"
],
"packages": [
"ggplot2"
],
"data_columns": {
"taxon": "类群名（字符串）",
"diff": "两组平均相对丰度之差，B 减 A（数值）",
"low": "95% 置信区间下界（数值）",
"high": "95% 置信区间上界（数值）",
"p": "双侧 p 值（数值）"
},
"when_to_use": "展示两组微生物类群平均比例差及置信区间时用。",
"customize": "Set `p_cut` (default 0.05) and toggle `show_ci` (default `TRUE`) and `label_p` (default `TRUE`) in `plot.R` to display confidence intervals and side statistics; fill `taxon`, `diff`, `low`, `high`, and `p` columns in `data.csv`.",
"lang": "R",
"task": "microbiome",
"task_zh": "微生物/生态",
"task_en": "Microbiome & ecology",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "p_cut",
"value": "0.05"
},
{
"name": "show_ci",
"value": "TRUE"
},
{
"name": "label_p",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/microbiome-ecology/stamp-diffbar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/stamp-diffbar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/stamp-diffbar/plot.R"
},
{
"name": "data.csv",
"path": "figures/microbiome-ecology/stamp-diffbar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/stamp-diffbar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/stamp-diffbar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/microbiome-ecology/stamp-diffbar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/stamp-diffbar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/stamp-diffbar/make_data.R"
}
],
"dir": "figures/microbiome-ecology/stamp-diffbar",
"preview": "figures/microbiome-ecology/stamp-diffbar/preview.png",
"docs_preview": "previews/stamp-diffbar.png",
"code": "figures/microbiome-ecology/stamp-diffbar/plot.R",
"data": "figures/microbiome-ecology/stamp-diffbar/data.csv",
"data_files": [
"figures/microbiome-ecology/stamp-diffbar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/stamp-diffbar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/stamp-diffbar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/microbiome-ecology/stamp-diffbar",
"code_text": "# STAMP-style mean-difference bars with 95% CI (house style). Taxa higher in B in red, higher in A\n# in blue (named in the panel corners); filled points have p below p_cut, open points do not;\n# the p value is written at the right. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\np_cut <- 0.05\nshow_ci <- TRUE\nlabel_p <- TRUE\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$taxon <- factor(df$taxon, levels = df$taxon[order(df$diff)])\ndf$direction <- ifelse(df$diff >= 0, \"higher in B\", \"higher in A\")\ndf$sig <- df$p < p_cut\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\ncols <- c(\"higher in A\" = hp[[\"blue\"]], \"higher in B\" = hp[[\"red\"]])\ndf$fill <- ifelse(df$sig, cols[df$direction], \"white\")\nfootnote <- sprintf(\"Filled points: p < %s. Simulated data for illustration; not biological results\", p_cut)\n\np <- ggplot(df, aes(diff, taxon, colour = direction)) +\n geom_vline(xintercept = 0, linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]])\nif (isTRUE(show_ci)) {\n p <- p + geom_errorbar(aes(xmin = low, xmax = high), orientation = \"y\", width = 0.3,\n linewidth = pv_house_lw(\"main\"))\n}\np <- p +\n geom_point(aes(fill = I(fill)), shape = 21, size = 1.8, stroke = 0.5) +\n annotate(\"text\", x = -Inf, y = Inf, hjust = -0.05, vjust = -0.6, label = \"Higher in A\",\n colour = hp[[\"blue\"]], size = pv_pt2size(7), family = house_family()) +\n annotate(\"text\", x = Inf, y = Inf, hjust = 1.05, vjust = -0.6, label = \"Higher in B\",\n colour = hp[[\"red\"]], size = pv_pt2size(7), family = house_family()) +\n scale_colour_manual(values = cols, guide = \"none\") +\n coord_cartesian(xlim = range(c(df$low, df$high)), clip = \"off\") +\n labs(x = \"Mean proportion difference (B - A)\", y = NULL, caption = footnote) +\n theme_house() +\n theme(plot.margin = margin(4, 1.5, 1, 1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\nif (isTRUE(label_p)) {\n x_p <- max(df$high) + 0.1 * diff(range(c(df$low, df$high))) # just right of the panel\n p <- p +\n geom_text(aes(x = x_p, label = ifelse(p < 0.001, \"<0.001\", sprintf(\"%.3f\", p))), colour = \"#1A1A1A\",\n size = pv_pt2size(7), hjust = 0, family = house_family()) +\n annotate(\"text\", x = x_p, y = Inf, hjust = 0, vjust = -0.6, label = \"p\",\n colour = \"#1A1A1A\", size = pv_pt2size(7), family = house_family()) +\n theme(plot.margin = margin(4, 10, 1, 1, \"mm\"))\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "stamp difference bar\nstamp 差异条形\nstamp-diffbar\n\nmicrobiome-ecology\n微生物与生态\nmicrobiome\n微生物/生态\nmicrobiome & ecology\n展示两组微生物类群平均比例差及置信区间时用。\nset `p_cut` (default 0.05) and toggle `show_ci` (default `true`) and `label_p` (default `true`) in `plot.r` to display confidence intervals and side statistics; fill `taxon`, `diff`, `low`, `high`, and `p` columns in `data.csv`.\nstamp microbiome difference\ntaxon 类群名（字符串） diff 两组平均相对丰度之差，b 减 a（数值） low 95% 置信区间下界（数值） high 95% 置信区间上界（数值） p 双侧 p 值（数值）"
},
{
"title": "Taxa bar with tree",
"title_zh": "带树的物种组成柱",
"slug": "taxa-tree-bar",
"category": "microbiome-ecology",
"tags": [
"microbiome",
"composition",
"dendrogram"
],
"packages": [
"ggtree",
"ggplot2",
"vegan",
"ape",
"patchwork"
],
"data_columns": {
"sample": "样品编号（字符串）",
"group": "样品分组（字符串）",
"taxon": "类群名（字符串）",
"abundance": "计数或丰度（数值）",
"tip": "与样品对应的树尖名（字符串）"
},
"when_to_use": "按样品聚类树的顺序展示类群相对丰度时用。",
"customize": "Toggle `relative` (default `TRUE`) normalisation in `plot.R`, modifying `group_order` (default c(\"Gut\", \"Oral\", \"Skin\", \"Soil\")) and `top_n` (default 12) while keeping at most six named taxa; provide `sample`, `group`, `taxon`, and `abundance` columns in `data.csv` alongside `tip` (only as an identifier, not read by plotting code).",
"lang": "R",
"task": "microbiome",
"task_zh": "微生物/生态",
"task_en": "Microbiome & ecology",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "relative",
"value": "TRUE"
},
{
"name": "top_n",
"value": "12"
},
{
"name": "group_order",
"value": "c(\"Gut\", \"Oral\", \"Skin\", \"Soil\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/microbiome-ecology/taxa-tree-bar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/taxa-tree-bar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/taxa-tree-bar/plot.R"
},
{
"name": "data.csv",
"path": "figures/microbiome-ecology/taxa-tree-bar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/taxa-tree-bar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/taxa-tree-bar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/microbiome-ecology/taxa-tree-bar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/microbiome-ecology/taxa-tree-bar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/taxa-tree-bar/make_data.R"
}
],
"dir": "figures/microbiome-ecology/taxa-tree-bar",
"preview": "figures/microbiome-ecology/taxa-tree-bar/preview.png",
"docs_preview": "previews/taxa-tree-bar.png",
"code": "figures/microbiome-ecology/taxa-tree-bar/plot.R",
"data": "figures/microbiome-ecology/taxa-tree-bar/data.csv",
"data_files": [
"figures/microbiome-ecology/taxa-tree-bar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/taxa-tree-bar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/microbiome-ecology/taxa-tree-bar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/microbiome-ecology/taxa-tree-bar",
"code_text": "# Sample clustering tree beside a stacked taxon bar, ordered by the tree (house style).\n# Tree branches carry the sample group; bars use the first six house colours plus grey Other.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\nlibrary(patchwork)\n\n# 可调参数 -----------------------------------------------------------------\nrelative <- TRUE\ntop_n <- 12\ngroup_order <- c(\"Gut\", \"Oral\", \"Skin\", \"Soil\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$group <- factor(df$group, levels = group_order)\n\nwide <- reshape(df[, c(\"sample\", \"taxon\", \"abundance\")], idvar = \"sample\", timevar = \"taxon\", direction = \"wide\")\nrownames(wide) <- wide$sample\nwide$sample <- NULL\nnames(wide) <- sub(\"^abundance\\\\.\", \"\", names(wide))\nmat <- as.matrix(wide)\nif (isTRUE(relative)) {\n mat <- mat / rowSums(mat)\n}\n# Bray-Curtis clustering\nbc <- vegan::vegdist(mat, method = \"bray\")\nhc <- stats::hclust(bc, method = \"average\")\ntr <- ape::as.phylo(hc)\n\ngrp <- unique(df[, c(\"sample\", \"group\")])\ngrp <- grp[match(tr$tip.label, grp$sample), ]\ngroups <- split(grp$sample, grp$group)\ntr <- ggtree::groupOTU(tr, groups, group_name = \"group\")\nhp <- pv_palette(\"house\")\ngrey <- pv_palette(\"house_grey\")\nfootnote <- \"Bray-Curtis distance, average linkage.\\nSimulated data for illustration; not biological results\"\n# Groups take the house colours not used by the taxa, so no colour means two things.\ngcols <- setNames(c(hp[c(\"gold\", \"magenta\", \"brown\")], grey[[\"dark\"]])[seq_along(group_order)], group_order)\n\np_tree <- ggtree::ggtree(tr, ggplot2::aes(colour = group), linewidth = pv_house_lw(\"main\")) +\n ggtree::geom_tiplab(ggplot2::aes(label = label), size = pv_pt2size(7), colour = \"#1A1A1A\",\n family = house_family(), offset = 0.01, align = FALSE) +\n ggplot2::scale_colour_manual(values = gcols, name = \"Group\", na.value = grey[[\"dark\"]],\n breaks = group_order) +\n ggplot2::scale_x_continuous(expand = ggplot2::expansion(mult = c(0.02, 0.18))) +\n theme_house() +\n ggplot2::theme(\n panel.border = ggplot2::element_blank(),\n axis.line = ggplot2::element_blank(),\n axis.text.x = ggplot2::element_blank(), axis.text.y = ggplot2::element_blank(),\n axis.ticks.x = ggplot2::element_blank(), axis.ticks.y = ggplot2::element_blank(),\n axis.line.x = ggplot2::element_blank(), axis.line.y = ggplot2::element_blank(),\n axis.title.x = ggplot2::element_blank(), axis.title.y = ggplot2::element_blank()\n ) +\n ggplot2::guides(colour = ggplot2::guide_legend(nrow = 1, override.aes = list(linewidth = 1.2)))\n\nyd <- p_tree$data[p_tree$data$isTip, c(\"label\", \"y\")]\nyd <- yd[order(yd$y), , drop = FALSE]\n\nmean_ab <- tapply(as.vector(mat), rep(colnames(mat), each = nrow(mat)), mean)\nrank_taxa <- names(sort(mean_ab, decreasing = TRUE))\n# At most six named taxa (the first six house colours); the rest fold into Other.\nn_keep <- min(6L, as.integer(top_n), length(rank_taxa))\nkeep <- rank_taxa[seq_len(n_keep)]\nlong <- as.data.frame(as.table(mat), stringsAsFactors = FALSE)\nnames(long) <- c(\"sample\", \"taxon\", \"abundance\")\nlong$taxon <- ifelse(long$taxon %in% keep, as.character(long$taxon), \"Other\")\nlong <- stats::aggregate(abundance ~ sample + taxon, long, sum)\ntax_levels <- c(keep, if (\"Other\" %in% long$taxon) \"Other\")\nlong$taxon <- factor(long$taxon, levels = tax_levels)\nnamed <- setdiff(as.character(tax_levels), \"Other\")\ntcols <- setNames(unname(hp[seq_along(named)]), named)\nif (\"Other\" %in% tax_levels) tcols[\"Other\"] <- grey[[\"light\"]]\n\nlong <- merge(long, yd, by.x = \"sample\", by.y = \"label\")\np_bar <- ggplot2::ggplot(long, ggplot2::aes(abundance, y, fill = taxon)) +\n ggplot2::geom_col(\n width = 0.8, orientation = \"y\", colour = NA,\n position = ggplot2::position_stack(reverse = TRUE)\n ) +\n ggplot2::scale_fill_manual(values = tcols, name = \"Taxon\") +\n ggplot2::scale_x_continuous(expand = c(0, 0), breaks = scales::breaks_pretty(n = 3)) +\n ggplot2::scale_y_continuous(limits = range(yd$y) + c(-0.5, 0.5), expand = c(0, 0)) +\n ggplot2::labs(x = if (isTRUE(relative)) \"Relative abundance\" else \"Abundance\", y = NULL) +\n theme_house() +\n ggplot2::theme(\n axis.text.y = ggplot2::element_blank(),\n axis.ticks.y = ggplot2::element_blank(),\n axis.line.y = ggplot2::element_blank()\n ) +\n ggplot2::guides(fill = ggplot2::guide_legend(ncol = 3, byrow = TRUE))\n\np <- (p_tree | p_bar) +\n patchwork::plot_layout(widths = c(0.8, 1.2), guides = \"collect\") +\n patchwork::plot_annotation(\n caption = footnote,\n theme = ggplot2::theme(\n text = ggplot2::element_text(family = house_family()),\n plot.caption = ggplot2::element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]], lineheight = 0.9,\n margin = ggplot2::margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\"\n )\n ) &\n ggplot2::theme(legend.position = \"bottom\", legend.box = \"vertical\",\n legend.box.just = \"left\", legend.justification = \"left\",\n legend.key.size = ggplot2::unit(3, \"mm\"), legend.margin = ggplot2::margin(0, 0, 0, 0))\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "taxa bar with tree\n带树的物种组成柱\ntaxa-tree-bar\n\nmicrobiome-ecology\n微生物与生态\nmicrobiome\n微生物/生态\nmicrobiome & ecology\n按样品聚类树的顺序展示类群相对丰度时用。\ntoggle `relative` (default `true`) normalisation in `plot.r`, modifying `group_order` (default c(\"gut\", \"oral\", \"skin\", \"soil\")) and `top_n` (default 12) while keeping at most six named taxa; provide `sample`, `group`, `taxon`, and `abundance` columns in `data.csv` alongside `tip` (only as an identifier, not read by plotting code).\nmicrobiome composition dendrogram\nsample 样品编号（字符串） group 样品分组（字符串） taxon 类群名（字符串） abundance 计数或丰度（数值） tip 与样品对应的树尖名（字符串）"
},
{
"title": "Chord diagram",
"title_zh": "弦图",
"slug": "chord",
"category": "network",
"tags": [
"chord",
"flow",
"network"
],
"packages": [
"circlize",
"ggplot2",
"ggplotify"
],
"data_columns": {
"source": "流出组（字符串）",
"target": "流入组（字符串）",
"value": "流量强度（数值）"
},
"when_to_use": "展示若干组别之间的定向流量或互作强度时用。",
"customize": "在 `plot.R` 调 `show_labels`（默认 `TRUE`）显隐名称，改 `link_alpha` 与 `directional`（默认 `TRUE`）；填 `data.csv` 的 `source`、`target`、`value`。仅留前五大组，其余并入 `Other`，不画 `Other` 到 `Other` 流量。",
"lang": "R",
"task": "network",
"task_zh": "网络",
"task_en": "Network",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_labels",
"value": "TRUE"
},
{
"name": "link_alpha",
"value": "0.55"
},
{
"name": "directional",
"value": "TRUE"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/network/chord/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/network/chord/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/chord/plot.R"
},
{
"name": "data.csv",
"path": "figures/network/chord/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/network/chord/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/chord/data.csv"
},
{
"name": "make_data.R",
"path": "figures/network/chord/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/network/chord/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/chord/make_data.R"
}
],
"dir": "figures/network/chord",
"preview": "figures/network/chord/preview.png",
"docs_preview": "previews/chord.png",
"code": "figures/network/chord/plot.R",
"data": "figures/network/chord/data.csv",
"data_files": [
"figures/network/chord/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/chord/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/chord/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/network/chord",
"code_text": "# Chord diagram of flows among groups (house style). circlize base graphics, wrapped with\n# ggplotify for pv_save_house(); text is Arial 7 pt via cex = pt / 12 (ggplotify replays on a\n# 12 pt device). Sector names take the sector colour when it is >= 3:1 on white, else #1A1A1A.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_labels <- TRUE\nlink_alpha <- 0.55\ndirectional <- TRUE\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nfam <- house_family()\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\ncex_pt <- function(pt) pt / 12\ngroups0 <- sort(unique(c(df$source, df$target)))\nw_src <- tapply(df$value, df$source, sum)\nw_tgt <- tapply(df$value, df$target, sum)\nscore <- vapply(groups0, function(g) sum(w_src[g], w_tgt[g], na.rm = TRUE), numeric(1))\n# More than six sectors tangle the ribbons: keep five named groups plus Other.\nif (length(groups0) > 6) {\n keep <- names(sort(score, decreasing = TRUE))[seq_len(5)]\n map_g <- function(g) if (g %in% keep) g else \"Other\"\n df$source <- vapply(df$source, map_g, character(1))\n df$target <- vapply(df$target, map_g, character(1))\n df <- stats::aggregate(value ~ source + target, df, sum)\n df <- df[df$source != df$target, , drop = FALSE]\n groups <- c(keep, \"Other\")\n pal <- c(unname(hp[seq_along(keep)]), grey[[\"light\"]])\n} else {\n groups <- groups0\n pal <- unname(hp[seq_along(groups)])\n}\ngrid_col <- stats::setNames(pal, groups)\nlabel_col <- ifelse(pal %in% c(hp[c(\"orange\", \"sky\", \"gold\")], grey[[\"light\"]]), \"#1A1A1A\", pal)\nnames(label_col) <- groups\ndf$source <- factor(df$source, levels = groups)\ndf$target <- factor(df$target, levels = groups)\n\ndraw <- function() {\n graphics::par(bg = \"white\", mar = c(0, 0, 0, 0), family = fam)\n circlize::circos.clear()\n circlize::chordDiagram(\n df[, c(\"source\", \"target\", \"value\")],\n grid.col = grid_col,\n transparency = 1 - link_alpha,\n directional = if (isTRUE(directional)) 1 else 0,\n direction.type = \"arrows\",\n link.arr.type = \"big.arrow\",\n annotationTrack = \"grid\",\n preAllocateTracks = list(track.height = 0.08),\n big.gap = 4,\n small.gap = 1,\n link.border = NA\n )\n if (isTRUE(show_labels)) {\n circlize::circos.track(\n track.index = 1, panel.fun = function(x, y) {\n circlize::circos.text(\n circlize::CELL_META$xcenter,\n circlize::CELL_META$ylim[1],\n circlize::CELL_META$sector.index,\n facing = \"inside\", niceFacing = TRUE,\n adj = c(0.5, 0), cex = cex_pt(7),\n col = label_col[[circlize::CELL_META$sector.index]]\n )\n }, bg.border = NA\n )\n }\n circlize::circos.clear()\n}\n\np <- ggplotify::as.ggplot(draw) +\n labs(caption = footnote) +\n theme(text = element_text(family = fam),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\", plot.background = element_rect(fill = \"white\", colour = NA))\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "chord diagram\n弦图\nchord\n\nnetwork\n网络\nnetwork\n网络\nnetwork\n展示若干组别之间的定向流量或互作强度时用。\n在 `plot.r` 调 `show_labels`（默认 `true`）显隐名称，改 `link_alpha` 与 `directional`（默认 `true`）；填 `data.csv` 的 `source`、`target`、`value`。仅留前五大组，其余并入 `other`，不画 `other` 到 `other` 流量。\nchord flow network\nsource 流出组（字符串） target 流入组（字符串） value 流量强度（数值）"
},
{
"title": "Correlation network",
"title_zh": "相关性网络",
"slug": "network",
"category": "network",
"tags": [
"network",
"correlation",
"community"
],
"packages": [
"ggraph",
"igraph",
"ggplot2"
],
"data_columns": {
"from": "边的起点节点（字符串）",
"to": "边的终点节点（字符串）",
"weight": "相关或边权，0 到 1（数值）",
"node": "data_nodes.csv 中的节点名（字符串）",
"community": "节点所属社区分组（字符串）"
},
"when_to_use": "看特征之间的相关边、边权和社区结构时用。",
"customize": "在 `plot.R` 调整 `weight_min` 过滤边，控制 `show_labels`（默认 `FALSE`）显隐节点名，设定 `colour_by` 着色方式；在 `data.csv` 填 `from`、`to`、`weight`，在 `data_nodes.csv` 填 `node`。",
"lang": "R",
"task": "network",
"task_zh": "网络",
"task_en": "Network",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "weight_min",
"value": "0.30"
},
{
"name": "show_labels",
"value": "FALSE"
},
{
"name": "colour_by",
"value": "\"community\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/network/network/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/network/network/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/network/plot.R"
},
{
"name": "data.csv",
"path": "figures/network/network/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/network/network/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/network/data.csv"
},
{
"name": "make_data.R",
"path": "figures/network/network/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/network/network/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/network/make_data.R"
},
{
"name": "data_nodes.csv",
"path": "figures/network/network/data_nodes.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/network/network/data_nodes.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/network/data_nodes.csv"
}
],
"dir": "figures/network/network",
"preview": "figures/network/network/preview.png",
"docs_preview": "previews/network.png",
"code": "figures/network/network/plot.R",
"data": "figures/network/network/data.csv",
"data_files": [
"figures/network/network/data.csv",
"figures/network/network/data_nodes.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/network/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/network/network/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/network/network",
"code_text": "# Correlation network (house style). Edge width is |weight|; node fill is community.\n# Reads data.csv and data_nodes.csv. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nweight_min <- 0.30\nshow_labels <- FALSE\ncolour_by <- \"community\" # community | none\n\nedges <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nnodes <- utils::read.csv(\"data_nodes.csv\", stringsAsFactors = FALSE)\nedges <- edges[edges$weight >= weight_min, , drop = FALSE]\n# drop isolated nodes after the threshold\nkeep <- unique(c(edges$from, edges$to))\nnodes <- nodes[nodes$node %in% keep, , drop = FALSE]\n\ng <- igraph::graph_from_data_frame(edges[, c(\"from\", \"to\", \"weight\")], directed = FALSE, vertices = nodes)\nigraph::V(g)$degree <- igraph::degree(g)\nif (colour_by == \"none\") {\n cols <- setNames(rep(pv_palette(\"house\")[[\"blue\"]], 4), c(\"C1\", \"C2\", \"C3\", \"C4\"))\n} else {\n cols <- setNames(unname(pv_palette(\"house\")[1:4]), c(\"C1\", \"C2\", \"C3\", \"C4\"))\n}\ngrey <- pv_palette(\"house_grey\")\nfootnote <- \"Simulated data for illustration; not biological results\"\n\nset.seed(1)\np <- ggraph::ggraph(g, layout = \"fr\") +\n ggraph::geom_edge_link(aes(width = weight), colour = grey[[\"ci\"]]) +\n ggraph::geom_node_point(aes(fill = community, size = degree), shape = 21,\n colour = HOUSE_POINT$colour, stroke = HOUSE_POINT$stroke) +\n ggraph::scale_edge_width(range = c(0.15, 0.9), guide = \"none\") +\n scale_fill_manual(values = cols, name = \"Community\") +\n scale_size(range = c(1.5, 3.4), guide = \"none\") +\n coord_cartesian(clip = \"off\") +\n labs(x = NULL, y = NULL, caption = footnote) +\n guides(fill = guide_legend(override.aes = list(size = HOUSE_POINT$size))) +\n theme_house() +\n theme(axis.line = element_blank(), panel.border = element_blank(),\n axis.text.x = element_blank(), axis.text.y = element_blank(), axis.ticks = element_blank(),\n panel.grid = element_blank(),\n legend.position = \"top\", legend.justification = \"left\",\n legend.margin = margin(0, 0, 0, 0), legend.box.spacing = unit(1, \"mm\"),\n plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\nif (isTRUE(show_labels)) {\n p <- p + ggraph::geom_node_text(aes(label = name), size = pv_pt2size(7), repel = TRUE,\n colour = \"#1A1A1A\", family = house_family())\n}\nif (colour_by == \"none\") {\n p <- p + guides(fill = \"none\")\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "correlation network\n相关性网络\nnetwork\n\nnetwork\n网络\nnetwork\n网络\nnetwork\n看特征之间的相关边、边权和社区结构时用。\n在 `plot.r` 调整 `weight_min` 过滤边，控制 `show_labels`（默认 `false`）显隐节点名，设定 `colour_by` 着色方式；在 `data.csv` 填 `from`、`to`、`weight`，在 `data_nodes.csv` 填 `node`。\nnetwork correlation community\nfrom 边的起点节点（字符串） to 边的终点节点（字符串） weight 相关或边权，0 到 1（数值） node data_nodes.csv 中的节点名（字符串） community 节点所属社区分组（字符串）"
},
{
"title": "Annotated phylogeny",
"title_zh": "分组着色系统树",
"slug": "phylo-tree",
"category": "phylogeny",
"tags": [
"phylogeny",
"ggtree",
"population"
],
"packages": [
"ggtree",
"ggplot2",
"ape",
"patchwork"
],
"data_columns": {
"tip": "子节点名；内部节点为 N 加编号（字符串）",
"parent": "父节点名（字符串）",
"length": "枝长（数值）",
"group": "叶节点群体；内部节点留空（字符串）",
"bootstrap": "进入该节点的支持率；叶节点和根留空（数值）"
},
"when_to_use": "按群体给分支上色，并在内部节点标出支持率时用。",
"customize": "layout 更改为 \"rectangular\"、\"circular\"、\"fan\" 或 \"dendrogram\"；show_bootstrap 设为 TRUE 时在足够长的分支上写入数值，bootstrap_min 默认 70；show_tip_bar 设为 FALSE 隐藏分支长度条面板，或 TRUE 为矩形或树状图布局添加面板；show_tip_label 设为 TRUE 或 FALSE 显示或隐藏末端标签。",
"lang": "R",
"task": "phylogeny",
"task_zh": "系统发育",
"task_en": "Phylogeny",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "layout",
"value": "\"rectangular\""
},
{
"name": "show_bootstrap",
"value": "TRUE"
},
{
"name": "bootstrap_min",
"value": "70"
},
{
"name": "show_tip_bar",
"value": "FALSE"
},
{
"name": "show_tip_label",
"value": "TRUE"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": null,
"downloads": [
{
"name": "plot.R",
"path": "figures/phylogeny/phylo-tree/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/phylogeny/phylo-tree/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/phylogeny/phylo-tree/plot.R"
},
{
"name": "data.csv",
"path": "figures/phylogeny/phylo-tree/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/phylogeny/phylo-tree/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/phylogeny/phylo-tree/data.csv"
},
{
"name": "make_data.R",
"path": "figures/phylogeny/phylo-tree/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/phylogeny/phylo-tree/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/phylogeny/phylo-tree/make_data.R"
}
],
"dir": "figures/phylogeny/phylo-tree",
"preview": "figures/phylogeny/phylo-tree/preview.png",
"docs_preview": "previews/phylo-tree.png",
"code": "figures/phylogeny/phylo-tree/plot.R",
"data": "figures/phylogeny/phylo-tree/data.csv",
"data_files": [
"figures/phylogeny/phylo-tree/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/phylogeny/phylo-tree/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/phylogeny/phylo-tree/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/phylogeny/phylo-tree",
"code_text": "# Annotated phylogeny (house style): branches coloured by population (house colours), bootstrap values\n# on well-supported branches, population names written as clade strips right of the tips (no legend).\n# The tree panel has no frame. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nlayout <- \"rectangular\" # rectangular | circular | fan | dendrogram\nshow_bootstrap <- TRUE\nbootstrap_min <- 70\nshow_tip_bar <- FALSE\nshow_tip_label <- TRUE\n\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\ngrp_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n# populations ordered by geography (mean sampling latitude, north -> south) on the geo palette\npop_geo <- stats::setNames(pv_palette(\"geo\"),\n c(\"Wild N\", \"Cultivar A\", \"Landrace W\", \"Landrace E\", \"Cultivar B\", \"Wild S\"))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\n\nedges_to_phylo <- function(df) {\n tip_names <- sort(setdiff(df$tip, df$parent))\n root <- setdiff(df$parent, df$tip)\n internals <- c(root, sort(setdiff(unique(df$parent), root)))\n ids <- setNames(seq_along(c(tip_names, internals)), c(tip_names, internals))\n edge <- cbind(unname(ids[df$parent]), unname(ids[df$tip]))\n bs_map <- setNames(df$bootstrap, df$tip)\n node_label <- bs_map[internals]\n node_label[is.na(node_label)] <- \"\"\n tr <- list(\n edge = edge,\n edge.length = df$length,\n tip.label = tip_names,\n node.label = as.character(node_label),\n Nnode = length(internals)\n )\n class(tr) <- \"phylo\"\n gmap <- setNames(df$group[match(tip_names, df$tip)], tip_names)\n gmap <- gmap[!is.na(gmap)]\n groups <- split(names(gmap), gmap)\n tr <- ggtree::groupOTU(tr, groups, group_name = \"group\")\n tr\n}\n\ntr <- edges_to_phylo(df)\nlay <- if (layout == \"dendrogram\") \"rectangular\" else layout\nbrlen <- if (layout == \"dendrogram\") \"none\" else \"branch.length\"\ngrp_cols <- c(North = hp[[\"blue\"]], South = hp[[\"red\"]], East = hp[[\"green\"]], West = hp[[\"purple\"]])\n\np <- ggtree::ggtree(tr, aes(colour = group), layout = lay, branch.length = brlen,\n linewidth = pv_house_lw(\"main\")) +\n scale_colour_manual(values = grp_cols, guide = \"none\", na.value = grey[[\"dark\"]]) +\n labs(x = if (layout == \"dendrogram\") NULL else \"Divergence\", caption = footnote) +\n theme_house() +\n theme(\n panel.border = element_blank(),\n axis.line.x = if (layout %in% c(\"rectangular\")) element_line(linewidth = pv_house_lw(\"frame\")) else element_blank(),\n axis.text.x = if (layout %in% c(\"rectangular\")) element_text() else element_blank(),\n axis.ticks.x = if (layout %in% c(\"rectangular\")) element_line() else element_blank(),\n axis.line.y = element_blank(),\n axis.text.y = element_blank(),\n axis.ticks.y = element_blank(),\n plot.margin = margin(1, 1.5, 1, 1, \"mm\")\n ) +\n caption_theme\n\nif (isTRUE(show_tip_label) && layout %in% c(\"rectangular\", \"dendrogram\")) {\n p <- p + ggtree::geom_tiplab(size = pv_pt2size(7), colour = \"#1A1A1A\", offset = 0.02, family = house_family())\n}\nif (isTRUE(show_tip_label) && layout %in% c(\"circular\", \"fan\")) {\n p <- p + ggtree::geom_tiplab2(size = pv_pt2size(7), colour = \"#1A1A1A\", offset = 0.02, family = house_family())\n}\nif (isTRUE(show_bootstrap)) {\n nd <- p$data[!p$data$isTip & nzchar(p$data$label), , drop = FALSE]\n nd$bs <- suppressWarnings(as.numeric(nd$label))\n nd <- nd[!is.na(nd$bs) & nd$bs >= bootstrap_min & !is.na(nd$branch.length), , drop = FALSE]\n # A value is written only on a branch long enough to hold it (about 4 mm of the ~80 mm wide\n # x range); shorter branches would push the number into the parent node or the tip labels.\n short <- 0.05 * max(p$data$x) * 1.13\n nd <- nd[nd$branch.length >= short, , drop = FALSE]\n nd$xlab <- nd$x - 0.55 * nd$branch.length\n p <- p + geom_text(\n data = nd,\n aes(x = xlab, y = y, label = label),\n nudge_y = 0.55, vjust = 0, hjust = 0.5,\n size = pv_pt2size(7), colour = grey[[\"mid\"]], family = house_family(),\n inherit.aes = FALSE\n )\n}\n\n# population names as clade strips beyond the tip labels (rectangular trees)\nif (layout %in% c(\"rectangular\", \"dendrogram\")) {\n td <- p$data[p$data$isTip & !is.na(p$data$group) & p$data$group %in% names(grp_cols), ]\n xmax <- max(p$data$x)\n strip_x <- xmax * 1.16\n st <- do.call(rbind, lapply(split(td, as.character(td$group)), function(d)\n data.frame(group = d$group[1], y0 = min(d$y) - 0.3, y1 = max(d$y) + 0.3, ym = mean(range(d$y)))))\n p <- p +\n geom_segment(data = st, aes(x = strip_x, xend = strip_x, y = y0, yend = y1), inherit.aes = FALSE,\n colour = grp_cols[as.character(st$group)], linewidth = pv_house_lw(\"main\")) +\n geom_text(data = st, aes(x = strip_x, y = ym, label = group), inherit.aes = FALSE, hjust = -0.15,\n colour = text_col(grp_cols)[as.character(st$group)], size = pv_pt2size(7),\n family = house_family()) +\n scale_x_continuous(expand = expansion(mult = c(0.01, 0.12))) +\n coord_cartesian(clip = \"off\")\n}\n\nif (isTRUE(show_tip_bar) && layout %in% c(\"rectangular\", \"dendrogram\")) {\n tip_len <- df[!is.na(df$group), c(\"tip\", \"length\", \"group\")]\n yd <- p$data[p$data$isTip, c(\"label\", \"y\")]\n tip_len <- merge(tip_len, yd, by.x = \"tip\", by.y = \"label\")\n p2 <- ggplot(tip_len, aes(length, y, fill = group)) +\n geom_col(width = 0.7, orientation = \"y\") +\n scale_fill_manual(values = grp_cols, guide = \"none\") +\n scale_y_continuous(limits = range(p$data$y) + c(-0.5, 0.5), expand = c(0, 0)) +\n labs(x = \"Tip length\", y = NULL) +\n theme_house() +\n theme(axis.text.y = element_blank(), axis.ticks.y = element_blank())\n p <- patchwork::wrap_plots(p, p2, nrow = 1, widths = c(1.4, 0.45))\n}\n\npv_save_house(p, \"figure\", cells = if (layout %in% c(\"circular\", \"fan\")) \"2x2\" else \"2x3\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "annotated phylogeny\n分组着色系统树\nphylo-tree\n\nphylogeny\n系统发育\nphylogeny\n系统发育\nphylogeny\n按群体给分支上色，并在内部节点标出支持率时用。\nlayout 更改为 \"rectangular\"、\"circular\"、\"fan\" 或 \"dendrogram\"；show_bootstrap 设为 true 时在足够长的分支上写入数值，bootstrap_min 默认 70；show_tip_bar 设为 false 隐藏分支长度条面板，或 true 为矩形或树状图布局添加面板；show_tip_label 设为 true 或 false 显示或隐藏末端标签。\nphylogeny ggtree population\ntip 子节点名；内部节点为 n 加编号（字符串） parent 父节点名（字符串） length 枝长（数值） group 叶节点群体；内部节点留空（字符串） bootstrap 进入该节点的支持率；叶节点和根留空（数值）"
},
{
"title": "Tree with heatmap",
"title_zh": "树加热图或条形注释",
"slug": "tree-heatmap",
"category": "phylogeny",
"tags": [
"phylogeny",
"heatmap",
"annotation"
],
"packages": [
"ggtree",
"ggplot2",
"ape"
],
"data_columns": {
"tip": "子节点或叶名（字符串）",
"parent": "父节点；性状行留空（字符串）",
"length": "枝长；性状行留空（数值）",
"trait": "性状名；树边行留空（字符串）",
"value": "性状值，已标准化；树边行留空（数值）"
},
"when_to_use": "把系统树和叶节点性状矩阵或单个性状条形对齐展示时用。",
"customize": "anno_mode 设为 \"heatmap\" 显示以 0 为对称中心的 12 个性状，或 \"bar\" 显示由默认值为 \"T01\" 的 bar_trait 定义的单一性状；n_clade 默认 4，设置通过共表型（cophenetic）距离平均连锁聚类得到的演化支数量。",
"lang": "R",
"task": "phylogeny",
"task_zh": "系统发育",
"task_en": "Phylogeny",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "anno_mode",
"value": "\"heatmap\""
},
{
"name": "bar_trait",
"value": "\"T01\""
},
{
"name": "n_clade",
"value": "4"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "135",
"label": "89 × 135 mm (2×3 cells)",
"cells": "2x3"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/phylogeny/tree-heatmap/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/phylogeny/tree-heatmap/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/phylogeny/tree-heatmap/plot.R"
},
{
"name": "data.csv",
"path": "figures/phylogeny/tree-heatmap/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/phylogeny/tree-heatmap/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/phylogeny/tree-heatmap/data.csv"
},
{
"name": "make_data.R",
"path": "figures/phylogeny/tree-heatmap/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/phylogeny/tree-heatmap/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/phylogeny/tree-heatmap/make_data.R"
}
],
"dir": "figures/phylogeny/tree-heatmap",
"preview": "figures/phylogeny/tree-heatmap/preview.png",
"docs_preview": "previews/tree-heatmap.png",
"code": "figures/phylogeny/tree-heatmap/plot.R",
"data": "figures/phylogeny/tree-heatmap/data.csv",
"data_files": [
"figures/phylogeny/tree-heatmap/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/phylogeny/tree-heatmap/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/phylogeny/tree-heatmap/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/phylogeny/tree-heatmap",
"code_text": "# Tree aligned to a trait heatmap (house_div, symmetric around 0) or to one trait drawn as bars\n# (house style). Branches coloured by clade (house colours); clade names written at each clade's\n# strip instead of a legend. The tree panel has no frame. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nanno_mode <- \"heatmap\" # heatmap | bar\nbar_trait <- \"T01\"\nn_clade <- 4\n\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n# populations ordered by geography (mean sampling latitude, north -> south) on the geo palette\npop_geo <- stats::setNames(pv_palette(\"geo\"),\n c(\"Wild N\", \"Cultivar A\", \"Landrace W\", \"Landrace E\", \"Cultivar B\", \"Wild S\"))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nedges <- df[df$trait == \"\", , drop = FALSE]\ntraits <- df[df$trait != \"\", , drop = FALSE]\n\ntip_names <- sort(setdiff(edges$tip, edges$parent))\nroot <- setdiff(edges$parent, edges$tip)\ninternals <- c(root, sort(setdiff(unique(edges$parent), root)))\nids <- setNames(seq_along(c(tip_names, internals)), c(tip_names, internals))\ntr <- list(\n edge = cbind(unname(ids[edges$parent]), unname(ids[edges$tip])),\n edge.length = edges$length,\n tip.label = tip_names,\n Nnode = length(internals)\n)\nclass(tr) <- \"phylo\"\ntr <- ape::ladderize(tr)\n\nd <- ape::cophenetic.phylo(tr)\ncl <- stats::cutree(stats::hclust(stats::as.dist(d), method = \"average\"), k = n_clade)\ngroups <- split(names(cl), sprintf(\"C%d\", cl))\ntr <- ggtree::groupOTU(tr, groups, group_name = \"clade\")\nclade_cols <- stats::setNames(unname(hp[c(\"blue\", \"red\", \"green\", \"purple\", \"brown\", \"magenta\")][seq_len(n_clade)]),\n paste0(\"C\", seq_len(n_clade)))\n\np <- ggtree::ggtree(tr, aes(colour = clade), linewidth = pv_house_lw(\"main\")) +\n ggtree::geom_tiplab(size = pv_pt2size(7), colour = \"#1A1A1A\", offset = 0.02, family = house_family()) +\n scale_colour_manual(values = clade_cols, guide = \"none\", na.value = grey[[\"dark\"]]) +\n labs(x = \"Divergence\", caption = footnote) +\n theme_house() +\n theme(\n panel.border = element_blank(),\n axis.line.x = element_line(linewidth = pv_house_lw(\"frame\")),\n axis.line.y = element_blank(),\n axis.text.y = element_blank(),\n axis.ticks.y = element_blank(),\n legend.position = \"bottom\", legend.justification = \"right\",\n legend.title = element_text(size = 7), legend.text = element_text(size = 7)\n ) +\n caption_theme\n# clade names as strips right of the annotation (no legend)\ntd <- p$data[p$data$isTip, c(\"label\", \"y\")]\ntd$clade <- as.character(cl[td$label]); td$clade <- paste0(\"C\", td$clade)\ncs <- do.call(rbind, lapply(split(td, td$clade), function(d)\n data.frame(clade = d$clade[1], y0 = min(d$y) - 0.35, y1 = max(d$y) + 0.35, ym = mean(range(d$y)))))\n\nxmax <- max(p$data$x, na.rm = TRUE)\nyd <- p$data[p$data$isTip, c(\"label\", \"y\")]\nif (anno_mode == \"bar\") {\n sub <- merge(traits[traits$trait == bar_trait, , drop = FALSE], yd, by.x = \"tip\", by.y = \"label\")\n x0 <- xmax + 0.55\n p <- p + geom_rect(\n data = sub,\n aes(xmin = x0, xmax = x0 + value * 0.12, ymin = y - 0.35, ymax = y + 0.35),\n fill = grey[[\"ref\"]], inherit.aes = FALSE\n ) +\n annotate(\"text\", x = x0, y = max(yd$y) + 1.2, label = bar_trait,\n size = pv_pt2size(7), hjust = 0, family = house_family())\n} else {\n sub <- merge(traits, yd, by.x = \"tip\", by.y = \"label\")\n sub$trait <- factor(sub$trait, levels = sprintf(\"T%02d\", 1:12))\n sub$tx <- xmax + 0.5 + (as.numeric(sub$trait) - 1) * 0.16\n labs <- unique(sub[, c(\"trait\", \"tx\")])\n p <- p + geom_tile(\n data = sub,\n aes(x = tx, y = y, fill = value),\n width = 0.15, height = 0.85, inherit.aes = FALSE\n ) +\n geom_text(\n data = labs,\n aes(tx, max(yd$y) + 0.8, label = trait),\n size = pv_pt2size(7), angle = 90, hjust = 0, inherit.aes = FALSE, family = house_family()\n ) +\n scale_fill_gradientn(colours = pv_palette(\"house_div\"), name = \"Trait value\",\n limits = c(-1, 1) * max(abs(sub$value), na.rm = TRUE)) +\n guides(fill = guide_colourbar(title.position = \"left\", title.vjust = 0.9,\n theme = theme(legend.key.width = unit(30, \"mm\"),\n legend.key.height = unit(2.2, \"mm\"),\n legend.title = element_text(margin = margin(r = 2, unit = \"mm\")))))\n}\nstrip_x <- if (anno_mode == \"bar\") xmax + 0.55 + max(sub$value, na.rm = TRUE) * 0.12 + 0.12 else max(sub$tx) + 0.15\np <- p +\n geom_segment(data = cs, aes(x = strip_x, xend = strip_x, y = y0, yend = y1), inherit.aes = FALSE,\n colour = clade_cols[cs$clade], linewidth = pv_house_lw(\"main\")) +\n geom_text(data = cs, aes(x = strip_x, y = ym, label = clade), inherit.aes = FALSE, hjust = -0.3,\n colour = text_col(clade_cols)[cs$clade], size = pv_pt2size(7), family = house_family())\np <- p + expand_limits(x = xmax + 2.75, y = max(yd$y) + 3.2) +\n scale_x_continuous(breaks = function(l) pretty(c(0, xmax), n = 3)[pretty(c(0, xmax), n = 3) <= xmax]) +\n coord_cartesian(clip = \"off\") +\n theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\"))\n\npv_save_house(p, \"figure\", cells = \"2x3\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "tree with heatmap\n树加热图或条形注释\ntree-heatmap\n\nphylogeny\n系统发育\nphylogeny\n系统发育\nphylogeny\n把系统树和叶节点性状矩阵或单个性状条形对齐展示时用。\nanno_mode 设为 \"heatmap\" 显示以 0 为对称中心的 12 个性状，或 \"bar\" 显示由默认值为 \"t01\" 的 bar_trait 定义的单一性状；n_clade 默认 4，设置通过共表型（cophenetic）距离平均连锁聚类得到的演化支数量。\nphylogeny heatmap annotation\ntip 子节点或叶名（字符串） parent 父节点；性状行留空（字符串） length 枝长；性状行留空（数值） trait 性状名；树边行留空（字符串） value 性状值，已标准化；树边行留空（数值）"
},
{
"title": "ADMIXTURE stacked bar",
"title_zh": "ADMIXTURE 堆积条",
"slug": "admixture-bar",
"category": "population-genetics",
"tags": [
"admixture",
"ancestry",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"sample": "个体编号（字符串）",
"pop": "群体（字符串）",
"k": "该行所属的 K（整数，2 到 6）",
"ancestry": "祖先成分名 A1–Ak（字符串）",
"q": "该成分比例（数值，同一个体同一 K 下加总为 1）"
},
"when_to_use": "展示个体祖先成分，并沿群体比较 K = 2 到 6 的结构。",
"customize": "k_values 默认 2:6，设置显示的行；sort_k 默认 4，在此 K 值下按主要祖先成分对群体内个体进行排序；pop_gap 默认 3，设置群体间的空白条带宽度；pop_order 设为 Wild N、Wild S、Landrace E、Landrace W、Cultivar A 和 Cultivar B 对群体进行排序。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "k_values",
"value": "2:6"
},
{
"name": "sort_k",
"value": "4"
},
{
"name": "pop_gap",
"value": "3"
},
{
"name": "pop_order",
"value": "c(\"Wild N\", \"Wild S\", \"Landrace E\", \"Landrace W\", \"Cultivar A\", \"Cultivar B\")"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/admixture-bar/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/admixture-bar/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/admixture-bar/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/admixture-bar/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/admixture-bar/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/admixture-bar/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/admixture-bar/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/admixture-bar/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/admixture-bar/make_data.R"
}
],
"dir": "figures/population-genetics/admixture-bar",
"preview": "figures/population-genetics/admixture-bar/preview.png",
"docs_preview": "previews/admixture-bar.png",
"code": "figures/population-genetics/admixture-bar/plot.R",
"data": "figures/population-genetics/admixture-bar/data.csv",
"data_files": [
"figures/population-genetics/admixture-bar/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/admixture-bar/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/admixture-bar/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/admixture-bar",
"code_text": "# ADMIXTURE stacked bars (house style): one row per K, individuals grouped by population and sorted by\n# their main ancestry at sort_k; ancestry components in house colours, row titles K = n on the left,\n# population names under the bars (no legend: components are unnamed model clusters).\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nk_values <- 2:6\nsort_k <- 4\npop_gap <- 3\npop_order <- c(\"Wild N\", \"Wild S\", \"Landrace E\", \"Landrace W\", \"Cultivar A\", \"Cultivar B\")\n\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n# populations ordered by geography (mean sampling latitude, north -> south) on the geo palette\npop_geo <- stats::setNames(pv_palette(\"geo\"),\n c(\"Wild N\", \"Cultivar A\", \"Landrace W\", \"Landrace E\", \"Cultivar B\", \"Wild S\"))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nsub <- df[df$k == sort_k, ]\nmeans <- aggregate(q ~ pop + ancestry, sub, mean)\ndom <- do.call(rbind, lapply(split(means, means$pop), function(m) m[which.max(m$q), ]))\nkey <- merge(sub, dom[, c(\"pop\", \"ancestry\")], by = c(\"pop\", \"ancestry\"))\nkey <- key[order(match(key$pop, pop_order), -key$q), ]\npos <- data.frame(sample = key$sample, pop = key$pop, stringsAsFactors = FALSE)\npos$pop <- factor(pos$pop, levels = pop_order)\npos$within <- ave(seq_len(nrow(pos)), pos$pop, FUN = seq_along)\nn_max <- max(pos$within)\npos$x <- pos$within + (as.integer(pos$pop) - 1) * (n_max + pop_gap)\nmids <- aggregate(x ~ pop, pos, mean)\n\nplot_df <- merge(df[df$k %in% k_values, ], pos[, c(\"sample\", \"x\")], by = \"sample\")\nplot_df$k_lab <- factor(paste0(\"K = \", plot_df$k), levels = paste0(\"K = \", k_values))\nanc_levels <- paste0(\"A\", seq_len(max(k_values)))\nplot_df$ancestry <- factor(plot_df$ancestry, levels = anc_levels)\npal <- stats::setNames(pv_palette(\"house\", length(anc_levels)), anc_levels)\n\np <- ggplot(plot_df, aes(x, q, fill = ancestry)) +\n geom_col(width = 1, colour = NA, linewidth = 0) +\n facet_grid(k_lab ~ ., switch = \"y\") +\n scale_fill_manual(values = pal, guide = \"none\") +\n scale_x_continuous(\n breaks = mids$x, labels = as.character(mids$pop),\n expand = expansion(add = 0.8)\n ) +\n scale_y_continuous(\n expand = expansion(mult = c(0.06, 0.03)),\n breaks = c(0, 1)\n ) +\n labs(x = NULL, y = \"Ancestry proportion\", caption = footnote) +\n theme_house() +\n theme(\n strip.background = element_blank(), strip.placement = \"outside\",\n strip.text.y.left = element_text(size = 7, angle = 0, hjust = 1),\n panel.spacing.y = unit(1.5, \"mm\"),\n axis.ticks.x = element_blank(),\n plot.margin = margin(1, 1.5, 1, 1, \"mm\")\n ) +\n caption_theme\n\npv_save_house(p, \"figure\", cells = \"4x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "admixture stacked bar\nadmixture 堆积条\nadmixture-bar\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n展示个体祖先成分，并沿群体比较 k = 2 到 6 的结构。\nk_values 默认 2:6，设置显示的行；sort_k 默认 4，在此 k 值下按主要祖先成分对群体内个体进行排序；pop_gap 默认 3，设置群体间的空白条带宽度；pop_order 设为 wild n、wild s、landrace e、landrace w、cultivar a 和 cultivar b 对群体进行排序。\nadmixture ancestry population-genetics\nsample 个体编号（字符串） pop 群体（字符串） k 该行所属的 k（整数，2 到 6） ancestry 祖先成分名 a1–ak（字符串） q 该成分比例（数值，同一个体同一 k 下加总为 1）"
},
{
"title": "ADMIXTURE CV error",
"title_zh": "ADMIXTURE 交叉验证折线",
"slug": "admixture-cv",
"category": "population-genetics",
"tags": [
"admixture",
"cross-validation",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"k": "祖先成分数 K（整数）",
"cv_mean": "交叉验证误差均值（数值，越低越好）",
"cv_sd": "重复或折次之间的标准差（数值）"
},
"when_to_use": "选 ADMIXTURE 的 K 时，看交叉验证误差在哪一档最低。",
"customize": "show_errorbar 设为 TRUE 显示交叉验证均值周围的标准差；mark_best 设为 TRUE 寻找均值最低的 K，以红色绘制并在点下方添加标签。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_errorbar",
"value": "TRUE"
},
{
"name": "mark_best",
"value": "TRUE"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/admixture-cv/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/admixture-cv/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/admixture-cv/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/admixture-cv/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/admixture-cv/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/admixture-cv/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/admixture-cv/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/admixture-cv/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/admixture-cv/make_data.R"
}
],
"dir": "figures/population-genetics/admixture-cv",
"preview": "figures/population-genetics/admixture-cv/preview.png",
"docs_preview": "previews/admixture-cv.png",
"code": "figures/population-genetics/admixture-cv/plot.R",
"data": "figures/population-genetics/admixture-cv/data.csv",
"data_files": [
"figures/population-genetics/admixture-cv/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/admixture-cv/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/admixture-cv/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/admixture-cv",
"code_text": "# ADMIXTURE cross-validation error by K (house style). The lowest K is marked from the data.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_errorbar <- TRUE\nmark_best <- TRUE\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nbest_k <- df$k[which.min(df$cv_mean)]\nline_col <- grey[[\"dark\"]]\n\np <- ggplot(df, aes(k, cv_mean))\nif (isTRUE(show_errorbar)) {\n p <- p + geom_errorbar(aes(ymin = cv_mean - cv_sd, ymax = cv_mean + cv_sd),\n width = 0.25, linewidth = pv_house_lw(\"minor\"), colour = line_col)\n}\np <- p +\n geom_line(linewidth = pv_house_lw(\"main\"), colour = line_col) +\n geom_point(shape = HOUSE_POINT$shape, size = HOUSE_POINT$size, stroke = HOUSE_POINT$stroke,\n colour = HOUSE_POINT$colour, fill = grey[[\"ci\"]])\nif (isTRUE(mark_best)) {\n b <- df[df$k == best_k, , drop = FALSE]\n p <- p +\n geom_point(data = b, shape = HOUSE_POINT$shape, size = HOUSE_POINT$size, stroke = HOUSE_POINT$stroke,\n colour = HOUSE_POINT$colour, fill = hp[[\"red\"]]) +\n annotate(\"text\", x = best_k, y = b$cv_mean - 0.06 * diff(range(df$cv_mean)), vjust = 1,\n label = sprintf(\"Lowest CV (K = %d)\", best_k),\n colour = text_col(hp[\"red\"]), size = pv_pt2size(7), family = house_family())\n}\np <- p +\n scale_x_continuous(breaks = df$k) +\n scale_y_continuous(expand = expansion(mult = c(0.16, 0.05))) +\n labs(x = \"K\", y = \"Cross-validation error\", caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")) + caption_theme\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "admixture cv error\nadmixture 交叉验证折线\nadmixture-cv\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n选 admixture 的 k 时，看交叉验证误差在哪一档最低。\nshow_errorbar 设为 true 显示交叉验证均值周围的标准差；mark_best 设为 true 寻找均值最低的 k，以红色绘制并在点下方添加标签。\nadmixture cross-validation population-genetics\nk 祖先成分数 k（整数） cv_mean 交叉验证误差均值（数值，越低越好） cv_sd 重复或折次之间的标准差（数值）"
},
{
"title": "Pairwise Fst heatmap",
"title_zh": "成对 Fst 热图",
"slug": "fst-heatmap",
"category": "population-genetics",
"tags": [
"fst",
"heatmap",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"pop_a": "群体甲（字符串）",
"pop_b": "群体乙（字符串）",
"fst": "成对 Fst（数值，对角线为 0；文件存上三角含对角线，作图时镜像）"
},
"when_to_use": "十二个群体的成对分化要按地理或驯化顺序排开、而不是按聚类字母序时用。",
"customize": "show_values 设为 TRUE 在每个图块中写入两位小数值；pop_order 设为 WN1 到 CB2 对 12 个亚群进行排序。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_values",
"value": "TRUE"
},
{
"name": "pop_order",
"value": "c(\"WN1\", \"WN2\", \"WS1\", \"WS2\", \"LE1\", \"LE2\", \"LW1\", \"LW2\", \"CA1\", \"CA2\", \"CB1\", \"CB2\")"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/fst-heatmap/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/fst-heatmap/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/fst-heatmap/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/fst-heatmap/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/fst-heatmap/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/fst-heatmap/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/fst-heatmap/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/fst-heatmap/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/fst-heatmap/make_data.R"
}
],
"dir": "figures/population-genetics/fst-heatmap",
"preview": "figures/population-genetics/fst-heatmap/preview.png",
"docs_preview": "previews/fst-heatmap.png",
"code": "figures/population-genetics/fst-heatmap/plot.R",
"data": "figures/population-genetics/fst-heatmap/data.csv",
"data_files": [
"figures/population-genetics/fst-heatmap/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/fst-heatmap/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/fst-heatmap/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/fst-heatmap",
"code_text": "# Pairwise FST heatmap (house style): house_warm sequential scale, values in the tiles, populations\n# in the file's geographic order. Reads data.csv only (upper triangle; mirrored here).\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_values <- TRUE\npop_order <- c(\"WN1\", \"WN2\", \"WS1\", \"WS2\", \"LE1\", \"LE2\", \"LW1\", \"LW2\", \"CA1\", \"CA2\", \"CB1\", \"CB2\")\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\n# mirror the upper triangle stored in the file\nswap <- df[df$pop_a != df$pop_b, ]\nswap <- data.frame(pop_a = swap$pop_b, pop_b = swap$pop_a, fst = swap$fst, stringsAsFactors = FALSE)\ndf <- rbind(df, swap)\ndf$pop_a <- factor(df$pop_a, levels = pop_order)\ndf$pop_b <- factor(df$pop_b, levels = rev(pop_order))\ndf$label <- sprintf(\"%.2f\", df$fst)\nwarm <- pv_palette(\"house_warm\")\nlims <- c(0, max(df$fst))\n# tile text: white or house_grey text #000000, whichever has the higher contrast on that tile's\n# own fill (computed the same way scale_fill_gradientn does), so every value reads at >= 4.5:1\nrel_lum <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n colSums(c(0.2126, 0.7152, 0.0722) * v)\n}\ntile_fill <- scales::gradient_n_pal(warm)(scales::rescale(df$fst, from = lims))\nl_fill <- rel_lum(tile_fill)\non_white <- 1.05 / (l_fill + 0.05)\non_black <- (l_fill + 0.05) / 0.05\ndf$txt <- ifelse(on_white > on_black, \"white\", \"#000000\")\ndf$txt_contrast <- pmax(on_white, on_black)\n\np <- ggplot(df, aes(pop_a, pop_b, fill = fst)) +\n geom_tile(colour = \"white\", linewidth = 0.3) +\n scale_fill_gradientn(colours = warm, limits = lims, name = \"FST\",\n breaks = function(l) pretty(l, n = 3)) +\n scale_colour_identity() +\n guides(fill = guide_colourbar(title.position = \"top\",\n theme = theme(legend.key.width = unit(30, \"mm\"),\n legend.key.height = unit(2.2, \"mm\"),\n legend.title = element_text(size = 7, margin = margin(b = 0.8, unit = \"mm\"))))) +\n scale_x_discrete(expand = c(0, 0)) +\n scale_y_discrete(expand = c(0, 0)) +\n coord_cartesian() +\n labs(x = NULL, y = NULL, caption = footnote) +\n theme_house() +\n theme(axis.ticks = element_blank(),\n legend.position = \"bottom\", legend.justification = \"right\",\n legend.margin = margin(0, 0, 0, 0), legend.box.spacing = unit(1.5, \"mm\"),\n legend.title = element_text(size = 7),\n legend.text = element_text(size = 7),\n\n plot.margin = margin(1, 1, 1, 1, \"mm\")) +\n caption_theme\nif (isTRUE(show_values)) {\n p <- p + geom_text(aes(label = label, colour = txt), size = pv_pt2size(7), family = house_family(),\n show.legend = FALSE)\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "pairwise fst heatmap\n成对 fst 热图\nfst-heatmap\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n十二个群体的成对分化要按地理或驯化顺序排开、而不是按聚类字母序时用。\nshow_values 设为 true 在每个图块中写入两位小数值；pop_order 设为 wn1 到 cb2 对 12 个亚群进行排序。\nfst heatmap population-genetics\npop_a 群体甲（字符串） pop_b 群体乙（字符串） fst 成对 fst（数值，对角线为 0；文件存上三角含对角线，作图时镜像）"
},
{
"title": "f-statistic point range",
"title_zh": "f3 / f4 / D 点距图",
"slug": "fstats-point",
"category": "population-genetics",
"tags": [
"d-statistic",
"f4",
"f3",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"test": "检验写法，如 D(P1, P2; P3, OG)（字符串）",
"estimate": "估计值（数值；本表示例为 D 的量级）",
"low": "95% 区间下界（数值）",
"high": "95% 区间上界（数值）",
"z": "estimate / 标准误（数值；|Z| > 3 通常视为偏离 0）"
},
"when_to_use": "一组 D 或 f4 检验要同时看估计、置信区间和是否跨过 0 时用。",
"customize": "show_ci 设为 TRUE 显示置信区间；z_cut 默认 3，当绝对 Z 分数大于或等于此界线时将正值设为蓝色负值设为红色；statistic 默认 \"D\" 设置横轴标题，也接受 \"f3\" 或 \"f4\"；order_by_estimate 设为 TRUE 对检验进行排序。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_ci",
"value": "TRUE"
},
{
"name": "z_cut",
"value": "3"
},
{
"name": "statistic",
"value": "\"D\""
},
{
"name": "order_by_estimate",
"value": "TRUE"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/fstats-point/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/fstats-point/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/fstats-point/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/fstats-point/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/fstats-point/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/fstats-point/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/fstats-point/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/fstats-point/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/fstats-point/make_data.R"
}
],
"dir": "figures/population-genetics/fstats-point",
"preview": "figures/population-genetics/fstats-point/preview.png",
"docs_preview": "previews/fstats-point.png",
"code": "figures/population-genetics/fstats-point/plot.R",
"data": "figures/population-genetics/fstats-point/data.csv",
"data_files": [
"figures/population-genetics/fstats-point/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/fstats-point/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/fstats-point/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/fstats-point",
"code_text": "# f-statistics / D point ranges (house style): one row per test, |Z| >= z_cut in colour (blue\n# positive, red negative), others grey; the class key is written in the panel. Example numbers are\n# on the D scale. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_ci <- TRUE\nz_cut <- 3\nstatistic <- \"D\"\norder_by_estimate <- TRUE\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf$class <- ifelse(abs(df$z) < z_cut, \"ns\", ifelse(df$estimate >= 0, \"positive\", \"negative\"))\nif (isTRUE(order_by_estimate)) {\n df$test <- factor(df$test, levels = df$test[order(df$estimate)])\n}\ncols <- c(positive = hp[[\"blue\"]], negative = hp[[\"red\"]], ns = grey[[\"ci\"]])\nkey_txt <- c(positive = sprintf(\"Z >= %g\", z_cut), negative = sprintf(\"Z <= -%g\", z_cut),\n ns = sprintf(\"|Z| < %g\", z_cut))\nkey_col <- c(text_col(cols[c(\"positive\", \"negative\")]), ns = grey[[\"mid\"]])\nx_lab <- switch(statistic, f3 = \"f3 statistic\", f4 = \"f4 statistic\", \"D statistic\")\nn_test <- nlevels(factor(df$test))\n\np <- ggplot(df, aes(estimate, test, colour = class)) +\n geom_vline(xintercept = 0, linetype = \"dashed\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"ref\"]])\nif (isTRUE(show_ci)) {\n p <- p + geom_errorbar(aes(xmin = low, xmax = high), width = 0.35, linewidth = pv_house_lw(\"minor\"),\n orientation = \"y\")\n}\np <- p +\n geom_point(size = 1.3, shape = 16) +\n # class key, top-left of the panel (the largest estimates sit at the top right)\n annotate(\"text\", x = -Inf, y = n_test + 0.2 - (0:2) * 1.4, label = paste0(\" \", key_txt[c(\"positive\", \"negative\", \"ns\")]),\n colour = key_col[c(\"positive\", \"negative\", \"ns\")], hjust = 0, vjust = 1,\n size = pv_pt2size(7), family = house_family()) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(labels = function(x) format(x, trim = TRUE), expand = expansion(mult = c(0.32, 0.05))) +\n labs(x = x_lab, y = NULL, caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")) + caption_theme\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "f-statistic point range\nf3 / f4 / d 点距图\nfstats-point\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n一组 d 或 f4 检验要同时看估计、置信区间和是否跨过 0 时用。\nshow_ci 设为 true 显示置信区间；z_cut 默认 3，当绝对 z 分数大于或等于此界线时将正值设为蓝色负值设为红色；statistic 默认 \"d\" 设置横轴标题，也接受 \"f3\" 或 \"f4\"；order_by_estimate 设为 true 对检验进行排序。\nd-statistic f4 f3 population-genetics\ntest 检验写法，如 d(p1, p2; p3, og)（字符串） estimate 估计值（数值；本表示例为 d 的量级） low 95% 区间下界（数值） high 95% 区间上界（数值） z estimate / 标准误（数值；|z| > 3 通常视为偏离 0）"
},
{
"title": "Geo-grouped PCA scatter (house style)",
"title_zh": "按地理分组的 PCA 散点（house 风格）",
"slug": "house-pca-geo",
"category": "population-genetics",
"tags": [
"pca",
"population-structure",
"geo-palette",
"direct-labels",
"house-style"
],
"packages": [
"ggplot2"
],
"data_columns": {
"sample": "个体编号（字符串）",
"region": "地理区组（字符串，6 组，自西向东）",
"snp001..snp300": "基因型（0/1/2，整数）"
},
"when_to_use": "Use this layout for a 2x2 grid measuring 89 x 89 mm. Base panel sizes increase by 2 pt, ticks use 9 pt, and axis titles use 10 pt. The dataset contains 120 individuals across 6 regions with 20 individuals each. The 6 regions are Iberia, W Europe, Balkans, Caucasus, Central Asia, and East Asia. Order the regions from west to east using geo colors 1 through 6. The data comprises 300 unlinked SNPs, which is equivalent to LD-pruned data. The plot.R script calculates the PCA directly. Variance explained is 16.42% for PC1 and 5.71% for PC2, written as 16.4% and 5.7% in the axis titles. Use direct labeling with group color text and no color blocks. Labels are placed within 2 mm of the nearest point of their own group without overlapping points. Do not use a legend. Axis limits equal the data range plus or minus 6%. Each label must be closer to its own group centroid in mm than to any other group. Place labels on the side facing away from the nearest other group. Place the footnote inside the figure, below the plot box. The in-plot footnote uses 7 pt text across two lines. The footnote reads: \"n = 20 per region; 300 unlinked SNPs (equivalent to LD-pruned)\" and \"Simulated data for illustration; not biological results\". Do not use coord_fixed because fixing the 3:1 variance ratio flattens the 2x2 canvas.",
"customize": "Define region order and color in region_order at the top of plot.R. Label positions are calculated automatically by the place() function. Positions must be at least 0.5 mm from points and at most 2 mm from the own group. This distance constraint is enforced by stopifnot assertions. The text_col() function applies group color if the contrast ratio is ≥ 3:1. If the contrast is lower, text_col() applies #1A1A1A. Set colors using pv_palette(\"geo\"). Draw data points using HOUSE_POINT.",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "region_order",
"value": "c(\"Iberia\", \"W Europe\", \"Balkans\", \"Caucasus\", \"Central Asia\", \"East Asia\")"
},
{
"name": "SIM_NOTE",
"value": "\"Simulated data for illustration; not biological results\""
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/house-pca-geo/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/house-pca-geo/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/house-pca-geo/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/house-pca-geo/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/house-pca-geo/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/house-pca-geo/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/house-pca-geo/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/house-pca-geo/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/house-pca-geo/make_data.R"
}
],
"dir": "figures/population-genetics/house-pca-geo",
"preview": "figures/population-genetics/house-pca-geo/preview.png",
"docs_preview": "previews/house-pca-geo.png",
"code": "figures/population-genetics/house-pca-geo/plot.R",
"data": "figures/population-genetics/house-pca-geo/data.csv",
"data_files": [
"figures/population-genetics/house-pca-geo/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/house-pca-geo/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/house-pca-geo/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/house-pca-geo",
"code_text": "# House-style PCA scatter of accessions, coloured by region with pv_palette(\"geo\") (west -> east).\n# PCA is computed here from the genotypes in data.csv; axis titles give % variance explained.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\nregion_order <- c(\"Iberia\", \"W Europe\", \"Balkans\", \"Caucasus\", \"Central Asia\", \"East Asia\") # west -> east\nSIM_NOTE <- \"Simulated data for illustration; not biological results\"\n\nd <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ng <- as.matrix(d[, grepl(\"^snp\", names(d))])\ng <- g[, apply(g, 2, stats::var) > 0]\npc <- stats::prcomp(g, center = TRUE, scale. = TRUE)\nve <- 100 * pc$sdev^2 / sum(pc$sdev^2) # % variance explained\nsc <- data.frame(region = factor(d$region, levels = region_order), pc1 = pc$x[, 1], pc2 = pc$x[, 2])\nif (stats::cor(sc$pc1, as.integer(sc$region)) < 0) sc$pc1 <- -sc$pc1 # west on the left\ncols <- stats::setNames(pv_palette(\"geo\"), region_order)\nn_per <- table(sc$region); n_snp <- ncol(g)\nstopifnot(all(n_per == n_per[[1]]), n_snp == 300)\n# the simulation draws every SNP independently (no linkage), i.e. what an LD-pruned panel approximates\nFOOT <- sprintf(\"n = %d per region; %d unlinked SNPs (equivalent to LD-pruned)\\n%s\", n_per[[1]], n_snp, SIM_NOTE)\nstopifnot(length(cols) == 6, nlevels(sc$region) == 6)\n\n# --- text colour: never a new colour -----------------------------------------------------------------\n# Rule: a group keeps its own palette colour for its label if that colour reaches 3:1 contrast on white\n# (WCAG 2); otherwise the label uses the house near-black text colour #1A1A1A (the same constant the\n# house-upset and transcriptome-mosaic contrast rules use). Group identity then comes from the label\n# sitting right next to its cluster. No colour is mixed or generated.\nTEXT_DARK <- \"#1A1A1A\"\nrel_lum <- function(hex) {\n v <- grDevices::col2rgb(hex)[, 1] / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n sum(c(0.2126, 0.7152, 0.0722) * v)\n}\ncontrast_white <- function(hex) 1.05 / (rel_lum(hex) + 0.05)\ntext_col <- function(hex) if (contrast_white(hex) >= 3) hex else TEXT_DARK\ntcols <- vapply(cols, text_col, \"\")\ncontrast_tab <- data.frame(region = region_order, fill = unname(cols), ratio_fill = vapply(cols, contrast_white, 0),\n text = unname(tcols), ratio_text = vapply(tcols, contrast_white, 0))\nstopifnot(all(contrast_tab$ratio_text >= 3), all(tcols %in% c(cols, TEXT_DARK))) # no new colours\n\n# --- direct labels next to each cluster -------------------------------------------------------------\n# Work in mm on the real panel: each label is moved out from its cluster centroid along one of 24\n# directions until its box clears every point by >= 0.5 mm; a placement is accepted only if the box is\n# <= 2 mm from the nearest point of its own cluster, inside the panel, clear of earlier labels, and its\n# centre is closer (in canvas mm, axes are not equal) to its own group centroid than to any other centroid,\n# on the side of its cluster facing away from the nearest other group.\nLAB_PT <- 9 # 7 pt + the 2x2 single-panel bump\nr_pt <- pv_point_dims()[[\"outer_mm\"]] / 2\nlab_w <- vapply(region_order, function(t) {\n grDevices::cairo_pdf(tempfile()); on.exit(grDevices::dev.off())\n grid::convertWidth(grid::grobWidth(grid::textGrob(t, gp = grid::gpar(fontfamily = house_family(), fontsize = LAB_PT))),\n \"mm\", valueOnly = TRUE)\n}, 0)\nLAB_H <- LAB_PT * 0.3528 * 0.74 # cap height + small descender allowance, mm\n\nbuild <- function(xl, yl, lab = NULL) {\n q <- ggplot(sc, aes(pc1, pc2)) +\n geom_point(aes(fill = region), shape = HOUSE_POINT$shape, size = HOUSE_POINT$size, stroke = HOUSE_POINT$stroke,\n colour = \"black\") +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = tcols, guide = \"none\") +\n scale_x_continuous(limits = xl, labels = minus, expand = c(0, 0)) +\n scale_y_continuous(limits = yl, labels = minus, expand = c(0, 0)) +\n labs(x = sprintf(\"PC1 (%.1f%%)\", ve[1]), y = sprintf(\"PC2 (%.1f%%)\", ve[2]), caption = FOOT) +\n theme_house() +\n theme(plot.caption = element_text(size = 5, hjust = 1, colour = pv_palette(\"house_grey\")[[\"mid\"]],\n lineheight = 0.95, margin = margin(t = 1.2, unit = \"mm\")),\n plot.caption.position = \"plot\")\n if (!is.null(lab)) q <- q + geom_text(data = lab, aes(x, y, label = region, colour = region), hjust = 0.5,\n vjust = 0.5, size = pv_pt2size(7))\n q\n}\nminus <- function(x) format(x, trim = TRUE) # ASCII \"-\" (matches the house axes; no extra font subset)\npanel_mm <- function(q) { # panel size on the 89 x 89 mm canvas\n grDevices::cairo_pdf(tempfile(), width = 89 / 25.4, height = 89 / 25.4); on.exit(grDevices::dev.off())\n g <- ggplot2::ggplotGrob(pv_bump_text(q, 2))\n pn <- g$layout[g$layout$name == \"panel\", ]\n wnull <- sum(grid::convertWidth(g$widths[-pn$l], \"mm\", valueOnly = TRUE))\n hnull <- sum(grid::convertHeight(g$heights[-pn$t], \"mm\", valueOnly = TRUE))\n c(w = 89 - wnull, h = 89 - hnull)\n}\nplace <- function(xl, yl) {\n pm <- panel_mm(build(xl, yl))\n kx <- pm[[\"w\"]] / diff(xl); ky <- pm[[\"h\"]] / diff(yl)\n P <- cbind((sc$pc1 - xl[1]) * kx, (sc$pc2 - yl[1]) * ky)\n boxes <- list(); out <- NULL\n C <- t(vapply(region_order, function(r) colMeans(P[sc$region == r, , drop = FALSE]), c(0, 0))) # centroids, mm\n dist_c <- as.matrix(stats::dist(C)); colnames(dist_c) <- rownames(dist_c) <- region_order\n for (rg in region_order) {\n own <- sc$region == rg; c0 <- colMeans(P[own, , drop = FALSE]); w <- lab_w[[rg]]; best <- NULL\n for (ang in seq(0, 2 * pi, length.out = 25)[-25]) {\n for (t in seq(0, 30, by = 0.2)) {\n cx <- c0[1] + t * cos(ang); cy <- c0[2] + t * sin(ang)\n bx <- c(cx - w / 2, cy - LAB_H / 2, cx + w / 2, cy + LAB_H / 2)\n dx <- pmax(bx[1] - P[, 1], 0, P[, 1] - bx[3]); dy <- pmax(bx[2] - P[, 2], 0, P[, 2] - bx[4])\n gap <- sqrt(dx^2 + dy^2) - r_pt\n if (min(gap) < 0.5) next\n own_gap <- min(gap[own])\n dc <- sqrt((C[, 1] - cx)^2 + (C[, 2] - cy)^2) # label centre to every centroid, mm\n nb <- names(which.min(dist_c[rg, colnames(dist_c) != rg])) # nearest other group (centroid, mm)\n away <- sum((c(cx, cy) - C[rg, ]) * (C[nb, ] - C[rg, ])) <= 0 # label on the far side from it\n ok <- away && dc[[rg]] < min(dc[names(dc) != rg]) && own_gap <= 2 && bx[1] >= 0.8 && bx[3] <= pm[[\"w\"]] - 0.8 && bx[2] >= 0.8 && bx[4] <= pm[[\"h\"]] - 0.8 &&\n all(vapply(boxes, function(o) bx[3] < o[1] - 0.8 || bx[1] > o[3] + 0.8 || bx[4] < o[2] - 0.5 || bx[2] > o[4] + 0.5, TRUE))\n if (ok && (is.null(best) || own_gap < best$g)) best <- list(g = own_gap, bx = bx, dc = dc)\n break # first clear spot along this direction\n }\n }\n if (is.null(best)) return(NULL)\n boxes[[rg]] <- best$bx\n out <- rbind(out, data.frame(region = factor(rg, levels = region_order),\n x = xl[1] + mean(best$bx[c(1, 3)]) / kx, y = yl[1] + mean(best$bx[c(2, 4)]) / ky,\n own_gap_mm = best$g, own_centroid_mm = best$dc[[rg]],\n other_centroid_mm = min(best$dc[names(best$dc) != rg]),\n nearest_other = names(best$dc[names(best$dc) != rg])[which.min(best$dc[names(best$dc) != rg])]))\n }\n out\n}\n# tight axis ranges: start at the data range + 4 %, widen in 3 % steps only if some label has no spot\nrx <- diff(range(sc$pc1)); ry <- diff(range(sc$pc2)); pad <- 0.04\nrepeat {\n xl <- range(sc$pc1) + c(-1, 1) * pad * rx; yl <- range(sc$pc2) + c(-1, 1) * pad * ry\n lab <- place(xl, yl)\n if (!is.null(lab) || pad > 0.3) break\n pad <- pad + 0.02 # widen a little if a label has no valid spot\n}\nstopifnot(!is.null(lab), nrow(lab) == 6, all(lab$own_gap_mm >= 0.5), all(lab$own_gap_mm <= 2),\n all(lab$own_centroid_mm < lab$other_centroid_mm)) # every label is nearest its own group centroid (mm)\np <- build(xl, yl, lab)\nprint(contrast_tab, digits = 3); print(lab, digits = 3); message(sprintf(\"axis pad %.2f\", pad))\n\npv_save_house(p, \"figure\", cells = \"2x2\")\nmessage(sprintf(\"PC1 %.2f%%, PC2 %.2f%%\", ve[1], ve[2]))\nmessage(\"wrote preview.png\")\n",
"search_text": "geo-grouped pca scatter (house style)\n按地理分组的 pca 散点（house 风格）\nhouse-pca-geo\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\nuse this layout for a 2x2 grid measuring 89 x 89 mm. base panel sizes increase by 2 pt, ticks use 9 pt, and axis titles use 10 pt. the dataset contains 120 individuals across 6 regions with 20 individuals each. the 6 regions are iberia, w europe, balkans, caucasus, central asia, and east asia. order the regions from west to east using geo colors 1 through 6. the data comprises 300 unlinked snps, which is equivalent to ld-pruned data. the plot.r script calculates the pca directly. variance explained is 16.42% for pc1 and 5.71% for pc2, written as 16.4% and 5.7% in the axis titles. use direct labeling with group color text and no color blocks. labels are placed within 2 mm of the nearest point of their own group without overlapping points. do not use a legend. axis limits equal the data range plus or minus 6%. each label must be closer to its own group centroid in mm than to any other group. place labels on the side facing away from the nearest other group. place the footnote inside the figure, below the plot box. the in-plot footnote uses 7 pt text across two lines. the footnote reads: \"n = 20 per region; 300 unlinked snps (equivalent to ld-pruned)\" and \"simulated data for illustration; not biological results\". do not use coord_fixed because fixing the 3:1 variance ratio flattens the 2x2 canvas.\ndefine region order and color in region_order at the top of plot.r. label positions are calculated automatically by the place() function. positions must be at least 0.5 mm from points and at most 2 mm from the own group. this distance constraint is enforced by stopifnot assertions. the text_col() function applies group color if the contrast ratio is ≥ 3:1. if the contrast is lower, text_col() applies #1a1a1a. set colors using pv_palette(\"geo\"). draw data points using house_point.\npca population-structure geo-palette direct-labels house-style\nsample 个体编号（字符串） region 地理区组（字符串，6 组，自西向东） snp001..snp300 基因型（0/1/2，整数）"
},
{
"title": "Isolation by distance",
"title_zh": "距离隔离散点",
"slug": "isolation-by-distance",
"category": "population-genetics",
"tags": [
"isolation-by-distance",
"fst",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"dist_km": "群体对的地理距离，单位 km（数值）",
"fst_linear": "Rousset 线性化 Fst/(1−Fst)（数值）",
"region": "这对比较所在的区域（字符串）"
},
"when_to_use": "检验分化是否随地理距离增加，并看不同区域斜率是否不一样。",
"customize": "show_regression 设为 TRUE 绘制回归线；by_region 默认 TRUE 为每个区域绘制一条线性模型线，或 FALSE 为所有点绘制一条带置信区间带的深灰色线；regions_show 设为 North、Central 和 South 限制显示的区域。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_regression",
"value": "TRUE"
},
{
"name": "by_region",
"value": "TRUE"
},
{
"name": "regions_show",
"value": "c(\"North\", \"Central\", \"South\")"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/isolation-by-distance/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/isolation-by-distance/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/isolation-by-distance/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/isolation-by-distance/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/isolation-by-distance/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/isolation-by-distance/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/isolation-by-distance/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/isolation-by-distance/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/isolation-by-distance/make_data.R"
}
],
"dir": "figures/population-genetics/isolation-by-distance",
"preview": "figures/population-genetics/isolation-by-distance/preview.png",
"docs_preview": "previews/isolation-by-distance.png",
"code": "figures/population-genetics/isolation-by-distance/plot.R",
"data": "figures/population-genetics/isolation-by-distance/data.csv",
"data_files": [
"figures/population-genetics/isolation-by-distance/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/isolation-by-distance/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/isolation-by-distance/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/isolation-by-distance",
"code_text": "# Isolation by distance (house style): linearised FST against geographic distance, one regression line\n# per region; region names stacked top-left, steepest\n# line first. Regions use the geo palette (north ->\n# south). Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_regression <- TRUE\nby_region <- TRUE\nregions_show <- c(\"North\", \"Central\", \"South\")\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$region %in% regions_show, ]\ndf$region <- factor(df$region, levels = regions_show)\ngeo <- pv_palette(\"geo\")\n# spread the regions over the geo stops (no interpolated colours)\ncols <- stats::setNames(geo[round(seq(2, length(geo), length.out = length(regions_show)))], regions_show)\n\np <- ggplot(df, aes(dist_km, fst_linear)) +\n geom_point(aes(fill = region), shape = HOUSE_POINT$shape, size = 0.9, stroke = HOUSE_POINT$stroke,\n colour = HOUSE_POINT$colour, alpha = 0.9)\nif (isTRUE(show_regression) && isTRUE(by_region)) {\n p <- p + geom_smooth(aes(colour = region), method = \"lm\", formula = y ~ x, se = FALSE,\n linewidth = pv_house_lw(\"main\"))\n} else {\n if (isTRUE(show_regression)) {\n p <- p + geom_smooth(method = \"lm\", formula = y ~ x, se = TRUE, linewidth = pv_house_lw(\"main\"),\n colour = grey[[\"dark\"]], fill = grey[[\"ci\"]])\n }\n}\n# names stacked in the empty top-left corner, steepest region first\nslope <- vapply(split(df, df$region, drop = TRUE), function(d) stats::coef(stats::lm(fst_linear ~ dist_km, d))[[2]], 0)\nlab <- names(sort(slope, decreasing = TRUE))\ny_lab <- max(df$fst_linear) * (1.1 - 0.09 * (seq_along(lab) - 1))\np <- p +\n annotate(\"text\", x = -Inf, y = y_lab, label = lab, hjust = -0.1, vjust = 1,\n colour = text_col(cols)[lab], size = pv_pt2size(7), family = house_family()) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_colour_manual(values = cols, guide = \"none\") +\n labs(x = \"Geographic distance (km)\", y = \"FST / (1 - FST)\",\n caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")) + caption_theme\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "isolation by distance\n距离隔离散点\nisolation-by-distance\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n检验分化是否随地理距离增加，并看不同区域斜率是否不一样。\nshow_regression 设为 true 绘制回归线；by_region 默认 true 为每个区域绘制一条线性模型线，或 false 为所有点绘制一条带置信区间带的深灰色线；regions_show 设为 north、central 和 south 限制显示的区域。\nisolation-by-distance fst population-genetics\ndist_km 群体对的地理距离，单位 km（数值） fst_linear rousset 线性化 fst/(1−fst)（数值） region 这对比较所在的区域（字符串）"
},
{
"title": "LD decay",
"title_zh": "LD 衰减曲线",
"slug": "ld-decay",
"category": "population-genetics",
"tags": [
"linkage-disequilibrium",
"ld-decay",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"pop": "群体（字符串）",
"dist_kb": "距离分箱中点，单位 kb（数值）",
"r2": "该距离上的平均 r²（数值，0 到 1）"
},
"when_to_use": "比较野生、农家种和栽培种的连锁不平衡随物理距离衰减有多快。",
"customize": "show_loess 设为 TRUE 绘制跨度为 0.65 的曲线；pops_show 设为 Wild N、Landrace E、Cultivar A 和 Cultivar B 过滤线条；log_x 设为 TRUE 对横轴使用对数刻度并在 1、10 和 100 kb 处设置刻度线。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_loess",
"value": "TRUE"
},
{
"name": "pops_show",
"value": "c(\"Wild N\", \"Landrace E\", \"Cultivar A\", \"Cultivar B\")"
},
{
"name": "log_x",
"value": "TRUE"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/ld-decay/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/ld-decay/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/ld-decay/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/ld-decay/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/ld-decay/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/ld-decay/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/ld-decay/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/ld-decay/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/ld-decay/make_data.R"
}
],
"dir": "figures/population-genetics/ld-decay",
"preview": "figures/population-genetics/ld-decay/preview.png",
"docs_preview": "previews/ld-decay.png",
"code": "figures/population-genetics/ld-decay/plot.R",
"data": "figures/population-genetics/ld-decay/data.csv",
"data_files": [
"figures/population-genetics/ld-decay/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/ld-decay/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/ld-decay/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/ld-decay",
"code_text": "# LD decay by population (house style): r^2 against distance in kb, loess curve per population,\n# population names at the right end of each curve. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_loess <- TRUE\npops_show <- c(\"Wild N\", \"Landrace E\", \"Cultivar A\", \"Cultivar B\")\nlog_x <- TRUE\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$pop %in% pops_show, ]\ndf$pop <- factor(df$pop, levels = pops_show)\ncols <- pop_cols[pops_show]\n\n# names stacked in the empty top-right corner, in the same top-to-bottom order as the curves\n# at the shortest distance (where they are furthest apart)\nstarts <- stats::aggregate(r2 ~ pop, df[df$dist_kb == min(df$dist_kb), ], mean)\nends <- data.frame(pop = starts$pop[order(-starts$r2)])\nends$y_lab <- 0.82 - 0.065 * (seq_len(nrow(ends)) - 1)\n\np <- ggplot(df, aes(dist_kb, r2, colour = pop)) +\n geom_point(size = 0.9, shape = 16, alpha = 0.8)\nif (isTRUE(show_loess)) {\n p <- p + geom_smooth(method = \"loess\", formula = y ~ x, se = FALSE, span = 0.65,\n linewidth = pv_house_lw(\"main\"))\n}\np <- p + if (isTRUE(log_x)) {\n scale_x_log10(breaks = c(1, 10, 100), labels = c(\"1\", \"10\", \"100\"))\n} else scale_x_continuous()\np <- p +\n annotate(\"text\", x = Inf, y = ends$y_lab, label = as.character(ends$pop), hjust = 1.08,\n colour = text_col(cols)[as.character(ends$pop)], size = pv_pt2size(7), family = house_family()) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_y_continuous(limits = c(0, 0.85), expand = expansion(mult = c(0, 0.04))) +\n labs(x = \"Distance (kb)\", y = \"LD (r\\u00b2)\", caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")) + caption_theme\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "ld decay\nld 衰减曲线\nld-decay\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n比较野生、农家种和栽培种的连锁不平衡随物理距离衰减有多快。\nshow_loess 设为 true 绘制跨度为 0.65 的曲线；pops_show 设为 wild n、landrace e、cultivar a 和 cultivar b 过滤线条；log_x 设为 true 对横轴使用对数刻度并在 1、10 和 100 kb 处设置刻度线。\nlinkage-disequilibrium ld-decay population-genetics\npop 群体（字符串） dist_kb 距离分箱中点，单位 kb（数值） r2 该距离上的平均 r²（数值，0 到 1）"
},
{
"title": "Population PCA",
"title_zh": "群体 PCA（着色与椭圆）",
"slug": "pca-population",
"category": "population-genetics",
"tags": [
"pca",
"population-structure",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"sample": "个体编号（字符串）",
"pop": "群体（字符串）",
"PC1": "第一主成分得分（数值）",
"PC2": "第二主成分得分（数值）",
"PC3": "第三主成分得分（数值，供 pc-pair 切换）",
"var_explained": "data.csv 中为 PC1 方差百分比的重复值；data_variance.csv 的 pc / var_explained 给出 PC1–PC3 各轴百分比"
},
"when_to_use": "用个体主成分看群体是否分开、栽培种是否比野生种更紧时用。",
"customize": "show_ellipse 设为 TRUE 且 ellipse_level 默认 0.95 绘制正态椭圆；show_labels 设为 TRUE 显示名称或 FALSE 显示图例；pc_x 默认 \"PC1\" 且 pc_y 默认 \"PC2\" 选择绘制的主成分；提供命名向量给 label_side 使用 \"above\"、\"below\"、\"left\"、\"right\" 或 \"below_left\" 定位每个椭圆名称。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_ellipse",
"value": "TRUE"
},
{
"name": "show_labels",
"value": "TRUE"
},
{
"name": "ellipse_level",
"value": "0.95"
},
{
"name": "pc_x",
"value": "\"PC1\""
},
{
"name": "pc_y",
"value": "\"PC2\""
},
{
"name": "label_side",
"value": "c(\"Wild N\" = \"below\", \"Wild S\" = \"below\", \"Landrace E\" = \"above\", \"Landrace W\" = \"below_left\", \"Cultivar A\" = \"above_left\", \"Cultivar B\" = \"below_left\")"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/pca-population/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/pca-population/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/pca-population/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/pca-population/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/pca-population/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/pca-population/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/pca-population/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/pca-population/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/pca-population/make_data.R"
},
{
"name": "data_variance.csv",
"path": "figures/population-genetics/pca-population/data_variance.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/pca-population/data_variance.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/pca-population/data_variance.csv"
}
],
"dir": "figures/population-genetics/pca-population",
"preview": "figures/population-genetics/pca-population/preview.png",
"docs_preview": "previews/pca-population.png",
"code": "figures/population-genetics/pca-population/plot.R",
"data": "figures/population-genetics/pca-population/data.csv",
"data_files": [
"figures/population-genetics/pca-population/data.csv",
"figures/population-genetics/pca-population/data_variance.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/pca-population/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/pca-population/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/pca-population",
"code_text": "# Population PCA (house style): accessions coloured by population on the geo palette (north -> south),\n# normal-theory ellipses, population names written beside each cluster. Reads data.csv and\n# data_variance.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_ellipse <- TRUE\nshow_labels <- TRUE\nellipse_level <- 0.95\npc_x <- \"PC1\"\npc_y <- \"PC2\"\n# side of its ellipse each population name sits on: above, below, left, right, below_left\n# (below, ending at the ellipse centre) or above_left (above, ending at the ellipse's right edge)\nlabel_side <- c(\"Wild N\" = \"below\", \"Wild S\" = \"below\", \"Landrace E\" = \"above\",\n \"Landrace W\" = \"below_left\", \"Cultivar A\" = \"above_left\", \"Cultivar B\" = \"below_left\")\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n# populations ordered by geography (mean sampling latitude, north -> south) on the geo palette\npop_geo <- stats::setNames(pv_palette(\"geo\"),\n c(\"Wild N\", \"Cultivar A\", \"Landrace W\", \"Landrace E\", \"Cultivar B\", \"Wild S\"))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nve <- utils::read.csv(\"data_variance.csv\", stringsAsFactors = FALSE)\nve_map <- stats::setNames(ve$var_explained, ve$pc)\npop_order <- c(\"Wild N\", \"Wild S\", \"Landrace E\", \"Landrace W\", \"Cultivar A\", \"Cultivar B\")\ndf$pop <- factor(df$pop, levels = pop_order)\ncols <- pop_geo[pop_order]\naxis_lab <- function(pc) sprintf(\"%s (%.1f%%)\", pc, ve_map[[pc]])\n\n# Name position: fixed coordinates (no repel), just outside the population's ellipse (or its points\n# when ellipses are off) on the side given by label_side.\nxr <- diff(range(df[[pc_x]])); yr <- diff(range(df[[pc_y]]))\nell <- ggplot2::layer_data(ggplot(df, aes(.data[[pc_x]], .data[[pc_y]], group = pop)) +\n stat_ellipse(type = \"norm\", level = ellipse_level))\nell$pop <- levels(df$pop)[ell$group]\next <- if (isTRUE(show_ellipse)) ell[, c(\"pop\", \"x\", \"y\")] else\n data.frame(pop = as.character(df$pop), x = df[[pc_x]], y = df[[pc_y]])\ncen <- do.call(rbind, lapply(pop_order, function(g) {\n e <- ext[ext$pop == g, ]\n side <- if (g %in% names(label_side)) label_side[[g]] else \"above\"\n mx <- mean(range(e$x)); my <- mean(range(e$y))\n switch(side,\n above = data.frame(pop = g, lx = mx, ly = max(e$y) + 0.03 * yr, hjust = 0.5, vjust = 0),\n above_left = data.frame(pop = g, lx = max(e$x), ly = max(e$y) + 0.05 * yr, hjust = 1, vjust = 0),\n below = data.frame(pop = g, lx = mx, ly = min(e$y) - 0.03 * yr, hjust = 0.5, vjust = 1),\n below_left = data.frame(pop = g, lx = mx, ly = min(e$y) - 0.03 * yr, hjust = 1, vjust = 1),\n left = data.frame(pop = g, lx = min(e$x) - 0.03 * xr, ly = my, hjust = 1, vjust = 0.5),\n right = data.frame(pop = g, lx = max(e$x) + 0.03 * xr, ly = my, hjust = 0, vjust = 0.5))\n}))\n\np <- ggplot(df, aes(.data[[pc_x]], .data[[pc_y]]))\nif (isTRUE(show_ellipse)) {\n p <- p + stat_ellipse(aes(fill = pop, colour = pop), geom = \"polygon\", type = \"norm\",\n level = ellipse_level, alpha = 0.12, linewidth = pv_house_lw(\"minor\"))\n}\np <- p + geom_point(aes(fill = pop), shape = HOUSE_POINT$shape, size = 1.1, stroke = HOUSE_POINT$stroke,\n colour = HOUSE_POINT$colour)\nif (isTRUE(show_labels)) {\n p <- p + geom_text(data = cen, aes(lx, ly, label = pop, hjust = hjust, vjust = vjust),\n colour = text_col(cols)[as.character(cen$pop)], size = pv_pt2size(7),\n family = house_family())\n}\np <- p +\n scale_x_continuous(expand = expansion(mult = c(0.42, 0.1)), labels = function(x) format(x, trim = TRUE)) +\n scale_y_continuous(expand = expansion(mult = 0.12), labels = function(x) format(x, trim = TRUE)) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_fill_manual(values = cols, guide = if (isTRUE(show_labels)) \"none\" else \"legend\", name = NULL) +\n labs(x = axis_lab(pc_x), y = axis_lab(pc_y), caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")) + caption_theme\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "population pca\n群体 pca（着色与椭圆）\npca-population\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n用个体主成分看群体是否分开、栽培种是否比野生种更紧时用。\nshow_ellipse 设为 true 且 ellipse_level 默认 0.95 绘制正态椭圆；show_labels 设为 true 显示名称或 false 显示图例；pc_x 默认 \"pc1\" 且 pc_y 默认 \"pc2\" 选择绘制的主成分；提供命名向量给 label_side 使用 \"above\"、\"below\"、\"left\"、\"right\" 或 \"below_left\" 定位每个椭圆名称。\npca population-structure population-genetics\nsample 个体编号（字符串） pop 群体（字符串） pc1 第一主成分得分（数值） pc2 第二主成分得分（数值） pc3 第三主成分得分（数值，供 pc-pair 切换） var_explained data.csv 中为 pc1 方差百分比的重复值；data_variance.csv 的 pc / var_explained 给出 pc1–pc3 各轴百分比"
},
{
"title": "Effective population size",
"title_zh": "有效群体大小（PSMC / SMC++）",
"slug": "psmc-ne",
"category": "population-genetics",
"tags": [
"psmc",
"smcpp",
"effective-population-size",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"pop": "群体（字符串）",
"years_ago": "距今年数（数值）",
"ne": "有效群体大小点估计（数值）",
"ne_low": "自助法下界（数值）",
"ne_high": "自助法上界（数值）"
},
"when_to_use": "看驯化瓶颈和野生种、栽培种在哪个时间尺度上 Ne 分开或重新汇合。",
"customize": "model 设为 \"psmc\" 对应 10 ka 到 1 Ma 的横轴窗口，或 \"smcpp\" 对应 2 ka 到 500 ka；show_ribbon 设为 TRUE 显示自举条带；pops_show 设为 Wild N 和 Cultivar A 过滤显示的曲线。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "model",
"value": "\"psmc\""
},
{
"name": "show_ribbon",
"value": "TRUE"
},
{
"name": "pops_show",
"value": "c(\"Wild N\", \"Cultivar A\")"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/psmc-ne/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/psmc-ne/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/psmc-ne/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/psmc-ne/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/psmc-ne/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/psmc-ne/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/psmc-ne/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/psmc-ne/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/psmc-ne/make_data.R"
}
],
"dir": "figures/population-genetics/psmc-ne",
"preview": "figures/population-genetics/psmc-ne/preview.png",
"docs_preview": "previews/psmc-ne.png",
"code": "figures/population-genetics/psmc-ne/plot.R",
"data": "figures/population-genetics/psmc-ne/data.csv",
"data_files": [
"figures/population-genetics/psmc-ne/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/psmc-ne/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/psmc-ne/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/psmc-ne",
"code_text": "# Effective population size through time on log-log axes (house style), with bootstrap ribbons;\n# population names written next to their curves. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\n# psmc: classic range (unreliable below ~10 ka). smcpp: includes more recent time.\nmodel <- \"psmc\"\nshow_ribbon <- TRUE\npops_show <- c(\"Wild N\", \"Cultivar A\")\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$pop %in% pops_show, ]\ndf$pop <- factor(df$pop, levels = pops_show)\ncols <- pop_cols[pops_show]\nxlim <- if (model == \"smcpp\") c(2e3, 5e5) else c(1e4, 1e6)\nshort <- function(x, unit) paste0(c(\"1\", \"10\", \"100\", \"1\")[match(x, c(1e3, 1e4, 1e5, 1e6))],\n ifelse(x < 1e6, unit[1], unit[2]))\n\n# each name sits at the recent (left) end of the window, above or below its curve: the higher\n# curve gets its name above, the others below\nvis <- df[df$years_ago >= xlim[1] & df$years_ago <= xlim[2], ]\nleft <- do.call(rbind, lapply(split(vis, vis$pop, drop = TRUE), function(d) d[which.min(d$years_ago), ]))\nleft$above <- left$ne == max(left$ne)\nleft$y <- ifelse(left$above, left$ne_high * 1.25, left$ne_low / 1.25)\n\np <- ggplot(df, aes(years_ago, ne, colour = pop, fill = pop))\nif (isTRUE(show_ribbon)) {\n p <- p + geom_ribbon(aes(ymin = ne_low, ymax = ne_high), alpha = 0.18, colour = NA)\n}\np <- p +\n geom_line(linewidth = pv_house_lw(\"main\")) +\n annotate(\"text\", x = xlim[1] * 1.15, y = left$y, label = as.character(left$pop), hjust = 0,\n vjust = ifelse(left$above, 0, 1), colour = text_col(cols)[as.character(left$pop)],\n size = pv_pt2size(7), family = house_family()) +\n scale_x_log10(breaks = c(1e3, 1e4, 1e5, 1e6), labels = function(x) short(x, c(\" ka\", \" Ma\"))) +\n scale_y_log10(breaks = c(1e3, 1e4, 1e5, 1e6), labels = function(x) short(x, c(\"k\", \"M\"))) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_fill_manual(values = cols, guide = \"none\") +\n coord_cartesian(xlim = xlim) +\n labs(x = \"Time before present\", y = \"Effective size (Ne)\", caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")) + caption_theme\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "effective population size\n有效群体大小（psmc / smc++）\npsmc-ne\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n看驯化瓶颈和野生种、栽培种在哪个时间尺度上 ne 分开或重新汇合。\nmodel 设为 \"psmc\" 对应 10 ka 到 1 ma 的横轴窗口，或 \"smcpp\" 对应 2 ka 到 500 ka；show_ribbon 设为 true 显示自举条带；pops_show 设为 wild n 和 cultivar a 过滤显示的曲线。\npsmc smcpp effective-population-size population-genetics\npop 群体（字符串） years_ago 距今年数（数值） ne 有效群体大小点估计（数值） ne_low 自助法下界（数值） ne_high 自助法上界（数值）"
},
{
"title": "ROH and IBD lengths",
"title_zh": "ROH / IBD 长度分布",
"slug": "roh-ibd",
"category": "population-genetics",
"tags": [
"roh",
"ibd",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"pop": "群体（字符串）",
"kind": "ROH 或 IBD（字符串）",
"length_mb": "片段长度，单位 Mb（数值）"
},
"when_to_use": "比较群体的纯合片段和同源 IBD 片段是短而多，还是出现很长的尾巴。",
"customize": "kinds_show 默认 c(\"ROH\", \"IBD\") 选择绘制的行；pop_order 以 Wild N 开始并以 Cultivar B 结束对横轴群体进行排序；log_y 设为 TRUE 对纵轴应用对数刻度并带有特定的兆碱基刻度线。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "kinds_show",
"value": "c(\"ROH\", \"IBD\")"
},
{
"name": "pop_order",
"value": "c(\"Wild N\", \"Wild S\", \"Landrace E\", \"Landrace W\", \"Cultivar A\", \"Cultivar B\")"
},
{
"name": "log_y",
"value": "TRUE"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "43",
"label": "89 × 43 mm (2×1 cells)",
"cells": "2x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/roh-ibd/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/roh-ibd/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/roh-ibd/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/roh-ibd/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/roh-ibd/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/roh-ibd/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/roh-ibd/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/roh-ibd/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/roh-ibd/make_data.R"
}
],
"dir": "figures/population-genetics/roh-ibd",
"preview": "figures/population-genetics/roh-ibd/preview.png",
"docs_preview": "previews/roh-ibd.png",
"code": "figures/population-genetics/roh-ibd/plot.R",
"data": "figures/population-genetics/roh-ibd/data.csv",
"data_files": [
"figures/population-genetics/roh-ibd/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/roh-ibd/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/roh-ibd/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/roh-ibd",
"code_text": "# ROH and IBD segment lengths by population (house style): violin + box per population, one row\n# per segment kind. Population names on the x axis, so no legend. Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nkinds_show <- c(\"ROH\", \"IBD\")\npop_order <- c(\"Wild N\", \"Wild S\", \"Landrace E\", \"Landrace W\", \"Cultivar A\", \"Cultivar B\")\nlog_y <- TRUE\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$kind %in% kinds_show, ]\ndf$pop <- factor(df$pop, levels = pop_order)\ndf$kind <- factor(df$kind, levels = kinds_show)\ncols <- pop_cols[pop_order]\ny_breaks <- c(0.5, 1, 2, 5, 10, 20)\n\np <- ggplot(df, aes(pop, length_mb, fill = pop)) +\n geom_violin(scale = \"width\", width = 0.8, linewidth = pv_house_lw(\"minor\"), colour = grey[[\"dark\"]]) +\n geom_boxplot(width = 0.12, outlier.shape = NA, linewidth = pv_house_lw(\"minor\"),\n fill = \"white\", colour = grey[[\"dark\"]]) +\n facet_grid(kind ~ .) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_x_discrete(labels = function(x) sub(\" \", \"\\n\", x)) +\n labs(x = NULL, y = \"Length (Mb)\", caption = footnote) +\n theme_house() +\n theme(axis.text.x = element_text(lineheight = 0.9), strip.background = element_blank(), strip.text.y = element_text(size = 7, angle = 0, hjust = 0),\n plot.margin = margin(1, 1.5, 1, 1, \"mm\")) +\n caption_theme\np <- p + if (isTRUE(log_y)) scale_y_log10(breaks = y_breaks, labels = format(y_breaks, drop0trailing = TRUE, trim = TRUE)) else scale_y_continuous()\n\npv_save_house(p, \"figure\", cells = \"2x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "roh and ibd lengths\nroh / ibd 长度分布\nroh-ibd\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n比较群体的纯合片段和同源 ibd 片段是短而多，还是出现很长的尾巴。\nkinds_show 默认 c(\"roh\", \"ibd\") 选择绘制的行；pop_order 以 wild n 开始并以 cultivar b 结束对横轴群体进行排序；log_y 设为 true 对纵轴应用对数刻度并带有特定的兆碱基刻度线。\nroh ibd population-genetics\npop 群体（字符串） kind roh 或 ibd（字符串） length_mb 片段长度，单位 mb（数值）"
},
{
"title": "Geographic sampling map",
"title_zh": "采样点地图",
"slug": "sampling-map",
"category": "population-genetics",
"tags": [
"map",
"sampling",
"population-genetics"
],
"packages": [
"ggplot2",
"maps"
],
"data_columns": {
"site": "采样点编号（字符串）",
"pop": "群体（字符串）",
"x": "经度（数值）",
"y": "纬度（数值）",
"n": "该点样本数（整数）"
},
"when_to_use": "采样点要按群体着色、按样本量缩放，并看出群体的地理范围时用。",
"customize": "show_hull 设为 TRUE 为每个群体显示浅色凸包；show_pie 保持 FALSE 让凸包可见；show_labels 设为 TRUE 渲染名称；将六个群体提供给 pops_show 以包含它们；调整 label_side 使用 \"left\"、\"right\"、\"above\"、\"below\" 或 \"above_left\" 相对站点定位文本。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_hull",
"value": "TRUE"
},
{
"name": "show_pie",
"value": "FALSE"
},
{
"name": "show_labels",
"value": "TRUE"
},
{
"name": "pops_show",
"value": "c(\"Wild N\", \"Wild S\", \"Landrace E\", \"Landrace W\", \"Cultivar A\", \"Cultivar B\")"
},
{
"name": "label_side",
"value": "c(\"Wild N\" = \"left\", \"Wild S\" = \"right\", \"Landrace E\" = \"above_left\", \"Landrace W\" = \"below\", \"Cultivar A\" = \"left\", \"Cultivar B\" = \"below\")"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/sampling-map/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/sampling-map/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/sampling-map/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/sampling-map/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/sampling-map/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/sampling-map/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/sampling-map/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/sampling-map/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/sampling-map/make_data.R"
}
],
"dir": "figures/population-genetics/sampling-map",
"preview": "figures/population-genetics/sampling-map/preview.png",
"docs_preview": "previews/sampling-map.png",
"code": "figures/population-genetics/sampling-map/plot.R",
"data": "figures/population-genetics/sampling-map/data.csv",
"data_files": [
"figures/population-genetics/sampling-map/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/sampling-map/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/sampling-map/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/sampling-map",
"code_text": "# Sampling map (house style): sites sized by sample number and coloured by population on the geo\n# palette (north -> south), optional convex hulls, population names written beside their sites.\n# Coastline from ggplot2::map_data (maps package, no network). Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_hull <- TRUE\nshow_pie <- FALSE\nshow_labels <- TRUE\npops_show <- c(\"Wild N\", \"Wild S\", \"Landrace E\", \"Landrace W\", \"Cultivar A\", \"Cultivar B\")\n# side of its site group each population name sits on: left, right, above, below or above_left\n# (above, shifted west)\nlabel_side <- c(\"Wild N\" = \"left\", \"Wild S\" = \"right\", \"Landrace E\" = \"above_left\",\n \"Landrace W\" = \"below\", \"Cultivar A\" = \"left\", \"Cultivar B\" = \"below\")\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n# populations ordered by geography (mean sampling latitude, north -> south) on the geo palette\npop_geo <- stats::setNames(pv_palette(\"geo\"),\n c(\"Wild N\", \"Cultivar A\", \"Landrace W\", \"Landrace E\", \"Cultivar B\", \"Wild S\"))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$pop %in% pops_show, ]\ndf$pop <- factor(df$pop, levels = pops_show)\ncols <- pop_geo[pops_show]\nxlim <- c(100, 126); ylim <- c(20, 45)\n\nworld <- map_data(\"world\")\nhulls <- do.call(rbind, lapply(split(df, df$pop), function(d) {\n if (nrow(d) < 3) return(NULL)\n h <- grDevices::chull(d$x, d$y)\n d[c(h, h[1]), ]\n}))\n\n# names sit on the land fill (#F0F0F0), not on white: orange #E17927 is only 2.65:1 there, so it\n# takes the next darker orange step in the house palettes (chrom12 #AB5A29, 4.37:1 on #F0F0F0)\nmap_text_col <- text_col(cols)\nmap_text_col[map_text_col == \"#E17927\"] <- \"#AB5A29\"\np <- ggplot() +\n geom_polygon(data = world, aes(long, lat, group = group),\n fill = grey[[\"bg\"]], colour = grey[[\"ci\"]], linewidth = pv_house_lw(\"minor\"))\nif (isTRUE(show_hull) && !isTRUE(show_pie) && !is.null(hulls) && nrow(hulls)) {\n p <- p + geom_polygon(data = hulls, aes(x, y, group = pop, fill = pop), alpha = 0.18,\n colour = NA, show.legend = FALSE)\n}\np <- p +\n geom_point(data = df, aes(x, y, fill = pop, size = n), shape = HOUSE_POINT$shape,\n stroke = HOUSE_POINT$stroke, colour = HOUSE_POINT$colour) +\n scale_fill_manual(values = cols, guide = \"none\") +\n scale_size_area(name = \"Samples\", max_size = 3.2, breaks = c(10, 20, 30)) +\n coord_quickmap(xlim = xlim, ylim = ylim, expand = FALSE) +\n scale_x_continuous(breaks = seq(105, 120, 5), labels = function(x) paste0(x, \"\\u00b0E\")) +\n scale_y_continuous(breaks = seq(25, 40, 5), labels = function(x) paste0(x, \"\\u00b0N\")) +\n labs(x = NULL, y = NULL, caption = footnote) +\n guides(size = guide_legend(override.aes = list(fill = grey[[\"ci\"]]))) +\n theme_house() +\n theme(axis.ticks = element_blank(),\n legend.position = \"inside\", legend.position.inside = c(0.02, 0.98),\n legend.justification.inside = c(0, 1),\n legend.background = element_rect(fill = \"white\", colour = NA),\n legend.title = element_text(size = 7), legend.text = element_text(size = 7),\n plot.margin = margin(1, 1.5, 1, 1, \"mm\")) +\n caption_theme\nif (isTRUE(show_labels)) {\n # fixed coordinates just outside the population's sites (no repel)\n pad <- 0.9\n cen <- do.call(rbind, lapply(split(df, df$pop, drop = TRUE), function(d) {\n g <- as.character(d$pop[1])\n side <- if (g %in% names(label_side)) label_side[[g]] else \"right\"\n switch(side,\n left = data.frame(pop = g, x = min(d$x) - pad, y = stats::median(d$y), hjust = 1, vjust = 0.5),\n right = data.frame(pop = g, x = max(d$x) + pad, y = stats::median(d$y), hjust = 0, vjust = 0.5),\n above = data.frame(pop = g, x = stats::median(d$x), y = max(d$y) + pad, hjust = 0.5, vjust = 0),\n above_left = data.frame(pop = g, x = stats::median(d$x), y = max(d$y) + pad, hjust = 0.62, vjust = 0),\n below = data.frame(pop = g, x = stats::median(d$x), y = min(d$y) - pad, hjust = 0.5, vjust = 1))\n }))\n p <- p + geom_text(data = cen, aes(x, y, label = pop, hjust = hjust, vjust = vjust),\n colour = map_text_col[cen$pop], size = pv_pt2size(7), family = house_family())\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "geographic sampling map\n采样点地图\nsampling-map\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n采样点要按群体着色、按样本量缩放，并看出群体的地理范围时用。\nshow_hull 设为 true 为每个群体显示浅色凸包；show_pie 保持 false 让凸包可见；show_labels 设为 true 渲染名称；将六个群体提供给 pops_show 以包含它们；调整 label_side 使用 \"left\"、\"right\"、\"above\"、\"below\" 或 \"above_left\" 相对站点定位文本。\nmap sampling population-genetics\nsite 采样点编号（字符串） pop 群体（字符串） x 经度（数值） y 纬度（数值） n 该点样本数（整数）"
},
{
"title": "Selection scan",
"title_zh": "选择扫描（XP-CLR / iHS）",
"slug": "selection-scan",
"category": "population-genetics",
"tags": [
"xp-clr",
"ihs",
"selection",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"chr": "染色体（chr1–chr5）",
"pos": "窗口中点，单位 bp（整数）",
"score": "XP-CLR 分数或 |iHS|（数值，由 method 决定）",
"method": "xpclr 或 ihs"
},
"when_to_use": "沿基因组找选择信号，XP-CLR 看群体间扫描，|iHS| 看单倍型纯合延伸。",
"customize": "methods_show 默认 c(\"xpclr\", \"ihs\") 选择绘制的行；show_threshold 设为 TRUE 显示水平线；xpclr_q 默认 0.995 调整全基因组分位数线，ihs_cut 默认 2 调整绝对 iHS 线。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": "Selection",
"variants": [
{
"slug": "selection-scan",
"variant_label": "Selection",
"title": "Selection scan",
"title_zh": "选择扫描（XP-CLR / iHS）",
"docs_preview": "previews/selection-scan.png"
},
{
"slug": "window-scan",
"variant_label": "Window",
"title": "Diversity window scan",
"title_zh": "多样性滑窗曼哈顿",
"docs_preview": "previews/window-scan.png"
}
],
"parameters": [
{
"name": "methods_show",
"value": "c(\"xpclr\", \"ihs\")"
},
{
"name": "show_threshold",
"value": "TRUE"
},
{
"name": "xpclr_q",
"value": "0.995"
},
{
"name": "ihs_cut",
"value": "2"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/selection-scan/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/selection-scan/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/selection-scan/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/selection-scan/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/selection-scan/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/selection-scan/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/selection-scan/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/selection-scan/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/selection-scan/make_data.R"
}
],
"dir": "figures/population-genetics/selection-scan",
"preview": "figures/population-genetics/selection-scan/preview.png",
"docs_preview": "previews/selection-scan.png",
"code": "figures/population-genetics/selection-scan/plot.R",
"data": "figures/population-genetics/selection-scan/data.csv",
"data_files": [
"figures/population-genetics/selection-scan/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/selection-scan/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/selection-scan/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/selection-scan",
"code_text": "# Selection scan, XP-CLR and |iHS| (house style): chromosomes in chrom12 colours, one row per method\n# with its name as the row title, dashed cut-off lines. Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nmethods_show <- c(\"xpclr\", \"ihs\")\nshow_threshold <- TRUE\nxpclr_q <- 0.995\nihs_cut <- 2\n\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$method %in% methods_show, ]\ndf$chr <- factor(df$chr, levels = paste0(\"chr\", 1:5))\ndf$method <- factor(df$method, levels = methods_show)\nchr_max <- tapply(df$pos, df$chr, max)\ngap <- 1.6e6\noff <- c(0, cumsum(chr_max + gap)[-length(chr_max)])\nnames(off) <- names(chr_max)\ndf$x <- df$pos + off[as.character(df$chr)]\nmids <- off + chr_max / 2\n# one chrom12 colour per chromosome (light and dark alternate along the genome)\nchr_pal <- stats::setNames(pv_palette(\"chrom12\", nlevels(df$chr)), levels(df$chr))\ndf$chr_col <- unname(chr_pal[as.character(df$chr)])\n\nmeth_lab <- c(xpclr = \"XP-CLR\", ihs = \"|iHS|\")\nthr <- data.frame(\n method = factor(c(\"xpclr\", \"ihs\"), levels = methods_show),\n y = c(stats::quantile(df$score[df$method == \"xpclr\"], xpclr_q), ihs_cut),\n stringsAsFactors = FALSE\n)\nthr <- thr[thr$method %in% methods_show, ]\n\np <- ggplot(df, aes(x, score, colour = chr_col)) +\n geom_point(size = 0.4, shape = 16, show.legend = FALSE) +\n scale_colour_identity() +\n scale_x_continuous(\n breaks = mids, labels = gsub(\"chr\", \"\", names(mids)),\n expand = expansion(mult = 0.01)\n ) +\n facet_grid(method ~ ., scales = \"free_y\", switch = \"y\", labeller = as_labeller(meth_lab)) +\n labs(x = \"Chromosome\", y = NULL) +\n labs(caption = footnote) +\n theme_house() +\n theme(\n strip.background = element_blank(), strip.placement = \"outside\",\n strip.text.y.left = element_text(size = 7, angle = 0, hjust = 1),\n panel.spacing.y = unit(2, \"mm\"),\n plot.margin = margin(2, 1.5, 1, 1, \"mm\") # top 2 mm: the top y tick label sits on the panel edge\n ) +\n caption_theme\nif (isTRUE(show_threshold)) {\n p <- p + geom_hline(\n data = thr, aes(yintercept = y),\n linetype = \"dashed\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"dark\"]], inherit.aes = FALSE\n )\n}\n\npv_save_house(p, \"figure\", cells = \"4x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "selection scan\n选择扫描（xp-clr / ihs）\nselection-scan\nselection\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n沿基因组找选择信号，xp-clr 看群体间扫描，|ihs| 看单倍型纯合延伸。\nmethods_show 默认 c(\"xpclr\", \"ihs\") 选择绘制的行；show_threshold 设为 true 显示水平线；xpclr_q 默认 0.995 调整全基因组分位数线，ihs_cut 默认 2 调整绝对 ihs 线。\nxp-clr ihs selection population-genetics\nchr 染色体（chr1–chr5） pos 窗口中点，单位 bp（整数） score xp-clr 分数或 |ihs|（数值，由 method 决定） method xpclr 或 ihs"
},
{
"title": "Site frequency spectrum",
"title_zh": "位点频谱",
"slug": "sfs",
"category": "population-genetics",
"tags": [
"sfs",
"allele-frequency",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"pop": "群体（字符串）",
"bin": "等位基因计数分箱，1 到 20（整数；40 条染色体的折叠频谱对应次等位基因数）",
"count": "该分箱的位点数（整数）",
"folded": "1 为折叠频谱，0 为展开频谱（整数）"
},
"when_to_use": "比较野生种、农家种和栽培种的稀有等位基因是过多还是被瓶颈削平。",
"customize": "use_folded 设为 TRUE 绘制次等位基因计数，或 FALSE 绘制展开的衍生等位基因计数；pops_show 设为 Wild N、Landrace E 和 Cultivar A 过滤显示为位点比例的群体。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "use_folded",
"value": "TRUE"
},
{
"name": "pops_show",
"value": "c(\"Wild N\", \"Landrace E\", \"Cultivar A\")"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "43",
"height_mm": "43",
"label": "43 × 43 mm (1×1 cells)",
"cells": "1x1"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/sfs/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/sfs/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/sfs/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/sfs/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/sfs/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/sfs/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/sfs/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/sfs/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/sfs/make_data.R"
}
],
"dir": "figures/population-genetics/sfs",
"preview": "figures/population-genetics/sfs/preview.png",
"docs_preview": "previews/sfs.png",
"code": "figures/population-genetics/sfs/plot.R",
"data": "figures/population-genetics/sfs/data.csv",
"data_files": [
"figures/population-genetics/sfs/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/sfs/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/sfs/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/sfs",
"code_text": "# Site frequency spectrum by population (house style): proportion of sites per allele-count bin,\n# population names stacked in the empty top-right corner in curve order. Reads data.csv only.\n# Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nuse_folded <- TRUE\npops_show <- c(\"Wild N\", \"Landrace E\", \"Cultivar A\")\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$pop %in% pops_show & df$folded == as.integer(use_folded), ]\ndf$pop <- factor(df$pop, levels = pops_show)\ndf$prop <- ave(df$count, df$pop, FUN = function(x) x / sum(x))\ncols <- pop_cols[pops_show]\nx_lab <- if (isTRUE(use_folded)) \"Minor allele count\" else \"Derived allele count\"\n\n# names in the order of the first bin (top to bottom)\nfirst <- df[df$bin == min(df$bin), ]\nlabs_df <- data.frame(pop = as.character(first$pop[order(-first$prop)]))\ntop <- max(df$prop)\nlabs_df$y <- top * (1 - 0.085 * (seq_len(nrow(labs_df)) - 1))\n\np <- ggplot(df, aes(bin, prop, colour = pop)) +\n geom_line(linewidth = pv_house_lw(\"main\")) +\n geom_point(size = 1.1, shape = 16) +\n annotate(\"text\", x = Inf, y = labs_df$y, label = labs_df$pop, hjust = 1.08, vjust = 1,\n colour = text_col(cols)[labs_df$pop], size = pv_pt2size(7), family = house_family()) +\n scale_colour_manual(values = cols, guide = \"none\") +\n scale_x_continuous(breaks = c(1, 5, 10, 15, 20)) +\n scale_y_continuous(expand = expansion(mult = c(0.04, 0.04))) +\n labs(x = x_lab, y = \"Proportion of sites\", caption = footnote) +\n theme_house() + theme(plot.margin = margin(1, 1.5, 1, 1, \"mm\")) + caption_theme\n\npv_save_house(p, \"figure\", cells = \"1x1\")\nmessage(\"wrote preview.png\")\n",
"search_text": "site frequency spectrum\n位点频谱\nsfs\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n比较野生种、农家种和栽培种的稀有等位基因是过多还是被瓶颈削平。\nuse_folded 设为 true 绘制次等位基因计数，或 false 绘制展开的衍生等位基因计数；pops_show 设为 wild n、landrace e 和 cultivar a 过滤显示为位点比例的群体。\nsfs allele-frequency population-genetics\npop 群体（字符串） bin 等位基因计数分箱，1 到 20（整数；40 条染色体的折叠频谱对应次等位基因数） count 该分箱的位点数（整数） folded 1 为折叠频谱，0 为展开频谱（整数）"
},
{
"title": "TreeMix migration tree",
"title_zh": "TreeMix 迁移树",
"slug": "treemix",
"category": "population-genetics",
"tags": [
"treemix",
"migration",
"population"
],
"packages": [
"ggtree",
"ggplot2",
"ape",
"patchwork"
],
"data_columns": {
"pop": "子节点或群体名；迁移行留空（字符串）",
"parent": "父节点；迁移行留空（字符串）",
"drift": "漂移枝长；迁移行留空（数值）",
"mig_from": "迁移来源群体；树边行留空（字符串）",
"mig_to": "迁移去向群体；树边行留空（字符串）",
"weight": "迁移权重；树边行留空（数值）"
},
"when_to_use": "在最大似然群体树上画出迁移边，并用颜色表示迁移权重时用。",
"customize": "show_migration 设为 TRUE 绘制按权重着色的弯曲箭头；show_residual 设为 FALSE 隐藏残差矩阵，或 TRUE 在树旁添加该矩阵；arrow_curvature 默认 0.55 调整迁移箭头的弯曲度。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [
{
"name": "show_migration",
"value": "TRUE"
},
{
"name": "show_residual",
"value": "FALSE"
},
{
"name": "arrow_curvature",
"value": "-0.4"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "89",
"height_mm": "89",
"label": "89 × 89 mm (2×2 cells)",
"cells": "2x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/treemix/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/treemix/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/treemix/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/treemix/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/treemix/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/treemix/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/treemix/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/treemix/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/treemix/make_data.R"
},
{
"name": "data_residual.csv",
"path": "figures/population-genetics/treemix/data_residual.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/treemix/data_residual.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/treemix/data_residual.csv"
}
],
"dir": "figures/population-genetics/treemix",
"preview": "figures/population-genetics/treemix/preview.png",
"docs_preview": "previews/treemix.png",
"code": "figures/population-genetics/treemix/plot.R",
"data": "figures/population-genetics/treemix/data.csv",
"data_files": [
"figures/population-genetics/treemix/data.csv",
"figures/population-genetics/treemix/data_residual.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/treemix/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/treemix/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/treemix",
"code_text": "# TreeMix-style drift tree (house style) with migration arrows coloured by weight on house_warm;\n# optional residual matrix on house_div beside it (patchwork). The tree panel has no frame.\n# Reads data.csv (and data_residual.csv when show_residual = TRUE). Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nshow_migration <- TRUE\nshow_residual <- FALSE\narrow_curvature <- -0.4\n\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n# populations ordered by geography (mean sampling latitude, north -> south) on the geo palette\npop_geo <- stats::setNames(pv_palette(\"geo\"),\n c(\"Wild N\", \"Cultivar A\", \"Landrace W\", \"Landrace E\", \"Cultivar B\", \"Wild S\"))\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\nedges <- df[nzchar(df$pop), , drop = FALSE]\nmigs <- df[nzchar(df$mig_from), , drop = FALSE]\n\ntip_names <- sort(setdiff(edges$pop, edges$parent))\nroot <- setdiff(edges$parent, edges$pop)\ninternals <- c(root, sort(setdiff(unique(edges$parent), root)))\nids <- setNames(seq_along(c(tip_names, internals)), c(tip_names, internals))\ntr <- list(\n edge = cbind(unname(ids[edges$parent]), unname(ids[edges$pop])),\n edge.length = edges$drift,\n tip.label = tip_names,\n Nnode = length(internals)\n)\nclass(tr) <- \"phylo\"\n\np <- ggtree::ggtree(tr, linewidth = pv_house_lw(\"main\"), colour = grey[[\"dark\"]]) +\n ggtree::geom_tiplab(size = pv_pt2size(7), offset = 0.14, family = house_family(), colour = \"#1A1A1A\") +\n scale_x_continuous(expand = expansion(mult = c(0.02, 0.12))) +\n labs(x = \"Drift parameter\", caption = footnote) +\n theme_house() +\n theme(\n panel.border = element_blank(),\n axis.line.x = element_line(linewidth = pv_house_lw(\"frame\"), colour = \"black\"),\n axis.line.y = element_blank(),\n axis.text.y = element_blank(),\n axis.ticks.y = element_blank(),\n legend.position = \"inside\", legend.position.inside = c(0.02, 0.98),\n legend.justification.inside = c(0, 1), legend.direction = \"horizontal\",\n legend.title = element_text(size = 7, margin = margin(b = 0.8, unit = \"mm\")),\n legend.text = element_text(size = 7),\n legend.key.width = unit(8, \"mm\"), legend.key.height = unit(2, \"mm\"),\n plot.margin = margin(1, 1.5, 1, 1, \"mm\")\n ) +\n caption_theme\n\nif (isTRUE(show_migration) && nrow(migs)) {\n dd <- p$data\n # arrow leaves the midpoint of the source tip's terminal branch and arrives at the midpoint\n # of the target's terminal branch (half-way between the parent node and the tip)\n mid_of <- function(tip) {\n child <- dd[which(dd$label == tip), , drop = FALSE] # which(): internal nodes have NA labels\n parent <- dd[dd$node == child$parent[1], , drop = FALSE]\n data.frame(x = (parent$x + child$x) / 2, y = child$y, stringsAsFactors = FALSE)\n }\n # Each arrow comes in from above or below and stops just short of the target's terminal\n # branch, so the head sits on the branch midpoint and clear of the vertical branches.\n # approach / curvature per arrow (fixed, chosen to keep crossings few); others default.\n approach <- c(\"P7>P10\" = \"below\")\n bend <- c(\"P7>P10\" = 0.35, \"P6>P5\" = 0) # P6 -> P5 straight, clear of the P9 label\n row_gap <- 0.08 # head tip stops this far from the branch (data units; tip spacing is 1)\n lead_in <- 0.45 # the curve ends this far above/below the target; a short vertical stem\n # carries the head straight down/up onto the branch midpoint\n seg <- lapply(seq_len(nrow(migs)), function(i) {\n key <- paste0(migs$mig_from[i], \">\", migs$mig_to[i])\n a <- mid_of(migs$mig_from[i])\n b <- mid_of(migs$mig_to[i])\n side <- if (key %in% names(approach)) approach[[key]] else \"above\"\n data.frame(\n x = a$x, y = a$y, xend = b$x, yend = b$y + if (side == \"above\") lead_in else -lead_in,\n yhead = b$y + if (side == \"above\") row_gap else -row_gap,\n weight = migs$weight[i],\n curv = if (key %in% names(bend)) bend[[key]] else arrow_curvature,\n stringsAsFactors = FALSE\n )\n })\n seg <- do.call(rbind, seg)\n for (k in seq_len(nrow(seg))) {\n p <- p + geom_curve(\n data = seg[k, , drop = FALSE],\n aes(x = x, y = y, xend = xend, yend = yend, colour = weight),\n curvature = seg$curv[k], linewidth = pv_house_lw(\"main\"), lineend = \"round\",\n inherit.aes = FALSE\n ) + geom_segment(\n data = seg[k, , drop = FALSE],\n aes(x = xend, y = yend, xend = xend, yend = yhead, colour = weight),\n arrow = grid::arrow(length = grid::unit(0.9, \"mm\"), angle = 20, type = \"closed\"),\n linewidth = pv_house_lw(\"main\"), lineend = \"round\", inherit.aes = FALSE\n )\n }\n p <- p +\n scale_colour_gradientn(colours = pv_palette(\"house_warm\")[4:5], name = \"Migration weight\",\n breaks = function(l) pretty(l, n = 2),\n guide = guide_colourbar(title.position = \"top\"))\n}\n\nif (isTRUE(show_residual)) {\n res <- utils::read.csv(\"data_residual.csv\", stringsAsFactors = FALSE)\n pops <- sort(unique(res$pop_a))\n res$pop_a <- factor(res$pop_a, levels = pops)\n res$pop_b <- factor(res$pop_b, levels = rev(pops))\n pr <- ggplot(res, aes(pop_a, pop_b, fill = residual)) +\n geom_tile(colour = \"white\", linewidth = 0.3) +\n scale_fill_gradientn(colours = pv_palette(\"house_div\"), name = \"Residual\",\n limits = c(-1, 1) * max(abs(res$residual))) +\n coord_fixed() +\n labs(x = NULL, y = NULL) +\n theme_house() +\n theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5), axis.ticks = element_blank(),\n legend.title = element_text(size = 7), legend.text = element_text(size = 7),\n legend.key.width = unit(2, \"mm\"), legend.key.height = unit(10, \"mm\"))\n p <- patchwork::wrap_plots(p, pr, nrow = 1, widths = c(1.15, 0.9))\n}\n\npv_save_house(p, \"figure\", cells = \"2x2\", bump = 0)\nmessage(\"wrote preview.png\")\n",
"search_text": "treemix migration tree\ntreemix 迁移树\ntreemix\n\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n在最大似然群体树上画出迁移边，并用颜色表示迁移权重时用。\nshow_migration 设为 true 绘制按权重着色的弯曲箭头；show_residual 设为 false 隐藏残差矩阵，或 true 在树旁添加该矩阵；arrow_curvature 默认 0.55 调整迁移箭头的弯曲度。\ntreemix migration population\npop 子节点或群体名；迁移行留空（字符串） parent 父节点；迁移行留空（字符串） drift 漂移枝长；迁移行留空（数值） mig_from 迁移来源群体；树边行留空（字符串） mig_to 迁移去向群体；树边行留空（字符串） weight 迁移权重；树边行留空（数值）"
},
{
"title": "Diversity window scan",
"title_zh": "多样性滑窗曼哈顿",
"slug": "window-scan",
"category": "population-genetics",
"tags": [
"fst",
"nucleotide-diversity",
"tajima",
"population-genetics"
],
"packages": [
"ggplot2"
],
"data_columns": {
"chr": "染色体（chr1–chr5）",
"pos": "窗口中点，单位 bp（整数）",
"stat": "fst、pi 或 tajima",
"value": "fst 为 Weir–Cockerham Fst；pi 为 π×10^3（每 kb）；tajima 为 Tajima's D"
},
"when_to_use": "沿染色体看分化高峰、多样性低谷和 Tajima's D 偏负是否落在同一段。",
"customize": "stats_show 默认 c(\"fst\", \"pi\", \"tajima\") 设置绘制的统计量行；show_threshold 设为 TRUE 绘制显著性线；fst_q 默认 0.99 调整上分位数，pi_q 默认 0.05 调整下分位数，tajima_line 默认 -2 调整 Tajima's D 线。",
"lang": "R",
"task": "popgen",
"task_zh": "群体遗传",
"task_en": "Population genetics",
"variant_of": "selection-scan",
"variant_label": "Window",
"variants": [],
"parameters": [
{
"name": "stats_show",
"value": "c(\"fst\", \"pi\", \"tajima\")"
},
{
"name": "show_threshold",
"value": "TRUE"
},
{
"name": "fst_q",
"value": "0.99"
},
{
"name": "pi_q",
"value": "0.05"
},
{
"name": "tajima_line",
"value": "-2"
},
{
"name": "footnote",
"value": "\"Simulated data;\\nnot biological results\""
},
{
"name": "hp",
"value": "pv_palette(\"house\")"
},
{
"name": "grey",
"value": "pv_palette(\"house_grey\")"
}
],
"canvas": {
"width_mm": "183",
"height_mm": "89",
"label": "183 × 89 mm (4×2 cells)",
"cells": "4x2"
},
"downloads": [
{
"name": "plot.R",
"path": "figures/population-genetics/window-scan/plot.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/window-scan/plot.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/window-scan/plot.R"
},
{
"name": "data.csv",
"path": "figures/population-genetics/window-scan/data.csv",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/window-scan/data.csv",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/window-scan/data.csv"
},
{
"name": "make_data.R",
"path": "figures/population-genetics/window-scan/make_data.R",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/population-genetics/window-scan/make_data.R",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/window-scan/make_data.R"
}
],
"dir": "figures/population-genetics/window-scan",
"preview": "figures/population-genetics/window-scan/preview.png",
"docs_preview": "previews/window-scan.png",
"code": "figures/population-genetics/window-scan/plot.R",
"data": "figures/population-genetics/window-scan/data.csv",
"data_files": [
"figures/population-genetics/window-scan/data.csv"
],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/window-scan/plot.R",
"github_data": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/population-genetics/window-scan/data.csv",
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/population-genetics/window-scan",
"code_text": "# Diversity window scan (house style): FST, pi and Tajima's D along the genome, chromosomes in chrom12\n# colours, one row per statistic with its name as the row title, dashed cut-off lines.\n# Reads data.csv only. Run from this directory.\nsource(\"../../../styles/r/theme_house.R\")\nlibrary(ggplot2)\n\n# 可调参数 -----------------------------------------------------------------\nstats_show <- c(\"fst\", \"pi\", \"tajima\")\nshow_threshold <- TRUE\nfst_q <- 0.99\npi_q <- 0.05\ntajima_line <- -2\n\nfootnote <- \"Simulated data;\\nnot biological results\"\nhp <- pv_palette(\"house\"); grey <- pv_palette(\"house_grey\")\n# label text: the group colour if it reaches 3:1 contrast on white (no new colours)\ntext_col <- function(hex) {\n v <- grDevices::col2rgb(hex) / 255\n v <- ifelse(v <= 0.03928, v / 12.92, ((v + 0.055) / 1.055)^2.4)\n ratio <- 1.05 / (colSums(c(0.2126, 0.7152, 0.0722) * v) + 0.05)\n # below 3:1, use the darker step of the same hue where one exists in the house palettes\n # (orange -> chrom12 orange #E17927, 3.01:1); otherwise #1A1A1A\n darker <- c(\"#E17D52\" = \"#E17927\", \"#F77E12\" = \"#E17927\")\n up <- toupper(hex)\n stats::setNames(ifelse(ratio >= 3, hex, ifelse(up %in% names(darker), darker[up], \"#1A1A1A\")),\n names(hex))\n}\ncaption_theme <- theme(plot.caption = element_text(size = 7, hjust = 0, colour = grey[[\"mid\"]],\n lineheight = 0.9, margin = margin(t = 0.8, unit = \"mm\")),\n plot.caption.position = \"plot\")\n# push end-of-line label positions apart to at least `gap` (data units), keeping their order\nspread <- function(y, gap) {\n o <- order(y); z <- y[o]\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n shift <- mean(z) - mean(y[o]); z <- z - shift\n for (i in seq_along(z)[-1]) z[i] <- max(z[i], z[i - 1] + gap)\n y[o] <- z; y\n}\n# fixed house colour per population (same in every B2 figure)\npop_cols <- c(\"Wild N\" = hp[[\"blue\"]], \"Wild S\" = hp[[\"sky\"]], \"Landrace E\" = hp[[\"green\"]],\n \"Landrace W\" = hp[[\"gold\"]], \"Cultivar A\" = hp[[\"red\"]], \"Cultivar B\" = hp[[\"purple\"]])\n\ndf <- utils::read.csv(\"data.csv\", stringsAsFactors = FALSE)\ndf <- df[df$stat %in% stats_show, ]\ndf$chr <- factor(df$chr, levels = paste0(\"chr\", 1:5))\ndf$stat <- factor(df$stat, levels = stats_show)\n\nchr_max <- tapply(df$pos, df$chr, max)\ngap <- 1.6e6\noff <- c(0, cumsum(chr_max + gap)[-length(chr_max)])\nnames(off) <- names(chr_max)\ndf$x <- df$pos + off[as.character(df$chr)]\nmids <- off + chr_max / 2\n# one chrom12 colour per chromosome (light and dark alternate along the genome)\nchr_pal <- stats::setNames(pv_palette(\"chrom12\", nlevels(df$chr)), levels(df$chr))\ndf$chr_col <- unname(chr_pal[as.character(df$chr)])\n\nstat_lab <- c(fst = \"FST\", pi = \"\\u03c0 (\\u00d710^-3)\", tajima = \"Tajima's D\")\nthr <- data.frame(\n stat = factor(stats_show, levels = stats_show),\n y = c(\n stats::quantile(df$value[df$stat == \"fst\"], fst_q),\n stats::quantile(df$value[df$stat == \"pi\"], pi_q),\n tajima_line\n ),\n stringsAsFactors = FALSE\n)\nthr <- thr[thr$stat %in% stats_show, ]\n\np <- ggplot(df, aes(x, value, colour = chr_col)) +\n geom_point(size = 0.4, shape = 16, show.legend = FALSE) +\n scale_colour_identity() +\n scale_x_continuous(\n breaks = mids, labels = gsub(\"chr\", \"\", names(mids)),\n expand = expansion(mult = 0.01)\n ) +\n facet_grid(\n stat ~ ., scales = \"free_y\", switch = \"y\",\n labeller = as_labeller(stat_lab)\n ) +\n labs(x = \"Chromosome\", y = NULL) +\n labs(caption = footnote) +\n theme_house() +\n theme(\n strip.background = element_blank(), strip.placement = \"outside\",\n strip.text.y.left = element_text(size = 7, angle = 0, hjust = 1),\n panel.spacing.y = unit(2, \"mm\"),\n plot.margin = margin(1, 1.5, 1, 1, \"mm\")\n ) +\n caption_theme\nif (isTRUE(show_threshold)) {\n p <- p + geom_hline(\n data = thr, aes(yintercept = y),\n linetype = \"dashed\", linewidth = pv_house_lw(\"ref\"), colour = grey[[\"dark\"]], inherit.aes = FALSE\n )\n}\n\npv_save_house(p, \"figure\", cells = \"4x2\")\nmessage(\"wrote preview.png\")\n",
"search_text": "diversity window scan\n多样性滑窗曼哈顿\nwindow-scan\nwindow\npopulation-genetics\n群体遗传\npopgen\n群体遗传\npopulation genetics\n沿染色体看分化高峰、多样性低谷和 tajima's d 偏负是否落在同一段。\nstats_show 默认 c(\"fst\", \"pi\", \"tajima\") 设置绘制的统计量行；show_threshold 设为 true 绘制显著性线；fst_q 默认 0.99 调整上分位数，pi_q 默认 0.05 调整下分位数，tajima_line 默认 -2 调整 tajima's d 线。\nfst nucleotide-diversity tajima population-genetics\nchr 染色体（chr1–chr5） pos 窗口中点，单位 bp（整数） stat fst、pi 或 tajima value fst 为 weir–cockerham fst；pi 为 π×10^3（每 kb）；tajima 为 tajima's d"
},
{
"title": "Ancient DNA processing",
"title_zh": "古 DNA 处理步骤",
"slug": "adna-processing",
"category": "schematic",
"tags": [
"ancient-dna",
"steps",
"authenticity"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "按顺序交代古 DNA 从取样到真实性检验的主线步骤。",
"customize": "左侧数字圆与右侧说明成对出现。增删一行时每行下移 68 px，并加高页面。副标题保持一句术语习语。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/adna-processing/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/adna-processing/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/adna-processing/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/adna-processing/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/adna-processing/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/adna-processing/figure.svg"
}
],
"dir": "figures/schematic/adna-processing",
"preview": "figures/schematic/adna-processing/preview.png",
"docs_preview": "previews/adna-processing.png",
"code": "figures/schematic/adna-processing/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/adna-processing/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/adna-processing",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "ancient dna processing\n古 dna 处理步骤\nadna-processing\n\nschematic\n流程图\nschematic\n流程图\nschematics\n按顺序交代古 dna 从取样到真实性检验的主线步骤。\n左侧数字圆与右侧说明成对出现。增删一行时每行下移 68 px，并加高页面。副标题保持一句术语习语。\nancient-dna steps authenticity\n"
},
{
"title": "Ancient DNA workflow by role",
"title_zh": "古 DNA 分工泳道",
"slug": "adna-swimlane",
"category": "schematic",
"tags": [
"ancient-dna",
"swimlane",
"roles"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "野外、实验和计算分成三条泳道。",
"customize": "泳道名在左侧色块。每条泳道内从左到右连线，只在泳道之间用一条向下的箭头交接。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/adna-swimlane/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/adna-swimlane/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/adna-swimlane/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/adna-swimlane/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/adna-swimlane/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/adna-swimlane/figure.svg"
}
],
"dir": "figures/schematic/adna-swimlane",
"preview": "figures/schematic/adna-swimlane/preview.png",
"docs_preview": "previews/adna-swimlane.png",
"code": "figures/schematic/adna-swimlane/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/adna-swimlane/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/adna-swimlane",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "ancient dna workflow by role\n古 dna 分工泳道\nadna-swimlane\n\nschematic\n流程图\nschematic\n流程图\nschematics\n野外、实验和计算分成三条泳道。\n泳道名在左侧色块。每条泳道内从左到右连线，只在泳道之间用一条向下的箭头交接。\nancient-dna swimlane roles\n"
},
{
"title": "Assembly strategy comparison",
"title_zh": "组装策略对比",
"slug": "assembly-compare",
"category": "schematic",
"tags": [
"assembly",
"comparison",
"methods"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "比较 HiFi、纳米孔、混合和短读长四条组装路线。",
"customize": "每列一种策略，列内步骤自上而下。底部绿色条是各列共用的评估，不要在列之间互相连线。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/assembly-compare/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/assembly-compare/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/assembly-compare/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/assembly-compare/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/assembly-compare/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/assembly-compare/figure.svg"
}
],
"dir": "figures/schematic/assembly-compare",
"preview": "figures/schematic/assembly-compare/preview.png",
"docs_preview": "previews/assembly-compare.png",
"code": "figures/schematic/assembly-compare/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/assembly-compare/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/assembly-compare",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "assembly strategy comparison\n组装策略对比\nassembly-compare\n\nschematic\n流程图\nschematic\n流程图\nschematics\n比较 hifi、纳米孔、混合和短读长四条组装路线。\n每列一种策略，列内步骤自上而下。底部绿色条是各列共用的评估，不要在列之间互相连线。\nassembly comparison methods\n"
},
{
"title": "Genome assembly iteration",
"title_zh": "基因组组装迭代",
"slug": "assembly-iteration",
"category": "schematic",
"tags": [
"assembly",
"iteration",
"busco"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "组装、抛光、评估、修订构成循环，通过后再发布。",
"customize": "循环四边走方框外侧。发布框只从评估框引出，并标 Pass。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/assembly-iteration/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/assembly-iteration/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/assembly-iteration/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/assembly-iteration/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/assembly-iteration/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/assembly-iteration/figure.svg"
}
],
"dir": "figures/schematic/assembly-iteration",
"preview": "figures/schematic/assembly-iteration/preview.png",
"docs_preview": "previews/assembly-iteration.png",
"code": "figures/schematic/assembly-iteration/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/assembly-iteration/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/assembly-iteration",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "genome assembly iteration\n基因组组装迭代\nassembly-iteration\n\nschematic\n流程图\nschematic\n流程图\nschematics\n组装、抛光、评估、修订构成循环，通过后再发布。\n循环四边走方框外侧。发布框只从评估框引出，并标 pass。\nassembly iteration busco\n"
},
{
"title": "Case-control sequencing design",
"title_zh": "病例对照测序设计",
"slug": "case-control-arms",
"category": "schematic",
"tags": [
"case-control",
"design",
"arms"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "病例和对照两条臂平行取样测序，再联合分析。",
"customize": "两臂步骤保持左右对齐。汇合框用绿色，箭头从每臂最后一步向下进入。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/case-control-arms/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/case-control-arms/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/case-control-arms/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/case-control-arms/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/case-control-arms/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/case-control-arms/figure.svg"
}
],
"dir": "figures/schematic/case-control-arms",
"preview": "figures/schematic/case-control-arms/preview.png",
"docs_preview": "previews/case-control-arms.png",
"code": "figures/schematic/case-control-arms/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/case-control-arms/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/case-control-arms",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "case-control sequencing design\n病例对照测序设计\ncase-control-arms\n\nschematic\n流程图\nschematic\n流程图\nschematics\n病例和对照两条臂平行取样测序，再联合分析。\n两臂步骤保持左右对齐。汇合框用绿色，箭头从每臂最后一步向下进入。\ncase-control design arms\n"
},
{
"title": "GWAS analysis flow",
"title_zh": "GWAS 输入模型输出",
"slug": "gwas-io",
"category": "schematic",
"tags": [
"gwas",
"inputs",
"outputs"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "表型、基因型和协变量进入模型，右侧是结果。",
"customize": "左列是输入，中列是模型，右列是输出。三列标题颜色固定：海军蓝、蓝、绿。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/gwas-io/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/gwas-io/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/gwas-io/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/gwas-io/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/gwas-io/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/gwas-io/figure.svg"
}
],
"dir": "figures/schematic/gwas-io",
"preview": "figures/schematic/gwas-io/preview.png",
"docs_preview": "previews/gwas-io.png",
"code": "figures/schematic/gwas-io/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/gwas-io/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/gwas-io",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "gwas analysis flow\ngwas 输入模型输出\ngwas-io\n\nschematic\n流程图\nschematic\n流程图\nschematics\n表型、基因型和协变量进入模型，右侧是结果。\n左列是输入，中列是模型，右列是输出。三列标题颜色固定：海军蓝、蓝、绿。\ngwas inputs outputs\n"
},
{
"title": "Multi-omics integration",
"title_zh": "多组学整合中心",
"slug": "multiomics-hub",
"category": "schematic",
"tags": [
"multi-omics",
"hub",
"integration"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "基因组、转录组、表观和表型汇入一个联合模型。",
"customize": "四个输入放在四角，中心椭圆是模型，下方绿色框是解释。连线停在椭圆边缘。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/multiomics-hub/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/multiomics-hub/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/multiomics-hub/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/multiomics-hub/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/multiomics-hub/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/multiomics-hub/figure.svg"
}
],
"dir": "figures/schematic/multiomics-hub",
"preview": "figures/schematic/multiomics-hub/preview.png",
"docs_preview": "previews/multiomics-hub.png",
"code": "figures/schematic/multiomics-hub/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/multiomics-hub/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/multiomics-hub",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "multi-omics integration\n多组学整合中心\nmultiomics-hub\n\nschematic\n流程图\nschematic\n流程图\nschematics\n基因组、转录组、表观和表型汇入一个联合模型。\n四个输入放在四角，中心椭圆是模型，下方绿色框是解释。连线停在椭圆边缘。\nmulti-omics hub integration\n"
},
{
"title": "Multi-omics from one cohort",
"title_zh": "同一队列的多组学并行",
"slug": "multiomics-parallel",
"category": "schematic",
"tags": [
"multi-omics",
"parallel",
"integration"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "同一批样本分出多条测定，再汇到整合。",
"customize": "并列组学可增删，但要等宽排布，汇合箭头在组学框下方的空白处汇入。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/multiomics-parallel/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/multiomics-parallel/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/multiomics-parallel/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/multiomics-parallel/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/multiomics-parallel/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/multiomics-parallel/figure.svg"
}
],
"dir": "figures/schematic/multiomics-parallel",
"preview": "figures/schematic/multiomics-parallel/preview.png",
"docs_preview": "previews/multiomics-parallel.png",
"code": "figures/schematic/multiomics-parallel/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/multiomics-parallel/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/multiomics-parallel",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "multi-omics from one cohort\n同一队列的多组学并行\nmultiomics-parallel\n\nschematic\n流程图\nschematic\n流程图\nschematics\n同一批样本分出多条测定，再汇到整合。\n并列组学可增删，但要等宽排布，汇合箭头在组学框下方的空白处汇入。\nmulti-omics parallel integration\n"
},
{
"title": "Pangenome construction",
"title_zh": "泛基因组构建阶段",
"slug": "pangenome-phases",
"category": "schematic",
"tags": [
"pangenome",
"phases",
"graph"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "把泛基因组工作分成采集、组装、图和下游四段。",
"customize": "每条色带左侧是阶段名，右侧三个任务从左到右。换阶段时改色带标题和三个方框。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/pangenome-phases/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/pangenome-phases/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/pangenome-phases/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/pangenome-phases/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/pangenome-phases/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/pangenome-phases/figure.svg"
}
],
"dir": "figures/schematic/pangenome-phases",
"preview": "figures/schematic/pangenome-phases/preview.png",
"docs_preview": "previews/pangenome-phases.png",
"code": "figures/schematic/pangenome-phases/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/pangenome-phases/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/pangenome-phases",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "pangenome construction\n泛基因组构建阶段\npangenome-phases\n\nschematic\n流程图\nschematic\n流程图\nschematics\n把泛基因组工作分成采集、组装、图和下游四段。\n每条色带左侧是阶段名，右侧三个任务从左到右。换阶段时改色带标题和三个方框。\npangenome phases graph\n"
},
{
"title": "Analysis platform layers",
"title_zh": "分析平台分层",
"slug": "platform-layers",
"category": "schematic",
"tags": [
"architecture",
"layers",
"platform"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "从数据、处理、模型到报告，自下而上四层。",
"customize": "阅读顺序是从下往上。每层左侧是层名，右侧是该层的三块。层与层之间不画箭头。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/platform-layers/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/platform-layers/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/platform-layers/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/platform-layers/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/platform-layers/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/platform-layers/figure.svg"
}
],
"dir": "figures/schematic/platform-layers",
"preview": "figures/schematic/platform-layers/preview.png",
"docs_preview": "previews/platform-layers.png",
"code": "figures/schematic/platform-layers/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/platform-layers/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/platform-layers",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "analysis platform layers\n分析平台分层\nplatform-layers\n\nschematic\n流程图\nschematic\n流程图\nschematics\n从数据、处理、模型到报告，自下而上四层。\n阅读顺序是从下往上。每层左侧是层名，右侧是该层的三块。层与层之间不画箭头。\narchitecture layers platform\n"
},
{
"title": "Population-genetic study design",
"title_zh": "群体遗传三目标",
"slug": "popgen-three-aims",
"category": "schematic",
"tags": [
"population-genetics",
"aims",
"parallel"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "一个问题拆成结构、历史和选择三条线，再汇合。",
"customize": "三列标题和列内步骤可改。汇合框保持在最下方，箭头从列底边进入。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/popgen-three-aims/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/popgen-three-aims/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/popgen-three-aims/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/popgen-three-aims/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/popgen-three-aims/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/popgen-three-aims/figure.svg"
}
],
"dir": "figures/schematic/popgen-three-aims",
"preview": "figures/schematic/popgen-three-aims/preview.png",
"docs_preview": "previews/popgen-three-aims.png",
"code": "figures/schematic/popgen-three-aims/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/popgen-three-aims/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/popgen-three-aims",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "population-genetic study design\n群体遗传三目标\npopgen-three-aims\n\nschematic\n流程图\nschematic\n流程图\nschematics\n一个问题拆成结构、历史和选择三条线，再汇合。\n三列标题和列内步骤可改。汇合框保持在最下方，箭头从列底边进入。\npopulation-genetics aims parallel\n"
},
{
"title": "Technical route for a genomics project",
"title_zh": "基因组课题技术路线",
"slug": "project-phases",
"category": "schematic",
"tags": [
"project",
"phases",
"roadmap"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "课题按设计、产生数据、分析和写作四段往下走。",
"customize": "左侧序号是阶段，右侧是该阶段的三步，最后一步是该阶段交付。阶段之间只连左侧色块。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/project-phases/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/project-phases/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/project-phases/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/project-phases/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/project-phases/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/project-phases/figure.svg"
}
],
"dir": "figures/schematic/project-phases",
"preview": "figures/schematic/project-phases/preview.png",
"docs_preview": "previews/project-phases.png",
"code": "figures/schematic/project-phases/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/project-phases/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/project-phases",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "technical route for a genomics project\n基因组课题技术路线\nproject-phases\n\nschematic\n流程图\nschematic\n流程图\nschematics\n课题按设计、产生数据、分析和写作四段往下走。\n左侧序号是阶段，右侧是该阶段的三步，最后一步是该阶段交付。阶段之间只连左侧色块。\nproject phases roadmap\n"
},
{
"title": "RNA-seq analysis route",
"title_zh": "RNA-seq 分析路线",
"slug": "rnaseq-stages",
"category": "schematic",
"tags": [
"rna-seq",
"stages",
"deliverable"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "每个分析阶段对应一项工作和一项交付。",
"customize": "三列分别是阶段、工作和交付。往下加行时复制一行并保持左缘对齐。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/rnaseq-stages/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/rnaseq-stages/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/rnaseq-stages/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/rnaseq-stages/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/rnaseq-stages/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/rnaseq-stages/figure.svg"
}
],
"dir": "figures/schematic/rnaseq-stages",
"preview": "figures/schematic/rnaseq-stages/preview.png",
"docs_preview": "previews/rnaseq-stages.png",
"code": "figures/schematic/rnaseq-stages/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/rnaseq-stages/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/rnaseq-stages",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "rna-seq analysis route\nrna-seq 分析路线\nrnaseq-stages\n\nschematic\n流程图\nschematic\n流程图\nschematics\n每个分析阶段对应一项工作和一项交付。\n三列分别是阶段、工作和交付。往下加行时复制一行并保持左缘对齐。\nrna-seq stages deliverable\n"
},
{
"title": "Sample routing by material",
"title_zh": "按材料分流样本",
"slug": "sample-routing",
"category": "schematic",
"tags": [
"routing",
"decision",
"materials"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "新鲜组织、馆藏标本和沉积物走不同前处理。",
"customize": "菱形之后分三列。列宽相等，列内步骤垂直对齐。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/sample-routing/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/sample-routing/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/sample-routing/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/sample-routing/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/sample-routing/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/sample-routing/figure.svg"
}
],
"dir": "figures/schematic/sample-routing",
"preview": "figures/schematic/sample-routing/preview.png",
"docs_preview": "previews/sample-routing.png",
"code": "figures/schematic/sample-routing/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/sample-routing/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/sample-routing",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "sample routing by material\n按材料分流样本\nsample-routing\n\nschematic\n流程图\nschematic\n流程图\nschematics\n新鲜组织、馆藏标本和沉积物走不同前处理。\n菱形之后分三列。列宽相等，列内步骤垂直对齐。\nrouting decision materials\n"
},
{
"title": "Field sampling timeline",
"title_zh": "野外采样时间线",
"slug": "sampling-timeline",
"category": "schematic",
"tags": [
"timeline",
"sampling",
"field"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "按年份排采样和分析里程碑。",
"customize": "轴上方和下方交替放事项。改年份时只改轴上的标签，保持圆点落在轴上。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/sampling-timeline/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/sampling-timeline/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/sampling-timeline/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/sampling-timeline/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/sampling-timeline/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/sampling-timeline/figure.svg"
}
],
"dir": "figures/schematic/sampling-timeline",
"preview": "figures/schematic/sampling-timeline/preview.png",
"docs_preview": "previews/sampling-timeline.png",
"code": "figures/schematic/sampling-timeline/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/sampling-timeline/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/sampling-timeline",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "field sampling timeline\n野外采样时间线\nsampling-timeline\n\nschematic\n流程图\nschematic\n流程图\nschematics\n按年份排采样和分析里程碑。\n轴上方和下方交替放事项。改年份时只改轴上的标签，保持圆点落在轴上。\ntimeline sampling field\n"
},
{
"title": "Convergent evidence for selection",
"title_zh": "选择信号的多重证据",
"slug": "selection-evidence",
"category": "schematic",
"tags": [
"selection",
"evidence",
"convergence"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "多种选择或关联证据汇到候选位点，再做功能验证。",
"customize": "上方证据框等距排列，箭头在中线上方的空白汇入候选框，不要穿过文字。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/selection-evidence/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/selection-evidence/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/selection-evidence/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/selection-evidence/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/selection-evidence/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/selection-evidence/figure.svg"
}
],
"dir": "figures/schematic/selection-evidence",
"preview": "figures/schematic/selection-evidence/preview.png",
"docs_preview": "previews/selection-evidence.png",
"code": "figures/schematic/selection-evidence/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/selection-evidence/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/selection-evidence",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "convergent evidence for selection\n选择信号的多重证据\nselection-evidence\n\nschematic\n流程图\nschematic\n流程图\nschematics\n多种选择或关联证据汇到候选位点，再做功能验证。\n上方证据框等距排列，箭头在中线上方的空白汇入候选框，不要穿过文字。\nselection evidence convergence\n"
},
{
"title": "Selective sweep concept",
"title_zh": "选择性清除概念",
"slug": "selective-sweep-concept",
"category": "schematic",
"tags": [
"population-genetics",
"selection",
"concept"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "演示有利突变在群体中频率上升时，如何带动周围单倍型（同一条染色体上一起遗传的变异组合）趋同并造成局部核苷酸多样性（π，序列间差异程度）出现低谷。",
"customize": "可直接在 draw.io 中打开 `template.drawio` 编辑，或修改 `build.py` 后运行 `python3 figures/schematic/selective-sweep-concept/build.py` 重新生成。常改项包括单倍型条数 `NH`、中性位点数 `NS`、受选择位点位置 `SITE`、重组断点范围 `left_d` 与 `right_d`（祖先片段边界）、低谷宽度 `LSC` 以及配色和标签文字。注意标签超出画布、互相重叠或字号小于 6 pt 时脚本会报错。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/selective-sweep-concept/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/selective-sweep-concept/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/selective-sweep-concept/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/selective-sweep-concept/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/selective-sweep-concept/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/selective-sweep-concept/figure.svg"
}
],
"dir": "figures/schematic/selective-sweep-concept",
"preview": "figures/schematic/selective-sweep-concept/preview.png",
"docs_preview": "previews/selective-sweep-concept.png",
"code": "figures/schematic/selective-sweep-concept/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/selective-sweep-concept/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/selective-sweep-concept",
"code_text": "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n",
"search_text": "selective sweep concept\n选择性清除概念\nselective-sweep-concept\n\nschematic\n流程图\nschematic\n流程图\nschematics\n演示有利突变在群体中频率上升时，如何带动周围单倍型（同一条染色体上一起遗传的变异组合）趋同并造成局部核苷酸多样性（π，序列间差异程度）出现低谷。\n可直接在 draw.io 中打开 `template.drawio` 编辑，或修改 `build.py` 后运行 `python3 figures/schematic/selective-sweep-concept/build.py` 重新生成。常改项包括单倍型条数 `nh`、中性位点数 `ns`、受选择位点位置 `site`、重组断点范围 `left_d` 与 `right_d`（祖先片段边界）、低谷宽度 `lsc` 以及配色和标签文字。注意标签超出画布、互相重叠或字号小于 6 pt 时脚本会报错。\npopulation-genetics selection concept\n"
},
{
"title": "Sequencing quality gate",
"title_zh": "测序质控分支",
"slug": "sequencing-qc-gate",
"category": "schematic",
"tags": [
"qc",
"decision",
"rework"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "质控通过才继续，不通过回到建库。",
"customize": "菱形只放短句。失败箭头走方框外侧的空白，不要穿过文字。通过用绿，退回用红。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/sequencing-qc-gate/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/sequencing-qc-gate/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/sequencing-qc-gate/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/sequencing-qc-gate/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/sequencing-qc-gate/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/sequencing-qc-gate/figure.svg"
}
],
"dir": "figures/schematic/sequencing-qc-gate",
"preview": "figures/schematic/sequencing-qc-gate/preview.png",
"docs_preview": "previews/sequencing-qc-gate.png",
"code": "figures/schematic/sequencing-qc-gate/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/sequencing-qc-gate/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/sequencing-qc-gate",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "sequencing quality gate\n测序质控分支\nsequencing-qc-gate\n\nschematic\n流程图\nschematic\n流程图\nschematics\n质控通过才继续，不通过回到建库。\n菱形只放短句。失败箭头走方框外侧的空白，不要穿过文字。通过用绿，退回用红。\nqc decision rework\n"
},
{
"title": "Variant filtering cascade",
"title_zh": "变异过滤漏斗",
"slug": "variant-filter-cascade",
"category": "schematic",
"tags": [
"variants",
"filter",
"cascade"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "变异集逐级变窄，直到高置信集合。",
"customize": "方框逐级变窄并居中。最后一层用绿色表示保留下来的集合。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/variant-filter-cascade/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/variant-filter-cascade/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/variant-filter-cascade/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/variant-filter-cascade/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/variant-filter-cascade/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/variant-filter-cascade/figure.svg"
}
],
"dir": "figures/schematic/variant-filter-cascade",
"preview": "figures/schematic/variant-filter-cascade/preview.png",
"docs_preview": "previews/variant-filter-cascade.png",
"code": "figures/schematic/variant-filter-cascade/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/variant-filter-cascade/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/variant-filter-cascade",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "variant filtering cascade\n变异过滤漏斗\nvariant-filter-cascade\n\nschematic\n流程图\nschematic\n流程图\nschematics\n变异集逐级变窄，直到高置信集合。\n方框逐级变窄并居中。最后一层用绿色表示保留下来的集合。\nvariants filter cascade\n"
},
{
"title": "Variant discovery modules",
"title_zh": "变异检出模块",
"slug": "variant-modules",
"category": "schematic",
"tags": [
"variants",
"modules",
"tree"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "比对读段分到 SNV、indel、SV 和 CNV，再合并。",
"customize": "模块数改变时重新均分宽度。汇合框放在所有模块下方居中。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/variant-modules/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/variant-modules/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/variant-modules/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/variant-modules/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/variant-modules/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/variant-modules/figure.svg"
}
],
"dir": "figures/schematic/variant-modules",
"preview": "figures/schematic/variant-modules/preview.png",
"docs_preview": "previews/variant-modules.png",
"code": "figures/schematic/variant-modules/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/variant-modules/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/variant-modules",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "variant discovery modules\n变异检出模块\nvariant-modules\n\nschematic\n流程图\nschematic\n流程图\nschematics\n比对读段分到 snv、indel、sv 和 cnv，再合并。\n模块数改变时重新均分宽度。汇合框放在所有模块下方居中。\nvariants modules tree\n"
},
{
"title": "Whole-genome sequencing pipeline",
"title_zh": "全基因组测序流程",
"slug": "wgs-pipeline",
"category": "schematic",
"tags": [
"wgs",
"pipeline",
"sequencing"
],
"packages": [
"draw.io"
],
"data_columns": {},
"when_to_use": "从采样到变异检出的一条直线流程。",
"customize": "改六个方框文字即可换步骤；增减方框时保持等宽并拉开箭头空隙。主色用蓝，交付物用绿。",
"lang": "drawio",
"task": "schematic",
"task_zh": "流程图",
"task_en": "Schematics",
"variant_of": null,
"variant_label": null,
"variants": [],
"parameters": [],
"canvas": null,
"downloads": [
{
"name": "template.drawio",
"path": "figures/schematic/wgs-pipeline/template.drawio",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/wgs-pipeline/template.drawio",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/wgs-pipeline/template.drawio"
},
{
"name": "figure.svg",
"path": "figures/schematic/wgs-pipeline/figure.svg",
"raw": "https://raw.githubusercontent.com/Xuzhen-Li/paper-viz/main/figures/schematic/wgs-pipeline/figure.svg",
"github": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/wgs-pipeline/figure.svg"
}
],
"dir": "figures/schematic/wgs-pipeline",
"preview": "figures/schematic/wgs-pipeline/preview.png",
"docs_preview": "previews/wgs-pipeline.png",
"code": "figures/schematic/wgs-pipeline/template.drawio",
"data": null,
"data_files": [],
"code_python": null,
"github_code": "https://github.com/Xuzhen-Li/paper-viz/blob/main/figures/schematic/wgs-pipeline/template.drawio",
"github_data": null,
"github_dir": "https://github.com/Xuzhen-Li/paper-viz/tree/main/figures/schematic/wgs-pipeline",
"code_text": "\n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n \n\n",
"search_text": "whole-genome sequencing pipeline\n全基因组测序流程\nwgs-pipeline\n\nschematic\n流程图\nschematic\n流程图\nschematics\n从采样到变异检出的一条直线流程。\n改六个方框文字即可换步骤；增减方框时保持等宽并拉开箭头空隙。主色用蓝，交付物用绿。\nwgs pipeline sequencing\n"
}
]
}