Post

MuSiC: BulkRNA Deconvolution tool using scRNA-seq data

๐Ÿ“‘ Wang, Xuran, et al. โ€œBulk tissue cell type deconvolution with multi-subject single-cell expression reference.โ€ Nature communications 10.1 (2019): 380.

MUlti-Subject SIngle Cell deconvolution (MuSiC)

Deconvolution ์ด๋ž€..

Bulk RNA seq data ๋ถ„์„์˜ ํ•œ ๋ฐฉ๋ฒ•์ค‘ ํ•˜๋‚˜๋กœ. ๋ชจ๋“  cell type์ด ๊ตฌ๋ถ„์—†์ด ๋‹ค ํ˜ผ์žฌ๋˜์–ด์žˆ๋Š” bulkRNA ๋ฐ์ดํ„ฐ์—์„œ ์—ฌ๋Ÿฌ cell type์˜ ๋น„์œจ์„ ์ถ”์ •ํ•˜๊ฑฐ๋‚˜, ์—ฌ๋Ÿฌ ์ƒ˜ํ”Œ๋“ค์—์„œ ๊ฐ cell type์˜ ์œ ์ „์ž ๋ฐœํ˜„ ํŒจํ„ด์„ ๋ถ„๋ฆฌํ•ด๋‚ด๊ธฐ ์œ„ํ•ด ์‚ฌ์šฉ๋˜๋Š” ๋ถ„์„ ๋ฐฉ๋ฒ•์ด๋‹ค.

๋ณดํ†ต Deconvolution ๊ณผ์ •์—๋Š” 2๊ฐ€์ง€ input์ด ํ•„์š”ํ•œ๋ฐ,..

  • Reference profile
    ์•Œ์•„๋‚ด๊ณ ์žํ•˜๋Š” cell type์˜ ์ˆœ์ˆ˜ํ•œ ์œ ์ „์ž ๋ฐœํ˜„ ํ”„๋กœํŒŒ์ผ. ์˜ˆ์ „์—๋Š” FACs(Fluorescence-Activated Cell Sorting) ๊ฐ™์€ ๊ฑธ๋กœ ๋ถ„๋ฆฌ๋œ ์„ธํฌ๊ตฐ์—์„œ ์–ป์–ด์ง„ bulkRNA-seq data ๋˜๋Š” microarray data๋กœ ๋งŒ๋“ค์–ด์ง„ database๋ฅผ ์‚ฌ์šฉํ–ˆ๋‹ค. ์š”์ฆ˜์€ single-cell data์–ป๊ธฐ๊ฐ€ ๋” ์‰ฌ์›Œ์ ธ์„œ ์ด๋ฅผ ํ™œ์šฉํ•œ ํˆด์ด ๋งŽ์ด ๋‚˜์˜ค๊ณ  ์žˆ๋Š” ์ถ”์„ธ๋‹ค. like MuSiC!!
  • Query profile (Mixed)
    cell type proportion์„ ์•Œ์•„๋‚ด๊ณ ์ž ํ•˜๋Š” Bulk RNA-seq data. ์—ฌ๋Ÿฌ cell type์ด ํ˜ผํ•ฉ๋ผ ์žˆ๋Š” ์ƒ˜ํ”Œ์—์„œ ์–ป์€ ๋ฐ์ดํ„ฐ.

์ด๋ ‡๊ฒŒ ๋‘๊ฐ€์ง€ data๋ฅผ ๊ฐ–๊ณ  deconvolution tool์€ ์ด ๋‘˜์„ ๋น„๊ตํ•˜๋ฉด์„œ Query data๋‚ด์˜ cell type ๋น„์œจ์„ ์ถ”์ •ํ•œ๋‹ค. ์ด ๊ณผ์ •์ค‘์— ์–ด๋–ค ๋ฐฉ๋ฒ•๋ก ์„ ์‚ฌ์šฉํ•  ๊ฒƒ์ด๋ƒ์— ๋”ฐ๋ผ์„œ tool์˜ ์˜ˆ์ธก๋ ฅ๊ฐ™์€๊ฒŒ ์ฐจ์ด๋‚˜๊ฒŒ ๋˜๋Š”๊ฒƒ. ๋ณดํ†ต Linear regression, Machine learning, Matrix fractorization๊ฐ™์€ ๋ฐฉ๋ฒ•์„ ์‚ฌ์šฉํ•œ๋‹ค.

MuSiC์€..

wieghted non-negtive least squares regression(W-NNLS) ๋ฅผ ์‚ฌ์šฉํ•œ ๋ฐฉ๋ฒ•์œผ๋กœ linear regression์˜ ์ผ์ข…์„ ์‚ฌ์šฉํ•œ๋‹ค. ๊ฐ„๋žตํžˆ ์„ค๋ช…ํ•˜๋ฉด ์šฐ๋ฆฌ๊ฐ€ ์•Œ์•„๋‚ด๊ณ ์ž ํ•˜๋Š” cell type์„ ๋น„์œจ์„ ์ถ”์ •ํ•˜๋Š”๋ฐ ๋ฐฉ์ •์‹์„ ์‚ฌ์šฉํ•˜๊ณ  ๊ฐ ํ•ด๊ฐ€ ์Œ์ˆ˜๊ฐ€ ์•„๋‹ ๊ฒƒ์ด๋ผ๊ณ  ๊ฐ€์ •ํ•˜๊ณ  ์ด๋ฅผ ํ’€์–ด๊ฐ€๋Š” ๊ฒƒ์ด๋‹ค. ์ž˜ ์ƒ๊ฐํ•ด ๋ณด๋ฉด ๋‹น์—ฐํ•œ ๊ฒƒ. cell type์˜ ๋น„์œจ์ด ์•„๋ฌด๋ฆฌ ์ž‘์•„๋„ 0์ด์ง€ ์Œ์ˆ˜๊ฐ€ ๋  ์ˆœ ์—†์œผ๋‹ˆ๊ป˜..

