生信人應該這樣學習R語言

# 生信技能树:
#   看完我的B站教学视频:https://www.bilibili.com/video/av25643438
# 有能力这持续注释R语言实战书籍附件代码 : https://github.com/biotrainee/RiA2     
# 作业的话最低要求 10 个题目,尽量根据参考代码理解及完成:http://www.bio-info-trainee.com/3793.html  
# 中等要求是完成20题: http://www.bio-info-trainee.com/3415.html
# 安装100个以上的R包,代码在:http://www.bio-info-trainee.com/3727.html 并且查看有哪些R包汇报一下
# 我的周末班培训讲义 配套的思维导图及资料在:https://mubu.com/doc/HGT7XBmgg

#能找到代码,能看懂代码,能修改代码!不要背代码!

# 生信技能树视频课程学习路径:  https://mp.weixin.qq.com/s/gqib-RtbC315Zad-8KmkXw


plot(1:10)  #因为没有打开画布,所以右下角plots那里直接出图。

png('tmp.png')  #打开画板,之后画的图都不会在右下角plots里面,
plot(1:10)
dev.off()  #关闭画板,只有执行了这一步files里面才有图片

.libPaths()  #R包安装的位置

substr('abcde', 1, 3)  #字符串取子集的函数


# P2【03期线下课程】02.R语言基础变量讲解 -------------------------------------------------
a=c(1, 2, 3)  #向量的创建方式,c表示create
b=c('a', 'b', 'c')
c=c(1, 'a', 3) #有数字也有字符时按字符算,向量类型之间是有优先级的


class(a)  #查看向量类型, 数值型向量
class(b)  #字符型向量
class(c)

d=LETTERS  #LETTERS是内置向量
e=d[1:10]  #向量取子集,字符串取子集是substr函数
e

dim(e)=c(2,5)  # 向量加上维度就会变成矩阵
e  #

e[1,2]='1'  #更改某个值
e


# is系列函数和as系列函数,is进行判断,as进行转换
a=1:10
a
dim(a)=c(2,5)
pheatmap::pheatmap(a)  #可以先library(pheatmap) ,library之后就不用打两遍pheatmap
is.matrix(a)  #进行判断
a[1,2]='5'
is.data.frame(e)


a=1:10
dim(a)=c(2,5)
b=as.data.frame(a)
b[1,2]='5'
View(b)
pheatmap::pheatmap(b) #会发现不能画热图了。
is.matrix(b) 
is.data.frame(b)



#通过save将内容保存,下次可直接load,并不需要运行前面的代码
# a=1:10
# dim(a)=c(2,5)
# b=as.data.frame(a)
# b[1,2]='5'
# View(b)
# pheatmap::pheatmap(b) #会发现不能画热图了。
save(b, file='input.Rdata')  
load(file='input.Rdata')


# **list介绍 ------------------------------------------------------------------
# list的每一个元素都可以通过$来取
b=options()  #此时可看到b就是一个有80个元素的list,每个元素都可以使用$来取;只有数据框和列表才能用$来取。
length(b)
lapply(b, length)  # lapply对b中的每一个元素进行length函数操作
unlist(lapply(b, length))  # 通过unlist将list转换成不是list,但是看起来还是不直观。
as.numeric(unlist(lapply(b, length)))  #将它变成纯粹的数字,不看名字

#sapply产生向量,lapply产生列表;lapply的操作对象可以是data.frame、character、list

tmp <- c('ENSG00000000003.13','ENSG00000000005.5','ENSG00000000419.11');class(tmp)  
tmp <- lapply(tmp, function(x){strsplit(x,'[.]')}[[1]][2]);class(tmp)  #lapply的操作对象是character,产生的是list,将2改成1试下
tmp

tmp <- rnorm(100);dim(tmp)<-c(5,20)
tmp <- as.data.frame(tmp)
lapply(tmp, mean) #对每一列计算mean,且输出的是list;同 apply(tmp, 2, mean),但后者输出是




# **取子集方式 -------------------------------------------------------------------
setwd("D:/电脑送检复制文件/离开汤lab后的/生信学习/生信技能树学习/2 生信人应该这样学R语言/用到的文件")
a=read.table('SraRunTable.txt', stringsAsFactors=F, header=T, sep=',')
View(a)

tmp=a[c(3,7,8), ]  #方法1:直接给出下标

index1=grep('RNA-Seq', a$Assay.Type)  #方法2:用grep来查找下标,把a$Assay.Type中是RNA-Seq的取出来
index1
tmp=a[index1,]

index2=grepl('RNA-Seq', a$Assay.Type)  #方法3:grepl对下标进行判断,和index1=grep('RNA-Seq', a$Assay.Type) 是一样的
index2
tmp=a[index2,]

d=options() 
as.numeric(unlist(lapply(d, length))) >2  #会以TRUE和FALSE形式来返回满足条件和不满足条件
index1=table(as.numeric(unlist(lapply(d, length))) >2)  #table函数可以统计满足条件和不满足条件的个数
d=d[index1]  #因为d是list,list选元素不像数据框,直接[index1]中间没有加逗号。数据框选行列使用逗号来分割开。
d






d=options() 
index1=as.numeric(unlist(lapply(d, length)))>2 #table函数可以统计满足条件和不满足条件的个数
index1
d=d[index1]  #因为d是list,list选元素不像数据框,直接[index1]中间没有加逗号。数据框选行列使用逗号来分割开。
d
d[4]  #list里面取元素需要用[[]],使用[]取到的只是一个子list
class(d[4])  #可以发现d的第四个元素依然是一个list

# 思考以下几个

d
d[4] #取到的仍然是有两层的
d[[4]]  #取到的只有一层
d[[4]][[1]] #只剩下一层之后再取第1个元素
d[[4]][[2]] #只剩下一层之后再取第2个元素



# P3【03期线下课程】03.外部数据导入导出 --------------------------------------------------
setwd("D:/电脑送检复制文件/离开汤lab后的/生信学习/生信技能树学习/2 生信人应该这样学R语言/用到的文件")
a=read.table('SraRunTable.txt',  header=T, sep=',')
a=read.table('SraRunTable.txt',  header=T, sep=',', comment.chr='!')
# comment.chr是指定注释符号,表示!后的不读取

rownames(b)=b[,1]  #将b的第1列作为b每一行的行名
b=b[,-1] #将b的第一列删除
b=log2(b)
save(b, file='input.Rdata')  #通过save将内容保存,下次可直接load,并不需要运行前面的代码
load(file='input.Rdata')
pheatmap::pheatmap(b[1:10,])  #对b的前10行画热图



# P4【03期线下课程】04.中级变量操作 ----------------------------------------------------
setwd("D:/电脑送检复制文件/离开汤lab后的/生信学习/生信技能树学习/2 生信人应该这样学R语言/用到的文件")
a=read.table('SraRunTable.txt',  header=T, sep=',')
sort(a$MBases)[1] #拿到MBases中的最小值
min(a$MBases) #拿到MBases中的最小值


#拿到MBases中的最大值
sort(a$MBases, decreasing = T)[1]  
max(a$MBases)  
sort(a$MBases)[length(a$MBases)]



fivenum(a$MBases)  #拿到MBases中的五分位数

boxplot(a$MBases~a$Assay.Type)  #根据a$Assay.Typedui对 a$MBases画图
table(a$Assay.Type)  # 看一下每个种类的个数
wes=a[a$Assay.Type=='WXS',]  # =表示赋值,==表示判断
rna=a[a$Assay.Type=='RNA-Seq',] 
fivenum(wes$MBases)
fivenum(rna$MBases)


b=a[a$MBases<5000,]
b

# a=read.table('D:/生信学习/Linux學習/生信技能树学习/2 生信人应该这样学R语言/用到的文件/input.Rdata') #input.Rdata是从文章上下载的表达矩阵,需要load。
setwd("D:/电脑送检复制文件/离开汤lab后的/生信学习/生信技能树学习/2 生信人应该这样学R语言/用到的文件")
load(file = 'input.Rdata')
class(a)
str(a)
head(a)[1:5,1:5]

