FRESA.CAD and Survival Analysis

Load the required libraries and data setup

library("epiR")
library("FRESA.CAD")
library(network)
library(GGally)
library("e1071")
a = as.numeric(Sys.time());
set.seed(a);

    # Get the stage C prostate cancer data from the rpart package
    library(rpart)
  data(stagec,package = "rpart")
  options(na.action = 'na.pass')
  dataCancer <- cbind(pgstat = stagec$pgstat,
                    pgtime = stagec$pgtime,
                    as.data.frame(model.matrix(Surv(pgtime,pgstat) ~ .,stagec))[-1])

  dataCancerImputed <- nearestNeighborImpute(dataCancer)
#> ..............
    # Remove the incomplete cases
    dataCancer <- dataCancer[complete.cases(dataCancer),]
    # Load a pre-stablished data frame with the names and descriptions of all variables
    data(cancerVarNames)
  dataCancer2 <- dataCancer 
  dataCancer2$pgtime <- NULL

Heat maps using FRESA.CAD



# the simple heat map
hm <- heatMaps(Outcome="pgstat",data=dataCancerImputed,title="Heat Map",Scale=FALSE) 

hm <- heatMaps(Outcome="pgstat",data=dataCancerImputed,title="Heat Map",Scale=TRUE) 


# transposing the heat-map with clustered colums
hm <- heatMaps(Outcome="pgstat",data=dataCancerImputed,title="Heat Map",Scale=TRUE,
               transpose= TRUE,hCluster = TRUE,
               cexRow=0.80,cexCol=0.50,srtCol=35) 


# transposing the heat-map with reds
hm <- heatMaps(Outcome="pgtime",data=dataCancerImputed,title="Heat Map",Scale=TRUE,
               theFiveColors=c("black","red","orange","yellow","white"),
               cexRow=0.50,cexCol=0.80,srtCol=35) 


#with the original data
hm <- heatMaps(cancerVarNames,varRank=NULL,Outcome="pgstat",data=dataCancer,title="Heat Map",hCluster=FALSE,prediction=NULL,Scale=TRUE,theFiveColors=c("blue","cyan","black","yellow","red"),outcomeColors = c("blue","lightgreen","yellow","orangered","red"),transpose=FALSE,cexRow=0.50,cexCol=0.80,srtCol=35)

Univariate Analysis

FRESA.CAD does several descriptive analysis of the data



UniRankFeaturesRaw <- univariateRankVariables(variableList = cancerVarNames,
                                                formula = "pgstat ~ 1+pgtime",
                                                Outcome = "pgstat",
                                                data = dataCancer, 
                                                categorizationType = "Raw", 
                                                type = "LOGIT", 
                                                rankingTest = "zIDI",
                                                description = "Description",
                                               uniType="Binary")

pander::pander(UniRankFeaturesRaw)
Table continues below
  Name parent
ploidytetraploid ploidytetraploid ploidytetraploid
grade grade grade
gleason gleason gleason
g2 g2 g2
ploidyaneuploid ploidyaneuploid ploidyaneuploid
age age age
eet eet eet
Table continues below
  descrip cohortMean cohortStd
ploidytetraploid the ploidy status: tetraploid 70 64
grade grade of the tumor, Farrow system 2.604 0.5883
gleason grade of the tumor, Gleason system 6.299 1.343
g2 # of cells in G2 phase 14.38 8.33
ploidyaneuploid the ploidy status: aneuploid 129 5
age Age at diagnosis 62.74 5.827
eet Early endocrine therapy (0 = yes, 1 = no) 32 102
Table continues below
  cohortKSD cohortKSP caseMean caseStd caseKSD
ploidytetraploid NA NA 17 32 NA
grade 0.3314 3.308e-13 2.939 0.5167 0.3839
gleason 0.147 0.00612 6.959 1.306 0.1814
g2 0.1553 0.003117 15.22 7.462 0.1977
ploidyaneuploid NA NA 45 4 NA
age 0.06926 0.5412 62.08 6.477 0.07434
eet NA NA 13 36 NA
Table continues below
  caseKSP caseZKSD caseZKSP controlMean
