ADAPTS (Automated Deconvolution Augmentation of Profiles for Tissue Specific cells) Vignette #1: Matrix Augmentation

Samuel Danziger, PhD

2019-09-07

Part I - A: Deconvolve purified CD138+ tumor samples using LM22 Note: ADAPTSdata and ADAPTSdata2 come from GitHub devtools::install_github(“sdanzige/ADAPTSdata”) devtools::install_github(“sdanzige/ADAPTSdata2”)

library(ADAPTS)
library(ADAPTSdata)
library(ADAPTSdata2)
library(preprocessCore)
library(pheatmap)
library(mclust)
#> Package 'mclust' version 5.4.2
#> Type 'citation("mclust")' for citing this R package in publications.
doParallel::registerDoParallel(cores = parallel::detectCores())

set.seed(42)

LM22 <- ADAPTS::LM22
cd138p <- ADAPTSdata::cd138p
wbm <- ADAPTSdata2::wbm
tumorPer <- ADAPTSdata2::tumorPer
LM22.source <- ADAPTSdata2::fullLM22
addMGSM27 <- ADAPTSdata::addMGSM27
cellCounts <- estCellPercent.DCQ(LM22, cd138p)
tumorPer$LM22.CD138p.tumor <- colSums(cellCounts[c('Plasma.cells','B.cells.memory'),
    match(make.names(tumorPer$celfileRnas),colnames(cellCounts))])

incBool <- !is.na(tumorPer$CD138_Post_Sort) 
curData <- tumorPer[incBool,]
rmse.lm22.cd138p <- sqrt(mean((curData$CD138_Post_Sort - curData$LM22.CD138p.tumor)^2))
ct.lm22.cd138p <- cor.test(curData$CD138_Post_Sort, curData$LM22.CD138p.tumor)
ct.lm22.cd138p.spear <- suppressWarnings(cor.test(curData$CD138_Post_Sort, curData$LM22.CD138p.tumor, method = 'spearman'))
titleStr <- paste0('LM22 Deconvolution of CD138+ Samples:\nRMSE = ', round(rmse.lm22.cd138p), '; Rho = ', round(ct.lm22.cd138p$estimate,2), '; Spear =', round(ct.lm22.cd138p.spear$estimate,2))
plot(curData$CD138_Post_Sort, curData$LM22.CD138p.tumor, main=titleStr, xlab='% Purity', 
     ylab='Deconvolved Tumor %')

Part I - B: Deconvolve WBM samples using LM22

cellCounts <- estCellPercent.DCQ(LM22, wbm)
tumorPer$LM22.WBM.tumor <- colSums(cellCounts[c('Plasma.cells','B.cells.memory'),
    match(make.names(tumorPer$celfileRnbx),colnames(cellCounts))])

tumorPer$PC_Mean <- rowMeans(tumorPer[,c('PC_AspNum','PC_BmbxNum')], na.rm=TRUE)
incBool <- !is.nan(tumorPer$PC_Mean) & !is.na(tumorPer$LM22.WBM.tumor)
curData <- tumorPer[incBool,] 
rmse.lm22.WBM <- sqrt(mean((curData$PC_Mean - curData$LM22.WBM.tumor)^2))
ct.lm22.WBM <- cor.test(curData$PC_Mean, curData$LM22.WBM.tumor)
ct.lm22.WBM.spear <- suppressWarnings(cor.test(curData$PC_Mean, curData$LM22.WBM.tumor, method = 'spearman'))
titleStr <- paste0('LM22 Deconvolution of WBM Samples:\nRMSE = ', round(rmse.lm22.WBM), '; Rho = ', round(ct.lm22.WBM$estimate,2), '; Spear =', round(ct.lm22.cd138p.spear$estimate,2))
plot(curData$PC_Mean, curData$LM22.WBM.tumor, main=titleStr, xlab='% WBM Tumor', ylab='Deconvolved Tumor %')

Part II - Build LM22 + ‘MM.plasma.cell’,‘PlasmaMemory’