b <- rnorm(100)
dim(b) <- c(5,20)
b
b<-as.data.frame(b)
# **穷举,rowMeans,for循环,apply四种方式求行平均值 --------------------------------------
mean(b[1,])  #因为b现在是数据框,所以无法运算
mean(as.numeric(b[1,]))  #as.numeric转成数值就可以进行运算了
mean(as.numeric(b[2,])) 

rowMeans(b)  #也可以使用rowMeans取每一行的平均值

for (i in 1:5) {mean(as.numeric(b[i,]))} #使用for循环也可以,但是没有值出现,需要print一下
for (i in 1:nrow(b)) {print(mean(as.numeric(b[i,])))}
for (i in 1:nrow(b)) {print(max(as.numeric(b[i,])))}  #求每行最大值

apply(b, 1, function(x){mean(x)})  #apply循环专门针对矩阵和数据框,b是矩阵名,1表示矩阵的行(2表示列),{}中是想要进行的运算
apply(b, 1, function(x){max(x)}) #求每行最大值
apply(b, 2, function(x){max(x)}) #求每列最大值
apply(b, 1, mean) #精简写法
apply(b, 1, max)  #精简写法


# 定义函数做自己需要进行的操作 --------------------------------------------------------------------
rowMax(b)  #定义之前不存在rowMax这个函数,无法运算
rowMax=function(x){apply(x, 1, max)}  #定义函数
rowMax(b)  #定义之后可以运算。

#定义一个函数可以使每行第1个值加上第2个值再减去第3个值。能完整默写出来才是真正的掌握。
Jimmy <- function(b){
  for (i in 1:nrow(b)) {
    x=as.numeric(b[i,])
    y=x[1]+x[2]-x[3]
    print(y)
  }
}

Jimmy(b)  #Jimmy是一个创造出来的函数

b <- rnorm(88)
dim(b)<- c(22,4)
b
rownames(b)<-c('甲','乙','丙','丁','戊','己','庚','辛','壬','癸','子','丑','寅','卯','辰','巳','午','未','申','酉','戌','亥')
b

#求b每一行的方差,并把方差值前四的行名找出来。
cg<- names(sort(apply(b,1,sd),decreasing = T)[1:6])  
cg

# 从b的所有行中随机抽取5行做热图
sample(1:nrow(b),6)  #从b所有行中随机抽6行
pheatmap::pheatmap(b[sample(1:nrow(b),6),])  #把随机抽出来的6行画热图
pheatmap::pheatmap(b[cg,]) #把排序后的画热图


# P5【03期线下课程】05.热图 --------------------------------------------------------
#这个热图自己动手画出来!!!
##直接执行下面代码,然后看着图该图画出来。
rm(list = ls())
library(pheatmap)  #library之后就不用打两遍pheatmap::pheatmap
a1<-rnorm(100);dim(a1)<-c(5,20)
pheatmap(a1)

a2<-rnorm(100)+2;dim(a2)<-c(5,20)
pheatmap(a2)

pheatmap(cbind(a1,a2))  #这样看是左边高,因为默认进行了排序
pheatmap(cbind(a1,a2), cluster_cols = F)  #cluster_cols =F表示不排序,此时左边是a1,右边是a2,可看到右边更红。

#但是此时热图没有名字
# 因为cbind(a1,a2)还是只是一个matrix,要变成数据框才行,但是变成数据框之后的列名无意义,可自己定义
b<-as.data.frame(cbind(a1,a2))

# **将名字命名为a1_1一直到a1_20和a2_1一直到a2_20 -----------------------------------------
names(b)<-c(paste('a1', 1:20, sep = '_'),paste('a2', 1:20, sep = '_'))  #自己来一遍
pheatmap(b, cluster_cols = F)

#如果名字很多,写不下,a1_1一直到a1_20只写a1,a2_1一直到a2_20只写a2,自学pheatmap包,
?pheatmap  #查看Examples

tmp <- data.frame(group=c(rep('a1',20),rep('a2',20)))
rownames(tmp) = colnames(b) #这一句他娘的很重要!因为b是热图数据,tmp是一系列的值,这些值要对应于热图数据来进行分组,所以tmp的行名等于b的列名,这样画图时就知道谁对应着谁了。

pheatmap(b,annotation_col = tmp)
# 热图高度自定义,只需要把Examples吃透


# P6【03期线下课程】06.选取差异明显的基因的表 -----------------------------------------------


# P7【03期线下课程】07.id转换 ------------------------------------------------------

#问题:取ENSG00000000005.5点前的部分,如果好多个如何批量取?

tmp<-strsplit('ENSG00000000005.5','[.]')  #按点分割,因为点是通配符`,所以用[]括住。
tmp[[1]][1] #list取元素是通过[[]]。而[[1]][1]表示取第1个元素的第1个元素。
tmp[[1]][2]
# 因为tmp[[1]]是一个向量,取向量的第一个元素用[1]就可以,


options(stringsAsFactors = F)  #读文件之前要加这个,stringsAsFactors是一个逻辑变量,表示字符向量是否转化成因子。默认值是 TRUE,除非它被 colClases所覆盖。当你在处理大型文本文件的时候,设置成 stringsAsFactors=FALSE 可以提升处理速度
a<-read.table('D:/生信学习/Linux學習/生信技能树学习/2 生信人应该这样学R语言/用到的文件/ensembl.txt')
a<-read.table('ensembl.txt')
library(stringr)
str_split(a$V1, '[.]')  #此时仍然是list形式;只有数据框和列表才能用$来取元素。
unlist(str_split(a$V1, '[.]'))  # 将list变成不是list
class(unlist(str_split(a$V1, '[.]')))  #看一下现在是啥
class(str_split(a$V1, '[.]', simplify = T)) #得到matrix #simplify = T得到的是矩阵,为F得到的是list;
a$ensembl_id=str_split(a$V1, '[.]', simplify = T)[,1]  #只有得到matrix之后才能用[,]进行取行和列
a

#---------补充:我自己的做法---------
a<-read.table('ensembl.txt',stringsAsFactors = F);library(stringr)
tmp=unlist(str_split(a$V1,'[.]'))
dim(tmp)=c(2,8)
tmp=t(tmp)
a$ensembl_id<-tmp[,1]
a
#-------------------------------


#将基因和id对应起来(谁谁下了一堆基因id但不知道是啥意思可以使用下列方法转换。)
library(org.Hs.eg.db)  #这个包里面有基因和id的对应关系
g2e<-toTable(org.Hs.egENSEMBL) #得到ensembl_id
g2s<-toTable(org.Hs.egSYMBOL) #得到gene symbol
# 先在g2e里面通过ensembl_id,找到对应的gene_id,再在g2s里面通过gene_id找到对应的symbol(基因名)。一个个去查比较低效。
# 思路:通过ensembl_id将g2e和a关联起来,然后再通过gene_id将三者关联起来,注意 merge(a,b) 和 merge(b,a) 是不一样的,可以调换一下看差别.
b<-merge(a,g2e, by='ensembl_id', all.x=T)  #all.x=T表示a里面的东西即使有的对应不上也保留,假如=F则对应不上就会丢掉
d<-merge(b,g2s, by='gene_id', all.x=T) #继续关联
#有的关联不到是正常的,因为基因命名是不断变化的,有些可能就关联不到了。
table(d$ensembl_id)>1
table(table(d$ensembl_id)>1)  #有些ensembl_id对应着不止1个gene_id。
table(d$ensembl_id)[table(d$ensembl_id)>1]   #将>1的挑选出来,table(d$ensembl_id)是列出所有内容,后面[]中是条件,将所有内容里满足条件的列出。
 
d=d[!duplicated(d$V1),] #对d的V1部分进行去重复
d=d[match(a$V1,d$V1),]  #使d中V1的排列顺序跟a中V1的顺序一样,矫正顺序用match。