ploidytetraploid NA NA NA 53
grade 1.068e-06 0.3839 1.068e-06 2.412
gleason 0.07948 0.1814 0.07948 5.918
g2 0.04333 0.1977 0.04333 13.9
ploidyaneuploid NA NA NA 84
age 0.9494 0.07434 0.9494 63.12
eet NA NA NA 19
Table continues below
  controlStd controlKSD controlKSP controlZKSD
ploidytetraploid 32 NA NA NA
grade 0.541 0.3414 4.965e-09 0.3414
gleason 1.217 0.2099 0.00112 0.2099
g2 8.798 0.1966 0.002802 0.1966
ploidyaneuploid 1 NA NA NA
age 5.421 0.06781 0.8292 0.06781
eet 66 NA NA NA
Table continues below
  controlZKSP Beta t.Rawvalue t.Zvalue
ploidytetraploid NA 1.67 NA NA
grade 4.965e-09 1.377 -5.589 -5.589
gleason 0.00112 0.4624 -4.556 -4.556
g2 0.002802 0.05711 -0.9163 -0.9163
ploidyaneuploid NA 1.672 NA NA
age 0.8292 -0.03302 0.945 0.945
eet NA 0.1313 NA NA
Table continues below
  wilcox.Zvalue ZGLM zNRI zIDI ROCAUC
ploidytetraploid 2.86 3.252 3.218 2.793 0.8954
grade 4.781 2.741 5.327 2.368 0.8873
gleason 4.149 2.283 3.075 1.751 0.8807
g2 2.066 1.909 3.573 1.634 0.8675
ploidyaneuploid 1.736 0.9343 -3.856 0.867 0.8583
age 0.2375 0.8591 0.1448 0.787 0.8615
eet -0.2235 0.2488 -0.5384 0.1635 0.8589
Table continues below
  cStatCorr NRI IDI NeRI kendall.r
ploidytetraploid 0.6383 0.5532 0.0642 0.2687 0.2667
grade 0.7248 0.8029 0.04464 0.3284 0.4171
gleason 0.718 0.5297 0.02736 0.2537 0.3352
g2 0.6216 0.6079 0.0186 0.3582 0.1663
ploidyaneuploid 0.5349 -0.4956 0.005923 -0.08955 0.1775
age 0.5432 0.02593 0.004876 0 -0.06057
eet 0.5209 -0.08355 0.0002878 -0.1791 -0.04719
Table continues below
  kendall.p BinRes.p TstudentRes.p WilcoxRes.p
ploidytetraploid 0.002101 0.001186 7.386e-05 0.00385
grade 8.601e-07 9.007e-05 0.0006969 0.00313
gleason 1.648e-05 0.002094 0.007185 0.006891
g2 0.01929 2.056e-05 0.0199 0.0002405
ploidyaneuploid 0.04061 0.5 0.0722 1
age 0.4048 0.5344 0.1299 0.1704
eet 0.5863 0.5 0.4092 1
Table continues below
  FRes.p caseN_Z_Low_Tail caseN_Z_Hi_Tail
ploidytetraploid 0.0001442 0 0
grade 0.00171 0 0
gleason 0.01249 0 0
g2 0.02604 0 0
ploidyaneuploid 0.1314 0 0
age 0.1582 0 0
eet 0.3988 0 0
Table continues below
  controlN_Z_Low_Tail controlN_Z_Hi_Tail Sensitivity
ploidytetraploid 0 0 0.7347
grade 0 0 0.7143
gleason 0 0 0.6122
g2 0 0 0.6735
ploidyaneuploid 0 0 0.6735
age 0 0 0.7143
eet 0 0 0.6735
  Specificity