LM22p <- LM22
augData <- addMGSM27[match(rownames(LM22), rownames(addMGSM27)), ]#grepl('PlasmaMemory',colnames(addMGSM27)) | grepl('MM.plasma.cell',colnames(addMGSM27))]
LM22p$PlasmaMemory <- rowSums(augData[,grepl('PlasmaMemory',colnames(augData))], na.rm=TRUE)
LM22p$MM.plasma.cell <- rowSums(augData[,grepl('MM.plasma.cell',colnames(augData))], na.rm=TRUE)
LM22p$osteoclast <- rowSums(augData[,grepl('osteoclast',colnames(augData))], na.rm=TRUE)
LM22p$osteoblast <- rowSums(augData[,grepl('osteoblast',colnames(augData))], na.rm=TRUE)
LM22p$adipocyte <- rowSums(augData[,grepl('adipocyte',colnames(augData))], na.rm=TRUE)

Part II - A: Deconvolve purified CD138+ tumor samples using LM22 + ‘MM.plasma.cell’,‘PlasmaMemory’

cellCounts <- estCellPercent.DCQ(LM22p, cd138p)
tumorPer$LM22p.CD138p.tumor <- colSums(cellCounts[c('Plasma.cells','B.cells.memory','MM.plasma.cell','PlasmaMemory'),
    match(make.names(tumorPer$celfileRnas),colnames(cellCounts))])

incBool <- !is.na(tumorPer$CD138_Post_Sort)
curData <- tumorPer[incBool,]
rmse.lm22p.cd138p <- sqrt(mean((curData$CD138_Post_Sort - curData$LM22p.CD138p.tumor)^2))
ct.lm22p.cd138p <- cor.test(curData$CD138_Post_Sort, curData$LM22p.CD138p.tumor)
ct.lm22p.cd138p.spear <- suppressWarnings(cor.test(curData$CD138_Post_Sort, curData$LM22p.CD138p.tumor, method='spearman'))
titleStr <- paste0('LM22 + 5 Deconvolution of CD138+ Samples:\nRMSE = ', round(rmse.lm22p.cd138p), '; Rho = ', round(ct.lm22p.cd138p$estimate,2), '; Spear = ', round(ct.lm22p.cd138p.spear$estimate,2))
plot(curData$CD138_Post_Sort, curData$LM22p.CD138p.tumor, main=titleStr, xlab='% Purity', ylab='Deconvolved Tumor %')

Part II - B: Deconvolve WBM samples using LM22 + Bone Marrow Cells

cellCounts <- estCellPercent.DCQ(LM22p, wbm)
tumorPer$LM22p.WBM.tumor <- colSums(cellCounts[c('Plasma.cells','B.cells.memory','MM.plasma.cell','PlasmaMemory'),
    match(make.names(tumorPer$celfileRnbx),colnames(cellCounts))])

tumorPer$PC_Mean <- rowMeans(tumorPer[,c('PC_AspNum','PC_BmbxNum')], na.rm=TRUE)
incBool <- !is.nan(tumorPer$PC_Mean) & !is.na(tumorPer$LM22p.WBM.tumor)
curData <- tumorPer[incBool,] 
rmse.lm22p.WBM <- sqrt(mean((curData$PC_Mean - curData$LM22p.WBM.tumor)^2))
ct.lm22p.WBM <- cor.test(curData$PC_Mean, curData$LM22p.WBM.tumor)
ct.lm22p.WBM.spear <- suppressWarnings(cor.test(curData$PC_Mean, curData$LM22p.WBM.tumor, method='spearman'))
titleStr <- paste0('LM22 + 5 Deconvolution of WBM Samples:\nRMSE = ', round(rmse.lm22p.WBM), '; Rho = ', round(ct.lm22p.WBM$estimate,2), '; Spear = ', round(ct.lm22p.WBM.spear$estimate,2) )
plot(curData$PC_Mean, curData$LM22p.WBM.tumor, main=titleStr, xlab='% WBM Tumor', ylab='Deconvolved Tumor %')

Part III: Augmenting an existing signature matrix

olGenes <- rownames(LM22.source)[rownames(LM22.source) %in% rownames(addMGSM27)]
allData <- cbind(LM22.source[olGenes,], addMGSM27[olGenes,])
allData.nq <- as.data.frame(normalize.quantiles(as.matrix(allData)))
rownames(allData.nq) <- rownames(allData)
colnames(allData.nq) <- colnames(allData)
allData <- allData.nq