MuSic์˜ ํŠน์žฅ์ ?์€ โ€œmarker gene consistencyโ€๋ผ๊ณ  ํ•จ. ์ง€๊ธˆ๊นŒ์ง€ ๋‚˜์˜จ CIBERSORT๋‚˜ (CIBERSORx ์•„๋‹˜) BSEQ-sc, TIMBER๊ฐ™์€ ํˆด๋“ค์€ pre-selected cell type-specific marker gene์„ ์‚ฌ์šฉํ•ด์™”๋‹ค๋ฉด, MuSiC์€ ํˆด๋‚ด์—์„œ subject

์ง€๊ธˆ๊นŒ์ง€์˜ ํˆด๋“ค์€ cross-subject heterogeneity์™€ with-in cell type stocahsticitiy๋ฅผ ๋ฌด์‹œํ•˜๊ณ  ๊ทธ๋ƒฅ ํ‰๊ท ์ ์œผ๋กœ ๊ฐ cell type์˜ marker๋กœ ์‚ฌ์šฉ๋˜๋Š” ์œ ์ „์ž๋“ค์„ ์‚ฌ์šฉํ–ˆ๋‹ค๋ฉด, MuSic์€ cross-subject and cross-cell consistency๋ฅผ ๊ณ ๋ คํ•œ gene์— weight๋ฅผ ์ค˜์„œ deconvolutionํ•œ๋‹ค.

๋ฌด์Šจ ๋ง์ด๋ƒ๋ฉด, ์ง€๊ธˆ๊นŒ์ง€์˜ ํˆด๋“ค์€ single-cell data๋ฅผ reference๋กœ ์‚ฌ์šฉํ•ด์„œ bulkRNA๋ฅผ deconvolutionํ•œ๋‹ค๊ณ  ํ•ด๋„,.. ๊ทธ๋ƒฅ scRNA data์—์„œ T cell cluster ํŠน์ด์ ์œผ๋กœ logFC๋†’์€ ์œ ์ „์ž๋ฅผ ๊ณจ๋ผ์„œ marker๋กœ ์‚ฌ์šฉํ•˜๊ฑฐ๋‚˜ ๋˜๋Š” ์‹คํ—˜์ ์œผ๋กœ ๋งŽ์ด ์•Œ๋ ค์ ธ ์žˆ๋Š” surface protein marker๋ฅผ ๊ธฐ์ค€์œผ๋กœ ์ด๋“ค์˜ ๋ฐœํ˜„์— ๋”ฐ๋ผ์„œ deconvolution์„ ์ง„ํ–‰ํ–ˆ๋Š”๋ฐ.. MuSiC์ด ๊ผฌ์ง‘๋Š” ์ด๋Ÿฐ ๋ฐฉ๋ฒ•์˜ ๋ฌธ์ œ๋Š” reference๋กœ ์‚ฌ์šฉํ•˜๋Š” ๋ฐ์ดํ„ฐ๊ฐ€ ํ™˜์ž๋“ค์˜ phenotype์— ๋”ฐ๋ผ์„œ ๊ฐ™์€ cell type์ด๋”๋ผ๋„ subject๊ฐ„์˜ ๋ฐœํ˜„ ์ฐจ์ด๊ฐ€ ์žˆ์„ ์ˆ˜ ์žˆ๊ณ (heterogeneity) ๋˜๋Š” ๊ฐ™์€ cell type๋‚ด์—์„œ stocahsticity์— ์˜ํ•ด์„œ ์–ด๋–ค ์œ ์ „์ž๊ฐ€ ๋ฐœํ˜„์ด ๋งŽ๊ฑฐ๋‚˜/์ ๊ฒŒ ์บก์ณ๋์„ ์ˆ˜ ์žˆ๋Š”๋ฐ ์ด๋Ÿฐ ๊ฒƒ๋“ค์„ ๊ณ ๋ คํ•˜์ง€ ์•Š๊ณ  ๋”ฐ์ง€์ž๋ฉด noise๋ฅผ ๊ณ„์‚ฐ์— ์ง‘์–ด ๋„ฃ์—ˆ๋‹ค๋Š” ๊ฒƒ์ด๋‹ค.

