# 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.00

    print(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.00

### Construct 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          18

### Construct 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