#Remove low variance genes to make the example run faster
allData.noNA <- allData[!apply(allData, 1, function(x){any(is.na(x))}),]
vars.noNA <- apply(allData.noNA, 1, var)

hist(vars.noNA)

#This will take a while.  To make it faster, filter genes by variance
subData <- allData[vars.noNA>2,]
gList <- rankByT(subData)
olgenes <- rownames(subData)

fullData <- allData[olgenes,colnames(LM22.source)]
colnames(fullData) <- sub('\\.[0-9]+$', '', colnames(fullData)) #Strip any trailing numbers added by make.names()

newData <- allData[olgenes,colnames(addMGSM27)]
colnames(newData) <- sub('\\.[0-9]+$', '', colnames(newData)) #Strip any trailing numbers added by make.names()

#MGSM27 <- AugmentSigMatrix(origMatrix=LM22, fullData=fullData, newData=newData, gList=gList, nGenes=1:100, plotToPDF=FALSE, imputeMissing=TRUE, condTol=1.01, postNorm=TRUE, minSumToRem=NA, addTitle=NULL, autoDetectMin=TRUE, calcSpillOver=FALSE)
#Note:  For the Identifying a High-risk Cellular Signature in the Multiple Myeloma Bone Marrow Microenvironment, we used the call commented out above, which resulted in 601 genes.  It looks like the package used to find the minimima has changed, results in a smaller number of genes (~570).  We recommend trying this option and looking at the condition number curves to see if it makes sense.  Future version will probably upgrade the 'autoDetectMin' option to be smarter. 

MGSM27 <- AugmentSigMatrix(origMatrix=LM22, fullData=fullData, newData=newData, gList=gList, nGenes=1:100, plotToPDF=FALSE, imputeMissing=TRUE, condTol=1.01, postNorm=TRUE, minSumToRem=NA, addTitle=NULL, autoDetectMin=FALSE, calcSpillOver=FALSE)
#>   missForest iteration 1 in progress...
#> randomForest 4.6-14
#> Type rfNews() to see new features/changes/bug fixes.
#> done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 3 in progress...done!
#>   missForest iteration 4 in progress...done!
#>   missForest iteration 5 in progress...done!
#>   missForest iteration 6 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 3 in progress...done!
#>   missForest iteration 4 in progress...done!
#>   missForest iteration 5 in progress...done!

Part IV - A: Deconvolve purified CD138+ tumor samples using MGSM27

cellCounts <- estCellPercent.DCQ(MGSM27, cd138p)
tumorPer$MGSM27.CD138p.tumor <- colSums(cellCounts[c('Plasma.cells','B.cells.memory','MM.plasma.cell','PlasmaMemory'),
    match(make.names(tumorPer$celfileRnas),colnames(cellCounts))])

incBool <- !is.na(tumorPer$CD138_Post_Sort)
curData <- tumorPer[incBool,]
rmse.mgsm27.cd138p <- sqrt(mean((curData$CD138_Post_Sort - curData$MGSM27.CD138p.tumor)^2))
ct.mgsm27.cd138p <- cor.test(curData$CD138_Post_Sort, curData$MGSM27.CD138p.tumor)
ct.mgsm27.cd138p.spear <- suppressWarnings(cor.test(curData$CD138_Post_Sort, curData$MGSM27.CD138p.tumor, method='spearman'))
titleStr <- paste0('MGSM27 Deconvolution of CD138+ Samples:\nRMSE = ', round(rmse.mgsm27.cd138p), '; Rho = ', round(ct.mgsm27.cd138p$estimate,2), '; Spear = ', round(ct.mgsm27.cd138p.spear$estimate,2) )
plot(curData$CD138_Post_Sort, curData$MGSM27.CD138p.tumor, main=titleStr, xlab='% Purity', ylab='Deconvolved Tumor %')

Part IV - B: Deconvolve WBM samples using MGSM27

cellCounts <- estCellPercent.DCQ(MGSM27, wbm)
tumorPer$MGSM27.WBM.tumor <- colSums(cellCounts[c('Plasma.cells','B.cells.memory','MM.plasma.cell','PlasmaMemory'),
    match(make.names(tumorPer$celfileRnbx),colnames(cellCounts))])