์˜ˆ๋ฅผ ๋“ค์–ด ์œ ์ „์ž A๊ฐ€ T cell population์˜ marker๋กœ ์žกํ˜”๋Š”๋ฐ ์•Œ๊ณ  ๋ดค๋”๋‹ˆ ํŠน์ • ์งˆํ™˜์„ ์•“๋Š” ํ™˜์ž์˜ Tcell์—์„œ ๊ฐ•๋ ฅํ•˜๊ฒŒ ๋ฐœํ˜„๋˜๋Š” ์œ ์ „์ž์˜€๋‹ค. ์ด๋Ÿฐ ์œ ์ „์ž๋“ค์€ cross-subject consistency๋ฅผ ๋ณธ๋‹ค๋ฉด ํƒˆ๋ฝ. ๋น„์Šทํ•œ ๊ฒฝ์šฐ๋กœ ํ™˜์ž phenotype์œผ๋กœ ๋‚˜๋ˆŒ ์ˆœ ์—†์ง€๋งŒ stocahsticity์— ์˜ํ•ด์„œ ๋ช‡๋ช‡ cell์—์„œ ํŠน์ • ์œ ์ „์ž B์˜ ๋ฐœํ˜„์ด ๋†’๊ฒŒ ๋‚˜์™”๋Š”๋ฐ population์˜ ์‚ฌ์ด์ฆˆ๊ฐ€ ์ ์–ด์„œ ๊ทธ๋งŒํผ๋งŒ์œผ๋กœ๋„ B๋ฅผ marker๋กœ ๋ฝ‘ํžˆ๊ฒŒ ํ•  ์ˆ˜ ์žˆ์—ˆ๋‹ค๋ฉด?..

MuSiC์€ cross-subject and cross-cell consistency ๋ฅผ ์œ ์ง€ํ•˜๋Š” marker gene์„ ์ฐพ์•„๋‚ด๊ธฐ ์ด์ „์—, collinearity๋ฅผ ์œ„ํ•ด tree-guided ๋‹จ๊ณ„๋ฅผ ์ถ”๊ฐ€ํ–ˆ๋‹ค. ๋ณ„๊ฑด ์•„๋‹ˆ๊ณ  hierarchical clusteringํ•ด์„œ ์–ป์„ ์ˆ˜ ์žˆ๋Š” ๊ฒฐ๊ณผ๋ฅผ ์‚ฌ์šฉ. ๋‚ด๊ฐ€ input์œผ๋กœ ์ฃผ์–ด์ง„ ๋ชจ๋“  cell type์— ๋Œ€ํ•ด์„œ clustering์„ ๋จผ์ € ์ง„ํ•ดํ•ด์„œ ์ด cell type๋“ค์„ ๋” ํฐ ๋ฉ์–ด๋ฆฌ๋กœ ๋‚˜๋ˆ„๊ณ  ๊ทธ ์•ˆ์—์„œ ๋จผ์ € cluster-consistent genes์„ ์ฐพ๊ณ  ํฐ cluster๋ณ„๋กœ ๊ทธ ์•ˆ์—์„œ ๋‹ค์‹œ intra-cell type variance๋ฅผ ๋ณด์ด๋Š” ์œ ์ „์ž๋ฅผ ์ฐพ์•„์„œ deconvolution์— ์ด์šฉํ•˜๊ฒŒ ๋œ๋‹ค. ๋งŒ์•ฝ ํ•„์š”ํ•˜๋‹ค๋ฉด recursiveํ•˜๊ฒŒ ์ด ๊ณผ์ •์„ ๋ฐ˜๋ณตํ•œ๋‹ค.

TL;DR
Subject๊ฐ„์—์„œ๋„ ์ฐจ์ด๋ฅผ ๋ณด์ด์ง€ ์•Š๊ณ  constantly cell type์„ ๋Œ€ํ‘œํ•˜๋Š” ์œ ์ „์ž๋“ค์— weight์„ ์ฃผ์–ด์„œ deconvolution์— ์‚ฌ์šฉํ•˜๋Š” ํˆด์ด๋‹ค.

์ค€๋น„๋ฌผ

Installation

1
devtools::install_github('xursanw/MuSiC')

๐Ÿšจ v.1.0.0 ๋ณ„ ๋ฌธ์ œ์—†์ด ์„ค์น˜ ๋˜๊ธดํ–ˆ๋Š”๋ฐ ๋Œ๋ฆฌ๋˜ ์ค‘ bug๊ฐ€ ์žˆ๋Š” ๊ฒƒ ๊ฐ™์•„์„œ music_prop() function ๋ถ€๋ถ„ ์ฝ”๋“œ github์—์„œ ๋”ฐ์„œ ๊ฐœ์ธ์ ์œผ๋กœ ์ˆ˜์ •ํ›„ ์‚ฌ์šฉ. ์•„๋ž˜๋‚ด์šฉ ์ฐธ์กฐ.

01. Data Preparations

์•ž์„œ ๋งํ–ˆ๋“ฏ์ด MuSic์€ single-cell data๋ฅผ SCE ํฌ๋งท์œผ๋กœ ๋ฐ›๊ธฐ ๋•Œ๋ฌธ์— ๋ณ€๊ฒฝํ•ด์„œ ์ค€๋น„ํ•ด์ค€๋‹ค.

1
2
3
4
5
6
7
8
GEX[["RNA"]] <- as(object = GEX[["RNA"]], Class = "Assay")
saveRDS(GEX,"GEX.v3.rds")

conda activate Seurat4
library(Seurat)
GEX <- readRDS("GEX.v3.rds")
test <- as.SingleCellExperiment(GEX)
saveRDS(test,"GEX.SCE.rds")

02. Estimation of cell type proportions

1
2
3
library(MuSiC)
library(reshape)
library(cowplot)