ploidytetraploid 0.8706
grade 0.8706
gleason 0.8941
g2 0.8824
ploidyaneuploid 0.9176
age 0.8941
eet 0.9059

COX Basic Modeling and Kaplan-Meier


# A simple BSIWMS Model


system.time(BSWiMSModel <- BSWiMS.model(formula = Surv(pgtime, pgstat) ~ 1, dataCancerImputed))

[+++] user system elapsed 0.62 0.00 0.25


BSWiMSModel$bagging$bagged.model$coefficients
 (Intercept)            grade          gleason ploidytetraploid 
   0.0000000        0.3634306        0.1748421        0.4126177

ploidyaneuploid 0.6322486

BSWiMSModel$bagging$bagged.model$estimations
 (Intercept)            grade          gleason ploidytetraploid 
  0.00000000       0.36343062       0.17484209       0.41261775

ploidyaneuploid (Intercept) grade gleason 0.63224859 1.00000000 2.67119565 6.41168478 ploidytetraploid ploidyaneuploid 0.49048913 0.09646739


comodel <- survival::coxph(formula = Surv(pgtime, pgstat) ~ 1, data=dataCancerImputed)



lrp <- EmpiricalSurvDiff(dataCancerImputed$pgtime,dataCancerImputed$pgstat,BSWiMSModel$BSWiMS.model$back.model$linear.predictors > 0,type="Chi",plots=TRUE,samples=50000,main="Log-Rank Chi Square Null Distribution")



lrp <- EmpiricalSurvDiff(dataCancerImputed$pgtime,dataCancerImputed$pgstat,BSWiMSModel$BSWiMS.model$back.model$linear.predictors > 0,type="SLR",plots=TRUE,samples=10000,main="Log-Rank SLR Null Distribution")



lrp <- EmpiricalSurvDiff(dataCancerImputed$pgtime,dataCancerImputed$pgstat,BSWiMSModel$BSWiMS.model$back.model$linear.predictors > 0,computeDist=TRUE,plots=TRUE,main="Log-Rank SLR Distribution")


lrp <- EmpiricalSurvDiff(dataCancerImputed$pgtime,dataCancerImputed$pgstat,BSWiMSModel$BSWiMS.model$back.model$linear.predictors > 0,type="Chi",computeDist=TRUE,plots=TRUE,main="Log-Rank SLR Square Distribution")


lrsurvdiff <- survdiff(Surv(pgtime,pgstat)~BSWiMSModel$BSWiMS.model$back.model$linear.predictors > 0,data=dataCancerImputed)

# I´ll  check its performance of the final model
sm <- summary(BSWiMSModel$BSWiMS.model$back.model)

if (!is.null(sm$coefficients))
{

  pander::pander(sm$coefficients)
  pv <- plot(sm$bootstrap)
  
  
  # THe equivalent model
  eq <- reportEquivalentVariables(BSWiMSModel$BSWiMS.model$back.model,data=dataCancer,
                                      variableList=cancerVarNames,Outcome = "pgstat",
                                      timeOutcome="pgtime",                               
                                      type = "COX");
  
  pander::pander(eq$equivalentMatrix)
}

Surv(pgtime, pgstat) ~ strata(x\(boot.model\)linear.predictors > strata.levels):

Name Locus Extended_Name UniPerformance
grade grade grade:grade 0.7007 
 gleason        grade       gleason:grade            0.6618

ploidytetraploid grade ploidytetraploid:grade 0.6383

Table continues below
FullPerformance DeltaPerformance ImprovementFraction p.value
0.7007 0.2007 0.4014 8.333e-09
0.6618 0.1618 0.3236 1.807e-06
0.6383 0.1383 0.2766 0.0007098 

