ADAPTS Vignette #2: Single Cell Analysis

Samuel Danziger, PhD

2019-09-07

This code can install ADAPTSdata3

install.packages(‘devtools’) library(devtools) devtools::install_github(‘sdanzige/ADAPTSdata3’)

library(ADAPTS)
library(ADAPTSdata3)
library(preprocessCore)
library(pheatmap)
library(foreach)
doParallel::registerDoParallel(cores = parallel::detectCores())

set.seed(42)
method <- 'DCQ'
#Set to FALSE to use saved version of processor intensive variables
#  If set to TRUE, it will probable take 50+ minutes to complete
rebuild <- FALSE

Step 1: Build a signature matrix from the normal data

normalData <- log(ADAPTSdata3::normalData.5061+1)

Step 1a: Make a gList to rank genes

#The gList has the significantly different genes ranked by expression ratio
#  Note, this is slow
if(rebuild==TRUE) {
  gList <- ADAPTS::rankByT(normalData,remZinf = TRUE)
} else {
  gList <- ADAPTSdata3::gList
}

Step 1b: Determine 100 highest variance genes

#Find the most variant genes across cell types 
cNames <- sub('\\.+[0-9]+$','',colnames(normalData))
ctMeans <- apply(normalData, 1, function(x){tapply(x, cNames, mean, na.rm=TRUE)})

gVars <- apply(ctMeans, 2, var)
topGenes <- names(tail(sort(gVars),100))

Step 1c: Build the seed signature matrix & augment

sigMat1 <- t(ctMeans[,topGenes])

allSCdata <- normalData
colnames(allSCdata) <- cNames

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

Step 2: Deconvolve pseudo-bulk

pseudoBulk <- log(rowSums(ADAPTSdata3::normalData.5061, na.rm=TRUE)+1)
cellEst.top100 <- estCellPercent(refExpr = sigMat1, geneExpr = data.frame(pseudoBulk=pseudoBulk), method=method)
cellEst.aug <- estCellPercent(refExpr = topAug.var100$sigMatrix, geneExpr = data.frame(pseudoBulk=pseudoBulk), method=method)

actualFrac <- ADAPTSdata3::enumerateCellTypes(ADAPTSdata3::normalData.5061)
#> 
#>                 acinar.cell                  alpha.cell 
#>                         130                         541 
#>                   beta.cell          co.expression.cell 
#>                         152                          23 
#>                  delta.cell                 ductal.cell 
#>                          44                         179 
#>            endothelial.cell                epsilon.cell 
#>                          11                           5 
#>                  gamma.cell                   mast.cell 
#>                         107                           4 
#>           MHC.class.II.cell                    PSC.cell 
#>                           2                          32 
#> unclassified.endocrine.cell 
#>                          25
actualFrac <- actualFrac / sum(actualFrac)
actualFrac <- c(actualFrac, 0) * 100
deconTable <- data.frame(top100=cellEst.top100, augmented=cellEst.aug, ref=actualFrac)
colnames(deconTable) <- c('top100','augmented','ref')

Caclulate some statistics

AbsError <- abs(deconTable - actualFrac)
deconTableP <- as.data.frame(t(deconTable))
RMSEs <- apply(AbsError, 2, function(x){sqrt(mean(x^2))})
deconTableP$RMSE <- RMSEs
rhos <- apply(deconTable, 2, function(x){cor(x, actualFrac)})
deconTableP$rho <- rhos
rhos.spear <- apply(deconTable, 2, function(x){cor(x, actualFrac, method='spearman')})
deconTableP$rho.spear <- rhos.spear

deconTableP <- t(deconTableP)
colnames(deconTableP) <- c('top100', 'augmented', 'ref')
print(round(deconTableP,2))
#>                             top100 augmented   ref
#> acinar.cell                  11.38     11.56 10.36
#> alpha.cell                    7.32      7.85 43.11
#> beta.cell                     7.46      8.34 12.11
#> co.expression.cell           11.66      9.68  1.83
#> delta.cell                    7.11      7.66  3.51
#> ductal.cell                   4.36     11.49 14.26
#> endothelial.cell              0.00      2.56  0.88
#> epsilon.cell                  7.02      6.11  0.40
#> gamma.cell                    8.37      7.63  8.53
#> mast.cell                     0.00      2.13  0.32
#> MHC.class.II.cell             0.00      2.68  0.16
#> PSC.cell                      0.00      5.96  2.55
#> unclassified.endocrine.cell  35.33     16.37  1.99
#> others                        0.00      0.00  0.00
#> RMSE                         13.82     10.72  0.00
#> rho                           0.05      0.26  1.00
#> rho.spear                     0.50      0.69  1.00

