Benchmarks for Recurence Risk

1 FRESA.CAD Regresion Benchmark

1.1 BRCA Recurence RISK Data Set

lesionsSumDiffRed <- NULL
load("RadiomicsBRCA.RDATA")



ExperimentName <- "HSJBC_Oncotype"
bswimsReps <- 20;
theData <- lesionsSumDiffRed;
theOutcome <- "Risk";
reps <- 150;
fraction <- 0.9;

BSWiMSFileName <- paste(ExperimentName,"FRESAMethod.RDATA",sep = "_")
CVFileName <- paste(ExperimentName,"CVMethod.RDATA",sep = "_")

1.2 Benchmark

BSWiMSMODEL <- BSWiMS.model(formula = paste(theOutcome," ~ 1"),data = theData,NumberofRepeats = -bswimsReps)
save(BSWiMSMODEL,file = BSWiMSFileName)
load(file = BSWiMSFileName)

cv <- randomCV(theData,
               theOutcome,
               BSWiMS.model,
               trainFraction = fraction,
               repetitions = reps,
               NumberofRepeats = 0);

ps <- predictionStats_regression(cv$medianTest,plotname = "eBSWiMS",cex = 0.8)

ps$pearson


par(mfrow = c(2,2),cex = 0.6);
cp <- RegresionBenchmark(referenceCV = cv,referenceName = "eBSWiMS",referenceFilterName = "eBSWiMS")

par(op );


save(cp,file = CVFileName)
load(file = CVFileName)

1.3 Results

1.3.1 Model Selection Results

hm <- heatMaps(Outcome = "Outcome",data = cp$testPredictions,title = "Heat Map",Scale = TRUE,hCluster = "col",cexRow = 0.25,cexCol = 0.75,srtCol = 45) 

#The Times
pander::pander(cp$cpuElapsedTimes)

eBSWiMS	RF	RPART	LASSO	SVM	ENS
1.603	1.372	0.1051	0.1878	0.008133	3.277

pr <- plot(cp,prefix = paste(ExperimentName,":"));

par(op);



pander::pander(pr$metrics,caption = ExperimentName,round = 3)

HSJBC_Oncotype

	eBSWiMS	LASSO	ENS	SVM	RPART	RF
Spearman	0.542	0.469	0.452	0.366	0.307	0.252
MAE	39.96	44.13	43.04	43.59	45.88	46.91
Pearson	0.482	0.318	0.39	0.326	0.272	0.219
RMSE	48.52	52.86	50.92	52.37	56.44	54.06
Bias	0.778	1.132	0.296	-1.529	-0.38	0.801

pander::pander(pr$metrics_filter,caption = ExperimentName,round = 3)

HSJBC_Oncotype (continued below)

	eBSWiMS	Pearson	LASSO	F-Test	RF.ref	Kendall	RPART
Spearman	0.561	0.532	0.493	0.516	0.42	0.442	0.427
MAE	38.68	41.27	42.64	40.33	43.52	42.4	44
Pearson	0.511	0.441	0.393	0.456	0.352	0.392	0.338
RMSE	48.07	50.71	54.79	50.61	52.99	52.13	54.34
Bias	0.818	0.119	1.254	0.135	1.181	1.857	0.843

	mRMR	W-Test
Spearman	0.23	0.15
MAE	100.4	50.03
Pearson	0.215	0.162
RMSE	137	57.52
Bias	-13.45	-1.336

pander::pander(pr$fttable,caption = ExperimentName,round = 3)

HSJBC_Oncotype (continued below)

	eBSWiMS	RF	LASSO	RPART	SVM.mRMR	Ensemble
eBSWiMS	1	1	1	1	1	1
RF	0	1	0.075	1	0.034	0.004
LASSO	0.001	1	1	1	0.252	0.022
RPART	0	0.014	0.002	1	0.001	0
SVM.mRMR	0.001	1	1	1	1	0.047
Ensemble	0.009	1	1	1	1	1
RIDGE.eBSWiMS	1	1	1	1	1	1
RIDGE.LASSO	0	0.062	0.01	1	0.005	0.001
RIDGE.RPART	0	0.223	0.031	1	0.015	0.002
RIDGE.RF.ref	0	1	0.093	1	0.042	0.004
RIDGE.FT	0.018	1	1	1	1	1
RIDGE.Wt	0	0.171	0.025	1	0.012	0.001
RIDGE.Pearson	0.006	1	1	1	1	0.402
RIDGE.Kendall	0.001	1	1	1	1	0.049
RIDGE.mRMR	0	0	0	0	0	0