music_prop() functionโ€™s parameters

  • bulk.eset: ExpressionSet of bulk data; rownames = genename, colnames = sampleID
  • sc.eset: ExpressionSet of annotated single cell data;
  • markers: vector or list of gene names, default as NULL. If NULL, then use all genes that overlapping in bulk and single-cell dataset;
  • clusters: character, must be one of the column names of the phenoData from single cell data, used as clusters;
  • samples: character, must be one of the column names of the phenoData from single cell data, used as samples;
  • select.ct: vector of cell types included for deconvolution, default as NULL. If NULL, then use all cell types that provided by single-cell dataset.
  • verbose: logical that toggles log messages.

bulk.eset (bulkRNA-seq expression matrix)๋Š” ๊ฐ’์— ์Œ์ˆ˜ ๋“ค์–ด์žˆ์œผ๋ฉด ๋‚˜์ค‘์— ์—๋Ÿฌ๋‚œ๋‹ค.
๋…ผ๋ฌธ์—์„œ๋„ raw count ๊ฐ’์„ ์‚ฌ์šฉํ•˜๋Š” ๊ฒƒ์„ ๊ถŒ์žฅํ•˜๊ณ , TPM์œผ๋กœ๋Š” ๊ฒฐ๊ณผ๊ฐ€ ์•ˆ๋‚˜์˜จ๋‹ค๊ณ  ๋˜์–ด ์žˆ์Œ. FPKM์€ ๋œ๋‹ค๊ณ  ํ•จ.
์‹œ๋„ํ•ด๋ณธ ๊ฒฐ๊ณผ, CUF๋กœ๋Š” ๋Œ์•„๊ฐ€์ง€๋งŒ logCPM์œผ๋กœ๋Š” ์ œ๋Œ€๋กœ ๋Œ์•„๊ฐ€์ง€ ์•Š๋Š”๋‹ค.

bulk.eset์—์„œ ์ƒ˜ํ”Œ๋ณ„๋กœ ๋ฐœํ˜„๋˜๋Š” ์œ ์ „์ž์˜ ๊ฐฏ์ˆ˜์™€ ์ด ์œ ์ „์ž๋“ค์ด single-cell data์˜ ์œ ์ „์ž ๋ฆฌ์ŠคํŠธ์™€ ๊ฒน์น˜๋Š”์ง€๊ฐ€ ์ค‘์š”ํ•˜๋‹ค.
๊ฒน์น˜๋Š” ์œ ์ „์ž์˜ ๊ฐฏ์ˆ˜๊ฐ€ 20%์ดํ•˜๋ฉด ์—๋Ÿฌ๋‚˜์„œ ๋Œ์•„๊ฐ€์ง€ ์•Š๋Š”๋‹ค.

๋”ฐ๋ผ์„œ ๋ฏธ๋ฆฌ input์œผ๋กœ ์ฃผ๋Š” bulk.eset์˜ matrix๋ฅผ ์ •๋ฆฌํ•ด์„œ ๋„ฃ๊ฑฐ๋‚˜
(์œ ์ „์ž ๋ฐœํ˜„์ด ์ ์€ ์ƒ˜ํ”Œ์ œ๊ฑฐ ๋ฐ single-cell dataset์—์„œ ๋ฐœํ˜„๋˜๋Š” ์œ ์ „์ž๋งŒ row์— ํฌํ•จ์‹œํ‚ค๊ธฐ)
markers ์˜ต์…˜์œผ๋กœ ์‚ฌ์šฉํ•  ์œ ์ „์ž๋ฅผ limit์‹œํ‚ค๋Š”๊ฒƒ์ด ํ•„์š”

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# Bulk expression matrix
CUF = read.table("CUF.tsv",sep='\t',quote="",header=1)
# single-cell RNA-seq exp SCE obj.
sc.sce <- readRDS("GEX.SCE.rds")

# (optional) data cleaning

## rowname = hgnc_symbol๋กœ ํ•˜๊ธฐ ์œ„ํ•ด ์ •๋ฆฌ
# bulk.mtx = CUF[CUF$hgnc_symbol!="",c(1,9:826)] # 818 samples
# gene_names <- bulk.mtx$hgnc_symbol 
# bulk.mtx <- bulk.mtx %>% group_by(hgnc_symbol) %>%
#   summarise(across(everything(), max, na.rm = TRUE)) %>% as.data.frame()
# rownames(bulk.mtx) <- bulk.mtx$hgnc_symbol
# bulk.mtx <- bulk.mtx[,-1]

## singlecell data์™€ ์ผ์น˜ํ•˜๋Š” ์œ ์ „์ž๋งŒ ์‚ฌ์šฉ
# bulk.mtx <- bulk.mtx[intersect(rownames(sc.sce),rownames(bulk.mtx)),]

## ๋ฐœํ˜„๋˜๋Š” ์œ ์ „์ž์˜ ๊ฐฏ์ˆ˜๊ฐ€ ์ „์ฒด์˜ 20% ์ดํ•˜์ธ ์ƒ˜ํ”Œ์„ ์ฐพ์•„์„œ ์ œ๊ฑฐ
# threshold <- nrow(bulk.mtx) * 0.2
# bulk.mtx <- bulk.mtx[, colSums(bulk.mtx > 0) >= threshold] # 808 samples