#I'll create a bagged model using the forward selection formulas.
#useFreq=32 is the number of boostrap loops used in BSWiMS.model.
#For this example I 'll use 30 boostraps to estimate mean and the standard deviation of the coefficients
bagging <- baggedModel(BSWiMSModel$forward.selection.list,dataCancer,type="COX",useFreq=32,n_bootstrap = 30)

………………………++………………………………………………………………………………………………………………………………………………………………………………………………………………………

#Plot the prediction with 95% CI intervals
pm <- plotModels.ROC(cbind(dataCancer$pgstat,bagging$bagged.model$linear.predictors),main=("Bagged"))

#Chcking the diagnostic table
summary(epi.tests(pm$predictionTable))
           est        lower       upper

aprev 1.0000000 0.97284652 1.00000000 tprev 0.3656716 0.28421608 0.45320567 se 1.0000000 0.92748074 1.00000000 sp 0.0000000 0.00000000 0.04247034 diag.acc 0.3656716 0.28421608 0.45320567 diag.or NaN NaN NaN nnd Inf -13.78943952 23.54584404 youden 0.0000000 -0.07251926 0.04247034 ppv 0.3656716 0.28421608 0.45320567 npv NaN 0.00000000 1.00000000 plr 1.0000000 1.00000000 1.00000000 nlr NaN NaN NaN pro 0.0000000 0.00000000 0.02715348 pri 1.0000000 0.97284652 1.00000000 pfp 1.0000000 0.95752966 1.00000000 pfn 0.0000000 0.00000000 0.07251926



#Let me check the performance of the model 
sm <- summary(bagging$bagged.model)
pander::pander(sm$coefficients)
Table continues below
  Estimate lower OR upper u.Accuracy
grade 0.4777 1.425 1.612 1.824 0.6642
gleason 0.1752 1.126 1.191 1.26 0.6642
ploidytetraploid 0.3811 1.241 1.464 1.727 0.6217
ploidyaneuploid 0.8684 1.551 2.383 3.662 0.636
age -0.001382 0.9969 0.9986 1 0.5245
Table continues below
  r.Accuracy full.Accuracy u.AUC r.AUC full.AUC
grade 0.4106 0.6648 0.7007 0.522 0.6998
gleason 0.3971 0.6647 0.6618 0.5139 0.6631
ploidytetraploid 0.5877 0.6497 0.6253 0.5522 0.6581
ploidyaneuploid 0.6114 0.653 0.5308 0.6198 0.6558
age 0.6592 0.6493 0.519 0.6775 0.6589
  IDI NRI z.IDI z.NRI Frequency
grade 0.1762 0.7729 6.305 5.926 0.3021
gleason 0.1261 0.6349 5.426 4.494 0.3542
ploidytetraploid 0.06 0.5801 3.809 4.175 0.375
ploidyaneuploid 0.05417 0.5581 3.5 4.378 0.2604
age 0.01331 0.1747 1.258 1.167 0.03125 
plot(sm$coefficients[,1],sm$coefficients[,3])


#Using bootstraping object I can check the Jaccard Index
pander::pander(bagging$Jaccard.SM)

0.2944


#Ploting the evolution of the coefficient value
plot(bagging$coefEvolution$grade,main="Evolution of grade")

plot(bagging$coefEvolution$ploidytetraploid,main="Evolution of diploid")


#With FRESA.CAD I can do a leave-one-out (LOO) using the list of models
ep <- ensemblePredict(BSWiMSModel$forward.selection.list,dataCancer,predictType = "linear",type="LOGIT",Outcome="pgstat")

………….

#The ROC plots every single LOO prediction 
pm <- plotModels.ROC(ep$predictions,main=("LOO Median Predict"))

#We can also do the ROC plot of the final ensemble prediction
pm <- plotModels.ROC(cbind(dataCancer$pgstat,ep$ensemblePredict),main=("LOO Median Predict"))


#Bagging provides the feature-to-feature matrix that can be used to explore the association between features
gplots::heatmap.2(bagging$formulaNetwork,trace="none",mar=c(10,10),main="eB:SWIMS Formula Network")


