R语言小作业-中级

作业 1

请根据R包org.Hs.eg.db找到下面ensembl 基因ID 对应的基因名(symbol)
ENSG00000000003
ENSG00000000005
ENSG00000000419
ENSG00000000457
ENSG00000000460
ENSG00000000938
提示:

library(org.Hs.eg.db)
 g2s=toTable(org.Hs.egSYMBOL)
 g2e=toTable(org.Hs.egENSEMBL)
g2se <-  merge(g2s,g2e,by.x="gene_id",by.y="gene_id")
index <- c("ENSG00000000003","ENSG00000000005","ENSG00000000419",
           "ENSG00000000457","ENSG00000000460","ENSG00000000938")

g2se[1:5,1:3]
# gene_id symbol      ensembl_id
#1       1   A1BG ENSG00000121410
#2      10   NAT2 ENSG00000156006
#3     100    ADA ENSG00000196839
#4    1000   CDH2 ENSG00000170558
#5   10000   AKT3 ENSG00000117020
g2se[g2se$ensembl_id %in% index,]
 gene_id   symbol      ensembl_id
# gene_id   symbol      ensembl_id
# 11530    2268      FGR ENSG00000000938
# 21666   55732 C1orf112 ENSG00000000460
# 22360   57147    SCYL3 ENSG00000000457
# 23819   64102     TNMD ENSG00000000005
# 25603    7105   TSPAN6 ENSG00000000003
# 29268    8813     DPM1 ENSG00000000419

作业 2

作业 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)
# probe_id symbol
# 1   1053_at   RFC2
# 2    117_at  HSPA6
# 3    121_at   PAX8
# 4 1255_g_at GUCA1A
# 5   1316_at   THRA
# 6   1320_at PTPN21
index2 <- 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")
ids[ids$probe_id %in% index2,]

# probe_id symbol
# 1    1053_at   RFC2
# 2     117_at  HSPA6
# 3     121_at   PAX8
# 4  1255_g_at GUCA1A
# 5    1316_at   THRA
# 6    1320_at PTPN21
# 7  1405_i_at   CCL5
# 8    1431_at CYP2E1
# 9    1438_at  EPHB3
# 10   1487_at  ESRRA
# 11 1494_f_at CYP2A6
# 12 1598_g_at   GAS6
# 13 160020_at  MMP14
# 14   1729_at  TRADD
# 15    177_at   PLD1

作业 3

找到R包CLL内置的数据集的表达矩阵里面的TP53基因的表达量,并且绘制在 progres.-stable分组的boxplot图
提示:

suppressPackageStartupMessages(library(CLL))
data(sCLLex)
sCLLex
exprSet=exprs(sCLLex) 
group_list <- pData(sCLLex)
library(hgu95av2.db)

想想如何通过 ggpubr 进行美化。

ids3 <- toTable(hgu95av2SYMBOL)
ids3[ids3$symbol %in% "TP53",]
# probe_id symbol
# 966    1939_at   TP53
# 997  1974_s_at   TP53
# 1420  31618_at   TP53
TP53 <- c(ids3[ids3$symbol %in% "TP53",][,1])
exprSet_TP53 <- exprSet[rownames(exprSet) %in% TP53,]

library(reshape2)
exprSet_TP53_L <- melt(exprSet_TP53)
colnames(exprSet_TP53_L) <- c("probe","sample","value")
exprSet_TP53_L$group <- rep(group_list$Disease,each=nrow(exprSet_TP53))

library(ggplot2)
ggplot(data = exprSet_TP53_L)+geom_boxplot(mapping = aes(x=group,
                                                         y=value))

作业 4

找到BRCA1基因在TCGA数据库的乳腺癌数据集(Breast Invasive Carcinoma (TCGA, PanCancer Atlas))的表达情况
提示:使用http://www.cbioportal.org/index.do 定位数据集:http://www.cbioportal.org/datasets

自己上网操作即可

作业 5

找到TP53基因在TCGA数据库的乳腺癌数据集的表达量分组看其是否影响生存 提示使用:http://www.oncolnc.org/

自己上网操作即可

作业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,缩小表达矩阵绘制热图,没有检查到的基因直接忽略即可。