# P8【03期线下课程】08.任意基因任意癌症表达量分组的生存分析-----------------------------------------
#如果我们想看某个基因在TCGA数据库中各个癌症中的生存关系图
# 进入www.oncolnc.org,随便输入一个(比如ARHGAP18),点submit,然后选择一个癌症(比如点LGG后的Yes please!),分组可以写成50和50将基因分成高表达组和低表达组,再点击submit,
#这样就可以得到一个生存分析的图。网页也会将样本表达量给出,数据也可以自己下载回去重新画图。点击click here就可以下载到它的表达矩阵。
# 在文件所在位置project只是一个定位的东西,可以去别处拷贝一个,然后放在表达矩阵所在的文件夹下,直接点击该project文件就可以定位到此。
rm(list = ls())
options(stringsAsFactors = F)
a<-read.table('D:/生信学习/Linux學習/生信技能树学习/2 生信人应该这样学R语言/用到的文件/LGG_93663_50_50.csv', sep=',',header=T, fill=T)
a<-read.csv('LGG_93663_50_50.csv')
#曾健明说 read.table指定逗号分割的时候和read.csv是一回事
colnames(a)  #后面作图时候可以直接复制这一步产生的名字
dat<-a

#当我们对网页给出的图不满意,我们可以下载数据源,自己作图。
library(ggstatsplot)
ggbetweenstats(data = dat, x=Group, y=Expression)  # 根据我们分的高低表达group来分组,x和y直接复制 colnames(a) 产生的名字,不要自己手写,容易错。
ggbetweenstats(data = dat, x=Status, y=Expression)  # 也可以根据Status分组。

#重画生存分析图
rm(list = ls())
options(stringsAsFactors = F)
#a<-read.table('D:/生信学习/Linux學習/生信技能树学习/2 生信人应该这样学R语言/用到的文件/LGG_93663_50_50.csv', sep=',',header=T, fill=T)
a<-read.table('LGG_93663_50_50.csv', sep=',',header=T, fill=T)
dat<-a
library(ggplot2)
library(survival)
library(survminer)
# table(dat$Status)
dat$Status<-ifelse(dat$Status=='Dead',1,0)   #通过ifelse将dead变成1,alive变成0
sfit <-survfit(Surv(Days,Status)~Group, data=dat) #以Days为x轴,以status为y轴,根据group画图,因为有两个group,所以画两条线,代表两个group
# sfit
# summary(sfit)
ggsurvplot(sfit,conf.int = F, pval = T)
ggsave('survival_ARHGAP18_in_LGG.png')
#有其他调节需求可以去看帮助文档


# P9【03期线下课程】09.任意基因任意癌症表达量和临床性状关联 -----------------------------------------
#去他妈的,网速太差啦,去PPT上看。 
# cbioportal网页工具可获取任意基因任意癌症的临床信息。因为www.oncolnc.org网站只有生活史的临床信息。
rm(list = ls())
options(stringsAsFactors = F)

# 下载数据:登录www.cbioportal.org,左边栏目找到并点击Ovary/Fallopian Tube,右边选中Ovarian Serous Cystadenocarcinoma(TCGA, Nature 2011),点击Query By Gene

# 在Select Patient/Case Set处填写Tumors with sequencing and CNA data (316)并填写基因ARHGAP18,点击Submit Query

#想看一下不同的clinical stage表达量是否有差异
plot-data-ARHGAP18-TCGA-OV-cbioportal.txt
a<-read.table('plot-again-ARHGAP18-TCGA-OA-cbioportal.png', sep='\t',header=T, fill = T) #TCGA卵巢癌316个样本
colnames(a)=c('id', 'stage', 'gene', 'mut')  #通过colnames重新取名,因为原来的名字太复杂。
dat=a
library(ggstatsplot)
ggbetweenstats(data=dat, x=stage, y=gene)  #通过stage画gene的表达量
library(ggplot2)
ggsave('plot-again-ARHGAP18-TCGA-OA-cbioportal.png')
#曾健明说通过这一节的学习可以知道任何基因在任何癌症中的表达以及和感兴趣的临床症状是否有关系!




# P10【03期线下课程】10.表达矩阵的样本的相关性 ----------------------------------------------
#看两个比变量的相关性
cor(1:10,1:10) #因为完全等同,故相关性为1

a<-rnorm(10)  #产生10个随机数
b<-rnorm(10)  #产生10个随机数
cor(a,b)  #看相关性,因为随机,所以相关性很差

a<-rnorm(10)  #产生10个随机数
b<-10*a+rnorm(10)  
cor(a,b)  #相关性很高,因为rnorm(10)  对于ab间的相关性就是一个噪音而已

rm(list = ls())
options(stringsAsFactors = F)
library(airway)  #airway是bioconductor的数据包,bioconductor有三种包:功能函数包、数据包、注释包。注释包就是各种各样的芯片各种各样的基因之间的转换。数据包只有一个加载数据的功能。
data(airway)  #通过data函数将数据加载进来
airway
exprSet<-assay(airway)  # 获得它的表达矩阵
colnames(exprSet)

View(exprSet)
dim(exprSet)  #总共8个样本,64102个基因。

#探究样本与样本之间的相关性
cor(exprSet[,1],exprSet[,2])  #直接看第1和第2个样本的相关性。会发现相关性很好,有两种可能,一种可能是这两个就是同一个样本的技术重复,还有一个可能就是二者0都太多了。
#但是看相关性应该是看高表达的,表达量低的不准确,这是技术的限制,如果是芯片就更不准确。
cor(exprSet)  #得到所有样本之间的相关性的表达矩阵,发现都接近1,这是不符合实际情况的,因为有处理组和对照组按道理是应该能够分开的。
pheatmap::pheatmap(cor(exprSet)) #提前library(pheatmap)就不用pheatmap两遍了


#想看一下处理信息,看相关性是否等于它
group_list <- colData(airway)[,3]  #group_list 里面是处理信息
group_list
#画热图将group_list加到注释信息里面可以看到热图信息
tmp=data.frame(g=group_list)

# tmp有多少列不要紧,关键是tmp的行名一定要符合矩阵的列名
rownames(tmp)=colnames(exprSet)
pheatmap::pheatmap(cor(exprSet),annotation_col = tmp)


#虽然从得到的图上可以看到能分开,但是从数据的角度不好看,因为都是接近1,因此需要找到它们之间真实的相关性,有很多东西做相关性是需要去掉的。这里可以设定一个标准,如果一个基因的表达量大于1的样本数小于5我们就舍弃。
#我们要删除的是基因,基因是行,
# apply(exprSet, 1, mean) #对exprSet的每行进行mean的操作
# apply(exprSet, 1, function(x) x>3)  #这样写是不行的
x=exprSet[1,]
x
x>1  #判断
table(x>1)  #求判断成功和失败的个数,但table统计不是最好的办法
sum(x>1)  ##求判断成功和失败的个数,TRUE等价于1,FALSE等价于0
sum(x>1) >5  #判断每一行基因表达大于1的样本个数是否超过5个

x=exprSet[2,]
sum(x>1) >5

apply(exprSet, 1, function(x) sum(x>1)>5)  #这样写才是对的。其实应该用{}将sum(x>1)>5括起来,不括也可以。
dim(exprSet)
exprSet=exprSet[apply(exprSet, 1, function(x) sum(x>1)>5),]   #过!其实应该用{}将sum(x>1)>5括起来,不括也可以。
dim(exprSet)  #高表达量的基因不会太多,而且通常都是蛋白编码基因,可以将gene名拿去看,转换方法前面已经介绍

exprSet=log(edgeR::cpm(exprSet)+1)  #去除文库差异! edgeR::cpm是为了去除文库大小的差异,这样得到一个新的表达矩阵。
dim(exprSet) 
exprSet=exprSet[names(sort(apply(exprSet,1,mad), decreasing = T)[1:500]),]  #取了mad前500个变化量最大的基因,mad(Median absolute deviation, 中位数绝对偏差)
dim(exprSet) 