#Bagging also provides the frequency of the features
barplot(bagging$frequencyTable,las = 2,cex.axis=1.0,cex.names=0.75,main="Feature Frequency")


# And the formula network can be displayed using ggnet2
n <- network::network(bagging$formulaNetwork, directed = FALSE,ignore.eval = FALSE,names.eval = "weights")
ggnet2(n, label = TRUE, size = "degree",size.cut = 3,size.min = 1, mode = "circle",edge.label = "weights",edge.label.size=4)

FRESA.Model with features that reduce clasification IDI

Cox proportional hazards model using the default parameters


    mdCOXs <- FRESA.Model(formula = Surv(pgtime, pgstat) ~ 1,data = dataCancer)

Unadjusted size: 4 Adjusted Size: 4 Cut size: 7

Z: 1.281552 , Features to test: 5 ,Adjust Size: 7 [+++]

    sm <- summary(mdCOXs$BSWiMS.model)
    if (!is.null(sm))
    {
    pander::pander(sm$coefficients)
    if (!is.null(sm$bootstrap)) pv <- plot(sm$bootstrap)
    }

FRESA.Model with features that reduce residual error significantly

Cox proportional hazards model using residual improvement:

    mdCOXs <- FRESA.Model(formula = Surv(pgtime, pgstat) ~ 1,data = dataCancer,OptType = "Residual" )

Doing a Ordinal Fit with zIDI Selection Ordinal Fit will be stored in BSWiMS.models\(oridinalModels Use predict(BSWiMS.models\)oridinalModels,testSet) to get the ordinal prediction on a new dataset Features to test: 5 Adjusted Size: 7

Z: 1.281552 Var Max: 7 FitType: COX Test Type: zIDI [+++]

    sm <- summary(mdCOXs$BSWiMS.model)
    pander::pander(sm$coefficients)
Table continues below
  Estimate lower OR upper u.Accuracy
grade 0.4262 1.371 1.531 1.711 0.6642
gleason 0.1201 1.084 1.128 1.173 0.6642
ploidytetraploid 0.4845 1.339 1.623 1.968 0.6343
ploidyaneuploid 0.9804 1.578 2.665 4.503 0.6567
Table continues below
  r.Accuracy full.Accuracy u.AUC r.AUC full.AUC
grade 0.3657 0.6642 0.7007 0.5 0.7007
gleason 0.3657 0.6642 0.6618 0.5 0.6618
ploidytetraploid 0.6567 0.6567 0.6383 0.5349 0.6732
ploidyaneuploid 0.6343 0.6567 0.5349 0.6383 0.6732
  IDI NRI z.IDI z.NRI Frequency
grade 0.2116 0.9412 7.525 7.143 0.3333
gleason 0.1152 0.6196 5.895 4.261 0.3333
ploidytetraploid 0.08431 0.7373 4.916 5.279 0.3333
ploidyaneuploid 0.0468 0.7373 3.663 5.279 0.3333

FRESA.Model second order models

Cox proportional hazards model using second order models:

    mdCOX <- FRESA.Model(formula = Surv(pgtime, pgstat) ~ 1,data = dataCancer,categorizationType="RawRaw")

Unadjusted size: 8 Adjusted Size: 11 Cut size: 11

Z: 1.281552 , Features to test: 8 ,Adjust Size: 11 [+++++++]

    sm <- summary(mdCOX$BSWiMS.model)
    pander::pander(sm$coefficients)
Table continues below
  Estimate lower OR upper u.Accuracy
I(grade * gleason) 0.01916 1.015 1.019 1.023 0.6766
grade 0.2456 1.217 1.278 1.343 0.6642
I(grade * grade) 0.0378 1.026 1.039 1.051 0.6642
gleason 0.08497 1.059 1.089 1.119 0.6642
I(gleason * gleason) 0.004291 1.003 1.004 1.006 0.6642
**I(grade * ploidytetraploid)** 0.04511 1.027 1.046 1.065 0.6343
**I(gleason * ploidytetraploid)** 0.01324 1.008 1.013 1.019 0.6343
Table continues below
  r.Accuracy full.Accuracy u.AUC r.AUC