library(GEOquery)
gset <- getGEO("GSE17215",destdir = ".",AnnotGPL = F,
               getGPL = F)
exprSet6 <- exprs(gset[[1]]) 
Pdata6 <- pData(gset[[1]]) 

library(hthgu133a.db)
ids6 <- toTable(hthgu133aSYMBOL)
index6 <- c("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")

probe_idex <- ids6[ids6$symbol %in% index6,][,1]
exprSet_filter <- exprSet6[rownames(exprSet6) %in% probe_idex,]
exprSet_filter= t(scale(t(exprSet_filter)))
pheatmap::pheatmap(exprSet_filter)
image.png

作业7

下载数据集GSE24673的表达矩阵计算样本的相关性并且绘制热图,需要标记上样本分组信息

gset7 <- getGEO("GSE24673",destdir = ".",AnnotGPL = F,
               getGPL = F)

##没有分组情况下表达相关性初探
exprSet7 <- exprs(gset7[[1]]) 
Pdata7 <- pData(gset7[[1]]) 
cor_sample <- cor(exprSet7)
pheatmap::pheatmap(cor_sample)


#分组情况下表达相关性
group_list7 <- as.character(Pdata7[,8])
library(stringr)
group_list7=str_split(group_list7," -",simplify = T)[,2]
group_list7[10:11]=c("healthy","healthy")


cor_sample <- cor(exprSet7)
annotation_col = data.frame(
  group = group_list7
)
rownames(annotation_col) =colnames(exprSet7)

pheatmap::pheatmap(cor_sample,annotation_col = annotation_col)

image.png

作业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("hugene10sttranscriptcluster.db",ask = F,update = F)
options()$repos
options()$BioC_mirror
#我本身有这个包,所有就直接加载了
library(hugene10sttranscriptcluster.db)

作业9

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

library(GEOquery)
gset <- getGEO("GSE42872",destdir = ".",AnnotGPL = F,
               getGPL = F)
###注意变量名字不要和前面几道题的重复了
exprSet9 <- exprs(gset[[1]]) 
Pdata9 <- pData(gset[[1]]) 

library(hugene10sttranscriptcluster.db)
ids9 <- toTable(hugene10sttranscriptclusterSYMBOL)
tail(sort(table(ids9$symbol)))
#可以看到有些symbol对应了多个探针
# RPL41  UBTFL1  CDK11B  UBE2D3    IGKC LRRFIP1 
# 6       6       8       8      10      10
table(sort(table(ids9$symbol)))
#18072个symol和探针是一一对应的
# 1     2     3     4     5     6     8    10 
# 18072   599   132    16     5     6     2     2 
ids9=ids9[ids$symbol != "",]
#顺序一致了
# 1  7896759 LINC01128
# 2  7896761    SAMD11
# 3  7896779    KLHL17
# 4  7896798   PLEKHN1
# 5  7896817     ISG15
ids9=ids9[ids9$probe_id %in% rownames(exprSet9),]

dat9=exprSet9
dim(dat9)
#过滤前有33279个探针
# 33297     6 

dat9=dat9[ids9$probe_id,]
dim(dat9)
#过滤后19827个探针
# 19827     6
dat9[1:5,1:5]
# GSM1052615 GSM1052616 GSM1052617 GSM1052618 GSM1052619
# 7896759    8.75126    8.61650    8.81149    8.32067    8.41445
# 7896761    8.39069    8.52617    8.43338    9.17284    9.10216
# 7896779    8.20228    8.30886    8.18518    8.13322    8.06453
# 7896798    8.41004    8.37679    8.27521    8.34524    8.35557
# 7896817    7.72204    7.74572    7.78022    7.72308    7.53797
ids9[1:5,1:2]



####按照平均值
ids9$mean <- apply(dat9,1,mean)
ids9$max <- apply(dat9,1,max)
ids9$sd <- apply(dat9,1,sd)
ids9_mean <- ids9
ids9_max <- ids9
ids_sd <- ids9

ids9_mean=ids9_mean[order(ids9$symbol,ids9$mean,decreasing = T),]
dim(ids9_mean)
#去重复之前
# 19827     5

