作者：老王
鏈接：https://laowang2023.cn/2023/03/22/20230322-pheCorDist/
來源：請叫我老王（個人博客）
本文采用 CC BY 4.0 許可協議 進行共享。轉載請注明作者姓名和鏈接

考察一個群體的多個表型或者一個表型的多個重復，我們想展示其分布和他們之間的相關關系可以使用柱狀圖和散點圖（如下圖所示）。

test.png

這幅圖主要有兩部分組成，一個是對角線上的柱狀圖，使用柱狀圖展示了每一個表型重復的分布；另一個就是對角線下面的散點圖，用散點圖展示兩兩之間的相關關系，并且用不同顏色表示點的密度，在上面標注其相關性。下面我們將使用R語言完成這幅圖。

對于這幅圖我們可以先分別繪制其中每一個部分，然后使用圖片組合、拼接函數進行整合：

分圖繪制

首先導入數據，數據格式如下，每一行代表一個樣本，每一列代表一個重復：

>data <- read.table("./data.txt", header = T, row.names = 1, sep = "\t")
>data
     pheno16rep1 pheno16rep2 pheno17 pheno18rep1 pheno18rep2
s1          28.4        24.9  27.740    27.72500    29.30000
s2          26.6        25.3      NA          NA          NA
s3          27.8        27.0  24.660          NA    27.97500
s4          25.5        26.9  22.680    29.27500    25.95000
s5          26.5        28.7  24.760    31.97500    27.52000
s6          ....        ....  .......   ........    ........

使用ggplot2擴展包繪制每一個分圖。柱狀圖使用geom_histogram()繪制，散點圖使用ggpointdensity包的geom_pointdensity()函數繪制，使用cor()函數計算兩個重復之間的相關系數，并將其放在圖片標題位置，并使用ggtext包的element_markdown()函數設置標題的主題，同時使用cowplot包的theme_half_open()函數設置整體主題。

>library(tidyverse)
>library(ggpointdensity)
>library(cowplot)
>library(ggtext)
>
># 柱狀圖
>p1 <- ggplot(data, aes(x = pheno16rep1)) + 
>        geom_histogram(binwidth = 1) +
>        labs(x = NULL, y = NULL, title = cn[i]) +
>        theme_half_open() +
>        theme(plot.title = element_text(hjust = 0.5))
># 散點密度圖
>p2 <- ggplot(data, aes(x = pheno16rep2, y = pheno16rep1)) +
>        geom_pointdensity() +
>        scale_color_continuous(type = "viridis") +                # 設置點密度顏色梯度
>        labs(x = NULL, y = NULL, title = paste("*R*: ", round(cor(df$col1, df$col2, use = "na.or.complete"), 2), sep = "")) +
>        theme_half_open() +
>        theme(legend.position = "NA", 
>           plot.title = element_markdown(hjust = 0.5,
>                           face = "plain"))

Rplot03.png

組合圖片

使用customLayout包進行圖片組合，這個包可以對base繪圖和ggplot2繪圖進行整合，而且比較靈活。首先需要lay_new()函數創建一個拼接畫布，然后使用lay_grid()函數組合各個圖片。因為總共有5個重復，因此需要一個5×5的畫圖，如下圖所示，各個分圖從左上角開始往下排列走”之“字形排列。

>lay <- lay_new(mat = matrix(1:25, nrow = 5), widths = rep(1, 1), heights = rep(1, 1))
>lay_show(lay)

Rplot02.png

現在出現了一個問題，我們并沒有在對角線上方安排圖片，而lay_new()產生的是一個矩形排列畫布，因此我們需要在右上角填充空白圖片，并將空白圖和柱狀圖、散點密度圖整合。

>p <- ggplot() + theme_nothing()
>lay_grid(list(p1, p2, p3, ...), lay)

整理以上過程

在一個5×5的組合中我們總共需要繪制25個分圖，其中有多次重復的過程，并且最終圖片是矩形有規律分布，因此為了減少代碼長度我們可以使用循環來處理每個分圖。根據lay_new()的組合形式可以設置兩層循環分別處理行和列，并且因為組合圖是從左上角開始向下排布，因此外層循環用來處理行，內層分布處理列。最后一點就是可以把這一系列代碼寫成一個function，方便以后使用。

最終代碼如下所示：

library(tidyverse)
library(ggpointdensity)
library(cowplot)
library(ggtext)
library(customLayout)

## 定義pheCorDist函數
pheCorDist <- function(data) {
  #
  n <- ncol(data)
  cn <- colnames(data)
  Pall <- list()
  index <- 1
  #
  for (j in 1:n) {
    for (i in 1:n) {
      df <- data[, c(i,j)]
      colnames(df) <- c("col1", "col2")
      if (i == j) {
        p <- ggplot(df, aes(x = col1)) + 
          geom_histogram(binwidth = 1) +
          labs(x = NULL, y = NULL, title = cn[i]) +
          theme_half_open() +
          theme(plot.title = element_text(hjust = 0.5))
      } else if (i > j) {
        p <- ggplot(df, aes(x = col2, y = col1)) +
          geom_pointdensity() +
          scale_color_continuous(type = "viridis") +
          labs(x = NULL, y = NULL, title = paste("*R*: ", round(cor(df$col1, df$col2, use = "na.or.complete"), 2), sep = "")) +
          theme_half_open() +
          theme(legend.position = "NA", 
                plot.title = element_markdown(hjust = 0.5,
                                              face = "plain"))
      } else if(i < j) {
        p <- ggplot() + theme_nothing()
      }
      Pall[index][[1]] <- p
      index = index + 1
    }
  }
  lay <- lay_new(mat = matrix(1:n^2, nrow = n), widths = rep(1, n), heights = rep(1, n))
  lay_grid(Pall, lay)
}

# 導入數據并繪圖
data <- read.table("./data.txt", header = T, row.names = 1, sep = "\t")
png(filename = "test.png", width = 10, height = 8, units = "in", res = 500)
pheCorDist(data)
dev.off()

圖片與主題無關