M=cor(log2(exprSet+1))
View(M)  #可以看到经过这些变换之后,差异大了一些。这时候这些基因在样本里的表达才有差异,这种差异反应了了样本本质的区别,就是处理和不处理的差别。
group_list <- colData(airway)[,3]  #group_list 里面是处理信息
group_list
tmp=data.frame(g=group_list)
rownames(tmp)=colnames(exprSet) # tmp有多少列不要紧,关键是tmp的行名一定要符合矩阵的列名
pheatmap::pheatmap(M,annotation_col = tmp, filename = 'cor.png')  # 加上名字就會会将图画到文件中去。
pheatmap::pheatmap(M,annotation_col = tmp)  #此时还是无法出现画的图,是因为画板没有关闭
dev.off()  #关闭画板
pheatmap::pheatmap(M,annotation_col = tmp)   #此时出现了画的图,从图中可以看到,同组之间的相关性比较高,不同组之间的相关性比较低。
#曾健明说本节对表达矩阵进行了充分的探索。



# P11【03期线下课程】11.芯片表达矩阵下游分析 -----------------------------------------------

# ***得到芯片表达矩阵 -------------------------------------------------------------
rm(list = ls())
options(stringsAsFactors = F)
suppressPackageStartupMessages(library(CLL))
data(sCLLex)#加载数据;P10中的airway使用的也是data加载数据;sex中间插入CLL
sCLLex  #sCLLex是依赖于CLL这个package的一个对象
exprSet=exprs(sCLLex) #sCLLex是R包CLL的对象,获取该对象的表达矩阵使用exprs,P10中的airway使用的是assay获取对象表达矩阵;

sample<-sampleNames(sCLLex)
pData<-pData(sCLLex)  #pData获取分组信息
group_list<-as.character((pData[,2]))
dim(exprSet)
exprSet[1:5,1:5]

#也可以根据group_list一个一个做差异分析。
t.test(exprSet[1,]~group_list)   #对第1个基因看在不同分组中的差异显著性,得到的结果是p-value = 0.5355,发现不显著。
boxplot(exprSet[1,]~group_list)  #从boxplot上面也可以看到。
boxplot(exprSet[2,]~group_list)  #对第2个基因看在不同分组中的差异显著性
t.test(exprSet[2,]~group_list)
#可以用apply进行批量循环
# apply(exprSet,1, ) ???该怎样写?

boxplot(exprSet)  
# Error in plot.new() : figure margins too large  如果右下角画图的地方给的空间太小,会报此错。


# ***芯片表达矩阵下游分析(limma包) -----------------------------------------------------------
#差异分析需要一个表达矩阵和一个分组信息。group_list就是分组信息
# group_list
# table(group_list)  #查看每一种分组有多少。
# 通常不会用apply进行批量循环,而是会用limma这个包。首先这个包引用较多,其次它加入了一些校正效果。它的用法首先要构造好design这个矩阵
suppressMessages(library(limma))
design<-model.matrix(~0+factor((group_list)))
colnames(design)<-levels(factor(group_list))
row.names(design)<-colnames(exprSet)
design
#曾建明说上面不需要理解,将来做差异分析也只是将下载的矩阵读进去

# 构造分组的比较矩阵。
contrast.matrix <- makeContrasts(paste0(unique(group_list),collapse = '-'),levels=design)
# contrast.matrix <- makeContrasts("progres.-stable", levels=design)  #这个和上面那个是等价的,因为paste0(unique(group_list),collapse = '-')返回的就是"progres.-stable"
contrast.matrix #这个矩阵声明,我们要把progres.组跟stable进行差异分析比较。
## 构造好分组的比较矩阵之后,后面的差异分析就是走了三个代码。
#step1
fit<-lmFit(exprSet,design)
#step2
fit2 <- contrasts.fit(fit, contrast.matrix)  #这一步很重要,大家可以自行看看效果。
fit2 <- eBayes(fit2)  #default no trend!!!
#eBayes() with trend=TRUE
#step3
tempOutput=topTable(fit2, coef = 1, n=Inf)
nrDEG=na.omit(tempOutput)
#write.csv(nrDEG2, "limma_notrend.results.csv", quote=F)
head(nrDEG)  #走完三个代码拿到的nrDEG就是差异分析的结果,这些结果就可以拿去做差异分析,画火山图或者挑选显著的基因,logFC比较大或者比较小的基因,结合p-value就可以做富集分析,超几何分布检验之类的。
#只是学了一个包的说明书,只要把自己的分组做好,表达矩阵做好。如果做自己的分析,可以从GEO里面下载。上面就是芯片的差异分析。





# P12【03期线下课程】12.RNA-seq表达矩阵差异分析 ------------------------------------------
#讲完RNA-seq表达矩阵差异分析就可以应付大部分的需求了,包括数据库挖掘之类的,这些技巧都涵盖了。
# airway包中就自带有转录组表达矩阵
rm(list = ls())
options(stringsAsFactors = F)
library(airway)  #airway是bioconductor的数据包,bioconductor有三种包:功能函数包、数据包、注释包。注释包就是各种各样的芯片各种各样的基因之间的转换。数据包只有一个加载数据的功能。
data(airway)  #通过data函数将数据加载进来
exprSet<-assay(airway)  # 这个包就是使用assay从对象中来获取表达矩阵,没有为什么,就是规定的。
#一般变量要么是向量,要么是数据框等等,如果又有向量又有数据框,又有一大堆东西,这个就是对象,对象就是什么都有。对象非常复杂,打开看一下
# 右上角打开airway可以看到有的需要使用@来取,前面讲的list里面最多也就$来取,说明对象里面的内容很杂,很多。
#一般比较大,比较复杂的包才会有对象,对于大部分人把五个基本的变量搞清楚就可以了。
colnames(exprSet)
group_list <- colData(airway)[,3]  #group_list 里面是处理信息
exprSet=exprSet[apply(exprSet, 1, function(x) sum(x>1)>5),]
table(group_list)
exprSet[1:4,1:4]
boxplot(log(exprSet+1))  #对于离差比较大的情况可以log一下,这样看起来整齐一些。这是比较粗糙的normalization的方法。
#上面也是读入表达矩阵和分组信息。只不过这里做差异分析不能使用limma那个包,因为它们的数据特征不一样,limma是应用于芯片数据的,RNA-seq的数据差异分析有三种方法。DESeq2包、edgeR包和
#以下三种方法公众号多次推过。

#方法一:DESeq2(曾健明比较喜欢用这个)
#曾健明说上面已经有表达矩阵和分组信息了,所以下面闭着眼睛跑就行了
if(T){
  library(DESeq2)
  (colData <-data.frame(row.names = colnames(exprSet), group_l=group_list))  #构造一个分组信息的数据框。
  dds <- DESeqDataSetFromMatrix(countData = exprSet, colData = colData, design = ~group_l)   #注意:这里的design对应的是数据框colData的列名,而不是对应着分组信息!
  tmp_f='airway_DESeq2-dds.Rdata'   #这里‘airway_DESeq2-dds.Rdata’只是一个字符串而已,不是一个文件
  
  if(!file.exists(tmp_f)){
    dds <- DESeq(dds)
    save(dds, file = tmp_f) #上面的'airway_DESeq2-dds.Rdata' 只是为了这里给文件命名,上面也可以省略,然后在这里写上file=''
    }

  load(file = tmp_f)
  res <- results(dds, contrast = c("group_list", "trt", "untrt"))
  resOrdered <- res[order(res$padj),]
  head(resOrdered)
  DEG=as.data.frame(resOrdered)
  DESeq2_DEG = na.omit(DEG)  # 得到差异分析的结果.
# RNA-seq测的表达量范围要大一些。
# 下面的就是数据库挖掘了
nrDEG=DESeq2_DEG[,c(2,6)];head(nrDEG)
colnames(nrDEG)=c('log2FoldChange','pvalue')  #注意列名,如果报错,可能是列名不对,要按自己的列名。
}