Show how combining Cell Types that are highly correlated improves correlation Step 3: Deconvolve pseudo-bulk with heirarchical deconvolution

#This is pretty slow

if(rebuild==TRUE) {
  hier.top100 <- ADAPTS::hierarchicalSplit(sigMatrix = sigMat1, geneExpr = allSCdata, method=method)
  hier.augment <- ADAPTS::hierarchicalSplit(sigMatrix = topAug.var100$sigMatrix, geneExpr = allSCdata, method=method)
} else {
  hier.top100 <- ADAPTSdata3::hier.top100
  hier.augment <- ADAPTSdata3::hier.augment
}
pheatmap(t(hier.top100$deconMatrices[[2]]), cluster_rows = FALSE, cluster_cols = FALSE, main='Top 100 genes:spillover matrix')

pheatmap(t(hier.top100$deconMatrices[[length(hier.top100$deconMatrices)]]), main='Top 100 genes:clustered spillover matrix')
hier.top100$allClusters
#> [[1]]
#> [1] "acinar.cell" "ductal.cell"
#> 
#> [[2]]
#> [1] "alpha.cell" "gamma.cell"
#> 
#> [[3]]
#> [1] "beta.cell"                   "co.expression.cell"         
#> [3] "delta.cell"                  "unclassified.endocrine.cell"
#> 
#> [[4]]
#> [1] "endothelial.cell" "PSC.cell"        
#> 
#> [[5]]
#> [1] "epsilon.cell"
#> 
#> [[6]]
#> [1] "mast.cell"
#> 
#> [[7]]
#> [1] "MHC.class.II.cell"

#conv <- ADAPTS::spillToConvergence(sigMatrix = sigMat1, geneExpr = allSCdata)

pheatmap(t(hier.augment$deconMatrices[[2]]), cluster_rows = FALSE, cluster_cols = FALSE, main='Augmented:spillover matrix')

pheatmap(t(hier.augment$deconMatrices[[length(hier.augment$deconMatrices)]]), main='Augmented:clustered spillover matrix')
hier.augment$allClusters
#> [[1]]
#> [1] "acinar.cell" "ductal.cell"
#> 
#> [[2]]
#> [1] "alpha.cell"                  "beta.cell"                  
#> [3] "co.expression.cell"          "delta.cell"                 
#> [5] "gamma.cell"                  "unclassified.endocrine.cell"
#> 
#> [[3]]
#> [1] "endothelial.cell" "PSC.cell"        
#> 
#> [[4]]
#> [1] "epsilon.cell"
#> 
#> [[5]]
#> [1] "mast.cell"         "MHC.class.II.cell"

#conv <- ADAPTS::spillToConvergence(sigMatrix = sigMat1, geneExpr = allSCdata)

groups <- sapply (unlist(hier.top100$allClusters), function(g) {
  which(sapply(hier.top100$allClusters, function(x){g %in% x}))
})
groups <- c(groups, others=max(groups)+1)

comb.top100 <- apply(deconTable, 2, function(x){tapply(x, groups, sum)})
cors.top100 <- apply(comb.top100, 2, function(x){cor(x, comb.top100[,'ref'])})
cors.spear.top100 <- apply(comb.top100, 2, function(x){cor(x, comb.top100[,'ref'], method='spearman')})
rmses.top100 <- apply(comb.top100, 2, function(x){sqrt(mean((x-comb.top100[,'ref'])^2))})

combP.top100 <- as.data.frame(t(comb.top100))
colnames(combP.top100) <- c(sapply(hier.top100$allClusters, function(x){paste(x, collapse='_')}),'others')

combP.top100$RMSE <- rmses.top100
combP.top100$rho <- cors.top100
combP.top100$rho.spear <- cors.spear.top100

combP.top100 <- t(combP.top100)
combP.top100 <- combP.top100[,c(1,3)]