tumorPer$PC_Mean <- rowMeans(tumorPer[,c('PC_AspNum','PC_BmbxNum')], na.rm=TRUE)
incBool <- !is.nan(tumorPer$PC_Mean) & !is.na(tumorPer$LM22.WBM.tumor)
curData <- tumorPer[incBool,] 
rmse.mgsm27.WBM <- sqrt(mean((as.numeric(curData$PC_Mean) - curData$MGSM27.WBM.tumor)^2))
ct.mgsm27.WBM <- cor.test(as.numeric(curData$PC_Mean), curData$MGSM27.WBM.tumor)
ct.mgsm27.WBM.spear <- suppressWarnings(cor.test(as.numeric(curData$PC_Mean), curData$MGSM27.WBM.tumor, method='spearman'))
titleStr <- paste0('MGSM27 Deconvolution of WBM Samples:\nRMSE = ', round(rmse.mgsm27.WBM), '; Rho = ', round(ct.mgsm27.WBM$estimate,2), '; Spear = ', round(ct.mgsm27.WBM.spear$estimate,2) )
plot(curData$PC_Mean, curData$MGSM27.WBM.tumor, main=titleStr, xlab='% WBM Tumor', ylab='Deconvolved Tumor %')

Part V: Generating a new signature matrix (Top Variance, Subtract, Recreate)

olGenes <- rownames(LM22.source)[rownames(LM22.source) %in% rownames(addMGSM27)]
allData <- cbind(LM22.source[olGenes,], addMGSM27[olGenes,])
allData.nq <- as.data.frame(normalize.quantiles(as.matrix(allData)))
rownames(allData.nq) <- rownames(allData)
colnames(allData.nq) <- colnames(allData)
allData <- allData.nq

The top genes by variance will be the seedMatrix

nGenes <- 100

seedMat <- allData.noNA[names(tail(sort(vars.noNA), nGenes)),]
colnames(seedMat) <- sub('\\.[0-9]+$', '', colnames(seedMat))
seedMat.sig <- lapply(unique(colnames(seedMat)), function(x){ rowMeans(seedMat[,colnames(seedMat)==x], na.rm=TRUE)})
seedMat.sig <- do.call(cbind, seedMat.sig)
colnames(seedMat.sig) <- unique(colnames(seedMat))
pheatmap(seedMat.sig)

Augment that top gene network

subData.noNA <- allData.noNA[vars.noNA>2,]
colnames(allData.noNA) <- sub('\\.[0-9]+$', '', colnames(allData.noNA))
gList.noNA <- rankByT(subData.noNA)
topAug <- AugmentSigMatrix(origMatrix=seedMat.sig, fullData=allData.noNA, newData=allData.noNA, gList=gList.noNA, nGenes=1:100, plotToPDF=FALSE, imputeMissing=TRUE, condTol=1.01, postNorm=TRUE, minSumToRem=NA, addTitle=NULL, autoDetectMin=FALSE, calcSpillOver=FALSE)

Remove the seed genes and then rebuild

topAug.remSeed <- topAug[!(rownames(topAug) %in% rownames(seedMat.sig)),]

topAug2 <- AugmentSigMatrix(origMatrix=topAug.remSeed, fullData=allData.noNA, newData=allData.noNA, gList=gList.noNA, nGenes=1:100, plotToPDF=FALSE, imputeMissing=TRUE, condTol=1.01, postNorm=TRUE, minSumToRem=NA, addTitle=NULL, autoDetectMin=FALSE, calcSpillOver=FALSE)

Part VI - A: Deconvolve purified CD138+ tumor samples using de-novo deconvolution matrix

cellCounts <- estCellPercent.DCQ(topAug2, cd138p)
tumorPer$DeNovo.CD138p.tumor <- colSums(cellCounts[c('Plasma.cells','B.cells.memory','MM.plasma.cell','PlasmaMemory'),
    match(make.names(tumorPer$celfileRnas),colnames(cellCounts))])

