Benchmarks for Body FAT

1 FRESA.CAD Benchmark

1.1 Modeling Body FAT

data("bodyfat", package = "TH.data")
bodyfat_mat <- as.data.frame(model.matrix(DEXfat~.*.,bodyfat))
bodyfat_mat$`(Intercept)` <- NULL
bodyfat_mat$DEXfat <- bodyfat$DEXfat
fnames <- colnames(bodyfat_mat)
fnames <- str_replace_all(fnames,":",".")
colnames(bodyfat_mat) <- fnames


ExperimentName <- "bodyfat"
bswimsReps <- 20;
theData <- bodyfat_mat;
theOutcome <- "DEXfat";
reps <- 150;
fraction <- 0.9;

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

1.2 Benchmark

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

par(mfrow = c(2,2));

cp <- RegresionBenchmark(theData = theData, theOutcome = theOutcome, reps = reps, trainFraction = fraction)

par(mfrow = c(1,1),cex=1.0);

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)

BSWiMS	RF	RPART	LASSO	SVM	ENS
1.093	0.07547	0.003933	0.1365	0.003733	1.313

par(mfrow = c(2,1));
pr <- plot(cp,prefix = paste(ExperimentName,":"));

par(mfrow = c(1,1));

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

bodyfat

	LASSO	ENS	BSWiMS	RF	SVM	RPART
Spearman	0.965	0.964	0.962	0.961	0.953	0.922
MAE	2.578	2.373	2.512	2.435	2.808	3.659
Pearson	0.948	0.951	0.95	0.955	0.927	0.896
RMSE	3.491	3.441	3.431	3.331	4.258	4.877
Bias	0.015	-0.151	-0.04	-0.066	-0.514	-0.198

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

bodyfat (continued below)

	RPART	LASSO	Kendall	W-Test	mRMR	BSWiMS	RF.ref
Spearman	0.96	0.963	0.958	0.958	0.958	0.958	0.957
MAE	2.477	2.562	2.583	2.664	2.607	2.618	2.603
Pearson	0.948	0.947	0.942	0.94	0.943	0.943	0.945
RMSE	3.496	3.521	3.697	3.755	3.65	3.67	3.585
Bias	-0.021	-0.076	-0.115	-0.068	-0.075	-0.135	-0.12

	Pearson	F-Test
