最新国产好看的视频,伊人天堂AV在线,国产Aaaaaa视频,蜜臀视频在线观看一区,人妻av色图,密臀久久久精品影片,青青视频免费观看毛片,久草在线观看视,国产三级精品色情在线

如何使用R語(yǔ)言繪制Nature級(jí)別的圖片

 更新時(shí)間:2026年01月15日 10:42:46   作者:拓云者也  
這篇文章主要介紹了如何使用R語(yǔ)言繪制Nature級(jí)別圖片的相關(guān)資料,通過(guò)示例代碼詳細(xì)介紹了如何使用R語(yǔ)言繪制生物統(tǒng)計(jì)圖,包括熱圖和柱狀圖,并提供了相應(yīng)的代碼示例,需要的朋友可以參考下

嘗試用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)文章

最新評(píng)論

墨江| 荥阳市| 大厂| 宣化县| 松潘县| 鄯善县| 平南县| 惠水县| 东宁县| 友谊县| 昂仁县| 霞浦县| 鹿泉市| 长垣县| 常山县| 杭州市| 克山县| 嘉定区| 绥滨县| 石首市| 鹤山市| 政和县| 银川市| 墨竹工卡县| 根河市| 卢龙县| 凤阳县| 金坛市| 灵武市| 大安市| 津市市| 古丈县| 隆林| 雅江县| 扎鲁特旗| 大冶市| 平泉县| 顺平县| 馆陶县| 杭州市| 肥西县|