colnames(nrDEG)=c('logFC', 'P.Value')
attach(nrDEG)
plot(logFC, -log10(P.Value))  
library(ggpubr)
df=nrDEG
df$v=-log10(P.Value)  #添加新列
ggscatter(df, x="logFC", y="v", size = 0.5)

#添加新列,根据P.Value划分成'stable'、'up'、'down'三种情况
df$g=ifelse(df$P.Value>0.01, 'stable', #若差异不显著则是‘stable’
          ifelse(df$logFC >1.5, 'up',  #若差异显著且logFC >1.5则‘up’
                 ifelse(df$logFC< -1.5, 'down', 'stable')) #若差异显著且logFC <-1.5则‘down’,否则‘stable’
)

table(df$g)
df$name=rownames(df)  #添加新列
ggscatter(df, x="logFC", y="v", size = 0.5, color = 'g')
ggscatter(df, x="logFC", y="v", size = 0.5, color = 'g', 
          # label = "symbol", repel = T,
          # label.select = rownames(df)[df$g != 'stable'],
          # label.select = c('PROM1', 'AGR3', 'AGR2'),
          palette = c("#00AFBB", "#E7B800", "#FC4E07"))

# R语言基础知识就讲完了,接下来做芯片数据实战,在开始之前几篇文章一定先看完!
# 《解读GEO数据存放规律及下载,一文就够》
# 《解读SRA数据库规律一文就够》
# 《从GEO数据库下载得到表达矩阵 一文就够》
# 《GSEA分析一文就够(单机版+R语言版)》
# 《根据分组信息做差异分析- 这个一文不够的》
# 《差异分析得到的结果注释一文就够》
# 《多个探针对应同一个基因取最大表达量探针极简代码》




# P13【03期线下课程】R语言小作业-10题的答案 -----------------------------------------------
# # 搜狗搜索文章:《R语言练习题10道,有答案代码,还有视频》

# 作业 1
# 根据R包org.Hs.eg.db找到下面ensembl 基因ID 对应的基因名(symbol)
# 
# ENSG00000000003.13
# ENSG00000000005.5
# ENSG00000000419.11
# ENSG00000000457.12
# ENSG00000000460.15
# ENSG00000000938.11
# 提示:
# 
# library(org.Hs.eg.db)
# g2s=toTable(org.Hs.egSYMBOL)
# g2e=toTable(org.Hs.egENSEMBL)

# 我的答案:
rm(list = ls())
library(org.Hs.eg.db)
g2s=toTable(org.Hs.egSYMBOL)
g2e=toTable(org.Hs.egENSEMBL)
# tmp <- read.table(file = 'C:/Users/HASEE/Desktop/test.txt')
tmp <-c('ENSG00000000003.13', 'ENSG00000000005.5', 'ENSG00000000419.11', 
    'ENSG00000000457.12', 'ENSG00000000460.15', 'ENSG00000000938.11')
tmp=as.matrix(tmp) #str_split要求被处理的为矩阵,或向量,从?str_split可以看出,所以这里转化一下。
library(stringr)
tmp=str_split(tmp, '[.]', simplify = T) ##如果不加simplify = T则出来的tmp是list,加了之后出来的是matrix,才能用[]进行提取
tmp=tmp[,1]
tmp=as.data.frame(tmp)
names(tmp)<-c('ensembl_id')
M1<-merge(tmp,g2e, by='ensembl_id', all.x=F)
M2<-merge(M1, g2s, by='gene_id')

#曾健明的答案:
rm(list = ls())
options(stringsAsFactors = F)
a=read.table('e1.txt')  #打开project进行定位,这一句可以行得通。
head(a)
library(org.Hs.eg.db)
ls("package:org.Hs.eg.db")
g2s=toTable(org.Hs.egSYMBOL);head(g2s)
g2e=toTable(org.Hs.egENSEMBL);head(g2e)
# library(stringr) #不加载这个包也有自带的功能strsplit,若加载可使用str_split
a$ensembl_id=unlist(lapply(a$V1,function(x){strsplit(x,'[.]')[[1]][1]}))  
#如果前面不加options(stringsAsFactors = F)这里会报错,但是可以使用as.character(x)来替代strsplit(x,'[.]')的x
tmp=merge(a,g2e,by='ensembl_id')
tmp=merge(tmp,g2s,by='gene_id')


foo <- as.data.frame(unlist(lapply(a$V1, function(x){str_split(x,'[.]')})))
class(foo)

foo <- lapply(a$V1,function(x){strsplit(x,'[.]')[[1]][1]})




#因为探针和基因不是一一对应的关系,存在多个探针对应同一个基因的情况;所以通过探针找基因名使用包hgu133a.db;通过基因名找对应的探针使用包hgu95av2.db;

# 作业 2
# 根据R包hgu133a.db找到下面探针对应的基因名(symbol)
# 
# 1053_at
# 117_at
# 121_at
# 1255_g_at
# 1316_at
# 1320_at
# 1405_i_at
# 1431_at
# 1438_at
# 1487_at
# 1494_f_at
# 1598_g_at
# 160020_at
# 1729_at
# 177_at
# 提示:
# 
# library(hgu133a.db)
# ids=toTable(hgu133aSYMBOL)
# head(ids)

# 我的答案:
rm(list = ls())
options(stringsAsFactors = F)  #读文件之前要加这个
library(hgu133a.db)
ids=toTable(hgu133aSYMBOL);head(ids)

tmp=c('1053_at', '117_at','121_at','1255_g_at','1316_at','1320_at','1405_i_at','1431_at',
      '1438_at','1487_at','1494_f_at', '1598_g_at','160020_at','1729_at','177_at')
# tmp=as.matrix(tmp)
# colnames(tmp)=c('probe_id')  #這樣也可以
tmp=as.data.frame(tmp)
names(tmp)=c('probe_id');head(tmp)
tmp=merge(tmp, ids, by='probe_id')


#曾健明的答案:
rm(list = ls())
options(stringsAsFactors = F)
a=read.table('e2.txt')
colnames(a)='probe_id'
library(hgu133a.db)
ids=toTable(hgu133aSYMBOL);head(ids)



tmp1=merge(ids,a,by='probe_id')  #可以使用merge
tmp2=ids[match(a$probe_id,ids$probe_id),]  #也可以使用match



# 作业 3
# 找到R包CLL内置的数据集的表达矩阵里面的TP53基因的表达量,并且绘制在 progres.-stable分组的boxplot图
# 提示:
# suppressPackageStartupMessages(library(CLL))
# data(sCLLex)
# sCLLex
# exprSet=exprs(sCLLex)   
# library(hgu95av2.db)
# 想想如何通过 ggpubr 进行美化。

#曾健明的答案:
rm(list = ls())
options(stringsAsFactors = F)
suppressPackageStartupMessages(library(CLL))
data(sCLLex);sCLLex  #加载CLL包的内置数据使用data,这个包和内置数据的名字不一样而airway包的名字和内置数据的名字都叫airway
exprSet=exprs(sCLLex)  #sCLLex是R包CLL的对象,获取该对象的表达矩阵使用exprs
pd=pData(sCLLex)  #pData获取分组信息
library(hgu95av2.db) #通过这个包找到TP53对应的探针
ids=toTable(hgu95av2SYMBOL);head(ids)  #在R的右上角点开ids,然后在里面搜索TP53,找到对应的探针
# 上面不用搜索改用取子集也可以 tmp <- ids[ids$symbol=='TP53',];tmp
#根据分组信息来画boxplot,分组信息是pd$Disease
boxplot(exprSet['1939_at',] ~ pd$Disease)  #这个探针差异显著ss
boxplot(exprSet['1974_s_at',] ~ pd$Disease)
boxplot(exprSet['31618_at',] ~ pd$Disease)