incBool <- !is.na(tumorPer$CD138_Post_Sort)
curData <- tumorPer[incBool,]
rmse.DeNovo.cd138p <- sqrt(mean((curData$CD138_Post_Sort - curData$DeNovo.CD138p.tumor)^2))
ct.DeNovo.cd138p <- cor.test(curData$CD138_Post_Sort, curData$DeNovo.CD138p.tumor)
ct.DeNovo.cd138p.spear <- suppressWarnings(cor.test(curData$CD138_Post_Sort, curData$DeNovo.CD138p.tumor, method='spearman'))
titleStr <- paste0('DeNovo Deconvolution of CD138+ Samples:\nRMSE = ', round(rmse.DeNovo.cd138p), '; Rho = ', round(ct.DeNovo.cd138p$estimate,2), '; Spear = ', round(ct.DeNovo.cd138p.spear$estimate,2) )
plot(curData$CD138_Post_Sort, curData$DeNovo.CD138p.tumor, main=titleStr, xlab='% Purity', ylab='Deconvolved Tumor %')

Part VI - B: Deconvolve WBM samples using de-novo deconvolution matrix

cellCounts <- estCellPercent.DCQ(topAug2, wbm)
tumorPer$DeNovo.WBM.tumor <- colSums(cellCounts[c('Plasma.cells','B.cells.memory','MM.plasma.cell','PlasmaMemory'),
    match(make.names(tumorPer$celfileRnbx),colnames(cellCounts))])

tumorPer$PC_Mean <- rowMeans(tumorPer[,c('PC_AspNum','PC_BmbxNum')], na.rm=TRUE)
incBool <- !is.nan(tumorPer$PC_Mean) & !is.na(tumorPer$DeNovo.WBM.tumor)
curData <- tumorPer[incBool,] 
rmse.DeNovo.WBM <- sqrt(mean((curData$PC_Mean - curData$DeNovo.WBM.tumor)^2))
ct.DeNovo.WBM <- cor.test(curData$PC_Mean, curData$DeNovo.WBM.tumor)
ct.DeNovo.WBM.spear <- suppressWarnings(cor.test(curData$PC_Mean, curData$DeNovo.WBM.tumor, method='spearman'))
titleStr <- paste0('DeNovo Deconvolution of WBM Samples:\nRMSE = ', round(rmse.DeNovo.WBM), '; Rho = ', round(ct.DeNovo.WBM$estimate,2), '; Spear = ', round(ct.DeNovo.WBM.spear$estimate,2) )
plot(curData$PC_Mean, curData$DeNovo.WBM.tumor, main=titleStr, xlab='% WBM Tumor', ylab='Deconvolved Tumor %')

Build the summary table

outMatrix <- matrix(0, nrow=4, ncol=4, dimnames=list(c('LM22','LM22 + 5','MGSM27','DeNovo MGSM27'),c('CD138+.RMSE','CD138+.Rho','WBM.RMSE','WBM.Rho')))
outMatrix[1,1] <- rmse.lm22.cd138p
outMatrix[1,2] <- ct.lm22.cd138p$estimate
outMatrix[1,3] <- rmse.lm22.WBM
outMatrix[1,4] <- ct.lm22.WBM$estimate

outMatrix[2,1] <- rmse.lm22p.cd138p
outMatrix[2,2] <- ct.lm22p.cd138p$estimate
outMatrix[2,3] <- rmse.lm22p.WBM
outMatrix[2,4] <- ct.lm22p.WBM$estimate
  
outMatrix[3,1] <- rmse.mgsm27.cd138p
outMatrix[3,2] <- ct.mgsm27.cd138p$estimate
outMatrix[3,3] <- rmse.mgsm27.WBM
outMatrix[3,4] <- ct.mgsm27.WBM$estimate

outMatrix[4,1] <- rmse.DeNovo.cd138p
outMatrix[4,2] <- ct.DeNovo.cd138p$estimate
outMatrix[4,3] <- rmse.DeNovo.WBM
outMatrix[4,4] <- ct.DeNovo.WBM$estimate
print(signif(outMatrix,2))
#>               CD138+.RMSE CD138+.Rho WBM.RMSE WBM.Rho
#> LM22                 27.0       0.26       38    0.59
#> LM22 + 5             12.0       0.26       37    0.53
#> MGSM27                8.7       0.33       22    0.60
#> DeNovo MGSM27        33.0       0.21       23    0.64