Spearman	0.955	0.95
MAE	2.705	2.756
Pearson	0.94	0.939
RMSE	3.765	3.799
Bias	-0.163	-0.15

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("BSWiMS","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
  waistcirc.anthro3c	0.005557	0.003478	0.005557	0.007635
  anthro3a.anthro3c	0.121	0.08946	0.121	0.1526
  elbowbreadth.anthro3a	0.04667	0.03668	0.04667	0.05666
  age.hipcirc	0.0001734	0.0001435	0.0001734	0.0002032
  age.elbowbreadth	-0.002631	-0.003271	-0.002631	-0.001991
  hipcirc.anthro3b	0.008121	0.006055	0.008121	0.01019
  anthro3b.anthro3c	0.1136	0.07795	0.1136	0.1493
  hipcirc.elbowbreadth	0.01181	0.007654	0.01181	0.01596
  waistcirc.kneebreadth	0.002212	0.001399	0.002212	0.003024
  elbowbreadth	-1.585	-2.182	-1.585	-0.9889
  anthro3b	0.3889	0.2398	0.3889	0.5381
  waistcirc.elbowbreadth	0.005002	0.003016	0.005002	0.006987
  waistcirc.anthro3b	0.008016	0.00451	0.008016	0.01152
  hipcirc.anthro3a	0.007694	0.004312	0.007694	0.01108
  waistcirc.anthro3a	0.008243	0.004613	0.008243	0.01187
  waistcirc.hipcirc	0.0002563	0.0001427	0.0002563	0.00037
  hipcirc	0.04504	0.02502	0.04504	0.06505
  kneebreadth.anthro3c	0.0291	0.01575	0.0291	0.04245
  hipcirc.anthro3c	0.009718	0.005174	0.009718	0.01426
  elbowbreadth.anthro3c	-0.0731	-0.1078	-0.0731	-0.03839
  anthro3c	-0.1426	-0.2134	-0.1426	-0.07186
  hipcirc.kneebreadth	0.002508	0.001227	0.002508	0.003789
  waistcirc	0.02929	0.0142	0.02929	0.04438
  anthro3a	0.05865	0.02686	0.05865	0.09043
  kneebreadth	0.3072	0.1345	0.3072	0.4798
  elbowbreadth.kneebreadth	0.01258	0.005313	0.01258	0.01985
  kneebreadth.anthro3a	0.1324	0.0487	0.1324	0.216
  anthro4	0.1311	0.04373	0.1311	0.2186
  kneebreadth.anthro3b	0.05274	0.01667	0.05274	0.0888
  elbowbreadth.anthro3b	0.01007	0.0005135	0.01007	0.01963

  Table continues below

  	u.MSE	r.MSE	model.MSE	NeRI	F.pvalue
  waistcirc.anthro3c	17.48	15.62	10.45	0.2324	0
  anthro3a.anthro3c	29.33	23.41	12.14	0.2989	0
  elbowbreadth.anthro3a	42.27	41.94	19.65	0.3052	0
  age.hipcirc	83.47	37.06	19.65	0.3427	0
  age.elbowbreadth	105.2	34.21	13.63	0.1972	3.925e-16
  hipcirc.anthro3b	13.66	21.16	9.124	0.4085	6.661e-15
  anthro3b.anthro3c	33.99	17.18	9.83	0.2777	2.158e-10
  hipcirc.elbowbreadth	37.48	16.38	10.42	0.3254	1.256e-08
  waistcirc.kneebreadth	21.16	13.66	9.124	0.2394	4.798e-08
  elbowbreadth	105.2	15.68	10.65	0.3014	9.495e-08
  anthro3b	41.52	19.17	13.97	0.3005	1.607e-07
  waistcirc.elbowbreadth	32.8	17.27	11.47	0.2629	3.952e-07
  waistcirc.anthro3b	14.75	12.48	9.383	0.2915	3.724e-06
  hipcirc.anthro3a	13.57	13.5	9.972	0.2225	4.129e-06
  waistcirc.anthro3a	14.99	13.65	10.16	0.2887	4.287e-06
  waistcirc.hipcirc	17.65	13.22	9.757	0.3592	4.941e-06
  hipcirc	22.37	12.44	9.441	0.3028	5.16e-06
  kneebreadth.anthro3c	21.89	14.43	10.85	0.1367	9.724e-06
  hipcirc.anthro3c	16.71	12.97	9.991	0.1761	1.386e-05
  elbowbreadth.anthro3c	40.03	15.29	12.05	0.2254	1.829e-05
  anthro3c	41.43	13.07	10.38	0.1831	3.899e-05
  hipcirc.kneebreadth	25.05	12.05	9.711	0.1634	6.197e-05
  waistcirc	23.13	12.24	9.972	0.2113	7.129e-05
  anthro3a	35.99	12.42	10.18	0.1873	0.0001493
  kneebreadth	49.3	12.98	10.72	0.1634	0.0002437
  elbowbreadth.kneebreadth	61.5	13.02	10.93	0.09233	0.0003466
  kneebreadth.anthro3a	21	10.74	9.374	0.02394	0.0009648
  anthro4	38.79	12.04	10.67	0.1509	0.001639
  kneebreadth.anthro3b	20.33	10.98	9.774	0.02113	0.002078
  elbowbreadth.anthro3b	43.95	22.79	21.86	0.01408	0.01945

  Table continues below

  	t.pvalue	Sign.pvalue	Wilcox.pvalue
  waistcirc.anthro3c	5.965e-05	0.01964	0.003897
  anthro3a.anthro3c	3.107e-07	0.006647	0.0003371
  elbowbreadth.anthro3a	8.306e-09	0.003046	0.000303
  age.hipcirc	9.277e-08	0.000992	0.0002333
  age.elbowbreadth	5.224e-08	0.05228	0.001038
  hipcirc.anthro3b	3.709e-09	0.0003834	2.581e-05
  anthro3b.anthro3c	1.924e-07	0.01223	0.0002052
  hipcirc.elbowbreadth	0.0001101	0.003016	0.002826
  waistcirc.kneebreadth	0.0006276	0.02841	0.01281
  elbowbreadth	1.044e-05	0.00685	0.0009704
  anthro3b	1.005e-05	0.001716	0.001208
  waistcirc.elbowbreadth	5.823e-05	0.01062	0.003884
  waistcirc.anthro3b	2.218e-05	0.008977	0.002291
  hipcirc.anthro3a	0.0007218	0.03766	0.01272
  waistcirc.anthro3a	0.0001096	0.009536	0.003287
  waistcirc.hipcirc	9.668e-05	0.001385	0.002259
  hipcirc	0.0004569	0.006471	0.008303
  kneebreadth.anthro3c	0.01058	0.1032	0.0689
  hipcirc.anthro3c	0.002567	0.04923	0.02422
  elbowbreadth.anthro3c	0.0006046	0.03507	0.007349
  anthro3c	0.008535	0.04156	0.04227
  hipcirc.kneebreadth	0.08004	0.102	0.1239
  waistcirc	0.0006319	0.04796	0.00805
  anthro3a	0.008718	0.04795	0.04079
  kneebreadth	0.1096	0.09026	0.1385
  elbowbreadth.kneebreadth	0.08147	0.2492	0.1757
  kneebreadth.anthro3a	0.1539	0.3257	0.4906
  anthro4	0.06526	0.1159	0.1381
  kneebreadth.anthro3b	0.2553	0.4651	0.2869
  elbowbreadth.anthro3b	0.3905	0.3985	0.6108

  	Frequency
  waistcirc.anthro3c	0.8
  anthro3a.anthro3c	0.45
  elbowbreadth.anthro3a	0.15
  age.hipcirc	0.15
  age.elbowbreadth	0.1
  hipcirc.anthro3b	1
  anthro3b.anthro3c	0.7
  hipcirc.elbowbreadth	1
  waistcirc.kneebreadth	1
  elbowbreadth	1
  anthro3b	0.3
  waistcirc.elbowbreadth	0.6
  waistcirc.anthro3b	1
  hipcirc.anthro3a	1
  waistcirc.anthro3a	1
  waistcirc.hipcirc	1
  hipcirc	1
  kneebreadth.anthro3c	0.85
  hipcirc.anthro3c	1
  elbowbreadth.anthro3c	0.3
  anthro3c	0.4
  hipcirc.kneebreadth	1
  waistcirc	1
  anthro3a	1
  kneebreadth	1
  elbowbreadth.kneebreadth	0.45
  kneebreadth.anthro3a	1
  anthro4	0.35
  kneebreadth.anthro3b	1
  elbowbreadth.anthro3b	0.1

• MSE: 9.16
• R2: 0.9249

• bootstrap:

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

rm <- rowMeans(cp$featureSelectionFrequency[,c("BSWiMS","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
hipcirc.anthro3b	455.3	89.46	0.8349	0
hipcirc.kneebreadth	986.8	192.2	0.7011	0
hipcirc	105.3	11.04	0.7782	0
waistcirc.hipcirc	9333	2437	0.814	0
hipcirc.elbowbreadth	686.9	98.95	0.6677	0
kneebreadth.anthro3b	40.13	7.356	0.7475	0
waistcirc.anthro3a	343	89.45	0.81	0
waistcirc.anthro3b	379.7	94.11	0.8079	0
waistcirc.kneebreadth	822	201.7	0.7338	0
waistcirc.elbowbreadth	571.3	113.4	0.6788	0
kneebreadth.anthro3c	36.42	7.73	0.7448	0
hipcirc.anthro3c	413.3	93.37	0.8124	0
hipcirc.anthro3a	411	85.86	0.8065	0
waistcirc.anthro3c	345.3	95.42	0.7961	0
waistcirc	87.38	14.03	0.7465	0
kneebreadth	9.301	0.9136	0.5464	0
elbowbreadth	6.508	0.4563	0.2566	0.0021
age.anthro3c	199.7	64.04	0.4159	0
kneebreadth.anthro3a	36.24	7.131	0.7228	0
age.waistcirc	4488	1455	0.4722	0
hipcirc.anthro4	573.1	116.1	0.8301	0
elbowbreadth.kneebreadth	60.73	8.798	0.4786	0
elbowbreadth.anthro3c	25.35	4.379	0.6495	0
waistcirc.anthro4	478.2	121.8	0.8108	0
anthro3b.anthro3c	16.93	3.939	0.7093	0
age.hipcirc	5381	1580	0.3946	0
age.elbowbreadth	330.6	88.88	0.2284	0.0049
anthro3a.anthro3c	15.27	3.669	0.7335	0
age.kneebreadth	474.6	136.1	0.3057	2e-04
anthro3c	3.886	0.5647	0.6721	0

	Frequency
hipcirc.anthro3b	0.9314
hipcirc.kneebreadth	0.8457
hipcirc	0.8305
waistcirc.hipcirc	0.78
hipcirc.elbowbreadth	0.7524
kneebreadth.anthro3b	0.7476
waistcirc.anthro3a	0.7381
waistcirc.anthro3b	0.7114
waistcirc.kneebreadth	0.6952
waistcirc.elbowbreadth	0.6676
kneebreadth.anthro3c	0.6333
hipcirc.anthro3c	0.6257
hipcirc.anthro3a	0.5581
waistcirc.anthro3c	0.5495
waistcirc	0.541
kneebreadth	0.5162
elbowbreadth	0.4286
age.anthro3c	0.4229
kneebreadth.anthro3a	0.419
age.waistcirc	0.4171
hipcirc.anthro4	0.3981
elbowbreadth.kneebreadth	0.38
elbowbreadth.anthro3c	0.3667
waistcirc.anthro4	0.3552
anthro3b.anthro3c	0.3524
age.hipcirc	0.3114
age.elbowbreadth	0.3067
anthro3a.anthro3c	0.2981
age.kneebreadth	0.281
anthro3c	0.2333