如何使用R語(yǔ)言繪制Nature級(jí)別的圖片
嘗試用R來(lái)繪制生物方面的統(tǒng)計(jì)圖(熱圖、柱狀圖等),繪圖如下:

繪制上圖所需的R語(yǔ)言代碼如下:
# ======================
# 1. 安裝與加載必要包
# ======================
# 定義所需的R包名稱向量
required_packages <- c("tidyverse", "patchwork", "ggrepel", "viridis",
"ggsci", "RColorBrewer", "ggforce", "ggtext", "scales")
# 檢查哪些包尚未安裝:比較required_packages與已安裝包的差異
new_packages <- required_packages[!(required_packages %in% installed.packages()[,"Package"])]
# 如果有未安裝的包,則安裝它們
if(length(new_packages)) install.packages(new_packages)
# 加載所有必需的包到當(dāng)前R
library(tidyverse) # 數(shù)據(jù)處理和可視化核心套件(含ggplot2、dplyr等)
library(patchwork) # 用于組合多個(gè)ggplot圖形
library(ggrepel) # 提供避免重疊的智能文本標(biāo)簽
library(viridis) # 提供科學(xué)、美觀且色盲友好的顏色漸變
library(ggsci) # 提供基于頂級(jí)期刊(如Nature、Science)的調(diào)色板
library(RColorBrewer) # 提供經(jīng)典ColorBrewer調(diào)色板
library(ggforce) # 擴(kuò)展ggplot2功能(如geom_mark_hull用于標(biāo)注區(qū)域)
library(ggtext) # 支持在圖形標(biāo)題、標(biāo)簽中使用Markdown/HTML格式文本
library(scales) # 提供調(diào)整坐標(biāo)軸和圖例格式的函數(shù)
# ======================
# 2. 設(shè)置全局圖形主題(符合Nature標(biāo)準(zhǔn))
# ======================
# 自定義一個(gè)名為nature_theme的函數(shù),用于定義全局圖形樣式
nature_theme <- function(base_size = 11, base_family = "sans") {
# 以theme_minimal為基礎(chǔ),用%+replace%運(yùn)算符完全替換其部分元素
theme_minimal(base_size = base_size, base_family = base_family) %+replace%
theme(
# 文本元素
plot.title = element_text(size = 16, face = "bold", hjust = 0.5,
margin = margin(b = 12)), # 主標(biāo)題:加粗、居中,下邊距12點(diǎn)
plot.subtitle = element_text(size = 12, hjust = 0.5, color = "gray40",
margin = margin(b = 15)), # 副標(biāo)題:灰色、居中,下邊距15點(diǎn)
axis.title = element_text(size = 12, face = "bold"), # 坐標(biāo)軸標(biāo)題:加粗
axis.text = element_text(size = 10, color = "black"), # 坐標(biāo)軸刻度標(biāo)簽
legend.title = element_text(face = "bold", size = 10), # 圖例標(biāo)題:加粗
legend.text = element_text(size = 9), # 圖例項(xiàng)目文本
# 網(wǎng)格與背景
panel.grid.major = element_line(color = "gray90", linewidth = 0.3), # 主網(wǎng)格線:淺灰色,細(xì)線
panel.grid.minor = element_blank(), # 隱藏次網(wǎng)格線,使圖表更簡(jiǎn)潔
panel.border = element_rect(fill = NA, color = "gray70", linewidth = 0.5), # 為每個(gè)繪圖面板添加細(xì)邊框
plot.background = element_rect(fill = "white", color = NA), # 設(shè)置整個(gè)圖形背景為純白
# 邊距(上、右、下、左)
plot.margin = margin(15, 20, 15, 20), # 為圖形四周留出適當(dāng)空白
# 圖例樣式
legend.background = element_rect(fill = "white", color = "gray80"), # 圖例背景框
legend.box.background = element_rect(color = "gray80", fill = "white"), # 當(dāng)有多個(gè)圖例時(shí)的外框
legend.margin = margin(5, 8, 5, 8), # 圖例內(nèi)部的邊距
legend.key = element_rect(fill = "white"), # 圖例中顏色鍵(小方塊)的背景
# 分面(facet)標(biāo)簽樣式
strip.text = element_text(face = "bold", size = 10), # 分面標(biāo)簽文字:加粗
strip.background = element_rect(fill = "gray95", color = "gray70") # 分面標(biāo)簽背景:淺灰
)
}
# 應(yīng)用自定義主題為后續(xù)所有g(shù)gplot圖形的默認(rèn)主題
theme_set(nature_theme())
# 設(shè)置隨機(jī)數(shù)種子,確保每次運(yùn)行代碼時(shí)隨機(jī)生成的數(shù)據(jù)和圖形布局完全相同
set.seed(2024)
# ======================
# 3. 模擬數(shù)據(jù)生成
# ======================
# 3.1 模擬單細(xì)胞軌跡數(shù)據(jù) (子圖A)
n_cells <- 300 # 定義模擬的細(xì)胞數(shù)量
pseudotime <- runif(n_cells, 0, 10) # 為每個(gè)細(xì)胞生成0到10之間的隨機(jī)偽時(shí)間值
# 根據(jù)偽時(shí)間將細(xì)胞劃分為三個(gè)階段
cell_stages <- cut(pseudotime, breaks = c(0, 3, 6, 10),
labels = c("Stage 1", "Stage 2", "Stage 3"))
# 創(chuàng)建一個(gè)包含所有單細(xì)胞數(shù)據(jù)的tibble(現(xiàn)代數(shù)據(jù)框)
trajectory_data <- tibble(
Cell_ID = sprintf("Cell_%04d", 1:n_cells), # 生成格式化的細(xì)胞ID
Pseudotime = pseudotime, # 偽時(shí)間值
# 基于偽時(shí)間計(jì)算UMAP坐標(biāo)(加入螺旋趨勢(shì)和隨機(jī)噪聲),模擬真實(shí)的降維軌跡
UMAP_1 = pseudotime * cos(pseudotime/2) + rnorm(n_cells, 0, 0.5),
UMAP_2 = pseudotime * sin(pseudotime/2) + rnorm(n_cells, 0, 0.5),
Stage = cell_stages, # 細(xì)胞所屬階段
Cluster = sample(1:4, n_cells, replace = TRUE, prob = c(0.3, 0.25, 0.25, 0.2)) # 隨機(jī)分配聚類
)
# 3.2 模擬基因表達(dá)熱圖數(shù)據(jù) (子圖B)
genes <- paste0("Gene_", sprintf("%02d", 1:15)) # 生成15個(gè)基因的名稱
# 生成樣本名稱:3個(gè)階段,每個(gè)階段5個(gè)生物學(xué)重復(fù)
samples <- paste0("Stage", rep(1:3, each = 5), "_Rep", rep(1:5, 3))
set.seed(123) # 為熱圖數(shù)據(jù)設(shè)置特定種子,確保這部分?jǐn)?shù)據(jù)穩(wěn)定
# 初始化一個(gè)15行(基因)×15列(樣本)的零矩陣
expression_matrix <- matrix(0, nrow = length(genes), ncol = length(samples))
rownames(expression_matrix) <- genes # 設(shè)置行名為基因
colnames(expression_matrix) <- samples # 設(shè)置列名為樣本
# 創(chuàng)建生物學(xué)上合理的表達(dá)模式:模擬基因在不同階段特異性高表達(dá)
expression_matrix[1:5, 1:10] <- expression_matrix[1:5, 1:10] + 2.5 # 基因1-5在早期(樣本1-10)高表達(dá)
expression_matrix[6:10, 6:15] <- expression_matrix[6:10, 6:15] + 2.0 # 基因6-10在中期高表達(dá)
expression_matrix[11:15, 11:15] <- expression_matrix[11:15, 11:15] + 3.0 # 基因11-15在晚期高表達(dá)
# 添加隨機(jī)噪聲,模擬真實(shí)實(shí)驗(yàn)數(shù)據(jù)中的技術(shù)變異
expression_matrix <- expression_matrix + matrix(rnorm(length(genes)*length(samples), 0, 0.3),
nrow = length(genes))
# 將寬格式矩陣轉(zhuǎn)換為長(zhǎng)格式數(shù)據(jù)框,這是ggplot繪制熱圖所需的結(jié)構(gòu)
heatmap_data <- as.data.frame(expression_matrix) %>%
rownames_to_column(var = "Gene") %>% # 將行名轉(zhuǎn)換為"Gene"列
pivot_longer(cols = -Gene, names_to = "Sample", values_to = "Expression") %>% # 轉(zhuǎn)換列
mutate(
Stage = str_extract(Sample, "Stage[123]"), # 從樣本名中提取階段信息
Stage = factor(Stage, levels = c("Stage1", "Stage2", "Stage3")), # 轉(zhuǎn)換為因子并指定順序
Gene = factor(Gene, levels = rev(genes)) # 將基因轉(zhuǎn)為因子,并反轉(zhuǎn)順序使熱圖從上到下基因1開(kāi)始
)
# 3.3 模擬調(diào)控網(wǎng)絡(luò)數(shù)據(jù) (子圖C - 簡(jiǎn)版)
set.seed(123) # 為網(wǎng)絡(luò)數(shù)據(jù)設(shè)置種子
n_nodes <- 15 # 定義節(jié)點(diǎn)數(shù)量,減少節(jié)點(diǎn)數(shù)使圖形更清晰
# 在固定網(wǎng)格上創(chuàng)建節(jié)點(diǎn)坐標(biāo)
network_nodes <- tibble(
Node_ID = paste0("TF_", sprintf("%02d", 1:n_nodes)), # 轉(zhuǎn)錄因子節(jié)點(diǎn)ID
# 將節(jié)點(diǎn)大致放置在5×3的網(wǎng)格上
x = rep(1:5, each = 3, length.out = n_nodes),
y = rep(c(1, 2, 3), times = 5, length.out = n_nodes),
Type = sample(c("Activator", "Repressor"), n_nodes, replace = TRUE, prob = c(0.6, 0.4)),
Module = sample(c("Early", "Middle", "Late"), n_nodes, replace = TRUE, prob = c(0.4, 0.3, 0.3))
) %>%
# 添加輕微隨機(jī)抖動(dòng),避免節(jié)點(diǎn)在網(wǎng)格上完全對(duì)齊,使圖形更自然
mutate(
x = x + runif(n(), -0.2, 0.2),
y = y + runif(n(), -0.2, 0.2)
)
# 創(chuàng)建邊數(shù)據(jù)(確保from和to不同)
set.seed(456) # 為邊的生成使用不同的種子
n_edges <- 25 # 定義邊的數(shù)量
edge_list <- list() # 初始化一個(gè)空列表來(lái)存儲(chǔ)邊
# 使用循環(huán)生成邊,確保連接不重復(fù)且不是自連接
for(i in 1:n_edges) {
repeat { # 重復(fù)抽樣直到找到符合條件的節(jié)點(diǎn)對(duì)
from_idx <- sample(1:n_nodes, 1) # 隨機(jī)選取一個(gè)起始節(jié)點(diǎn)索引
to_idx <- sample(1:n_nodes, 1) # 隨機(jī)選取一個(gè)終止節(jié)點(diǎn)索引
if(from_idx != to_idx) { # 確保不是同一個(gè)節(jié)點(diǎn)(避免自環(huán))
# 檢查是否已存在完全相同的連接
existing <- sapply(edge_list, function(e)
e$from == from_idx && e$to == to_idx)
if(!any(existing)) { # 如果此連接尚不存在
edge_list[[i]] <- list( # 將此邊信息添加到列表中
from_idx = from_idx,
to_idx = to_idx,
Weight = runif(1, 0.4, 1), # 邊的權(quán)重(強(qiáng)度)
Type = sample(c("Activation", "Repression"), 1, prob = c(0.7, 0.3)) # 調(diào)控類型
)
break # 找到有效邊,退出當(dāng)前repeat循環(huán)
}
}
}
}
network_edges <- bind_rows(edge_list) # 將邊列表轉(zhuǎn)換為一個(gè)tibble數(shù)據(jù)框
# 將索引轉(zhuǎn)換為實(shí)際的節(jié)點(diǎn)ID和坐標(biāo),方便繪圖時(shí)映射
network_edges <- network_edges %>%
mutate(
from = network_nodes$Node_ID[from_idx], # 根據(jù)索引獲取起始節(jié)點(diǎn)名稱
to = network_nodes$Node_ID[to_idx], # 根據(jù)索引獲取終止節(jié)點(diǎn)名稱
from_x = network_nodes$x[from_idx], # 起始節(jié)點(diǎn)的x坐標(biāo)
from_y = network_nodes$y[from_idx], # 起始節(jié)點(diǎn)的y坐標(biāo)
to_x = network_nodes$x[to_idx], # 終止節(jié)點(diǎn)的x坐標(biāo)
to_y = network_nodes$y[to_idx] # 終止節(jié)點(diǎn)的y坐標(biāo)
)
# 3.4 模擬功能驗(yàn)證數(shù)據(jù) (子圖D)
# 創(chuàng)建所有條件與檢測(cè)指標(biāo)的組合
validation_data <- expand.grid(
Condition = c("Control", "KO1", "KO2", "OE1", "OE2"), # 實(shí)驗(yàn)條件:對(duì)照、兩個(gè)敲低、兩個(gè)過(guò)表達(dá)
Assay = c("Proliferation", "Differentiation", "Migration", "Apoptosis"), # 功能檢測(cè)指標(biāo)
stringsAsFactors = FALSE # 返回字符向量而非因子
)
validation_data <- validation_data %>%
mutate(
# 根據(jù)條件分配不同的模擬測(cè)量值,反映預(yù)期的生物學(xué)效應(yīng)
Value = case_when(
Condition == "Control" ~ rnorm(n(), 1.0, 0.1), # 對(duì)照組的基準(zhǔn)值
Condition == "KO1" ~ rnorm(n(), 0.3, 0.15), # 敲低1:值較低
Condition == "KO2" ~ rnorm(n(), 0.6, 0.12), # 敲低2:值中等
Condition == "OE1" ~ rnorm(n(), 1.8, 0.18), # 過(guò)表達(dá)1:值較高
Condition == "OE2" ~ rnorm(n(), 1.4, 0.14) # 過(guò)表達(dá)2:值稍高
),
# 模擬p值:對(duì)照設(shè)為1,處理組根據(jù)效應(yīng)大小生成不同顯著水平的p值
p_value = case_when(
Condition == "Control" ~ 1.0,
Condition %in% c("KO1", "KO2") ~ 10^(-runif(n(), 3, 8)), # 敲低通常效應(yīng)強(qiáng),p值很小
Condition %in% c("OE1", "OE2") ~ 10^(-runif(n(), 2, 6)) # 過(guò)表達(dá)效應(yīng)稍弱,p值稍大
),
# 根據(jù)p值范圍轉(zhuǎn)換為顯著性標(biāo)記符號(hào)
Significance = case_when(
p_value > 0.05 ~ "ns", # 不顯著
p_value > 0.01 ~ "*", # p < 0.05
p_value > 0.001 ~ "**", # p < 0.01
TRUE ~ "***" # p < 0.001
)
)
# ======================
# 4. 繪制各個(gè)子圖(帶A、B、C、D標(biāo)號(hào))
# ======================
# 4.1 子圖A:?jiǎn)渭?xì)胞軌跡圖
p_A <- ggplot(trajectory_data, aes(x = UMAP_1, y = UMAP_2)) + # 初始化ggplot,設(shè)置x和y軸美學(xué)映射
# 繪制散點(diǎn):顏色和填充根據(jù)Stage,形狀根據(jù)Cluster
geom_point(aes(color = Stage, fill = Stage, shape = as.factor(Cluster)),
size = 3.5, alpha = 0.85, stroke = 0.8) + # size點(diǎn)大小,alpha透明度,stroke邊框粗細(xì)
# 繪制一條連接所有點(diǎn)的路徑,用于指示軌跡方向
geom_path(aes(group = 1), color = "gray40", alpha = 0.6,
linewidth = 1.2, linetype = "dashed") +
# 使用ggforce的geom_mark_hull為每個(gè)Stage繪制凸包區(qū)域并進(jìn)行標(biāo)注
geom_mark_hull(aes(fill = Stage, label = Stage),
alpha = 0.1, expand = unit(8, "mm"), # alpha區(qū)域透明度,expand區(qū)域擴(kuò)展范圍
concavity = 2, size = 0.5) + # concavity控制凸包形狀
# 手動(dòng)設(shè)置顏色標(biāo)度(適用于分類變量)
scale_color_manual(values = c("Stage 1" = "#4E79A7",
"Stage 2" = "#F28E2B",
"Stage 3" = "#E15759"),
name = "Developmental\nStage") + # \n在圖例標(biāo)題中換行
scale_fill_manual(values = c("Stage 1" = "#4E79A7",
"Stage 2" = "#F28E2B",
"Stage 3" = "#E15759"),
name = "Developmental\nStage") +
scale_shape_manual(values = c(21, 22, 23, 24), name = "Cell\nCluster") + # 設(shè)置形狀編號(hào)
# 添加圖形標(biāo)題和坐標(biāo)軸標(biāo)簽
labs(title = "Single-cell trajectory analysis",
subtitle = "Pseudotemporal ordering reveals developmental continuum",
x = "UMAP 1", y = "UMAP 2",
tag = "A") + # 添加"A"標(biāo)號(hào)
# 精細(xì)控制圖例的順序和外觀
guides(
color = guide_legend(order = 1), # 顏色圖例排第一
fill = guide_legend(order = 1), # 填充圖例與顏色圖例順序相同(合并顯示)
shape = guide_legend(order = 2) # 形狀圖例排第二
) +
# 調(diào)整主題元素:將圖例放置在圖形內(nèi)部
theme(
legend.position = c(0.85, 0.15), # 圖例位置(相對(duì)坐標(biāo):0到1之間)
legend.box = "vertical", # 多個(gè)圖例垂直排列
legend.spacing.y = unit(0.2, "cm"), # 圖例項(xiàng)之間的垂直間距
plot.tag = element_text(size = 24, face = "bold"), # 設(shè)置標(biāo)號(hào)樣式:大號(hào)加粗
plot.tag.position = c(0.02, 0.98) # 標(biāo)號(hào)位置:左上角(x=2%,y=98%)
)
# 4.2 子圖B:基因表達(dá)熱圖
p_B <- ggplot(heatmap_data, aes(x = Sample, y = Gene, fill = Expression)) +
# 使用geom_tile繪制熱圖:每個(gè)單元格是一個(gè)瓷磚
geom_tile(color = "white", linewidth = 0.5) + # 設(shè)置瓷磚間的白色縫隙
# 設(shè)置填充顏色梯度:使用RdBu(紅-藍(lán))漸變色,但用rev()反轉(zhuǎn),使高表達(dá)為紅,低表達(dá)為藍(lán)
scale_fill_gradientn(
colors = rev(brewer.pal(11, "RdBu")), # 從RColorBrewer包獲取11個(gè)顏色的RdBu漸變
limits = c(-2, 4), # 固定顏色映射的值域范圍
breaks = c(-2, 0, 2, 4), # 在圖例上顯示這幾個(gè)刻度
labels = c("-2", "0", "2", "4"), # 圖例刻度標(biāo)簽
name = "Expression\nZ-score", # 圖例標(biāo)題
guide = guide_colorbar( # 自定義連續(xù)型圖例(顏色條)的外觀
barwidth = unit(0.5, "cm"), # 顏色條寬度
barheight = unit(3, "cm"), # 顏色條高度
title.position = "left", # 標(biāo)題位置
title.hjust = 0.5 # 標(biāo)題水平對(duì)齊方式
)
) +
# 調(diào)整坐標(biāo)軸:取消x軸和y軸的默認(rèn)擴(kuò)展(使瓷磚緊貼坐標(biāo)軸)
scale_x_discrete(expand = expansion(mult = 0)) +
scale_y_discrete(expand = expansion(mult = 0)) +
# 添加圖形標(biāo)題和坐標(biāo)軸標(biāo)簽
labs(title = "Dynamic gene expression profiles",
subtitle = "Stage-specific expression patterns across development",
x = "Samples (biological replicates)", y = "",
tag = "B") + # 添加"B"標(biāo)號(hào)
# 進(jìn)一步自定義主題
theme(
axis.text.x = element_text(angle = 45, hjust = 1, size = 9), # x軸標(biāo)簽旋轉(zhuǎn)45度
axis.text.y = element_text(size = 10, face = "italic"), # y軸(基因名)用斜體
panel.grid = element_blank(), # 熱圖中不需要網(wǎng)格線
legend.position = "right", # 圖例在右側(cè)
legend.title = element_text(angle = 90, vjust = 0.5, hjust = 0.5), # 圖例標(biāo)題旋轉(zhuǎn)90度
plot.tag = element_text(size = 24, face = "bold"), # 設(shè)置標(biāo)號(hào)樣式:大號(hào)加粗
plot.tag.position = c(0.02, 0.98) # 標(biāo)號(hào)位置:左上角
) +
# 按Stage對(duì)樣本進(jìn)行分面,使不同階段的樣本在x軸上分組顯示
facet_grid(. ~ Stage, scales = "free_x", space = "free_x") # 每個(gè)分面x軸獨(dú)立,空間自由分配
# 4.3 子圖C:簡(jiǎn)版調(diào)控網(wǎng)絡(luò)圖 (使用 geom_curve)
p_C <- ggplot() + # 初始化一個(gè)空的ggplot,因?yàn)槲覀儗⒎謭D層添加網(wǎng)絡(luò)邊和節(jié)點(diǎn)
# 第一層:繪制曲線邊,使用geom_curve
geom_curve(data = network_edges,
aes(x = from_x, xend = to_x,
y = from_y, yend = to_y,
color = Type, alpha = Weight), # 顏色和透明度根據(jù)邊屬性映射
curvature = 0.2, # 設(shè)置曲線彎曲度
linewidth = network_edges$Weight * 1.2, # 線寬與權(quán)重成正比(注意:此映射在aes外)
arrow = arrow(length = unit(0.15, "inches"), type = "closed")) + # 添加箭頭表示方向
# 第二層:在邊的上方繪制節(jié)點(diǎn),防止邊覆蓋節(jié)點(diǎn)
geom_point(data = network_nodes,
aes(x = x, y = y, fill = Module, shape = Type),
size = 9, color = "white", stroke = 1.5) + # 節(jié)點(diǎn):大尺寸,白色邊框
# 第三層:在節(jié)點(diǎn)上添加文本標(biāo)簽
geom_text(data = network_nodes,
aes(x = x, y = y, label = str_remove(Node_ID, "TF_")), # 標(biāo)簽只顯示編號(hào)
size = 3.5, fontface = "bold", color = "white") +
# 設(shè)置邊的顏色標(biāo)度
scale_color_manual(values = c("Activation" = alpha("#4E79A7", 0.8), # 激活邊用半透明藍(lán)色
"Repression" = alpha("#E15759", 0.8)), # 抑制邊用半透明紅色
name = "Regulation\nType") + # 添加圖例標(biāo)題
# 設(shè)置節(jié)點(diǎn)的填充顏色標(biāo)度
scale_fill_manual(values = c("Early" = "#4E79A7",
"Middle" = "#F28E2B",
"Late" = "#E15759"),
name = "Temporal\nModule") + # 添加圖例標(biāo)題
# 設(shè)置節(jié)點(diǎn)的形狀標(biāo)度
scale_shape_manual(values = c("Activator" = 21, "Repressor" = 22), # 21和22是帶填充的形狀
name = "TF Type") + # 添加圖例標(biāo)題
# 設(shè)置邊的透明度標(biāo)度,但不顯示對(duì)應(yīng)的圖例(guide = "none")
scale_alpha_continuous(range = c(0.4, 0.9), guide = "none") +
# 添加圖形標(biāo)題和副標(biāo)題
labs(title = "Transcriptional regulatory network",
subtitle = "Core circuit governing cell fate decisions",
x = "", y = "", # 清空坐標(biāo)軸標(biāo)簽,網(wǎng)絡(luò)圖通常不需要
tag = "C") + # 添加"C"標(biāo)號(hào)
theme_void() + # 使用完全空白的主題(無(wú)坐標(biāo)軸、網(wǎng)格、背景等)
theme(
# 在void主題基礎(chǔ)上,添加回標(biāo)題和副標(biāo)題的樣式
plot.title = element_text(size = 14, face = "bold", hjust = 0.5, margin = margin(b = 5)),
plot.subtitle = element_text(size = 11, hjust = 0.5, color = "gray40", margin = margin(b = 10)),
legend.position = "right", # 圖例在右側(cè)
legend.box = "vertical", # 多個(gè)圖例垂直排列
legend.spacing.y = unit(0.2, "cm"), # 圖例項(xiàng)間距
plot.margin = margin(10, 10, 10, 10), # 圖形邊距
plot.tag = element_text(size = 24, face = "bold"), # 設(shè)置標(biāo)號(hào)樣式:大號(hào)加粗
plot.tag.position = c(0.02, 0.98) # 標(biāo)號(hào)位置:左上角
) +
coord_fixed(ratio = 1) # 固定縱橫比為1:1,防止圖形拉伸變形
# 4.4 子圖D:功能驗(yàn)證條形圖
p_D <- ggplot(validation_data, aes(x = Condition, y = Value, fill = Condition)) +
# 繪制條形圖
geom_bar(stat = "identity", width = 0.7, color = "black", linewidth = 0.4) + # stat='identity'表示直接使用y值
# 在條形頂端添加誤差條(此處為固定值的模擬誤差)
geom_errorbar(aes(ymin = Value - 0.1, ymax = Value + 0.1),
width = 0.2, linewidth = 0.5, color = "black") + # width誤差條兩端短橫線的寬度
# 在條形上方添加顯著性標(biāo)記
geom_text(aes(label = Significance, y = Value + 0.15),
size = 4.5, fontface = "bold", vjust = 0) + # vjust=0使文本底部對(duì)齊指定y位置
# 為每個(gè)條件手動(dòng)指定填充色
scale_fill_manual(values = c("Control" = "#4E79A7",
"KO1" = "#E15759", "KO2" = "#F28E2B",
"OE1" = "#59A14F", "OE2" = "#76B7B2"),
name = "Condition") +
# 調(diào)整y軸:底部從0開(kāi)始,頂部擴(kuò)展15%的空間用于放置顯著性標(biāo)記
scale_y_continuous(expand = expansion(mult = c(0, 0.15)),
breaks = seq(0, 2.5, 0.5)) + # 設(shè)置y軸刻度間隔為0.5
# 添加圖形標(biāo)題和坐標(biāo)軸標(biāo)簽
labs(title = "Functional validation assays",
subtitle = "Phenotypic consequences of genetic perturbations",
x = "Experimental Condition",
y = "Normalized Response\n(Relative to Control)",
tag = "D") + # 添加"D"標(biāo)號(hào)
# 按檢測(cè)指標(biāo)(Assay)進(jìn)行分面,在一行中顯示所有指標(biāo)
facet_wrap(~ Assay, nrow = 1) +
theme(
axis.text.x = element_text(angle = 45, hjust = 1, size = 10), # x軸標(biāo)簽旋轉(zhuǎn)
strip.text = element_text(size = 10, face = "bold"), # 分面標(biāo)簽加粗
panel.spacing.x = unit(1.2, "lines"), # 增加分面之間的水平間距
legend.position = "none", # 隱藏圖例(顏色信息已通過(guò)x軸和條形本身展示)
plot.tag = element_text(size = 24, face = "bold"), # 設(shè)置標(biāo)號(hào)樣式:大號(hào)加粗
plot.tag.position = c(0.02, 0.98) # 標(biāo)號(hào)位置:左上角
)
# ======================
# 5. 組合子圖并添加主標(biāo)題
# ======================
# 使用patchwork語(yǔ)法組合圖形:| 表示并排,/ 表示換行
final_plot <-
(p_A | p_B) / # 第一行:A和B并列
(p_C | p_D) + # 第二行:C和D并列
# 使用plot_annotation添加整個(gè)組合圖的主標(biāo)題、副標(biāo)題和腳注
plot_annotation(
title = '<span style="font-size:22pt; font-weight:bold;">Cellular Plasticity and Fate Determination</span>',
subtitle = 'An integrated multi-modal analysis of developmental transitions',
caption = '**Fig. 1 |** Single-cell trajectory analysis reveals developmental continuum (A). \nDynamic gene expression profiles show stage-specific patterns (B). \nCore transcriptional network regulates cell fate decisions (C). \nFunctional validation confirms phenotypic consequences of genetic perturbations (D).',
theme = theme(
# 主標(biāo)題使用ggtext的element_markdown以解析HTML標(biāo)簽(如<span>)
plot.title = element_markdown(hjust = 0.5, margin = margin(t = 5, b = 10)),
# 副標(biāo)題
plot.subtitle = element_text(hjust = 0.5, size = 14, color = "gray40",
margin = margin(b = 20)),
# 腳注也使用element_markdown以解析加粗標(biāo)記(** **)
plot.caption = element_markdown(hjust = 0, size = 10, color = "gray30",
lineheight = 1.4, margin = margin(t = 20)),
plot.background = element_rect(fill = "white", color = NA) # 確保組合圖背景為白色
)
)
# ======================
# 6. 保存高質(zhì)量圖片
# ======================
# 保存為高分辨率PNG(用于在文檔、PPT中查看或初步提交)
ggsave("Nature_Main_Figure_with_Labels.png", plot = final_plot,
width = 16, height = 14, dpi = 600, bg = "white") # 尺寸寬16英寸高14英寸,分辨率600DPI
# 保存為矢量PDF(強(qiáng)烈推薦用于期刊投稿,可無(wú)限縮放不失真)
ggsave("Nature_Main_Figure_with_Labels.pdf", plot = final_plot,
width = 16, height = 14, device = cairo_pdf) # 使用cairo_pdf設(shè)備確保字體嵌入
# 在R控制臺(tái)輸出提示信息
cat("? 主圖已生成完成!\n")
cat("?? 已保存文件:\n")
cat(" ? Nature_Main_Figure_with_Labels.png (600 DPI PNG)\n")
cat(" ? Nature_Main_Figure_with_Labels.pdf (矢量PDF,推薦投稿使用)\n")
cat("\n?? 圖片特點(diǎn):\n")
cat(" ? 符合Nature期刊圖形規(guī)范\n")
cat(" ? 四面板科學(xué)敘事結(jié)構(gòu)(A、B、C、D標(biāo)號(hào)清晰)\n")
cat(" ? 一致的配色方案和視覺(jué)風(fēng)格\n")
cat(" ? 專業(yè)標(biāo)注和科學(xué)圖注\n")
總結(jié)
到此這篇關(guān)于如何使用R語(yǔ)言繪制Nature級(jí)別圖片的文章就介紹到這了,更多相關(guān)R語(yǔ)言繪制Nature級(jí)別圖片內(nèi)容請(qǐng)搜索腳本之家以前的文章或繼續(xù)瀏覽下面的相關(guān)文章希望大家以后多多支持腳本之家!
相關(guān)文章
解決R語(yǔ)言安裝時(shí)出現(xiàn)輯程包不存在的問(wèn)題
這篇文章主要介紹了解決R語(yǔ)言安裝時(shí)出現(xiàn)輯程包不存在的問(wèn)題,具有很好的參考價(jià)值,希望對(duì)大家有所幫助。一起跟隨小編過(guò)來(lái)看看吧2021-04-04
R語(yǔ)言繪圖數(shù)據(jù)可視化pie?chart餅圖
這篇文章主要介紹了R語(yǔ)言繪圖數(shù)據(jù)可視化pie?chart餅圖,教大家如何用R語(yǔ)言來(lái)畫大餅,有需要的朋友可以借鑒參考下,希望能夠有所幫助,祝大家多多進(jìn)步2022-02-02
詳解R語(yǔ)言MCMC:Metropolis-Hastings采樣用于回歸的貝葉斯估計(jì)
這篇文章主要介紹了R語(yǔ)言MCMC:Metropolis-Hastings采樣用于回歸的貝葉斯估計(jì),本文通過(guò)圖文實(shí)例相結(jié)合給大家介紹的非常詳細(xì),對(duì)大家的學(xué)習(xí)或工作具有一定的參考借鑒價(jià)值,需要的朋友可以參考下2021-03-03
R語(yǔ)言矩陣知識(shí)點(diǎn)總結(jié)及實(shí)例分析
在本篇文章里小編給各位整理了一篇關(guān)于R語(yǔ)言矩陣知識(shí)點(diǎn)總結(jié)及實(shí)例分析,對(duì)此有興趣的朋友們可以學(xué)習(xí)下。2021-04-04
R語(yǔ)言對(duì)Web數(shù)據(jù)操作實(shí)例
在本篇文章里小編給大家整理的是一篇關(guān)于R語(yǔ)言對(duì)Web數(shù)據(jù)操作實(shí)例內(nèi)容,有興趣的朋友們可以學(xué)習(xí)下。2021-05-05
R語(yǔ)言數(shù)據(jù)框中的負(fù)索引介紹
這篇文章主要介紹了R語(yǔ)言數(shù)據(jù)框中的負(fù)索引介紹,具有很好的參考價(jià)值,希望對(duì)大家有所幫助。一起跟隨小編過(guò)來(lái)看看吧2021-04-04
R 安裝包安裝(install.packages)時(shí)報(bào)錯(cuò)的解決方案
這篇文章主要介紹了R 安裝包安裝(install.packages)時(shí)報(bào)錯(cuò)的解決方案,具有很好的參考價(jià)值,希望對(duì)大家有所幫助。一起跟隨小編過(guò)來(lái)看看吧2021-04-04