Table continues below

	RIDGE.eBSWiMS	RIDGE.LASSO	RIDGE.RPART	RIDGE.RF.ref
eBSWiMS	0.445	1	1	1
RF	0	1	1	0.553
LASSO	0	1	1	1
RPART	0	0.108	0.032	0.011
SVM.mRMR	0.001	1	1	1
Ensemble	0.007	1	1	1
RIDGE.eBSWiMS	1	1	1	1
RIDGE.LASSO	0	1	0.157	0.05
RIDGE.RPART	0	1	1	0.176
RIDGE.RF.ref	0	1	1	1
RIDGE.FT	0.013	1	1	1
RIDGE.Wt	0	1	0.532	0.136
RIDGE.Pearson	0.004	1	1	1
RIDGE.Kendall	0.001	1	1	1
RIDGE.mRMR	0	0	0	0

Table continues below

	RIDGE.FT	RIDGE.Wt	RIDGE.Pearson	RIDGE.Kendall
eBSWiMS	1	1	1	1
RF	0.002	1	0.005	0.033
LASSO	0.011	1	0.033	0.239
RPART	0	0.04	0	0.001
SVM.mRMR	0.023	1	0.072	0.789
Ensemble	0.274	1	1	1
RIDGE.eBSWiMS	1	1	1	1
RIDGE.LASSO	0	0.204	0.001	0.005
RIDGE.RPART	0.001	1	0.002	0.014
RIDGE.RF.ref	0.002	1	0.007	0.04
RIDGE.FT	1	1	1	1
RIDGE.Wt	0.001	1	0.002	0.011
RIDGE.Pearson	0.168	1	1	1
RIDGE.Kendall	0.024	1	0.075	1
RIDGE.mRMR	0	0	0	0

	RIDGE.mRMR
eBSWiMS	1
RF	1
LASSO	1
RPART	1
SVM.mRMR	1
Ensemble	1
RIDGE.eBSWiMS	1
RIDGE.LASSO	1
RIDGE.RPART	1
RIDGE.RF.ref	1
RIDGE.FT	1
RIDGE.Wt	1
RIDGE.Pearson	1
RIDGE.Kendall	1
RIDGE.mRMR	1

1.3.2 Radar Plots

op <- par(no.readonly = TRUE)

library(fmsb)
par(mfrow = c(1,2),xpd = TRUE,pty = "s",mar = c(1,1,1,1))

mNames <- names(cp$cpuElapsedTimes)


classRanks <- c(pr$minMaxMetrics$Pearson[2],pr$minMaxMetrics$RMSE[1],pr$minMaxMetrics$Spearman[2],pr$minMaxMetrics$MAE[1],min(cp$cpuElapsedTimes))
classRanks <- rbind(classRanks,c(0,pr$minMaxMetrics$RMSE[2],0,pr$minMaxMetrics$MAE[2],max(cp$cpuElapsedTimes)))
classRanks <- as.data.frame(rbind(classRanks,cbind(t(pr$metrics[c("Pearson","RMSE","Spearman","MAE"),mNames]),cp$cpuElapsedTimes)))
colnames(classRanks) <- c("Pearson","RMSE","Spearman","MAE","CPU")

classRanks$RMSE <- -classRanks$RMSE
classRanks$MAE <- -classRanks$MAE
classRanks$CPU <- -classRanks$CPU