# 作业 4
# 找到BRCA1基因在TCGA数据库的乳腺癌数据集(Breast Invasive Carcinoma (TCGA, PanCancer Atlas))的表达情况
# 提示:使用http://www.cbioportal.org/index.do 定位数据集:http://www.cbioportal.org/datasets
# 具体方法见PPT,下载下来的数据自己作图的代码如下。
rm(list = ls())
options(stringsAsFactors = F)
setwd('D:/生信学习/Linux學習/生信技能树学习/2 生信人应该这样学R语言/用到的文件')
a=read.table('e4-plot.txt',sep = '\t',fill = T,header = T)   # 加上fill=T,这样不管有多少个元素都能读进来,因为最后一列有很多空值,如果不加fill=T则读进来会有问题。
head(a)
#画boxplot直接复制代码就可以。
colnames(a)=c('id','subtype','expression','mut')  #取名字
dat=a #这里为了下面不更改代码
library(ggstatsplot)
ggbetweenstats(data =dat, x = subtype,  y = expression)
library(ggplot2)
ggsave('plot-again-BRCA1-TCGA-BRCA-cbioportal.png')


# 作业 5
# 找到TP53基因在TCGA数据库的乳腺癌数据集的表达量分组看其是否影响生存
# 提示使用:http://www.oncolnc.org/
# 进入网址:http://www.oncolnc.org/ 然后输入TP53,找到BRCA,点击Yes Please!输入50和50(表示按50%和50%分组),点击submit可得到p-value。
#进阶:点击Click Here下载文件,根据文件中的patient和作业4的subtype重新分组,分组之后再看有没有显著性关系。
rm(list = ls())
options(stringsAsFactors = F)
a=read.table('BRCA_7157_50_50.csv',sep = ',',fill = T,header = T);head(a) #read.table读csv文件需要使用逗号进行分割

#曾健明说:画生存分析的代码从前面找,不要自己打,更不要背代码,只需要懂得修改代码就好。
dat=a
library(ggplot2)
library(survival)
library(survminer) 
table(dat$Status)
dat$Status=ifelse(dat$Status=='Dead',1,0)  #将dat$Status的Alive和Dead 改成0和1
sfit <- survfit(Surv(Days, Status)~Group, data=dat)
sfit
summary(sfit)
ggsurvplot(sfit, conf.int=F, pval=TRUE)
ggsave('survival_TP53_in_BRCA_TCGA.png')  #名字改下

#上面是将乳腺癌看做一大类,因为在这一大类乳腺癌中TP53高表达和低表达的生死差异不显著,所以去看一下乳腺癌每一个子类(按subtype来分组)中TP53高低表达的生死差异是否显著;乳腺癌的subtype信息从作业4中可以得到;(注:因为要做的是生存曲线,所谓显著不显著是指的死亡和活着的差异。)
b=read.table('e4-plot.txt',sep = '\t',fill = T,header = T);head(b)
colnames(b)=c('Patient','subtype','expression','mut');head(b)
b$Patient=substring(b$Patient,1,12);head(b)  #通过substring函数将后面的-01去掉,因为不切掉不能严格匹配;substring可以提取字符串一部分,这里的意思是将b$Patient第1到12个字符提取出来。
tmp=merge(a,b,by='Patient')


#只需要把数据变下
dat=tmp
table(tmp$subtype)  #看下有多少subtype

#查看第一个subtype的死亡存活差异是否显著
type='BRCA_Basal'   #对每一个subtype查看显著性,只需要改这里的subtype的名字就好了。
dat=tmp[tmp$subtype==type,] 
library(ggplot2)
library(survival)
library(survminer) 
table(dat$Status)
dat$Status=ifelse(dat$Status=='Dead',1,0)  #将dat$Status的Alive和Dead 改成0和1
sfit <- survfit(Surv(Days, Status)~Group, data=dat)
sfit
summary(sfit)
ggsurvplot(sfit, conf.int=F, pval=TRUE)
ggsave('survival_TP53_in_BRCA_Basal_TCGA.png')  #名字改下


#查看第二个subtype的死亡存活差异是否显著
type='BRCA_Her2'   #需要改这里的subtype的名字。
dat=tmp[tmp$subtype==type,] 
library(ggplot2)
library(survival)
library(survminer) 
table(dat$Status)
dat$Status=ifelse(dat$Status=='Dead',1,0)  #将dat$Status的Alive和Dead 改成0和1
sfit <- survfit(Surv(Days, Status)~Group, data=dat)
sfit
summary(sfit)
ggsurvplot(sfit, conf.int=F, pval=TRUE)
ggsave('survival_TP53_in_BRCA_Her2_TCGA.png')  #名字改下


#查看第三个subtype的死亡存活差异是否显著
type='BRCA_LumA'   #需要改这里的subtype的名字。
dat=tmp[tmp$subtype==type,] 
library(ggplot2)
library(survival)
library(survminer) 
table(dat$Status)
dat$Status=ifelse(dat$Status=='Dead',1,0)  
sfit <- survfit(Surv(Days, Status)~Group, data=dat)
sfit
summary(sfit)
ggsurvplot(sfit, conf.int=F, pval=TRUE)
ggsave('survival_TP53_in_BRCA_LumA_TCGA.png')  #名字改下


#查看第四个subtype的死亡存活差异是否显著
type='BRCA_LumB'   #需要改这里的subtype的名字。
dat=tmp[tmp$subtype==type,] 
library(ggplot2)
library(survival)
library(survminer) 
table(dat$Status)
dat$Status=ifelse(dat$Status=='Dead',1,0)  
sfit <- survfit(Surv(Days, Status)~Group, data=dat)
sfit
summary(sfit)
ggsurvplot(sfit, conf.int=F, pval=TRUE)
ggsave('survival_TP53_in_BRCA_LumB_TCGA.png')  #名字改下


#查看第五个subtype的死亡存活差异是否显著
type='BRCA_Normal'   #需要改这里的subtype的名字。
dat=tmp[tmp$subtype==type,] 
library(ggplot2)
library(survival)
library(survminer) 
table(dat$Status)
dat$Status=ifelse(dat$Status=='Dead',1,0)  
sfit <- survfit(Surv(Days, Status)~Group, data=dat)
sfit
summary(sfit)
ggsurvplot(sfit, conf.int=F, pval=TRUE)
ggsave('survival_TP53_in_BRCA_Normal_TCGA.png')  #名字改下



# 作业6
# 下载数据集GSE17215的表达矩阵并且提取下面的基因画热图
# ACTR3B    ANLN    BAG1    BCL2    BIRC5   BLVRA   CCNB1   CCNE1   CDC20   CDC6    CDCA1   CDH3    CENPF   CEP55   CXXC5   EGFR    ERBB2   ESR1    EXO1    FGFR4   FOXA1   FOXC1   GPR160  GRB7    KIF2C   KNTC2   KRT14   KRT17   KRT5    MAPT    MDM2    MELK    MIA MKI67   MLPH    MMP11   MYBL2   MYC NAT1    ORC6L   PGR PHGDH   PTTG1   RRM2    SFRP1   SLC39A6 TMEM45B TYMS    UBE2C   UBE2T
# 提示:根据基因名拿到探针ID,缩小表达矩阵绘制热图,没有检查到的基因直接忽略即可。

#下载的代码复制过来就可以了。
rm(list = ls())  ## 魔幻操作,一键清空~
options(stringsAsFactors = F)
# 注意查看下载文件的大小,检查数据 
f='GSE17215_eSet.Rdata'  #下载其它的数据集时这里名字改一下。

library(GEOquery)
# 这个包需要注意两个配置,一般来说自动化的配置是足够的。
#Setting options('download.file.method.GEOquery'='auto')
#Setting options('GEOquery.inmemory.gpl'=FALSE)
if(!file.exists(f)){
  gset <- getGEO('GSE17215', destdir=".",  #下载其它的数据集时这里名字改一下。表达矩阵是探针id。
                 AnnotGPL = F,     ## 注释文件
                 getGPL = F)       ## 平台文件
  save(gset,file=f)   ## 保存到本地
}