print('Top 100 Combination Predictions')
#> [1] "Top 100 Combination Predictions"
print(round(combP.top100,2))
#>                                                                     top100
#> acinar.cell_ductal.cell                                              18.70
#> alpha.cell_gamma.cell                                                19.12
#> beta.cell_co.expression.cell_delta.cell_unclassified.endocrine.cell  18.49
#> endothelial.cell_PSC.cell                                             8.37
#> epsilon.cell                                                          0.00
#> mast.cell                                                             0.00
#> MHC.class.II.cell                                                    35.33
#> others                                                                0.00
#> RMSE                                                                 17.15
#> rho                                                                   0.32
#> rho.spear                                                             0.51
#>                                                                       ref
#> acinar.cell_ductal.cell                                             53.47
#> alpha.cell_gamma.cell                                               13.94
#> beta.cell_co.expression.cell_delta.cell_unclassified.endocrine.cell 19.04
#> endothelial.cell_PSC.cell                                            8.84
#> epsilon.cell                                                         0.16
#> mast.cell                                                            2.55
#> MHC.class.II.cell                                                    1.99
#> others                                                               0.00
#> RMSE                                                                 0.00
#> rho                                                                  1.00
#> rho.spear                                                            1.00
groups <- sapply (unlist(hier.augment$allClusters), function(g) {
  which(sapply(hier.augment$allClusters, function(x){g %in% x}))
})
groups <- c(groups, others=max(groups)+1)

comb.augment <- apply(deconTable, 2, function(x){tapply(x, groups, sum)})
cors.augment <- apply(comb.augment, 2, function(x){cor(x, comb.augment[,'ref'])})
cors.spear.augment <- apply(comb.augment, 2, function(x){cor(x, comb.augment[,'ref'], method='spearman')})
rmses.augment <- apply(comb.augment, 2, function(x){sqrt(mean((x-comb.augment[,'ref'])^2))})

combP.augment <- as.data.frame(t(comb.augment))
colnames(combP.augment) <- c(sapply(hier.augment$allClusters, function(x){paste(x, collapse='_')}),'others')

combP.augment$RMSE <- rmses.augment
combP.augment$rho <- cors.augment
combP.augment$rho.spear <- cors.spear.augment

combP.augment <- t(combP.augment)
combP.augment <- combP.augment[,c(2,3)]

print('Augment Combination Predictions')
#> [1] "Augment Combination Predictions"
print(round(combP.augment,2))
#>                                                                                           augmented
#> acinar.cell_ductal.cell                                                                       19.41
#> alpha.cell_beta.cell_co.expression.cell_delta.cell_gamma.cell_unclassified.endocrine.cell     45.84
#> endothelial.cell_PSC.cell                                                                      9.76
#> epsilon.cell                                                                                   2.68
#> mast.cell_MHC.class.II.cell                                                                   22.33
#> others                                                                                         0.00
#> RMSE                                                                                          16.58
#> rho                                                                                            0.58
#> rho.spear                                                                                      0.71
#>                                                                                             ref
#> acinar.cell_ductal.cell                                                                   53.47
#> alpha.cell_beta.cell_co.expression.cell_delta.cell_gamma.cell_unclassified.endocrine.cell 32.99
#> endothelial.cell_PSC.cell                                                                  8.84
#> epsilon.cell                                                                               0.16
#> mast.cell_MHC.class.II.cell                                                                4.54
#> others                                                                                     0.00
#> RMSE                                                                                       0.00
#> rho                                                                                        1.00
#> rho.spear                                                                                  1.00

Step 4: Hierarchical Deconvolution

#cellEst.top100.hier <- ADAPTS::hierarchicalClassify(sigMatrix = sigMat1, toPred = data.frame(pseudoBulk=pseudoBulk), geneExpr = allSCdata, hierarchData = hier.top100, method=method)
cellEst.top100.hier <- ADAPTS::hierarchicalClassify(sigMatrix = sigMat1, toPred = data.frame(pseudoBulk=pseudoBulk), geneExpr = allSCdata, hierarchData = hier.top100, method=method)
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
cellEst.top100.hier
#>                             pseudoBulk
#> acinar.cell                   7.884952
#> ductal.cell                   7.853475
#> alpha.cell                    7.922658
#> gamma.cell                    7.765773
#> beta.cell                    11.745648
#> co.expression.cell           16.910532
#> delta.cell                   12.268908
#> unclassified.endocrine.cell  20.628756
#> endothelial.cell              0.000000
#> PSC.cell                      0.000000
#> epsilon.cell                  7.019298
#> mast.cell                     0.000000
#> MHC.class.II.cell             0.000000
#> others                        0.000000
cellEst.augment.hier <- ADAPTS::hierarchicalClassify(sigMatrix = topAug.var100$sigMatrix, toPred = data.frame(pseudoBulk=pseudoBulk), geneExpr = allSCdata, hierarchData = hier.augment, method=method)
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
cellEst.augment.hier
#>                             pseudoBulk
#> acinar.cell                 10.4856529
#> ductal.cell                 12.5597381
#> alpha.cell                   9.5135593
#> beta.cell                    8.5069856
#> co.expression.cell          10.7674625
#> delta.cell                   8.4092042
#> gamma.cell                   8.0353339
#> unclassified.endocrine.cell 12.2859508
#> endothelial.cell             0.0000000
#> PSC.cell                     8.5182963
#> epsilon.cell                 6.1087782
#> mast.cell                    0.7992621
#> MHC.class.II.cell            4.0097760
#> others                       0.0000000