colors_border = c( rgb(1.0,0.0,0.0,1.0), rgb(0.0,1.0,0.0,1.0) , rgb(0.0,0.0,1.0,1.0), rgb(0.2,0.2,0.0,1.0), rgb(0.0,1.0,1.0,1.0), rgb(1.0,0.0,1.0,1.0) )
colors_in = c( rgb(1.0,0.0,0.0,0.1), rgb(0.0,1.0,0.0,0.1) , rgb(0.0,0.0,1.0,0.1),rgb(1.0,1.0,0.0,0.1), rgb(0.0,1.0,1.0,0.1) , rgb(1.0,0.0,1.0,0.1) )
radarchart(classRanks,axistype = 0,maxmin = T,pcol = colors_border,pfcol = colors_in,plwd = c(6,2,2,2,2,2),plty = 1, cglcol = "grey", cglty = 1,axislabcol = "black",cglwd = 0.8, vlcex  = 0.6 ,title = "Prediction Model")

legend("topleft",legend = rownames(classRanks[-c(1,2),]),bty = "n",pch = 20,col = colors_in,text.col = colors_border,cex = 0.5,pt.cex = 2)


filnames <- c("eBSWiMS","LASSO","RF.ref","F-Test","Kendall","mRMR")

filterRanks <- c(pr$minMaxMetrics$Pearson[2],pr$minMaxMetrics$RMSE[1],pr$minMaxMetrics$Spearman[2],pr$minMaxMetrics$MAE[1],max(cp$jaccard),min(cp$featsize));

filterRanks <- rbind(filterRanks,c(0,pr$minMaxMetrics$RMSE[2],0,pr$minMaxMetrics$MAE[2],0,max(cp$featsize)));

filterRanks <- as.data.frame(rbind(filterRanks,cbind(t(pr$metrics_filter[c("Pearson","RMSE","Spearman","MAE"),filnames]),cp$jaccard[filnames],cp$featsize[filnames])));
colnames(filterRanks) <- c("Pearson","RMSE","Spearman","MAE","Jaccard","SIZE")
filterRanks$RMSE <- -filterRanks$RMSE
filterRanks$MAE <- -filterRanks$MAE
filterRanks$SIZE <- -filterRanks$SIZE

colors_border = c( rgb(1.0,0.0,0.0,1.0), rgb(0.0,1.0,0.0,1.0) , rgb(0.0,0.0,1.0,1.0), rgb(0.2,0.2,0.0,1.0), rgb(0.0,1.0,1.0,1.0),rgb(1.0,0.0,1.0,1.0) )
colors_in = c( rgb(1.0,0.0,0.0,0.1), rgb(0.0,1.0,0.0,0.1) , rgb(0.0,0.0,1.0,0.1),rgb(1.0,1.0,0.0,0.1), rgb(0.0,1.0,1.0,0.1), rgb(1.0,0.0,1.0,0.1)  )
radarchart(filterRanks,axistype = 0,maxmin = T,pcol = colors_border,pfcol = colors_in,plwd = c(6,2,2,2,2,2),plty = 1, cglcol = "grey", cglty = 1,axislabcol = "black",cglwd = 0.8, vlcex  = 0.6,title = "Filter Method" )


legend("topleft",legend = rownames(filterRanks[-c(1,2),]),bty = "n",pch = 20,col = colors_in,text.col = colors_border,cex = 0.5,pt.cex = 2)

par(mfrow = c(1,1))

par(op)

1.3.3 Features Analysis

pander::pander(summary(BSWiMSMODEL),caption = "Model",round = 3)

