2022-04-16:一天就搞了一个这

library(readr)
library(ggtree)
library(treeio)
library(DESeq2)
library(ggplot2)
library(stringr)
library(tidyverse)

df_handle<-function(
  otu_table,
  treefile,
  tiplabelfile,
  pattern){
  dat01<-read_tsv(otu_table)
  tiplabgroup<-read_tsv(tiplabelfile)
  tree<-read.tree(treefile)
  new.tree<-full_join(tree,tiplabgroup,by='label')
  ggtree(new.tree)+
    #geom_tiplab(align = TRUE)+
    geom_tippoint(aes(color=GROUP))+
    #xlim(NA,1.5)+
    theme(legend.position = "none")-> p1
  
  group.info.01<-data.frame(
    row.names = dat01 %>% select(matches(pattern)) %>% 
      colnames(),
    conditions = c(rep("trt",5),
                   rep("ctl",5))
  )
  group.info.01$conditions<-factor(group.info.01$conditions)
  dat01 %>% 
    select(matches(paste(pattern,"OTU ID",sep = "|"))) %>% 
    column_to_rownames('OTU ID') -> dat01.1
  dds <- DESeq2::DESeqDataSetFromMatrix(countData = dat01.1,
                                        colData=group.info.01,
                                        design = ~ conditions)
  dds_res <- DESeq2::DESeq(dds, sfType = "poscounts")
  
  res <- results(dds_res, 
                 tidy=T, 
                 format="DataFrame",
                 contrast = c("conditions","trt","ctl"))
  res %>% 
    mutate(str_extract(row,"f__\\S+;") %>% 
             str_split_fixed(pattern = ";",n=10) %>% 
             as.data.frame() %>% 
             select(1)) -> res.01
  
  
  res.01[which(res.01$V1%in%tree$tip.label),] %>% 
    filter(!is.na(log2FoldChange)) %>% 
    group_by(V1) %>% 
    summarise(log2FoldChange=mean(log2FoldChange)) -> res.02
  merge(res.02,tiplabgroup,by.x='V1',by.y="label") -> res.02
  res.02$V1<-factor(res.02$V1,
                    levels = p1$data %>% na.omit() %>% arrange(y) %>% pull(label))
  dat01.1 %>% rownames_to_column(var = "family") %>% 
    mutate(str_extract(family,"f__\\S+;") %>% 
             str_split_fixed(pattern = ";",n=10) %>% 
             as.data.frame() %>% 
             select(1)) -> dat01.2
  dat01.1 %>% rownames_to_column(var = "family") %>% 
    mutate(str_extract(family,"f__\\S+;") %>% 
             str_split_fixed(pattern = ";",n=10) %>% 
             as.data.frame() %>% 
             select(1)) %>% 
    merge(tiplabgroup,by.x="V1",by.y='label') %>% 
    select(-c('family','GROUP')) %>% 
    group_by(V1) %>% 
    summarise_all(mean) %>% 
    mutate(mrd=rowSums(.[2:11])/10) %>% 
    select(V1,mrd) -> dat01.2
  res.02$V1<-str_replace(res.02$V1,"f__","")
  res.02$GROUP<-str_replace(res.02$GROUP,"c__","")
  dat01.2$V1<-str_replace(dat01.2$V1,"f__","")
  new.tree@phylo$tip.label<-
    str_replace(new.tree@phylo$tip.label,
                "f__","")
  new.tree@data$GROUP<-
    str_replace(new.tree@data$GROUP,
                "c__","")
  return(list(bubble.1 = res.02,
              bubble.2 = dat01.2,
              tree.1 = new.tree))
}




bubble_figure<-function(dat){
  ggplot(data=dat,
         aes(x=log2FoldChange,y=V1))+
    geom_vline(xintercept = 0,lty="dashed",
               color="grey",size=1)+
    geom_point(aes(size=log2FoldChange,
                   fill=GROUP),
               shape=21)+
    guides(size='none',
           fill=guide_legend(ncol=6))+
    scale_fill_discrete(name=NULL)+
    #ggtitle("F_0_20VSW_0_20")+
    theme_minimal()+
    theme(legend.position = "bottom",
          legend.direction = "vertical",
          legend.justification = c(0,0),
          axis.ticks.y = element_blank(),
          axis.text.y = element_blank(),
          panel.grid = element_blank(),
          axis.line.x = element_line(),
          axis.ticks.x = element_line())+
    labs(y=NULL) -> p
  return(p)
}
#bubble_figure(plot_data[["bubble.1"]])