Combine and calculate statistics

deconTable.hier <- data.frame(top100.hier=cellEst.top100.hier, augmented.hier=cellEst.augment.hier)
colnames(deconTable.hier) <- c('top100.hier','augmented.hier')
deconTable.all <- cbind(deconTable.hier, deconTable)
deconTableP.all <- as.data.frame(t(deconTable.all))

#AbsError.all <- abs(deconTable.all - actualFrac)
#RMSEs.all <- apply(AbsError.all, 2, function(x){sqrt(mean(x^2))})
#rhos.all <- apply(deconTable.all, 2, function(x){cor(x, actualFrac)})

cors.aug <- apply(deconTable.all, 2, function(x){cor(x, deconTable.all[,'ref'])})
cors.aug.spear <- apply(deconTable.all, 2, function(x){cor(x, deconTable.all[,'ref'], method='spearman')})
rmses.aug <- apply(deconTable.all, 2, function(x){sqrt(mean((x-deconTable.all[,'ref'])^2))})

deconTableP.all$RMSE <- rmses.aug
deconTableP.all$rho <- cors.aug
deconTableP.all$rho.spear <- cors.aug.spear

deconTableP.all <- t(deconTableP.all)
#colnames(deconTableP) <- c('top100', 'augmented', 'ref')
deconTableP.all <- deconTableP.all[,c('top100','top100.hier','augmented','augmented.hier','ref')]
colnames(deconTableP.all) <- c('top','top.hier','aug','aug.hier','ref')
print('Normal Cell Predictions')
#> [1] "Normal Cell Predictions"
print(round(deconTableP.all,2))
#>                               top top.hier   aug aug.hier   ref
#> acinar.cell                 11.38     7.88 11.56    10.49 10.36
#> ductal.cell                  7.32     7.85  7.85    12.56 43.11
#> alpha.cell                   7.46     7.92  8.34     9.51 12.11
#> gamma.cell                  11.66     7.77  9.68     8.51  1.83
#> beta.cell                    7.11    11.75  7.66    10.77  3.51
#> co.expression.cell           4.36    16.91 11.49     8.41 14.26
#> delta.cell                   0.00    12.27  2.56     8.04  0.88
#> unclassified.endocrine.cell  7.02    20.63  6.11    12.29  0.40
#> endothelial.cell             8.37     0.00  7.63     0.00  8.53
#> PSC.cell                     0.00     0.00  2.13     8.52  0.32
#> epsilon.cell                 0.00     7.02  2.68     6.11  0.16
#> mast.cell                    0.00     0.00  5.96     0.80  2.55
#> MHC.class.II.cell           35.33     0.00 16.37     4.01  1.99
#> others                       0.00     0.00  0.00     0.00  0.00
#> RMSE                        13.82    12.09 10.72    10.16  0.00
#> rho                          0.05     0.12  0.26     0.39  1.00
#> rho.spear                    0.50     0.31  0.69     0.37  1.00

Step 5: Deconvolve Diabetes data

pseudoBulk.diabetes <- log(rowSums(ADAPTSdata3::diabetesData.5061, na.rm=TRUE)+1)
pb.d.df <- data.frame(pseudoBulk.diabetes=pseudoBulk.diabetes)
cellEst.d.top100 <- estCellPercent(refExpr = sigMat1, geneExpr = pb.d.df, method=method)
cellEst.d.augment <- estCellPercent(refExpr = topAug.var100$sigMatrix, geneExpr = pb.d.df, method=method)