load('GSE17215_eSet.Rdata')  ## 载入数据
class(gset)
length(gset)
class(gset[[1]])
# 因为这个GEO数据集只有一个GPL平台,所以下载到的是一个含有一个元素的list
a=gset[[1]]
dat=exprs(a)  #使用exprs获取表达矩阵。#前面sCLLex是R包CLL的对象,获取sCLLex的表达矩阵也是使用的exprs
dim(dat)  


#得到的表达矩阵是探针id,要将探针id改为基因名(即基因symbol)。直接复制作业2的代码。
library(hgu133a.db)
ids=toTable(hgu133aSYMBOL);head(ids) #得到的ids有探针id和symbol的对应关系
dat=dat[ids$probe_id,]  
dat[1:4,1:4] 
ids$median=apply(dat,1,median)
ids=ids[order(ids$symbol,ids$median,decreasing = T),]
ids=ids[!duplicated(ids$symbol),]
dat=dat[ids$probe_id,]
rownames(dat)=ids$symbol
dat[1:4,1:4]  
dim(dat)

ng='ACTR3B ANLN BAG1 BCL2 BIRC5 BLVRA CCNB1 CCNE1 CDC20 CDC6 CDCA1 CDH3 CENPF CEP55 CXXC5 EGFR ERBB2 ESR1 EXO1 FGFR4 FOXA1 FOXC1 GPR160 GRB7 KIF2C KNTC2 KRT14 KRT17 KRT5 MAPT MDM2 MELK MIA MKI67 MLPH MMP11 MYBL2 MYC NAT1 ORC6L PGR PHGDH PTTG1 RRM2 SFRP1 SLC39A6 TMEM45B TYMS UBE2C UBE2T'
ng=strsplit(ng,' ')[[1]]  #对字符按空格切一下,因为strsplit(ng,' ')执行完之后得到的是list,对list取元素使用[[]]
# dat[ng,]   #这个是行不通的,因为有很多基因检测不到,hgu133a.db是20多年前的东西,比较落伍,有很多基因是检测不到。
# ng %in%  rownames(dat)   #这个是对ng这些基因进行判断,查看哪些还在,哪些基因已经不在了。
table(ng %in%  rownames(dat))  #查看存在和不存在的各有多少个。
ng=ng[ng %in%  rownames(dat)]  #这一步进行过滤,从ng中去掉那些已经不在的基因名
dat=dat[ng,]
dat=log2(dat)
pheatmap::pheatmap(dat,scale = 'row') #可以去掉scale = 'row'看下会怎样。



# ***补充:关于order函数的理解 ------------------------------------------------------
#order()返回的值表示位置,依次对应的是向量的最小值、次小值、第三小值......最大值
x <- c(10,2,3)
y <- c(3,2,1)
order(x)  #结果为[1] 2 3 1表示第二个数是最小值,第三个数是次小值,第一个数是最大值。
order(x,y)  #当有x,y两个向量时以第一个向量为准,这里以x为准
order(y,x)
y[order(x,y)]  #将y的值排列顺序变成:第一个位置排第二个值,第二个位置排第三个值,第三个位置排第一个值。

a <- c(5,3,2,14)
a_1 <-c(5,3,14)
b <- order(a,x)  #两个向量长短不同,无法order
order(a_1,x)
b <- order(a <- c(5,3,2,14),x <- c(10,2,3))
ii <- order(x <- c(1,1,3:1,1:4,3), y <- c(9,9:1), z <-c(2,1:9))
ii  #返回的是x的位置顺序,x为1 1 3 2 1 1 2 3 4 3。首先最小的值是1,而1有四个位置,分别为1、2、5、6,位置越靠后,order之后越要往前排。
order(x <- c(1,1,3:1,1:4,3), y <- c(9,9:1), z <-c(2,1:9),decreasing = T) #加上decreasing = T之后完全反过来。



# ***补充:关于!duplicated -----------------------------------------------------
a <- c('1','1','1','2','2','2','3','4')
b <- c(1,1,1,2,2,3,3,4)
d <- c('甲','乙','丙','丁','戊','己','庚','辛')
e <- c(1,0,0,0,0,0,0,0)
f <- c('甲','乙','乙','乙','乙','乙','乙','乙')
tmp <- matrix(nrow = 5,ncol = 8)
tmp[1,] <- a
tmp[2,] <- b
tmp[3,] <- d
tmp[4,] <- e
tmp[5,] <- f

rownames(tmp) <- c(paste('row',1:5,sep = '_'))
colnames(tmp) <- c(paste('col',1:8,sep = '_'))
tmp
tmp <- as.data.frame(tmp)
tmp
tmp[!duplicated(tmp$col_1),] #所有的列都留着,对行设置条件。将tmp里面col_1那一列里重复的行去除,保留第一次出现的行
tmp
arg <- !duplicated(tmp$col_1);arg  #结果为FALSE就是删除的,将该句放在行就是对行进行筛选,将该句放在列就是对列进行筛选。
#[1]  TRUE FALSE  TRUE FALSE FALSE

tmp[,arg] #该句放在列,对列进行筛选,所有的行都留着。arg第2、4、5为FALSE,故删去,但是6、7、8列没有对应的逻辑值,所以arg再排一遍,也就是col_6到col_8分别为TRUE、FALSE、TRUE
tmp[,!duplicated(tmp$col_1)]  #这句和tmp[,arg] 等价

tmp[,!duplicated(tmp$col_2)]
tmp[,!duplicated(tmp$col_3)]


# 作业7
# 下载数据集GSE24673的表达矩阵计算样本的相关性并且绘制热图,需要标记上样本分组信息
#下载的代码复制过来就可以了。
rm(list = ls())  ## 魔幻操作,一键清空~
options(stringsAsFactors = F)
# 注意查看下载文件的大小,检查数据 
f='GSE24673_eSet.Rdata'  #下载其它的数据集时这里名字改一下。

library(GEOquery)
# 这个包需要注意两个配置,一般来说自动化的配置是足够的。
#Setting options('download.file.method.GEOquery'='auto')
#Setting options('GEOquery.inmemory.gpl'=FALSE)
if(!file.exists(f)){
  gset <- getGEO('GSE24673', destdir=".",  #下载其它的数据集时这里名字改一下。
                 AnnotGPL = F,     ## 注释文件
                 getGPL = F)       ## 平台文件
  save(gset,file=f)   ## 保存到本地
}

load('GSE24673_eSet.Rdata')  ## 载入数据
class(gset)
length(gset)
class(gset[[1]])
# 因为这个GEO数据集只有一个GPL平台,所以下载到的是一个含有一个元素的list
a=gset[[1]]
dat=exprs(a)  #使用exprs获取表达矩阵。#前面sCLLex是R包CLL的对象,获取sCLLex的表达矩阵也是使用的exprs
dim(dat)  


#标记样本分组信息使用pData
pd=pData(a)  # pData获取分组信息
table(names(pd))

group_list=c('rbc','rbc','rbc',
             'rbn','rbn','rbn',
             'rbc','rbc','rbc',
             'normal','normal')  #曾健明说:当写代码比较麻烦,就自己创造变量。
#根据 source_name_ch1那一列来进行的分组,这个可以打开pd看一下,可以看到source_name_ch1那一列都是啥.

dat[1:4,1:4]  #做之前先检查一下,查看前四行和前四列。
M=cor(dat)  #看相关性,使用cor就可以得到相关性矩阵。前面讲过,如果相关性矩阵分的不是太清就去做一下处理。
pheatmap::pheatmap(M)
tmp=data.frame(g=group_list)  #做好之后加上临床信息就可以了,临床信息就是group_list。
rownames(tmp)=colnames(M)  #这样处理一下才能在画图的时候加上去。
pheatmap::pheatmap(M,annotation_col = tmp)