• coefficients:

  Table continues below

  	Estimate	lower	mean	upper
  S_CC_GLCM_4_Inertia	-1.958	-2.774	-1.958	-1.143
  S_CC_FRACTAL_ICDF_0.05	0.01417	0.008142	0.01417	0.0202
  S_CC_FRACTAL_Mean	0.0273	0.01556	0.0273	0.03903
  S_CC_GLCM_2_Inertia	-2.284	-3.296	-2.284	-1.273
  D_CC_LH_3_ICDF_0.99	-0.6938	-1.002	-0.6938	-0.3855
  S_CC_FRACTAL_ICDF_0.95	0.05027	0.02777	0.05027	0.07276
  S_CC_FRACTAL_ICDF_0.75	0.02811	0.01503	0.02811	0.04118
  D_CC_HL_4_ICDF_0.999	-0.07754	-0.1154	-0.07754	-0.03971
  S_CC_HH_4_ICDF_0.95	-0.05052	-0.07535	-0.05052	-0.0257
  S_CC_GLCM_4_DiffMoment	3.411	1.588	3.411	5.234
  S_CC_LH_2_z_Mean	-11.26	-17.39	-11.26	-5.133
  D_CC_LSTD_Entropy	-4.096	-6.365	-4.096	-1.827
  S_CC_HL_3_ICDF_0.75	-0.02054	-0.03196	-0.02054	-0.009117
  D_CC_LH_3_ICDF_0.999	-0.003321	-0.005182	-0.003321	-0.001461
  S_CC_LH_2_Mean	-0.0762	-0.1225	-0.0762	-0.02993

  Table continues below

  	u.MSE	r.MSE	model.MSE	NeRI	F.pvalue
  S_CC_GLCM_4_Inertia	2684	2152	1573	0.3921	1.245e-06
  S_CC_FRACTAL_ICDF_0.05	2575	2166	1606	0.2278	2.035e-06
  S_CC_FRACTAL_Mean	2473	2144	1597	0.5211	2.576e-06
  S_CC_GLCM_2_Inertia	2772	2144	1624	0.4085	4.82e-06
  D_CC_LH_3_ICDF_0.99	2443	2152	1632	0.2151	5.164e-06
  S_CC_FRACTAL_ICDF_0.95	2422	2144	1634	0.4366	5.949e-06
  S_CC_FRACTAL_ICDF_0.75	2483	2144	1667	0.4366	1.254e-05
  D_CC_HL_4_ICDF_0.999	2750	2052	1632	0.1199	2.944e-05
  S_CC_HH_4_ICDF_0.95	2745	2148	1715	0.3164	3.325e-05
  S_CC_GLCM_4_DiffMoment	2813	2212	1831	0.3052	0.0001227
  S_CC_LH_2_z_Mean	2629	2427	2019	0.2207	0.0001582
  D_CC_LSTD_Entropy	2828	2382	1994	0.2042	0.0002013
  S_CC_HL_3_ICDF_0.75	2734	2226	1868	0.2732	0.000212
  D_CC_LH_3_ICDF_0.999	2503	2502	2105	0.2019	0.0002338
  S_CC_LH_2_Mean	2586	2340	2018	0.1362	0.0006241

  	t.pvalue	Sign.pvalue	Wilcox.pvalue	Frequency
  S_CC_GLCM_4_Inertia	2.232e-06	0.0005379	0.0002089	0.1958
  S_CC_FRACTAL_ICDF_0.05	2.361e-05	0.03322	0.003642	0.1752
  S_CC_FRACTAL_Mean	1.765e-05	6.263e-06	0.0001584	0.2061
  S_CC_GLCM_2_Inertia	1.546e-06	0.0003834	0.0001036	0.1134
  D_CC_LH_3_ICDF_0.99	8.179e-05	0.03241	0.006667	1.278
  S_CC_FRACTAL_ICDF_0.95	1.665e-05	0.0001516	0.0009588	0.2061
  S_CC_FRACTAL_ICDF_0.75	3.53e-05	0.0001516	0.0002721	0.1855
  D_CC_HL_4_ICDF_0.999	0.0006527	0.1671	0.0131	1.278
  S_CC_HH_4_ICDF_0.95	6.923e-06	0.005025	0.001306	0.1546
  S_CC_GLCM_4_DiffMoment	0.0001297	0.00583	0.002947	0.03092
  S_CC_LH_2_z_Mean	0.005981	0.04028	0.03281	0.03092
  D_CC_LSTD_Entropy	0.0003903	0.0533	0.01385	0.04122
  S_CC_HL_3_ICDF_0.75	0.0003362	0.0103	0.006352	0.05153
  D_CC_LH_3_ICDF_0.999	0.001863	0.04326	0.02312	0.03092
  S_CC_LH_2_Mean	0.005942	0.1464	0.03999	0.03092

• MSE: 1479

• R2: 0.5231

• bootstrap:

topFeat <- min(ncol(BSWiMSMODEL$bagging$formulaNetwork),30);
shortformulaNetwork <- BSWiMSMODEL$bagging$formulaNetwork[1:topFeat,1:topFeat]
validf <- diag(shortformulaNetwork) > 0.1
gplots::heatmap.2(log(shortformulaNetwork[validf,validf]+1),trace="none",mar = c(10,10),main = "B:SWiMS Formula Network",cexRow = 0.65,cexCol = 0.65)

