參考資料鏈接

https://github.com/cxli233/SimpleTidy_GeneCoEx/tree/v1.0.1

提供完整的示例數據和代碼，非常好的學習材料

做基因共表達比較常用的是WGCNA那個R包，這個鏈接里提供的代碼不是用WGCNA這個R包實現的，而是利用表達量數據計算不同基因之間的相關性，這種方法也挺常用的在論文里見過

表達量數據是來源于論文

High-resolution spatiotemporal transcriptome mapping of tomato fruit development and ripening

https://www.nature.com/articles/s41467-017-02782-9

數據是不同發育階段的轉錄數據，表達量數據的下載鏈接是 https://zenodo.org/record/7117357#.Y0WB13ZBzic

關于樣本的一些分組信息在鏈接里提供了，大家如果感興趣可以自己下載數據然后跟著這個鏈接完全重復一下

接下來的內容我重復一下資料中利用表達量數據做PCA的內容

代碼

setwd("data/20221012/")
list.files()

#library(data.table)
library(readr)
Exp_table <- read_csv("Shinozaki_tpm_all.csv", col_types = cols())
head(Exp_table)
dim(Exp_table)

library(readxl)
Metadata <- read_excel("SimpleTidy_GeneCoEx-1.0.1/Data/Shinozaki_datasets_SRA_info.xlsx")
head(Metadata)
dim(Metadata)

library(tidyverse)
Exp_table_long <- Exp_table %>% 
  rename(gene_ID = `...1`) %>% 
  pivot_longer(cols = !gene_ID, names_to = "library", values_to = "tpm") %>% 
  mutate(logTPM = log10(tpm + 1)) 

head(Exp_table_long)


Exp_table_log_wide <- Exp_table_long %>% 
  select(gene_ID, library, logTPM) %>% 
  pivot_wider(names_from = library, values_from = logTPM)

head(Exp_table_log_wide)

my_pca <- prcomp(t(Exp_table_log_wide[, -1]))
pc_importance <- as.data.frame(t(summary(my_pca)$importance))
head(pc_importance, 20)


PCA_coord <- my_pca$x[, 1:10] %>% 
  as.data.frame() %>% 
  mutate(Run = row.names(.)) %>% 
  full_join(Metadata %>% 
              select(Run, tissue, dev_stage, `Library Name`, `Sample Name`), by = "Run")

head(PCA_coord)


PCA_coord <- PCA_coord %>% 
  mutate(stage = case_when(
    str_detect(dev_stage, "MG|Br|Pk") ~ str_sub(dev_stage, start = 1, end = 2),
    T ~ dev_stage
  )) %>% 
  mutate(stage = factor(stage, levels = c(
    "Anthesis",
    "5 DPA",
    "10 DPA",
    "20 DPA",
    "30 DPA",
    "MG",
    "Br",
    "Pk",
    "LR",
    "RR"
  ))) %>% 
  mutate(dissection_method = case_when(
    str_detect(tissue, "epidermis") ~ "LM",
    str_detect(tissue, "Collenchyma") ~ "LM",
    str_detect(tissue, "Parenchyma") ~ "LM",
    str_detect(tissue, "Vascular") ~ "LM",
    str_detect(dev_stage, "Anthesis") ~ "LM",
    str_detect(dev_stage, "5 DPA") &
      str_detect(tissue, "Locular tissue|Placenta|Seeds") ~ "LM",
    T ~ "Hand"
  ))

head(PCA_coord)

library(viridis)
library(RColorBrewer)

PCA_by_method <- PCA_coord %>% 
  ggplot(aes(x = PC1, y = PC2)) +
  geom_point(aes(fill = dissection_method), color = "grey20", shape = 21, size = 3, alpha = 0.8) +
  scale_fill_manual(values = brewer.pal(n = 3, "Accent")) +
  labs(x = paste("PC1 (", pc_importance[1, 2] %>% signif(3)*100, "% of Variance)", sep = ""), 
       y = paste("PC2 (", pc_importance[2, 2] %>% signif(3)*100, "% of Variance)", "  ", sep = ""),
       fill = NULL) +  
  theme_bw() +
  theme(
    text = element_text(size= 14),
    axis.text = element_text(color = "black")
  )


PCA_by_method

PCA_by_tissue <- PCA_coord %>% 
  ggplot(aes(x = PC1, y = PC2)) +
  geom_point(aes(fill = tissue), color = "grey20", shape = 21, size = 3, alpha = 0.8) +
  scale_fill_manual(values = brewer.pal(11, "Set3")) +
  labs(x = paste("PC2 (", pc_importance[2, 2] %>% signif(3)*100, "% of Variance)", sep = ""), 
       y = paste("PC3 (", pc_importance[3, 2] %>% signif(3)*100, "% of Variance)", "  ", sep = ""),
       fill = "tissue") +  
  theme_bw() +
  theme(
    text = element_text(size= 14),
    axis.text = element_text(color = "black")
  )

PCA_by_tissue

PCA_by_stage <- PCA_coord %>% 
  ggplot(aes(x = PC2, y = PC3)) +
  geom_point(aes(fill = stage), color = "grey20", shape = 21, size = 3, alpha = 0.8) +
  scale_fill_manual(values = viridis(10, option = "D")) +
  labs(x = paste("PC2 (", pc_importance[2, 2] %>% signif(3)*100, "% of Variance)", sep = ""), 
       y = paste("PC3 (", pc_importance[3, 2] %>% signif(3)*100, "% of Variance)", "  ", sep = ""),
       fill = "stage") +  
  theme_bw() +
  theme(
    text = element_text(size= 14),
    axis.text = element_text(color = "black")
  )

PCA_by_stage 


library(patchwork)

PCA_by_method+PCA_by_tissue+PCA_by_tissue

image.png

以上用到的代碼和示例數據都可以在推文開頭提到鏈接里找到

上面的代碼有一步是對TPM值 加1然后取log10，他的實現方式是先將寬格式數據轉換為長格式，然后把取log10后的長格式再轉換為寬格式，這里我沒能還可以借助mutate_at()函數

Exp_table %>% select(1,2,3) %>% 
  rename("gene_id"="...1") %>% 
  mutate_at(vars(starts_with("SRR")),
            function(x){log10(x+1)})

image.png

歡迎大家關注我的公眾號

小明的數據分析筆記本

小明的數據分析筆記本 公眾號 主要分享：1、R語言和python做數據分析和數據可視化的簡單小例子；2、園藝植物相關轉錄組學、基因組學、群體遺傳學文獻閱讀筆記；3、生物信息學入門學習資料及自己的學習筆記！