actualFrac.diabetes <- ADAPTSdata3::enumerateCellTypes(ADAPTSdata3::diabetesData.5061)
#> 
#>                 acinar.cell                  alpha.cell 
#>                          55                         345 
#>                   beta.cell          co.expression.cell 
#>                         118                          16 
#>                  delta.cell                 ductal.cell 
#>                          70                         207 
#>            endothelial.cell                epsilon.cell 
#>                           5                           2 
#>                  gamma.cell                   mast.cell 
#>                          90                           3 
#>           MHC.class.II.cell                    PSC.cell 
#>                           3                          22 
#> unclassified.endocrine.cell 
#>                          16
actualFrac.diabetes <- actualFrac.diabetes / sum(actualFrac.diabetes)
actualFrac.diabetes <- c(actualFrac.diabetes, 0) * 100

#Heirarchical Deconvolution
cellEst.d.top100.hier <- ADAPTS::hierarchicalClassify(sigMatrix = sigMat1, toPred = pb.d.df, geneExpr = allSCdata, hierarchData = hier.top100, method=method)
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
cellEst.d.augment.hier <- ADAPTS::hierarchicalClassify(sigMatrix = topAug.var100$sigMatrix, toPred = pb.d.df, geneExpr = allSCdata, hierarchData = hier.augment, method=method)
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
#>   missForest iteration 1 in progress...done!
#>   missForest iteration 2 in progress...done!
deconTable.d.aug <- data.frame(top100.d=cellEst.d.top100, top100.d.hier=cellEst.d.top100.hier, augmented.d=cellEst.d.augment, augmented.d.hier=cellEst.d.augment.hier, ref.d=actualFrac.diabetes)
colnames(deconTable.d.aug) <- c('top.d', 'top.d.hier', 'aug.d', 'aug.d.hier', 'ref.d')

cors.d.aug <- apply(deconTable.d.aug, 2, function(x){cor(x, deconTable.d.aug[,'ref.d'])})
cors.d.aug.spear <- apply(deconTable.d.aug, 2, function(x){cor(x, deconTable.d.aug[,'ref.d'], method='spearman')})
rmses.d.aug <- apply(deconTable.d.aug, 2, function(x){sqrt(mean((x-deconTable.d.aug[,'ref.d'])^2))})

deconTableP.d.aug <- as.data.frame(t(deconTable.d.aug))
deconTableP.d.aug$RMSE <- rmses.d.aug
deconTableP.d.aug$rho <- cors.d.aug
deconTableP.d.aug$rho.spear <- cors.d.aug.spear

print('Deconvolution of diabetes samples')
#> [1] "Deconvolution of diabetes samples"
print(round(t(deconTableP.d.aug),2))
#>                             top.d top.d.hier aug.d aug.d.hier ref.d
#> acinar.cell                  7.40       4.32 10.82       8.89  5.78
#> alpha.cell                   7.93       9.01  7.94      14.41 36.24
#> beta.cell                    8.04       8.44  8.58       9.35 12.39
#> co.expression.cell          12.33       7.95 10.03       8.55  1.68
#> delta.cell                   9.38      11.50  8.13      10.93  7.35
#> ductal.cell                  5.93      17.06 12.49       8.90 21.74
#> endothelial.cell             0.00      13.80  2.58       7.91  0.53
#> epsilon.cell                 6.56      21.36  5.83      12.12  0.21
#> gamma.cell                   8.46       0.00  7.61       0.00  9.45
#> mast.cell                    0.00       0.00  1.72       8.51  0.32
#> MHC.class.II.cell            0.00       6.56  2.88       5.83  0.32
#> PSC.cell                     0.00       0.00  5.93       0.55  2.31
#> unclassified.endocrine.cell 33.97       0.00 15.47       4.05  1.68
#> others                       0.00       0.00  0.00       0.00  0.00
#> RMSE                        12.76      10.68  9.44       8.91  0.00
#> rho                          0.06       0.24  0.35       0.46  1.00
#> rho.spear                    0.46       0.22  0.64       0.39  1.00

Try Rescaling predictions based on single cell data

dim(ADAPTSdata3::normalData.5061)
#> [1] 26178  1255
nCounts <- colSums(ADAPTSdata3::normalData.5061)
lnCounts <- log(nCounts)
cellTable <- sub('.cell$', '', sub('\\.+[0-9]+$', '', names(nCounts)))
par(mar=c(11,5,1,1))
boxplot(nCounts~cellTable, main='Counts by Cell Type', las=2, cex.lab = 0.65)

Generate the scaling factors