ids9_mean=ids9_mean[!duplicated(ids9_mean$symbol),]
dat9=dat9[ids9_mean$probe_id,]
dim(dat9)
#去重复之后
# 18834     6
rownames(dat9) <- ids9_mean$symbol


###后面的方法和之前一样,注意重新导入dat9。按照最大值方法
dat9=exprSet9
dim(dat9)
dat9=dat9[ids9$probe_id,]
dim(dat9)

ids9_max=ids9_max[order(ids9_max$symbol,ids9_max$max,decreasing = T),]
dim(ids9_max)
ids9_max=ids9_max[!duplicated(ids9_max$symbol),]
dat9=dat9[ids9_max$probe_id,]
dim(dat9)
rownames(dat9) <- ids9_max$symbol


###按照方差
dat9=exprSet9
dim(dat9)
dat9=dat9[ids9$probe_id,]
dim(dat9)

ids_sd=ids_sd[order(ids_sd$symbol,ids_sd$sd,decreasing = T),]
dim(ids_sd)
ids_sd=ids_sd[!duplicated(ids_sd$symbol),]
dat9=dat9[ids_sd$probe_id,]
dim(dat9)
rownames(dat9) <- ids_sd$symbol

作业10

下载数据集GSE42872的表达矩阵,并且根据分组使用limma做差异分析,得到差异结果矩阵
This entry was posted in 未分类 by ulwvfje. Bookmark the permalink.

#准备好三个文件:过滤去重后的表达矩阵(上一步的dat9)、design分组文件、contrast.matrix比较文件
exprSet9=dat9
Pdata9 <- pData(gset[[1]]) 
group_list9 <- str_split(Pdata9$title," ",simplify = T)[,4]
library(limma)
design <- model.matrix(~0+factor(group_list9))
colnames(design)=levels(factor(group_list9))
head(design)
# Control Vemurafenib
# 1       1           0
# 2       1           0
# 3       1           0
# 4       0           1
# 5       0           1
# 6       0           1
exprSet=dat9
rownames(design)=colnames(exprSet)
design
# Control Vemurafenib
# GSM1052615       1           0
# GSM1052616       1           0
# GSM1052617       1           0
# GSM1052618       0           1
# GSM1052619       0           1
# GSM1052620       0           1
# attr(,"assign")
# [1] 1 1
# attr(,"contrasts")
# attr(,"contrasts")$`factor(group_list9)`
# [1] "contr.treatment"
contrast.matrix<-makeContrasts("Vemurafenib-Control",
                               levels = design)
contrast.matrix ##这个矩阵声明,我们要把 Tumor 组跟 Normal 进行差异分析比较
# Contrasts
# Levels        Vemurafenib-Control
# Control                      -1
# Vemurafenib                   1

  ##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)

  # logFC   AveExpr         t      P.Value    adj.P.Val        B
  # CD36   5.780170  7.370282  79.72556 1.209610e-16 2.278179e-12 26.75898
  # DUSP6 -4.212683  9.106625 -62.43810 1.804535e-15 1.323536e-11 25.01000
  # DCT    5.633027  8.763220  61.56547 2.108212e-15 1.323536e-11 24.89904
  # SPRY2 -3.801663  9.726468 -53.95479 9.056119e-15 4.264073e-11 23.80849
  # MOXD1  3.263063 10.171635  47.08154 4.074111e-14 1.305678e-10 22.59432
  # ETV4  -3.843247  9.667077 -46.99304 4.159535e-14 1.305678e-10 22.57698
exprSet["CD36",]
#验证,说明结果是正确的
# GSM1052615 GSM1052616 GSM1052617 GSM1052618 GSM1052619 GSM1052620 
# 4.54610    4.40210    4.49239   10.25060   10.21480   10.31570
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 204,053评论 6 478
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 85,527评论 2 381
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 150,779评论 0 337
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 54,685评论 1 276
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 63,699评论 5 366
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 48,609评论 1 281
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 37,989评论 3 396
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 36,654评论 0 258
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 40,890评论 1 298
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,634评论 2 321
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,716评论 1 330
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 33,394评论 4 319
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 38,976评论 3 307
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,950评论 0 19
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,191评论 1 260
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 44,849评论 2 349
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 42,458评论 2 342

推荐阅读更多精彩内容