基本流程：數據導入，QC去除低質量細胞，歸一化，由于矩陣過于稀疏所以選取top1000~2000，對每個基因進行zscore，線性降維和非線性降維，聚類（基于線性降維的結果進行KNN,SNN）
rm( list = ls())
library(dplyr)
library(Seurat)
library(patchwork)
# Load the PBMC dataset
pbmc.data <- Read10X(data.dir = "F:/class/test/filtered_gene_bc_matrices/hg19/")
#### Method1對于不規范數據
dir.10x = 'F:/class/test/filtered_gene_bc_matrices/hg19/'
#首先處理genelist文件，考慮到只需要第二行
genes <- read.table(paste0(dir.10x, 'genes.tsv'), stringsAsFactors=F, header=F)$V2
genes <- make.unique(genes, sep = '.')#將重復的以一個點分開
#barcode是當列矩陣
barcodes <- readLines(paste0(dir.10x, 'barcodes.tsv'))
mtx <- Matrix::readMM(paste0(dir.10x, 'matrix.mtx'))
mtx <- as(mtx, 'dgCMatrix')#格式轉換
colnames(mtx) = barcodes#賦予列名
rownames(mtx) = genes#賦予行名
pbmc <- CreateSeuratObject(counts = mtx, project = "pbmc3k",min.cells = 3, min.features = 200)
#### Method2
# Initialize the Seurat object with the raw (non-normalized data).
pbmc <- CreateSeuratObject(counts = pbmc.data, project = "pbmc3k", min.cells = 3, min.features = 200)
pbmc
# Lets examine a few genes in the first thirty cells
pbmc.data[c("CD3D", "TCL1A", "MS4A1"), 1:30]
dense.size <- object.size(as.matrix(pbmc.data))
dense.size
sparse.size <- object.size(pbmc.data)
sparse.size
dense.size/sparse.size
#######QC計算線粒體比例，線粒體比例高是死細胞，過濾掉線粒體高的細胞
# The [[ operator can add columns to object metadata. This is a great place to stash QC stats
pbmc[["percent.mt"]] <- PercentageFeatureSet(pbmc, pattern = "^MT-")
# Visualize QC metrics as a violin plot
#三張圖每個細胞檢測到的基因數量，每個細胞檢測到的count數量，每個細胞檢測到的線粒體比例
VlnPlot(pbmc, features = c("nFeature_RNA", "nCount_RNA", "percent.mt"), ncol = 3)
# FeatureScatter is typically used to visualize feature-feature relationships, but can be used
# for anything calculated by the object, i.e. columns in object metadata, PC scores etc.
#count和線粒體基因的的關系
plot1 <- FeatureScatter(pbmc, feature1 = "nCount_RNA", feature2 = "percent.mt")
#count和基因總數的關系
plot2 <- FeatureScatter(pbmc, feature1 = "nCount_RNA", feature2 = "nFeature_RNA")
plot1 + plot2
#根據數據特點選擇適合的過濾方式
pbmc <- subset(pbmc, subset = nFeature_RNA > 200 & nFeature_RNA < 2500 & percent.mt < 5)
######NormalizeData去除測序深度對數據分析的影響
#將每一個細胞的count先歸一化到10000，再對每一個基因表達值log
pbmc <- NormalizeData(pbmc, normalization.method = "LogNormalize", scale.factor = 10000)
#pbmc <- NormalizeData(pbmc)
##########Feature selection 1500，3000
pbmc <- FindVariableFeatures(pbmc, selection.method = "vst", nfeatures = 2000)
# Identify the 10 most highly variable genes
top10 <- head(VariableFeatures(pbmc), 10)
top10
# plot variable features with and without labels
plot1 <- VariableFeaturePlot(pbmc)
plot2 <- LabelPoints(plot = plot1, points = top10, repel=TRUE)
plot2
#FindVariableFeatures選擇基因的原理平均表達量，一個細胞的平均表達量在不同的細胞之間的方差有多大，方差越大就是細胞類群分開的依據
plot1 + plot2
all.genes <- rownames(pbmc)
pbmc <- ScaleData(pbmc, features = all.genes)#本質還是zscore，每一個基因在所有細胞中平均細胞表達量為0，方差為1
########降維Reduction
pbmc <- RunPCA(pbmc, features = VariableFeatures(object = pbmc))
# Examine and visualize PCA results a few different ways
DimPlot(pbmc, reduction = "pca")#可視化
# FeaturePlot(pbmc, reduction = 'pca', features = c('CD79A', 'CD14', 'FCGR3A', 'CD4', 'CST3', 'PPBP'))
# FeaturePlot(pbmc, reduction = 'pca', features = c('nCount_RNA', 'nFeature_RNA'))
# loadings_sorted = dplyr::arrange(as.data.frame(loadings), desc(PC_1))
# DimHeatmap(pbmc, dims = 1:2, cells = 200, balanced = TRUE)
# print(pbmc[["pca"]], dims = 1:5, nfeatures = 5)
# VizDimLoadings(pbmc, dims = 1:2, reduction = "pca")
# DimHeatmap(pbmc, dims = 1, cells = 500, balanced = TRUE)
# DimHeatmap(pbmc, dims = 1:15, cells = 500, balanced = TRUE)
ElbowPlot(pbmc,ndims = 50)#做了50個pca可視化，縱軸奇異值
# NOTE: This process can take a long time for big datasets, comment out for expediency. More
# approximate techniques such as those implemented in ElbowPlot() can be used to reduce
# computation time
#pbmc <- JackStraw(pbmc, num.replicate = 100)
#pbmc <- ScoreJackStraw(pbmc, dims = 1:20)
#JackStrawPlot(pbmc, dims = 1:15)
#ElbowPlot(pbmc)
# Look at cluster IDs of the first 5 cells
#head(Idents(pbmc), 5)
# If you haven't installed UMAP, you can do so via reticulate::py_install(packages =
# 'umap-learn')
#選取前10的特征進行非線性降維，兩種方式umap,tsne,但是umap更好可以更真實的表現群與群的真實距離
pbmc <- RunUMAP(pbmc, dims = 1:10)
FeaturePlot(pbmc, features = c('FCGR3A', 'CD14'), reduction = 'umap')
#DimPlot(pbmc, reduction = "umap")
# note that you can set `label = TRUE` or use the LabelClusters function to help label
#######cluster分群
pbmc <- FindNeighbors(pbmc, dims = 1:10)# louvain cluster, graph based
pbmc <- FindClusters(pbmc, resolution = 0.5)#resolution越大群越多
DimPlot(pbmc, reduction = "umap", group.by = 'seurat_clusters', label=T)
#根據maker對細胞進行細胞注釋
FeaturePlot(pbmc, features = c("MS4A1", "TYROBP", "CD14",'FCGR3A', "FCER1A",
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? "CCR7", "IL7R", "PPBP", "CD8A"))
new.cluster.ids <- c("Naive CD4 T", "CD14+ Mono", "Memory CD4 T", "B", "CD8 T", "FCGR3A+ Mono",
? ? ? ? ? ? ? ? ? ? "NK", "DC", "Platelet")
names(new.cluster.ids) <- levels(pbmc)
pbmc <- RenameIdents(pbmc, new.cluster.ids)
#重新定義的亞群
DimPlot(pbmc, reduction = "umap", label=T)
# ############################################################################################################
# ## DE analysis有很多小群無法判斷時
# ############################################################################################################
#利用差異基因的方式，來看所有群表達怎樣的marker，來確定每一個群表達什么樣的基因，再去推斷那個群可能是什么樣的細胞亞群
pbmc.markers <- FindAllMarkers(pbmc, only.pos = TRUE, min.pct = 0.25, logfc.threshold = 0.25)#都所有亞群依次求差異基因
pbmc.markers %>% group_by(cluster) %>% slice_max(n = 2, order_by = avg_log2FC)#每個cluster top2的差異基因看
CD4.mem.DEGS <- FindMarkers(pbmc, ident.1 = 'Memory CD4 T', ident.2 = 'Naive CD4 T', min.pct = 0.25)#要計算哪一群的差異基因，要計算的差異基因對照的是什么
#test.use計算方式
# ############################################################################################################
# ## gene signature analysis
# ############################################################################################################
exhaustion_genes = list(c('PDCD1','CD160','FASLG','CD244','LAG3','TNFRSF1B','CCR5','CCL3',
? ? ? ? ? ? ? ? ? ? ? ? ? 'CCL4','CXCL10','CTLA4','LGALS1','LGALS3','PTPN13','RGS16','ISG20',
? ? ? ? ? ? ? ? ? ? ? ? ? 'MX1','IRF4','EOMES','PBX3','NFATC1','NR4A2','CKS2','GAS2','ENTPD1','CA2'))
pbmc = Seurat::AddModuleScore(pbmc, features = exhaustion_genes, name='exhaustion.score')
FeaturePlot(pbmc, features = 'exhaustion.score1', reduction = 'umap')
VlnPlot(pbmc,features = 'exhaustion.score1', group.by = 'seurat_clusters')