# Estimate cell type proportions
Est.prop = music_prop(bulk.mtx, sc.sce, clusters = 'predicted.celltype.l2',samples = 'SampleID')
# saveRDS(Est.prop,"Est.prop_result.rds")

# names(Est.prop)
#[1] "Est.prop.weighted" "Est.prop.allgene"  "Weight.gene"       "r.squared.full"    "Var.prop"  

๐Ÿšจ music_prop ์ˆ˜์ •๋œ ์ฝ”๋“œ

๊ทธ๋ƒฅ ๋‹ค์šด๋ฐ›์€ library ๊ทธ๋Œ€๋กœ ๋Œ๋ ธ๋”๋‹ˆ, ์ถฉ๋ถ„ํ•œ ์–‘์˜ ์œ ์ „์ž๊ฐ€ ๋ฐœํ˜„๋˜๊ณ  ์žˆ์Œ์—๋„ ๋ถˆ๊ตฌํ•˜๊ณ  ์•„๋ž˜๊ฐ™์€ ์—๋Ÿฌ๋ฉ”์„ธ์ง€๊ฐ€ ๋‚˜์˜ค๊ณ  ์ง„ํ–‰์ด ์•ˆ๋ผ์„œ ๋ช‡์ค„ ์ถ”๊ฐ€ํ•ด์„œ ์ˆ˜์ •ํ•จ