I(grade * gleason) 0.3657 0.6766 0.6846 0.5
grade 0.3657 0.6642 0.7007 0.5
I(grade * grade) 0.3657 0.6642 0.7007 0.5
gleason 0.3657 0.6642 0.6618 0.5
I(gleason * gleason) 0.3657 0.6642 0.6618 0.5
**I(grade * ploidytetraploid)** 0.3657 0.6343 0.6383 0.5
**I(gleason * ploidytetraploid)** 0.3657 0.6343 0.6383 0.5
  full.AUC IDI NRI z.IDI z.NRI Frequency
I(grade * gleason) 0.6846 0.1962 0.8235 7.521 5.989 0.1429
grade 0.7007 0.2079 0.902 7.382 6.916 0.1429
I(grade * grade) 0.7007 0.151 0.7765 6.154 5.666 0.1429
gleason 0.6618 0.1365 0.7765 5.928 5.526 0.1429
I(gleason * gleason) 0.6618 0.09132 0.6118 5.182 4.204 0.1429
**I(grade * ploidytetraploid)** 0.6383 0.07514 0.6039 4.76 4.217 0.1429
**I(gleason * ploidytetraploid)** 0.6383 0.06121 0.6353 4.591 4.418 0.1429 

namesc <- names(mdCOX$BSWiMS.model$coefficients)[-1]
hm <- heatMaps(mdCOX$univariateAnalysis[namesc,],varRank=NULL,Outcome="pgstat",data=dataCancer,title="Heat Map",hCluster=FALSE,prediction=NULL,Scale=TRUE,theFiveColors=c("blue","cyan","black","yellow","red"),outcomeColors = c("blue","lightgreen","yellow","orangered","red"),transpose=FALSE,cexRow=0.50,cexCol=0.80,srtCol=35) 

    
# The LOO estimation
pm <- ensemblePredict(mdCOX$BSWiMS.models$formula.list,dataCancer,predictType = "linear",type="LOGIT",Outcome="pgstat")

………….

pm <- plotModels.ROC(cbind(dataCancer$pgstat,pm$ensemblePredict),main=("Second Order LOO Median Predict"))

## FRESA.Model now with logistic models

Getting a Logitmodel using the default parameters

    mdLOGIT <- FRESA.Model(formula = pgstat ~ 1,data = dataCancer2)
#> Unadjusted size: 4  Adjusted Size: 4  Cut size: 7 
#> 
#>  Z:  1.281552 , Features to test:  5 ,Adjust Size: 7 
#> [+++]
    mdLOGIT$bootstrappedModel$boot.model$coefficients
#> (Intercept)       grade 
#>   -4.789711    1.782101
    if (!is.null(mdLOGIT$bootstrappedModel)) pv <- plot(mdLOGIT$bootstrappedModel)

    pm <- plotModels.ROC(cbind(dataCancer2$pgstat,predict(mdLOGIT$BSWiMS.model,dataCancer2)))

    sm <- summary(mdLOGIT$BSWiMS.model)

FRESA.Model with Cross Validation and Recursive Partitioning and Regression Trees



md <- FRESA.Model(formula = Surv(pgtime, pgstat) ~ 1,data = dataCancer,CVfolds = 20,repeats = 5,equivalent = TRUE,usrFitFun=rpart)

pm <- plotModels.ROC(md$cvObject$LASSO.testPredictions,theCVfolds=20,main="CV LASSO",cex=0.90)