ref <- mean(tapply(nCounts, cellTable, mean))
relExp <- nCounts / ref
aveRelExpr <- tapply(relExp, cellTable, mean)
par(mar=c(6,5,1,1))
plot(aveRelExpr, xaxt = "n", xlab="")
axis(1, at=1:length(aveRelExpr), labels=names(aveRelExpr), las=2, cex.axis=0.5)

Rescale the precitions based on the single cell counts

deconTableP.rescale.all <- deconTableP.all
for(j in 1:4) {
  corNames <- paste(names(aveRelExpr), 'cell', sep='.')
  x <- deconTableP.rescale.all[,j]
  x[corNames] <- x[corNames] / aveRelExpr
  x[corNames] <- 100 * x[corNames] / sum(x[corNames])
  
  x['rho'] <- cor(x[corNames], deconTableP.rescale.all[corNames,'ref'])
  x['RMSE'] <- sqrt(mean((x[corNames] - deconTableP.rescale.all[corNames,'ref'])^2))
  
  deconTableP.rescale.all[,j] <- x
}
print(round(deconTableP.rescale.all,2))
#>                               top top.hier   aug aug.hier   ref
#> acinar.cell                  9.40     7.33  9.76     9.15 10.36
#> ductal.cell                  8.45    10.20  9.26    15.32 43.11
#> alpha.cell                   7.76     9.28  8.88    10.47 12.11
#> gamma.cell                   8.87     6.65  7.53     6.84  1.83
#> beta.cell                    4.94     9.19  5.45     7.91  3.51
#> co.expression.cell           3.51    15.34  9.47     7.16 14.26
#> delta.cell                   0.00    10.18  1.93     6.26  0.88
#> unclassified.endocrine.cell  7.13    23.59  6.35    13.19  0.40
#> endothelial.cell            11.01     0.00 10.27     0.00  8.53
#> PSC.cell                     0.00     0.00  2.73    11.30  0.32
#> epsilon.cell                 0.00     8.25  2.86     6.74  0.16
#> mast.cell                    0.00     0.00  7.08     0.98  2.55
#> MHC.class.II.cell           38.93     0.00 18.45     4.67  1.99
#> others                       0.00     0.00  0.00     0.00  0.00
#> RMSE                        14.71    12.18 10.95    10.04  0.00
#> rho                          0.03     0.15  0.26     0.46  1.00
#> rho.spear                    0.50     0.31  0.69     0.37  1.00

Repeat with blind predictions.

deconTableP.d.rescale.all <- t(deconTableP.d.aug)
for(j in 1:4) {
  corNames <- paste(names(aveRelExpr), 'cell', sep='.')
  x <- deconTableP.d.rescale.all[,j]
  x[corNames] <- x[corNames] / aveRelExpr
  x[corNames] <- 100 * x[corNames] / sum(x[corNames])
  
  x['rho'] <- cor(x[corNames], deconTableP.d.rescale.all[corNames,'ref.d'])
  x['RMSE'] <- sqrt(mean((x[corNames] - deconTableP.d.rescale.all[corNames,'ref.d'])^2))
  
  deconTableP.d.rescale.all[,j] <- x
}
print(round(deconTableP.d.rescale.all,2))
#>                             top.d top.d.hier aug.d aug.d.hier ref.d
#> acinar.cell                  6.68       3.53  9.38       7.48  5.78
#> alpha.cell                   9.03       9.28  8.68      15.27 36.24
#> beta.cell                    6.11       5.81  6.26       6.61 12.39
#> co.expression.cell          10.87       6.34  8.49       7.01  1.68
#> delta.cell                   7.56       8.39  6.29       8.20  7.35
#> ductal.cell                  7.48      19.48 15.13      10.45 21.74
#> endothelial.cell             0.00      17.96  3.56      10.59  0.53
#> epsilon.cell                 7.49      22.07  6.39      12.89  0.21
#> gamma.cell                   7.04       0.00  6.08       0.00  9.45
#> mast.cell                    0.00       0.00  2.10      10.06  0.32
#> MHC.class.II.cell            0.00       7.15  3.33       6.54  0.32
#> PSC.cell                     0.00       0.00  7.81       0.71  2.31
#> unclassified.endocrine.cell 37.74       0.00 16.50       4.18  1.68
#> others                       0.00       0.00  0.00       0.00  0.00
#> RMSE                        13.68      11.53  9.70       9.31  0.00
#> rho                          0.03       0.17  0.32       0.41  1.00
#> rho.spear                    0.46       0.22  0.64       0.39  1.00