1
2
3
4
5
6
7
8
9
# error code
Creating Relative Abudance Matrix...
Creating Variance Matrix...
Creating Library Size Matrix...
Used 13092 common genes...
Used 29 cell types in deconvolution...
X208.d0 has common genes 13063 ...
Error in music.iter(Yjg.temp, D1.temp, M.S, Sigma.temp, iter.max = iter.max,  : 
  Not enough common genes! 

๐Ÿ‘‰๐Ÿ‘‰๐Ÿ‘‰ ์ˆ˜์ •ํ•œ ์ฝ”๋“œ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
## music_prop ์ฝ”๋“œ ์ˆ˜์ •
music_prop = function(bulk.mtx, sc.sce, markers = NULL, clusters, samples, select.ct = NULL, cell_size = NULL, ct.cov = FALSE, verbose = TRUE,
                      iter.max = 1000, nu = 0.0001, eps = 0.01, centered = FALSE, normalize = FALSE, ... ){
  bulk.gene = rownames(bulk.mtx)[rowMeans(bulk.mtx) != 0]
  bulk.mtx = bulk.mtx[bulk.gene, ]
  if(is.null(markers)){
    sc.markers = bulk.gene
  }else{
    sc.markers = intersect(bulk.gene, unlist(markers))
  }
  sc.basis = music_basis(sc.sce, non.zero = TRUE, markers = sc.markers, clusters = clusters, samples = samples, select.ct = select.ct, cell_size = cell_size, ct.cov = ct.cov, verbose = verbose)
  cm.gene = intersect( rownames(sc.basis$Disgn.mtx), bulk.gene )
  if(is.null(markers)){
    if(length(cm.gene)< 0.2*min(length(bulk.gene), nrow(sc.sce)) )
      stop("Too few common genes!")
  }else{
    if(length(cm.gene)< 0.2*length(unlist(markers)))
      stop("Too few common genes!")
  }
  if(verbose){message(paste('Used', length(cm.gene), 'common genes...'))}
  
  m.sc = match(cm.gene, rownames(sc.basis$Disgn.mtx)); m.bulk = match(cm.gene, bulk.gene)
  D1 = sc.basis$Disgn.mtx[m.sc, ]; 
  M.S = colMeans(sc.basis$S, na.rm = T);
  
  if(!is.null(cell_size)){
    if(!is.data.frame(cell_size)){
      stop("cell_size paramter should be a data.frame with 1st column for cell type names and 2nd column for cell sizes")
    }else if(sum(names(M.S) %in% cell_size[, 1]) != length(names(M.S))){
      stop("Cell type names in cell_size must match clusters")
    }else if (any(is.na(as.numeric(cell_size[, 2])))){
      stop("Cell sizes should all be numeric")
    }
    my_ms_names <- names(M.S)
    cell_size <- cell_size[my_ms_names %in% cell_size[, 1], ]
    M.S <- cell_size[match(my_ms_names, cell_size[, 1]),]
    M.S <- M.S[, 2]
    names(M.S) <- my_ms_names
  }
  
  Yjg = relative.ab(bulk.mtx[m.bulk, ]); N.bulk = ncol(bulk.mtx);
  if(ct.cov){
    Sigma.ct = sc.basis$Sigma.ct[, m.sc];
    
    Est.prop.allgene = NULL
    Est.prop.weighted = NULL
    Weight.gene = NULL
    r.squared.full = NULL
    Var.prop = NULL
    
    for(i in 1:N.bulk){
      if(sum(Yjg[, i] == 0) > 0){
        D1.temp = D1[Yjg[, i]!=0, ];
        Yjg.temp = Yjg[Yjg[, i]!=0, i];
        names(Yjg.temp) <- rownames(Yjg[Yjg[, i]!=0, ])
        Sigma.ct.temp = Sigma.ct[, Yjg[,i]!=0];
        if(verbose) message(paste(colnames(Yjg)[i], 'has common genes', sum(Yjg[, i] != 0), '...') )
      }else{
        D1.temp = D1;
        Yjg.temp = Yjg[, i];
        names(Yjg.temp) <- rownames(Yjg)
        Sigma.ct.temp = Sigma.ct;
        if(verbose) message(paste(colnames(Yjg)[i], 'has common genes', sum(Yjg[, i] != 0), '...'))
      }
      
      lm.D1.weighted = music.iter.ct(Yjg.temp, D1.temp, M.S, Sigma.ct.temp, iter.max = iter.max,
                                     nu = nu, eps = eps, centered = centered, normalize = normalize)
      Est.prop.allgene = rbind(Est.prop.allgene, lm.D1.weighted$p.nnls)
      Est.prop.weighted = rbind(Est.prop.weighted, lm.D1.weighted$p.weight)
      weight.gene.temp = rep(NA, nrow(Yjg)); weight.gene.temp[Yjg[,i]!=0] = lm.D1.weighted$weight.gene;
      Weight.gene = cbind(Weight.gene, weight.gene.temp)
      r.squared.full = c(r.squared.full, lm.D1.weighted$R.squared)
      Var.prop = rbind(Var.prop, lm.D1.weighted$var.p)
    }
  }else{
    Sigma = sc.basis$Sigma[m.sc, ];
    
    valid.ct = (colSums(is.na(Sigma)) == 0)&(colSums(is.na(D1)) == 0)&(!is.na(M.S))
    
    if(sum(valid.ct)<=1){
      stop("Not enough valid cell type!")
    }
    
    if(verbose){message(paste('Used', sum(valid.ct), 'cell types in deconvolution...' ))}
    
    D1 = D1[, valid.ct]; M.S = M.S[valid.ct]; Sigma = Sigma[, valid.ct];
    
    Est.prop.allgene = NULL
    Est.prop.weighted = NULL
    Weight.gene = NULL
    r.squared.full = NULL
    Var.prop = NULL
    for(i in 1:N.bulk){
      if(sum(Yjg[, i] == 0) > 0){
        D1.temp = D1[Yjg[, i]!=0, ];
        Yjg.temp = Yjg[Yjg[, i]!=0, i];
        names(Yjg.temp) <- rownames(Yjg[Yjg[, i]!=0, ])
        Sigma.temp = Sigma[Yjg[,i]!=0, ];
        if(verbose) message(paste(colnames(Yjg)[i], 'has common genes', sum(Yjg[, i] != 0), '...') )
      }else{
        D1.temp = D1;
        Yjg.temp = Yjg[, i];
        names(Yjg.temp) <- rownames(Yjg)
        Sigma.temp = Sigma;
        if(verbose) message(paste(colnames(Yjg)[i], 'has common genes', sum(Yjg[, i] != 0), '...'))
      }
      
      lm.D1.weighted = music.iter(Yjg.temp, D1.temp, M.S, Sigma.temp, iter.max = iter.max,
                                  nu = nu, eps = eps, centered = centered, normalize = normalize)
      Est.prop.allgene = rbind(Est.prop.allgene, lm.D1.weighted$p.nnls)
      Est.prop.weighted = rbind(Est.prop.weighted, lm.D1.weighted$p.weight)
      weight.gene.temp = rep(NA, nrow(Yjg)); weight.gene.temp[Yjg[,i]!=0] = lm.D1.weighted$weight.gene;
      Weight.gene = cbind(Weight.gene, weight.gene.temp)
      r.squared.full = c(r.squared.full, lm.D1.weighted$R.squared)
      Var.prop = rbind(Var.prop, lm.D1.weighted$var.p)
    }
  }
  colnames(Est.prop.weighted) = colnames(D1)
  rownames(Est.prop.weighted) = colnames(Yjg)
  colnames(Est.prop.allgene) = colnames(D1)
  rownames(Est.prop.allgene) = colnames(Yjg)
  names(r.squared.full) = colnames(Yjg)
  colnames(Weight.gene) = colnames(Yjg)
  rownames(Weight.gene) = cm.gene
  colnames(Var.prop) = colnames(D1)
  rownames(Var.prop) = colnames(Yjg)
  
  return(list(Est.prop.weighted = Est.prop.weighted, Est.prop.allgene = Est.prop.allgene,
              Weight.gene = Weight.gene, r.squared.full = r.squared.full, Var.prop = Var.prop))
}

๐Ÿšจ music_prop.cluster ์ˆ˜์ •๋œ ์ฝ”๋“œ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
#music_prop.cluster ์ฝ”๋“œ ์ˆ˜์ •
music_prop.cluster = function(bulk.mtx, sc.sce, group.markers, groups, clusters, samples, clusters.type,
                              verbose = TRUE, iter.max = 1000, nu = 0.0001, eps = 0.01, centered = FALSE, normalize = FALSE, ... ){
  bulk.gene = rownames(bulk.mtx)[rowMeans(bulk.mtx) != 0]
  bulk.mtx = bulk.mtx[bulk.gene, ]
  select.ct = unlist(clusters.type)
  
  if(length(setdiff(names(group.markers), names(clusters.type))) > 0 || length(setdiff(names(clusters.type), names(group.markers))) > 0){
    stop("Cluster number is not matching!")
  }else{
    group.markers = group.markers[names(clusters.type)]
  }
  
  
  if(verbose){message('Start: cluster estimations...')}
  cluster.sc.basis = music_basis(sc.sce, non.zero = TRUE, markers = NULL, clusters = groups, samples = samples, select.ct = names(clusters.type), verbose = verbose)
  if(verbose){message('Start: cell type estimations...')}
  sc.basis = music_basis(sc.sce, non.zero = TRUE, markers = NULL, clusters = clusters, samples = samples, select.ct = select.ct, verbose = verbose)
  cm.gene = intersect(rownames(sc.basis$Disgn.mtx), bulk.gene)
  
  if(length(cm.gene)< 0.2*min(length(bulk.gene), nrow(sc.sce)) ){
    stop("Too few common genes!")
  }
  
  if(verbose){message(paste('Used', length(cm.gene), 'common genes...'))}
  
  m.sc = match(cm.gene, rownames(sc.basis$Disgn.mtx)); m.bulk = match(cm.gene, bulk.gene)
  group.markers = lapply(group.markers, intersect, cm.gene)
  
  D1 = sc.basis$Disgn.mtx[m.sc,]; M.S = sc.basis$M.S; Sigma = sc.basis$Sigma[m.sc, ]
  
  cluster.select = setdiff(rownames(D1), unique(unlist(group.markers)))
  cluster.diff = unique(unlist(group.markers))
  
  D1.cluster = cluster.sc.basis$Disgn.mtx[cluster.select, ]; M.S.cluster = cluster.sc.basis$M.S;
  Yjg = relative.ab(bulk.mtx[m.bulk, ]); N.bulk = ncol(bulk.mtx);
  
  Sigma.cluster = cluster.sc.basis$Sigma[cluster.select, ];
  
  D1.sub = cluster.sc.basis$Disgn.mtx[cluster.diff, ]; Sigma.sub = cluster.sc.basis$Sigma[cluster.diff, ];
  
  Est.prop.weighted.cluster = NULL
  for(i in 1:N.bulk){
    if(sum(Yjg[, i] == 0) > 0){
      name.temp = rownames(Yjg)[Yjg[, i] != 0]
      D1.cluster.temp = D1.cluster[rownames(D1.cluster)%in%name.temp, ];
      D1.sub.temp = D1.sub[rownames(D1.sub)%in%name.temp, ];
      Yjg.temp = Yjg[Yjg[, i]!=0, i];
      names(Yjg.temp) <- rownames(Yjg[Yjg[, i]!=0, ])
      Sigma.cluster.temp = Sigma.cluster[rownames(Sigma.cluster)%in%name.temp, ];
      Sigma.sub.temp = Sigma.sub[rownames(Sigma.sub)%in%name.temp, ];
      if(verbose) message(paste(colnames(Yjg)[i], 'has common genes', sum(Yjg[, i] != 0), '...') )
    }else{
      D1.cluster.temp = D1.cluster;
      D1.sub.temp = D1.sub;
      Yjg.temp = Yjg[, i];
      names(Yjg.temp) <- rownames(Yjg)
      Sigma.cluster.temp = Sigma.cluster;
      Sigma.sub.temp = Sigma.sub;
      if(verbose) message(paste(colnames(Yjg)[i], 'has common genes', sum(Yjg[, i] != 0), '...'))
    }
    lm.D1.cluster = music.iter(Yjg.temp, D1.cluster.temp, M.S.cluster, Sigma.cluster.temp, iter.max = iter.max,
                               nu = nu, eps = eps, centered = centered, normalize = normalize)
    p.weight = NULL
    p.cluster.weight = lm.D1.cluster$p.weight
    for(j in 1:length(clusters.type)){
      if(length(clusters.type[[j]]) == 1){
        p.weight = c(p.weight, p.cluster.weight[j])
      }else{
        if(p.cluster.weight[j] == 0){
          p.weight = c(p.weight, rep(0, length(clusters.type[[j]])))
        }else{
          c.marker = intersect(group.markers[[j]], names(Yjg.temp))
          Y.sub = D1.sub.temp[c.marker, j]*p.cluster.weight[j] +
            (Yjg.temp[c.marker] - D1.sub.temp[c.marker, ]%*% p.cluster.weight) * p.cluster.weight[j]
          names(Y.sub) = c.marker
          Y.sub = Y.sub[Y.sub > 0]
          lm.D1.sub = music.iter(Y.sub, D1[c.marker, clusters.type[[j]]], M.S[clusters.type[[j]]],
                                 Sigma[c.marker, clusters.type[[j]]])
          p.weight = c(p.weight, p.cluster.weight[j] * lm.D1.sub$p.weight)
        }
      }
    }
    Est.prop.weighted.cluster = rbind(Est.prop.weighted.cluster, p.weight)
  }
  
  colnames(Est.prop.weighted.cluster) = unlist(clusters.type)
  rownames(Est.prop.weighted.cluster) = colnames(Yjg)
  
  return(list(Est.prop.weighted.cluster = Est.prop.weighted.cluster))
}

Results

๊ทธ๋ž˜์„œ ๋Œ๋ฆฌ๊ณ  ๋‚œ Est.prop์—๋Š” ์ƒ˜ํ”Œ๋ณ„๋กœ ์˜ˆ์ธก๋œ ๊ฒฐ๊ณผ๊ฐ€ ์ €์žฅ๋˜๋Š”๋ฐ..

  • Est.prop.weighted: data.frame of MuSiC estimated proportions, subjects by cell types;
  • Est.prop.allgene: data.frame of NNLS estimated proportions, subjects by cell types;
  • Weight.gene: matrix, MuSiC estimated weight for each gene, genes by subjects;
  • r.squared.full: vector of R squared from MuSiC estimated proportions for each subject;
  • Var.prop: matrix of variance of MuSiC estimates.

NNLS๋ž€โ€ฆ

Non-Negative Least Squares์˜ ์•ฝ์–ด. ๋น„์Œ์ˆ˜ ์ตœ์†Œ์ œ๊ณฑ๋ฒ•์ด๋ผ๊ณ ๋„ํ•จ.
๋…ผ๋ฌธ์—์„  CIBERSORT, BSEQ-sc์™€ ํ•จ๊ป˜ MuSiC์˜ ๊ฒฐ๊ณผ๋ฅผ ํ‰๊ฐ€ํ•˜๊ธฐ ์œ„ํ•œ ๋ฐฉ๋ฒ•์ค‘ ํ•˜๋‚˜๋กœ ์‚ฌ์šฉํ•จ.

linear regression์„ ์œ„ํ•œ ์ตœ์ ํ™” ์•Œ๊ณ ๋ฆฌ์ฆ˜ ์ค‘ ํ•˜๋‚˜.
์ด ๋ฐฉ๋ฒ•์˜ ํŠน์ง•์€ ๋ชจ๋“  x๊ฐ€ ๋น„์Œ์ˆ˜์—ฌ์•ผ ํ•œ๋‹ค๋Š” ์ œ์•ฝ์กฐ๊ฑด์ด ์žˆ์Œ.

์—ฌ๋Ÿฌ cell type์˜ ํ˜ผํ•ฉ๋ฌผ (bulkRNA-seq data)์—์„œ ๊ฐ cell type์˜ ๋น„์œจ์€ ์„ ํ˜•๋ฐฉ์ •์‹์œผ๋กœ ํ‘œํ˜„์ด ๊ฐ€๋Šฅํ• ํ…๋ฐ, ์ด๋•Œ ๊ฐ cell type์˜ ๋น„์œจ์€ ์ตœ์†Œ 0์ด์ง€ ์Œ์ˆ˜๊ฐ€ ๋  ์ˆ˜ ์—†๊ธฐ ๋•Œ๋ฌธ์—

1
2
Est.prop$Est.prop.weighted # sample X celltypes
rowSums(Est.prop$Est.prop.weighted) # ์ „๋ถ€ 1 

๊ทธ๋ฆผ์œผ๋กœ ํ‘œํ˜„

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
# ๊ฒฐ๊ณผ์ •๋ฆฌ
m.prop = rbind(meltnew(Est.prop$Est.prop.weighted), meltnew(Est.prop$Est.prop.allgene))
colnames(m.prop) = c('Sub', 'CellType', 'Prop')
m.prop$CellType = factor(m.prop$CellType, levels = unique(sort(colData(sc.sce)$predicted.celltype.l2)))
m.prop$Method = factor(rep(c('MuSiC', 'NNLS'), each = ncol(expression_matrix_filtered)*length(levels(m.prop$CellType))), levels = c('MuSiC', 'NNLS'))
m.prop$day = sapply(m.prop$Sub,function(x) strsplit(as.character(x),split="[.]")[[1]][2])
m.prop$day = factor(m.prop$day,levels=c('d0','d3','d7','d28'))
m.prop$PatientID = sapply(m.prop$Sub,function(x) strsplit(as.character(x),split="[.]")[[1]][1])

# celltype๋ณ„๋กœ ๊ทธ๋ฆผ 
cell_types <- unique(m.prop$CellType)

for (cell_type in cell_types) {
  # ํ•ด๋‹น Cell Type์— ๋Œ€ํ•œ ๋ฐ์ดํ„ฐ ์ถ”์ถœ
  cell_type_data <- m.prop[m.prop$Method=="MuSiC",] %>% filter(CellType == cell_type)
    
  # Box Plot ๊ทธ๋ฆฌ๊ธฐ
  p <- ggplot(data = cell_type_data, aes(x = factor(day), y = Prop, fill = factor(day))) +
    geom_boxplot() +
    labs(title = paste("Box Plot for", cell_type), x = "Day", y = "Proportion") +
    theme_minimal() +
    theme(axis.text.x = element_text(angle = 45, hjust = 1))
  
  # ๊ทธ๋ฆผ ์ €์žฅ
  ggsave(filename = paste(cell_type, "_MuSiC.png", sep = ""), plot = p)
}

์ด ํˆด ๋ง๊ณ ๋„ ์—ฌ๋Ÿฌ๊ฐ€์ง€ ๋‹ค๋ฅธ deconvolution ํˆด์ด ์กด์žฌํ•จ.

๐Ÿ‘‰ CIBERSORTx ์‚ฌ์šฉํ•˜๊ธฐ

๋

Reference

  • https://xuranw.github.io/MuSiC/articles/pages/MuSiC2.html#sample-analysis
This post is licensed under CC BY 4.0 by the author.

ยฉ Subin Cho. Some rights reserved.

Using the Chirpy theme for Jekyll.