pm <- plotModels.ROC(md$cvObject$KNN.testPrediction,theCVfolds=20,main="KNN",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="Prediction",main="B:SWiMS Bagging",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="Ensemble.Forward",main="Forward Selection Median Ensemble",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="Forward.Selection.Bagged",main="Forward Selection Bagging",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="Forward",main="Forward Model",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="first.B.SWiMS",main="The First B:SWiMS Model",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="eB.SWiMS",main="The Equivalent B.SWiMS",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="Ensemble.B.SWiMS",main="B:SWiMS Median Ensemble",cex=0.90)


md$cvObject$Models.testPrediction[,"usrFitFunction"] <- md$cvObject$Models.testPrediction[,"usrFitFunction"] -0.5
md$cvObject$Models.testPrediction[,"usrFitFunction_Sel"] <- md$cvObject$Models.testPrediction[,"usrFitFunction_Sel"] -0.5

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="usrFitFunction",main="Recursive Partitioning and Regression Trees",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="usrFitFunction_Sel",main="Recursive Partitioning and Regression Trees with FS",cex=0.90)

FRESA.Model with Cross Validation, LOGISTIC and Support Vector Machine


md <- FRESA.Model(formula = pgstat ~ 1,data = dataCancer2,CVfolds = 20,repeats = 5,equivalent = TRUE,usrFitFun=svm)

pm <- plotModels.ROC(md$cvObject$LASSO.testPredictions,theCVfolds=20,main="CV LASSO",cex=0.90)

pm <- plotModels.ROC(md$cvObject$KNN.testPrediction,theCVfolds=20,main="KNN",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="Prediction",main="B:SWiMS Bagging",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="Ensemble.Forward",main="Forward Selection Median Ensemble",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="Forward.Selection.Bagged",main="Forward Selection Bagging",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="Forward",main="Forward Model",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="first.B.SWiMS",main="The First B:SWiMS Model",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="eB.SWiMS",main="The Equivalent B.SWiMS",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="Ensemble.B.SWiMS",main="B:SWiMS Median Ensemble",cex=0.90)


md$cvObject$Models.testPrediction[,"usrFitFunction"] <- md$cvObject$Models.testPrediction[,"usrFitFunction"] -0.5
md$cvObject$Models.testPrediction[,"usrFitFunction_Sel"] <- md$cvObject$Models.testPrediction[,"usrFitFunction_Sel"] -0.5
pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="usrFitFunction",main="Support Vector Machine",cex=0.90)

pm <- plotModels.ROC(md$cvObject$Models.testPrediction,theCVfolds=20,
                     predictor="usrFitFunction_Sel",main="Support Vector Machine with FS",cex=0.90)

Model Bagging of last run


par(mfrow=c(2,1))
baggMD <- baggedModel(md$cvObject$allBSWiMSFormulas.list,dataCancer2,type="LOGIT",Outcome="pgstat")

frac = 0.10*length(md$cvObject$formula.list)
toshow <- sum(baggMD$frequencyTable>=frac)
fnshow <- min(11,length(baggMD$frequencyTable))
barplot(baggMD$frequencyTable[1:toshow],las = 2,cex.axis=1.0,cex.names=0.75,main="Feature Frequency",mar=c(6.1,4.1,4.1,2.1))
barplot(baggMD$avgLogPvalues[1:toshow],las = 2,cex.axis=1.0,cex.names=0.75,main="Z-Values",mar=c(6.1,4.1,4.1,2.1))

par(mfrow=c(1,1))
if (toshow>1)
{
gplots::heatmap.2(baggMD$formulaNetwork[1:toshow,1:toshow],trace="none",mar=c(10,10),main="B:SWIMS Formula Network")

n <- network::network(baggMD$formulaNetwork[1:fnshow,1:fnshow], directed = FALSE,ignore.eval = FALSE,names.eval = "weights")

ggnet2(n, label = TRUE, size = "degree",size.cut = 3,size.min = 1, mode = "circle",edge.label = "weights",edge.label.size=4)
}