ADAPTS Vignette #5
Repeated Leave-Half-Out Cross-Validation for Robust Accuracy Estimates
Xinyi Yan
8/21/2020
Install ADAPTSdata4 using the code:
install.packages(‘devtools’)
library(devtools)
devtools::install_github(‘yxinyi2/ADAPTSdata4’)
Construct all the signature matrices one time
This prostate data set comes from Henry, Gervaise H., et al. “A cellular anatomy of the normal adult human prostate and prostatic urethra.” Cell reports 25.12 (2018): 3530-3542.
Half of the data are held out as test set by setting ‘testOnHalf’ to TRUE.
Result tables are for original cell types and clustered cell types relatively.
scHenry<-as.matrix(log(ADAPTSdata4::scHenry+1))
resList<-testAllSigMatrices(exprData=scHenry, randomize = TRUE, skipShrink=FALSE, proportional=FALSE,handMetaCluster=NULL,testOnHalf=TRUE)
acc<-cbind(resList$testAcc.shrink,resList$testAcc.aug,resList$testAcc.all,resList$testAcc.seed)
acc<-acc[c(1,3,5,6), ]
acc<-cbind(acc,rep(1,4))
colnames(acc)<-c('Shrunk Matrix','Augmented Matrix','All Gene Matrix','Seed Matrix','actFrac.test')
deconTable<-round(rbind(resList$estimates.onTest,acc),2)
metacc<-cbind(resList$testAcc.metaAugShrink,resList$testAcc.metaAug,resList$testAcc.metaAll,resList$testAcc.metaSeed)
metacc<-metacc[c(1,3,5,6), ]
metacc<-cbind(metacc,rep(1,4))
colnames(metacc)<-c('Shrunk Meta','Augmented Meta','All Gene Meta','Seed Meta','actFrac.test')
metadeconTable<-round(rbind(resList$estimates.onTest.meta,metacc),2)
print(deconTable)## Shrunk Matrix Augmented Matrix All Gene Matrix
## Basal Epithelia 15.78 14.76 11.75
## Club Epithelia 11.41 10.98 8.97
## Endothelia 10.01 9.51 9.63
## Fibroblast 4.30 5.53 9.23
## Hillock Epithelia 9.17 9.24 9.35
## Leukocyte 7.98 8.66 10.25
## Luminal Epithelia 11.63 11.34 10.24
## Neuroenodcrine Epithelia 10.36 10.14 9.58
## Other 13.92 13.32 10.80
## Smooth Muscle 5.43 6.53 10.19
## others 0.00 0.00 0.00
## rho.cor 0.73 0.75 0.81
## spear.rho 0.76 0.76 0.32
## mae 8.34 8.66 9.77
## rmse 12.55 12.90 14.14
## Seed Matrix actFrac.test
## Basal Epithelia 14.69 51.42
## Club Epithelia 11.21 7.06
## Endothelia 10.32 4.42
## Fibroblast 2.27 3.26
## Hillock Epithelia 9.66 3.66
## Leukocyte 10.15 1.28
## Luminal Epithelia 12.65 6.24
## Neuroenodcrine Epithelia 11.56 0.07
## Other 14.90 19.97
## Smooth Muscle 2.60 2.63
## others 0.00 NA
## rho.cor 0.52 1.00
## spear.rho 0.62 1.00
## mae 8.56 1.00
## rmse 13.10 1.00print(metadeconTable)## Shrunk Meta Augmented Meta
## Basal Epithelia_Other 18.42 18.00
## Club Epithelia 12.82 12.82
## Endothelia 13.61 13.62
## Fibroblast_Smooth Muscle 15.25 15.50
## Hillock Epithelia 12.23 11.75
## Leukocyte 12.43 12.71
## Luminal Epithelia_Neuroenodcrine Epithelia 15.24 15.60
## others 0.00 0.00
## rho.cor 0.85 0.78
## spear.rho 0.71 0.75
## mae 15.13 15.25
## rmse 21.67 21.85
## All Gene Meta Seed Meta actFrac.test
## Basal Epithelia_Other 16.21 18.51 71.39
## Club Epithelia 12.46 12.89 7.06
## Endothelia 13.75 12.95 4.42
## Fibroblast_Smooth Muscle 15.10 15.12 5.89
## Hillock Epithelia 13.15 11.49 3.66
## Leukocyte 14.69 13.61 1.28
## Luminal Epithelia_Neuroenodcrine Epithelia 14.64 15.43 6.31
## others 0.00 0.00 NA
## rho.cor 0.66 0.82 1.00
## spear.rho 0.18 0.50 1.00
## mae 15.76 15.11 1.00
## rmse 22.63 21.66 1.00Construct all the signature matrices iteratively until results converge with 1% tolerance
The iteration stops when Pearson correlation, Spearman’s correlation, mae, and rmse all converge.
The result table shows the mean accuracy metrics and at which iteration the corresponding metric converges.
allResListCov<-loopTillConvergence(numLoops=NULL,fastStop=TRUE,exprData=scHenry,changePer=1,handMetaCluster=NULL,testOnHalf=TRUE)meanResListConv<-meanResults(allResListCov,changePer = 1)
meanResListConvOut<-meanResListConv[c('rho.cor','pVal','spear.rho','mae','rmse','N','convIt.rho.cor','convIt.pVal','convIt.spear.rho','convIt.mae','convIt.rmse')]
print(round(meanResListConvOut,2))## rho.cor pVal spear.rho mae rmse N convIt.rho.cor convIt.pVal
## seed 0.57 0.09 0.54 7.97 12.44 56 9 27
## all 0.75 0.02 0.24 9.79 14.19 56 14 NA
## aug 0.69 0.03 0.55 8.78 13.12 56 6 44
## shrink 0.70 0.03 0.57 8.54 12.83 56 6 NA
## metaSeed 0.82 0.07 0.73 15.53 20.46 56 16 52
## metaAll 0.65 0.18 0.39 17.54 22.87 56 10 36
## metaAug 0.83 0.05 0.70 15.94 20.93 56 16 NA
## metaAugShrink 0.85 0.05 0.71 15.40 20.25 56 10 NA
## convIt.spear.rho convIt.mae convIt.rmse
## seed 26 9 9
## all 29 5 5
## aug 23 12 10
## shrink 22 12 12
## metaSeed 18 18 14
## metaAll 56 14 14
## metaAug 34 18 14
## metaAugShrink 21 18 18Construct all the signature matrices 20 times with 5% tolerance
The result table shows the mean accuracy metrics of 20 iterations.
allResList<-loopTillConvergence(numLoops=20,fastStop=TRUE,exprData=scHenry,changePer=5,handMetaCluster=NULL,testOnHalf=TRUE)meanResList<-meanResults(allResList,changePer = 5)
meanResListOut<-meanResList[c('rho.cor','pVal','spear.rho','mae','rmse','N','convIt.rho.cor','convIt.pVal','convIt.spear.rho','convIt.mae','convIt.rmse')]
print(round(meanResListOut,2))## rho.cor pVal spear.rho mae rmse N convIt.rho.cor convIt.pVal
## seed 0.55 0.11 0.49 7.92 12.47 11 7 NA
## all 0.72 0.02 0.22 9.81 14.22 11 5 NA
## aug 0.66 0.05 0.51 8.90 13.23 11 6 NA
## shrink 0.67 0.04 0.54 8.74 13.06 11 6 NA
## metaSeed 0.85 0.05 0.74 15.59 20.44 11 8 NA
## metaAll 0.61 0.23 0.26 17.42 22.71 11 5 NA
## metaAug 0.88 0.03 0.64 16.07 20.98 11 6 NA
## metaAugShrink 0.90 0.02 0.65 15.48 20.26 11 5 NA
## convIt.spear.rho convIt.mae convIt.rmse
## seed 10 5 5
## all 10 5 5
## aug 10 6 5
## shrink 6 6 5
## metaSeed 8 7 7
## metaAll 11 6 7
## metaAug 10 7 7
## metaAugShrink 10 7 8