dat01<-read_tsv("data/20220414/data/otu_taxon_otu.full.xls")
dat01 %>% colnames()
dat01 %>% select(matches("[FW]\\d_0_20")) %>% colnames()
dat01 %>% select(matches("[FW]\\d_20_40")) %>% colnames()
dat01 %>% select(matches("[FW]\\d_40_60")) %>% colnames()

dat01 %>% select(matches("[HW]\\d_0_20")) %>% colnames()
dat01 %>% select(matches("[HW]\\d_20_40")) %>% colnames()
dat01 %>% select(matches("[HW]\\d_40_60")) %>% colnames()

dat01 %>% select(matches("[MW]\\d_0_20")) %>% colnames()
dat01 %>% select(matches("[MW]\\d_20_40")) %>% colnames()
dat01 %>% select(matches("[MW]\\d_40_60")) %>% colnames()

df_handle(otu_table = "data/20220414/data/otu_taxon_otu.full.xls",
          treefile = "data/20220414/data/phylo_tree .tre",
          tiplabelfile = "data/20220414/data/species_group .xls",
          pattern = "[FW]\\d_0_20") -> plot_data

trt_ctl<-c("[FW]\\d_0_20","[FW]\\d_20_40","[FW]\\d_40_60",
           "[HW]\\d_0_20","[HW]\\d_20_40","[HW]\\d_40_60",
           "[MW]\\d_0_20","[MW]\\d_20_40","[MW]\\d_40_60")

plot_list = list()
for (i in 1:9){
  df_handle(otu_table = "data/20220414/data/otu_taxon_otu.full.xls",
            treefile = "data/20220414/data/phylo_tree .tre",
            tiplabelfile = "data/20220414/data/species_group .xls",
            pattern = trt_ctl[i]) -> plot_data
  #print(plot_data)
  #print(bubble_figure(plot_data[["bubble.1"]]))
  bubble_figure(plot_data[["bubble.1"]]) -> plot_list[[i]]
}

p1<-ggtree(plot_data[["tree.1"]])+
  geom_tiplab(align = T,offset = 0.01)+
  geom_tippoint(aes(color=GROUP))+
  xlim(NA,2)+
  theme(legend.position = "none")
p1
p1+plot_spacer()+
  (plot_list[[1]]+
  plot_list[[2]]+
  plot_list[[3]]+
  plot_list[[4]]+
  plot_list[[5]]+
  plot_list[[6]]+
  plot_list[[7]]+
  plot_list[[8]]+
  plot_list[[9]]+
  plot_layout(guides = "collect",
              nrow=1)&theme(legend.position = "bottom"))+
  plot_layout(widths = c(1,1,9))
image.png
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 195,980评论 5 462
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 82,422评论 2 373
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 143,130评论 0 325
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 52,553评论 1 267
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 61,408评论 5 358
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 46,326评论 1 273
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 36,720评论 3 386
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 35,373评论 0 254
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 39,678评论 1 294
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 34,722评论 2 312
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 36,486评论 1 326
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 32,335评论 3 313
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 37,738评论 3 299
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,009评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 30,283评论 1 251
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 41,692评论 2 342
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 40,893评论 2 335

推荐阅读更多精彩内容

  • 2021年4月15日 落地真经严格就是爱,放纵既是害 目标确认 产值目标:16.5万 台次目标100台 产值已完成...
    京心达宁威阅读 97评论 0 0
  • 今天的效率也可以,完成了工作,还给儿子做了好吃的羊肉丸子汤。 下午的研讨,也很热烈,大家的点子都不错,课程的样子就...
    胡喜平阅读 105评论 0 2
  • 雨夜的温暖初三作文800字 导语:作文对于在校学生来说,是学习好语文的重要组成部分。我们每次考试得用到作文,它在各...
    64cd40b8fe4b阅读 130评论 0 2
  • 今天又给忘了,都没啥兴趣日更了,今天也是在家各种忙,我发现我不适合当家庭主妇,这俩娃天天在跟前,都不知道时间是...
    正在努力改变的妈妈阅读 142评论 0 0
  • 有些工作干着干着会耗尽一生的事业心。
    翡翠翎管阅读 180评论 0 0