rm <- rowMeans(cp$featureSelectionFrequency[,c("eBSWiMS","LASSO","RPART","RF.ref","W-Test","Kendall","mRMR")])
selFrequency <- cp$featureSelectionFrequency[rm > 0.10,]


gplots::heatmap.2(selFrequency,trace = "none",mar = c(10,10),main = "Features",cexRow = 0.6)

hm <- heatMaps(Outcome = theOutcome,data = theData[,c(theOutcome,rownames(selFrequency))],title = "Heat Map",Scale = TRUE,hCluster = "col",cexRow = 0.25,cexCol = 0.65,srtCol = 45)

vlist <- rownames(selFrequency)
vlist <- cbind(vlist,vlist)
univ <- univariateRankVariables(variableList = vlist,formula = paste(theOutcome,"~1"),Outcome = theOutcome,data = theData,type = "LM",rankingTest = "Ztest",uniType = "Regression")[,c("cohortMean","cohortStd","kendall.r","kendall.p")] 

cnames <- colnames(univ);
univ <- cbind(univ,rm[rownames(univ)])
colnames(univ) <- c(cnames,"Frequency")
univ <- univ[order(-univ[,5]),]
pander::pander(univ[1:topFeat,],caption = "Features",round = 4)

Features (continued below)

	cohortMean	cohortStd	kendall.r	kendall.p
D_CC_LH_3_ICDF_0.99	35.97	31.92	-0.3089	2e-04
S_CC_FRACTAL_ICDF_0.95	71.32	70.92	0.3296	0
S_CC_FRACTAL_Mean	152.2	138.7	0.3368	0
D_CC_LH_3_ICDF_0.999	87.35	76.42	-0.2566	0.0016
S_CC_LH_2_Mean	0.929	3.779	-0.2636	0.0011
S_CC_FRACTAL_ICDF_0.75	111.4	110.5	0.3356	0
D_CC_LH_3_ICDF_0.001	77.06	76.95	-0.2259	0.0054
D_CC_HL_4_ICDF_0.999	222.5	259.7	-0.1874	0.021
S_CC_GLCM_4_Inertia	-0.2624	1.877	-0.2451	0.0025
D_CC_HL_3_ICDF_0.99	46.15	43.31	-0.2681	0.001
S_CC_FRACTAL_ICDF_0.05	251.7	223.9	0.2577	0.0015
D_CC_HH_4_CDF_g2s	0.009	0.0076	-0.2097	0.0097
D_CC_LH_3_ICDF_0.01	33.54	27.6	-0.2219	0.0065
S_CC_FRACTAL_Entropy	-0.1819	0.333	-0.1903	0.0189
S_CC_HL_4_ICDF_0.01	123.8	323.5	0.2835	5e-04
D_CC_LH_4_ICDF_0.99	90.27	98.4	-0.2606	0.0013
S_CC_LH_2_z_Mean	0.0102	0.0334	-0.241	0.0029

	Frequency
D_CC_LH_3_ICDF_0.99	0.7819
S_CC_FRACTAL_ICDF_0.95	0.6352
S_CC_FRACTAL_Mean	0.5638
D_CC_LH_3_ICDF_0.999	0.5267
S_CC_LH_2_Mean	0.5
S_CC_FRACTAL_ICDF_0.75	0.4819
D_CC_LH_3_ICDF_0.001	0.4533
D_CC_HL_4_ICDF_0.999	0.4219
S_CC_GLCM_4_Inertia	0.3838
D_CC_HL_3_ICDF_0.99	0.3752
S_CC_FRACTAL_ICDF_0.05	0.341
D_CC_HH_4_CDF_g2s	0.2981
D_CC_LH_3_ICDF_0.01	0.281
S_CC_FRACTAL_Entropy	0.2581
S_CC_HL_4_ICDF_0.01	0.2467
D_CC_LH_4_ICDF_0.99	0.2448
S_CC_LH_2_z_Mean	0.2352