# 作业8
# 找到 GPL6244 platform of Affymetrix Human Gene 1.0 ST Array 对应的R的bioconductor注释包,并且安装它!
# 
# options()$repos
# options()$BioC_mirror
# options(BioC_mirror="https://mirrors.ustc.edu.cn/bioc/")
# options("repos" = c(CRAN="https://mirrors.tuna.tsinghua.edu.cn/CRAN/"))
# BiocManager::install("请输入自己找到的R包",ask = F,update = F)
# options()$repos
# options()$BioC_mirror

# 看文章《如何根据芯片的探针ID找到基因名-基于R语言》 网址http://www.bio-info-trainee.com/3752.html
# 看文章《用R获取芯片探针与基因的对应关系三部曲-bioconductor》网址http://www.bio-info-trainee.com/1399.html 在这篇文章中直接搜索GPL6244就可以找到对应的包名称
# 得到的包名称是hugene10sttranscriptcluster,使用bioconductor安装,但是要注意安装的时候要加上.db的后缀名字,因为所有的注释包都要加.db
options(BioC_mirror="https://mirrors.ustc.edu.cn/bioc/")
options("repos" = c(CRAN="https://mirrors.tuna.tsinghua.edu.cn/CRAN/"))
BiocManager::install("hugene10sttranscriptcluster.db",ask = F,update = F)  #所有的注释包都要加.db
#说明,上面三行代码我没有运行成功,但是我不运行1,2行直接运行第3行就成功了。


# 作业9
# 下载数据集GSE42872的表达矩阵,并且分别挑选出 所有样本的(平均表达量/sd/mad/)最大的探针,并且找到它们对应的基因。

#下载的代码复制过来就可以了。
rm(list = ls())  ## 魔幻操作,一键清空~
options(stringsAsFactors = F)
# 注意查看下载文件的大小,检查数据 
f='GSE42872_eSet.Rdata'  #下载其它的数据集时这里名字改一下。

library(GEOquery)
# 这个包需要注意两个配置,一般来说自动化的配置是足够的。
#Setting options('download.file.method.GEOquery'='auto')
#Setting options('GEOquery.inmemory.gpl'=FALSE)
if(!file.exists(f)){
  gset <- getGEO('GSE42872', destdir=".",  #下载其它的数据集时这里名字改一下。
                 AnnotGPL = F,     ## 注释文件
                 getGPL = F)       ## 平台文件
  save(gset,file=f)   ## 保存到本地
}

load('GSE42872_eSet.Rdata')  ## 载入数据
class(gset)
length(gset)
class(gset[[1]])
# 因为这个GEO数据集只有一个GPL平台,所以下载到的是一个含有一个元素的list
a=gset[[1]]
dat=exprs(a)  #使用exprs获取表达矩阵。#前面sCLLex是R包CLL的对象,获取sCLLex的表达矩阵也是使用的exprs
dim(dat)  

# (平均表达量/sd/mad/)最大的探针
# apply(dat, 1, mean)
boxplot(dat)
sort(apply(dat, 1, mean),decreasing = T)[1]  #曾说:得到的7978905就是探针的名字,跟前面的不太一样,探针就这样不用管它。
sort(apply(dat, 1, sd),decreasing = T)[1]    # 8133876
sort(apply(dat, 1, mad),decreasing = T)[1]   # 8133876

tmp <- c(7978905,8133876,8133876)
# 加载bioconduct注释包(包名有没有很熟悉?)
library(hugene10sttranscriptcluster.db)    #探针不是都是1053_at这种形式的,7978905也是探针的名字,不同的芯片平台要使用不同的bioconduct注释包来转换id
ls("package:hugene10sttranscriptcluster.db")
foo <-toTable(hugene10sttranscriptclusterSYMBOL)

table(tmp %in% foo$probe_id)
7978905 %in% foo$probe_id   #查看7978905是否存在于foo的probe_id列
8133876 %in% foo$probe_id

foo[foo$probe_id==7978905,]   #将foo中probe_id为7978905的行提取出来,因为7978905不存在故而失败。
foo[foo$probe_id==8133876,]
foo[foo$probe_id==tmp,]



# 作业10
# 下载数据集GSE42872的表达矩阵,并且根据分组使用limma做差异分析,得到差异结果矩阵

#下载的代码复制过来就可以了。
rm(list = ls())  ## 魔幻操作,一键清空~
options(stringsAsFactors = F)
# 注意查看下载文件的大小,检查数据 
f='GSE42872_eSet.Rdata'  #下载其它的数据集时这里名字改一下。

library(GEOquery)
# 这个包需要注意两个配置,一般来说自动化的配置是足够的。
#Setting options('download.file.method.GEOquery'='auto')
#Setting options('GEOquery.inmemory.gpl'=FALSE)
if(!file.exists(f)){
  gset <- getGEO('GSE42872', destdir=".",  #下载其它的数据集时这里名字改一下。
                 AnnotGPL = F,     ## 注释文件
                 getGPL = F)       ## 平台文件
  save(gset,file=f)   ## 保存到本地
}

load('GSE42872_eSet.Rdata')  ## 载入数据
class(gset)
length(gset)
class(gset[[1]])
# 因为这个GEO数据集只有一个GPL平台,所以下载到的是一个含有一个元素的list
a=gset[[1]]
dat=exprs(a)  #使用exprs获取表达矩阵。#前面sCLLex是R包CLL的对象,获取sCLLex的表达矩阵也是使用的exprs
dim(dat)  
pd=pData(a)  #pData获取分组信息


#得到分组信息
group_list=unlist(lapply(pd$title,function(x){  #分组信息看pd的title列,发现有三个ctrl和三个药物处理,这里使用代码将它取出来。
  strsplit(x,' ')[[1]][4]
}))

#得到表达矩阵
exprSet=dat
exprSet[1:4,1:4]  #曾说:检查一下是不是log之后的,因为limma接受的一定是log之后的矩阵
# DEG by limma 
#差异分析需要一个表达矩阵和一个分组信息。group_list就是分组信息
# group_list
# table(group_list)  #查看每一种分组有多少。
# 通常不会用apply进行批量循环,而是会用limma这个包。首先这个包引用较多,其次它加入了一些校正效果。它的用法首先要构造好design这个矩阵
suppressMessages(library(limma))
design<-model.matrix(~0+factor((group_list)))
colnames(design)<-levels(factor(group_list))
row.names(design)<-colnames(exprSet)
design
#曾建明说上面不需要理解,将来做差异分析也只是将下载的矩阵读进去

# 构造分组的比较矩阵。
contrast.matrix <- makeContrasts(paste0(unique(group_list),collapse = '-'),levels=design)
# contrast.matrix <- makeContrasts("progres.-stable", levels=design)  #这个和上面那个是等价的,因为paste0(unique(group_list),collapse = '-')返回的就是"progres.-stable"
contrast.matrix #这个矩阵声明,我们要把progres.组跟stable进行差异分析比较。
## 构造好分组的比较矩阵之后,后面的差异分析就是走了三个代码。
#step1
fit<-lmFit(exprSet,design)
#step2
fit2 <- contrasts.fit(fit, contrast.matrix)  #这一步很重要,大家可以自行看看效果。
fit2 <- eBayes(fit2)  #default no trend!!!
#eBayes() with trend=TRUE
#step3
tempOutput=topTable(fit2, coef = 1, n=Inf)
nrDEG=na.omit(tempOutput)
#write.csv(nrDEG2, "limma_notrend.results.csv", quote=F)
head(nrDEG)  #走完三个代码拿到的nrDEG就是差异分析的结果,这些结果就可以拿去做差异分析,画火山图或者挑选显著的基因,logFC比较大或者比较小的基因,结合p-value就可以做富集分析,超几何分布检验之类的。
#只是学了一个包的说明书,只要把自己的分组做好,表达矩阵做好。如果做自己的分析,可以从GEO里面下载。上面就是芯片的差异分析。

你可能感兴趣的:(生信人應該這樣學習R語言)