其他
可视化单细胞亚群的标记基因的5个方法的升级版
以前我们做了一个投票：可视化单细胞亚群的标记基因的5个方法，下面的5个基础函数相信大家都是已经烂熟于心了：
VlnPlot(pbmc, features = c("MS4A1", "CD79A")) FeaturePlot(pbmc, features = c("MS4A1", "CD79A")) RidgePlot(pbmc, features = c("MS4A1", "CD79A"), ncol = 1) DotPlot(pbmc, features = unique(features)) + RotatedAxis() DoHeatmap(subset(pbmc, downsample = 100), features = features, size = 3)
希望所有的学徒，实习生，学员都能在生信技能树的舞台上绽放自己的光彩！
1.FeaturePlot函数
FeaturePlot使用了split函数之后就没有legend了 这个问题之前困扰了我很久 后来就下定决心解决一下 其实很简单就只是加个命令 参考的是https://github.com/satijalab/seurat/pull/3748
FeaturePlot(object = obj, features = "Gene", split.by = "Meta_Name", order = T) & theme(legend.position = "right")
这个就是你只是用+是不可以的，那样就只会只改split图中右边的那个图 使用&符号的时候是会两个都改的 是不是很神奇 原来我以前只知道+ 后来才发现还有&这个用法
m_featureplot <- FeaturePlot(M_Aggregated_seurat, features = "Lepr", reduction = "tsne",
split.by = "orig.ident", pt.size = 1.8, repel = F, label = F,
order = T, max.cutoff = 1)
m_featureplot <- m_featureplot & scale_x_continuous(breaks=seq(-30, 20, 10)) ## 改x轴刻度标签
m_featureplot <- m_featureplot & scale_y_continuous(breaks=seq(-30, 20, 10)) ## 改y轴刻度标签
m_featureplot <- m_featureplot + theme(axis.text.y = element_blank()) + ## 删去所有刻度标签
theme(axis.ticks.y = element_blank()) + ##则只删去 Y 轴的刻度线
theme(axis.line.y = element_blank())
m_featureplot <- m_featureplot + ylab("")
2.VlnPlot的堆叠小提琴图
VlnPlot 中有个stack = T 但是这里面有个bug 因为Seurat::VlnPlot有个bug就是当用split的时候 细胞数目小于3个的时候 就不会画出来 后面又自己想加其他数据所以弄得复杂了点 但是我发现个很好用的方法就是直接把p1$data <- final_data 直接替换成我们想画图的数据就可以直接修改图片了
p1 <- Seurat::VlnPlot(F_Aggregated_seurat, features = ImDEGs, group.by = "small_celltype",
stack = T, split.by = "orig.ident",
fill.by="ident", flip = T, split.plot = F,adjust=1.3, same.y.lims = T)
p1$data$split <- factor(rep(F_Aggregated_seurat$try, length(ImDEGs)), levels = levels_define)
## GABA1 ob/ob 加6个细胞, GABA2 ob/ob 加4个细胞 GABA6 ob/ob加8个细胞 那样这三个细胞数目很少的细胞总共就有10个细胞了
## 因为Seurat::VlnPlot有个bug就是当用split的时候 细胞数目小于3个的时候 就不会画出来
GABA1_ob <- 6
GABA2_ob <- 4
GABA6_ob <- 8
add_cell_num <- GABA1_ob + GABA2_ob + GABA6_ob
row_num <- nrow(p1$data) + length(ImDEGs)*add_cell_num
col_num <- ncol(p1$data)
original_row <- nrow(p1$data)
try_data <- matrix(0, row_num, col_num)
try_data[1:original_row, 1:col_num] <- as.matrix(p1$data)
colnames(try_data) <- colnames(p1$data)
GABA1_ob_data <- matrix(0, length(ImDEGs) * GABA1_ob, col_num)
GABA1_ob_data[ ,1] <- rep(ImDEGs, GABA1_ob)
GABA1_ob_data[ ,3] <- rep("GABA1", length(ImDEGs) * GABA1_ob)
GABA1_ob_data[ ,4] <- rep("GABA1_ob/ob", length(ImDEGs) * GABA1_ob)
GABA1_ob_row <- (original_row+nrow(GABA1_ob_data))
try_data[(original_row+1):GABA1_ob_row, 1:4] <- GABA1_ob_data
GABA2_ob_data <- matrix(0, length(ImDEGs) * GABA2_ob, col_num)
GABA2_ob_data[ ,1] <- rep(ImDEGs, GABA2_ob)
GABA2_ob_data[ ,3] <- rep("GABA2", length(ImDEGs) * GABA2_ob)
GABA2_ob_data[ ,4] <- rep("GABA2_ob/ob", length(ImDEGs) * GABA2_ob)
GABA2_ob_row <- GABA1_ob_row + nrow(GABA2_ob_data)
try_data[(GABA1_ob_row+1):GABA2_ob_row, 1:4] <- GABA2_ob_data
GABA6_ob_data <- matrix(0, length(ImDEGs) * GABA6_ob, col_num)
GABA6_ob_data[ ,1] <- rep(ImDEGs, GABA6_ob)
GABA6_ob_data[ ,3] <- rep("GABA6", length(ImDEGs) * GABA6_ob)
GABA6_ob_data[ ,4] <- rep("GABA6_ob/ob", length(ImDEGs) * GABA6_ob)
GABA6_ob_row <- GABA2_ob_row + nrow(GABA6_ob_data)
try_data[(GABA2_ob_row+1):GABA6_ob_row, 1:4] <- GABA6_ob_data
try_data <- as.data.frame(try_data)
try_data$feature <- factor(try_data$feature, levels = ImDEGs)
try_data$expression <- as.numeric(try_data$expression)
try_data$ident <- factor(try_data$ident, levels = levels(p1$data$ident))
try_data$split <- factor(try_data$split, levels = levels(p1$data$split))
dim(try_data)
## 加上所有GABA Glu的细胞
All <- FetchData(F_Aggregated_seurat, vars = ImDEGs)
library(reshape)
All <- melt(All)
colnames(All) <- c("feature", "expression")
head(All)
All$ident <- rep(F_Aggregated_seurat$big_celltype, length(ImDEGs))
All_label <- rep(as.character(F_Aggregated_seurat$orig.ident), length(ImDEGs))
All$split <- paste(All$ident, All_label, sep="_")
colnames(All) <- colnames(try_data)
head(All)
dim(All)
final_data <- rbind(try_data, All)
dim(final_data)
final_data$split <- factor(final_data$split,
levels = c(levels_define[1:12],
"GABA_WT", "GABA_ob/ob",
levels_define[13:18],
"Glu_WT", "Glu_ob/ob"))
final_data$ident <- factor(final_data$ident,
levels = c(levels(try_data$ident)[1:6],
"GABA",
levels(try_data$ident)[7:9],
"Glu"))
levels(final_data$split)
levels(final_data$ident)
levels(final_data$feature)
dim(final_data)
p1$data <- final_data
dim(p1$data)
p3 <- p1 + scale_fill_manual(values = c('#F8766D','#F8766D', '#D39200','#D39200',
'#93AA00', '#93AA00', '#00BA38', '#00BA38',
'#00C19F', '#00C19F', '#00B9E3', '#00B9E3',
"#FC8D62", "#FC8D62",
# "#FFFF33", "#FFFF33",
'#619CFF','#619CFF', '#DB72FB','#DB72FB',
'#FF61C3','#FF61C3',
"#E41A1C", "#E41A1C"))
pdf("20210426_Vlnplot_Female_Gene_Related_to_Energy.pdf", 12, 10)
p3
dev.off()
3.DotPlot函数的图
dotplot_f_data_1 <- DotPlot(F_Aggregated_seurat, features = rev(ImDEGs),
group.by = "try",col.min=-2, col.max=2)$data
head(dotplot_f_data_1)
dim(dotplot_f_data_1)
dotplot_f_data_2 <- DotPlot(F_Aggregated_seurat, features = rev(ImDEGs),
group.by = "try2",col.min=-2, col.max=2)$data
head(dotplot_f_data_2)
dim(dotplot_f_data_2)
dotplot_f_data <- rbind(dotplot_f_data_1, dotplot_f_data_2)
head(dotplot_f_data)
dim(dotplot_f_data)
table(dotplot_f_data$id)
p_dotplot_f <- DotPlot(F_Aggregated_seurat, features = rev(ImDEGs),col.min=-2, col.max=2)
p_dotplot_f$data <- dotplot_f_data
p_dotplot_f <- p_dotplot_f + coord_flip()
p_dotplot_f <- p_dotplot_f+ scale_color_gradient2(high="red",mid = "lightgrey",low ="darkblue", midpoint = 0) + theme_classic()+
theme(axis.text.x = element_text(angle = -45,hjust = -0.1,vjust = 0.8))
p_dotplot_f$data$id <- factor(p_dotplot_f$data$id,
levels = c(levels_define[1:12],
"GABA_WT", "GABA_ob/ob",
levels_define[13:18],
"Glu_WT", "Glu_ob/ob"))
p_dotplot_f
文末友情推荐
做教学我们是认真的，如果你对我们的马拉松授课（直播一个月互动教学）有疑问，可以看完我们从2000多个提问互动交流里面精选的200个问答！ 2021第二期_生信入门班_微信群答疑整理，以及 2021第二期_数据挖掘班_微信群答疑笔记
与十万人一起学生信，你值得拥有下面的学习班：