FDeA and the GDSTM: DARWIN Data Set
Effect of GDSTM-Based Decorrelation on Feature Discovery: The DARWIN Evaluation
Here I showcase of to use BSWiMS feature selection/modeling function coupled with Goal Driven Sparse Transformation Matrix (GDSTM) as a pre-processing step to decorrelate highly correlated features. The aim(s) are:
To improve model performance by uncovering the hidden information between correlated features.
To simplify the interpretation of the machine learning models.
This demo will use:
FRESA.CAD::GDSTMDecorrelation(). For Decorrelation of Multidimensional data sets
FRESA.CAD::getDerivedCoefficients(). For the extraction of the model of the newly discovered of decorrelated features.
FRESA.CAD::randomCV() For the cross-validation of the Machine Learning models
FRESA.CAD::BSWiMS.model(). For the generation of bootstrapped logistic models
FRESA.CAD::summary(). For the summary description of the BSWiMS model
FRESA.CAD::predictionStats_binary(). For describing the performance of the model
heatmap.2(). For displaying the correlation matrix
igraph::graph_from_adjacency_matrix(). For the display of the network of BSWiMS formulas
vioplot::vioplot(). For the display of the z-distribution of significant features.
Loading the libraries
library("FRESA.CAD")
library(readxl)
library(vioplot)
library(igraph)
op <- par(no.readonly = TRUE)
pander::panderOptions('digits', 3)
pander::panderOptions('table.split.table', 400)
pander::panderOptions('keep.trailing.zeros',TRUE)Material and Methods
Signed Log Transform
The function will be used to transform all the continuous features of the data
signedlog <- function(x) { return (sign(x)*log(abs(x)+1.0e-12))}Data: The DARWIN Data-Set
The data to process is described in:
Cilia, Nicole D., Giuseppe De Gregorio, Claudio De Stefano, Francesco Fontanella, Angelo Marcelli, and Antonio Parziale. “Diagnosing Alzheimer’s disease from on-line handwriting: a novel dataset and performance benchmarking.” Engineering Applications of Artificial Intelligence 111 (2022): 104822.
From the DARWIN_readme.rtf
” The DARWIN dataset contains handwriting data collected according to the acquisition protocol described in [1], which is composed of 25 handwriting tasks. The protocol was specifically designed for the early detection of Alzheimer’s disease (AD). The dataset includes data from 174 participants (89 AD patients and 85 healthy people). The file “DARWIN.csv” contains the acquired data. The file consists of one row for each participant plus an additional header row. The first row is the header row, the next 89 rows collect patients data, whereas the remaining 84 rows collect information from healthy people. The file consists of 452 columns. The first column shows participants’ identifiers,whereas the last column shows the class to which each participant belongs. This value can be equal to ‘P’ (Patient) or ‘H’ (Healthy). The remaining columns report the features extracted from a specific task. The tasks performed are 25, and for each task 18 features have been extracted. The column will be identified by the name of the features followed by a numeric identifier representing the task the feature is extracted. E.g., the column with the header “total_time8” collects the values for the “total time” feature extracted from task #8.”
DARWIN <- read.csv("~/GitHub/FCA/Data/DARWIN/DARWIN.csv")
rownames(DARWIN) <- DARWIN$ID
DARWIN$ID <- NULL
DARWIN$class <- 1*(DARWIN$class=="P")
print(table(DARWIN$class))
#>
#> 0 1
#> 85 89
DARWIN[,1:ncol(DARWIN)] <- sapply(DARWIN,as.numeric)
whof <- !(colnames(DARWIN) %in% c("class"));
DARWIN[,whof] <- signedlog(DARWIN[,whof])
## The size of training
trainFraction=0.65;
## The file with codes for creating shorter names
namecode <- read.csv("~/GitHub/FCA/Data/DARWIN/Darnames.csv")Correlation Matrix of the DARWIN Data
cormat <- cor(DARWIN,method="spearman")
gplots::heatmap.2(abs(cormat),
trace = "none",
scale = "none",
mar = c(10,10),
col=rev(heat.colors(5)),
main = "Raw Correlation",
cexRow = 0.45,
cexCol = 0.45,
key.title=NA,
key.xlab="Spearman Correlation",
xlab="Feature", ylab="Feature")
Train and test set
set.seed(2)
caseSet <- subset(DARWIN, class == 1)
controlSet <- subset(DARWIN, class == 0)
caseTrainSize <- nrow(caseSet)*trainFraction;
controlTrainSize <- nrow(controlSet)*trainFraction;
sampleCaseTrain <- sample(nrow(caseSet),caseTrainSize)
sampleControlTrain <- sample(nrow(controlSet),controlTrainSize)
trainSet <- rbind(caseSet[sampleCaseTrain,], controlSet[sampleControlTrain,])
testSet <- rbind(caseSet[-sampleCaseTrain,],controlSet[-sampleControlTrain,])
pander::pander(table(trainSet$class))| 0 | 1 |
|---|---|
| 55 | 57 |
pander::pander(table(testSet$class))| 0 | 1 |
|---|---|
| 30 | 32 |
Decorrelation: Training and Testing Sets Creation
I compute a decorrelated version of the training and testing sets using the GDSTMDecorrelation() function of FRESA.CAD. The first decorrelation will be driven by features associated with the outcome. The second decorrelation will find the GDSTM without the outcome restriction.
## The GDSTM transformation driven by the Outcome
deTrain <- GDSTMDecorrelation(trainSet,Outcome="class",thr=0.8,verbose = TRUE)Included: 378 , Uni p: 0.005434231 To Outcome: 220 , Base: 33 , In Included: 33 , Base Cor: 51 1 , Top: 130 < 0.8 >( 1 ).1 : 0 : 0.792,<|>Tot Used: 294 , Added: 169 , Zero Std: 0 , Max Cor: 0.9968972 2 , Top: 33 < 0.8 >FALSE1 : 0 : 0,<|>Tot Used: 309 , Added: 35 , Zero Std: 0 , Max Cor: 0.9902345 3 , Top: 2 < 0.8 >( 1 )1 : 0 : 0.8,<|>Tot Used: 309 , Added: 2 , Zero Std: 0 , Max Cor: 0.7977194 [ 4 ], 0.7977194 . Cor to Base: 175 , ABase: 180
deTest <- predictDecorrelate(deTrain,testSet)
## The GDSTM transformation without outcome
deTrainU <- GDSTMDecorrelation(trainSet,thr=0.8,verbose = TRUE)Included: 378 , Uni p: 0.005434231 To Outcome: 0 , Base: 0 , In Included: 0 , Base Cor: 0 1 , Top: 131 < 0.8 >( 4 ).1 : 0 : 0,<|>Tot Used: 301 , Added: 173 , Zero Std: 0 , Max Cor: 0.9683179 2 , Top: 28 < 0.8 >( 1 )1 : 0 : 0,<|>Tot Used: 313 , Added: 29 , Zero Std: 0 , Max Cor: 0.8045096 3 , Top: 2 < 0.8 >( 1 )1 : 0 : 0.8,<|>Tot Used: 313 , Added: 2 , Zero Std: 0 , Max Cor: 0.7970469 [ 4 ], 0.7921168 . Cor to Base: 173 , ABase: 180
deTestU <- predictDecorrelate(deTrainU,testSet)Correlation Matrix of the Decorrelated Test Data
The heat map of the testing set.
cormat <- cor(deTest,method="spearman")
gplots::heatmap.2(abs(cormat),
trace = "none",
scale = "none",
mar = c(10,10),
col=rev(heat.colors(5)),
main = "Test Set Correlation after GDSTM",
cexRow = 0.45,
cexCol = 0.45,
key.title=NA,
key.xlab="Spearman Correlation",
xlab="Feature", ylab="Feature")
Holdout Cross-Validation
Before doing the feature analysis. I’ll explore BSWiMS modeling using the Holdout cross validation method of FRESA.CAD. The purpose of the cross-validation is to observe and estimate the performance gain of decorrelation.
par(op)
par(mfrow=c(1,3))
## The Raw validation
cvBSWiMSRaw <- randomCV(DARWIN,
"class",
fittingFunction= BSWiMS.model,
classSamplingType = "Pro",
trainFraction = trainFraction,
repetitions = 150
).[++-++++-++-].[+++++++++++-++++-]..[++++—++-].[++++++++-+–].[+++++++++–].[++++++++++-]..[++++++++++++++++++++]…[++++++-++-].[++++++++++++++++++++]…[+++++–++++++–].10 Tested: 171 Avg. Selected: 41.3 Min Tests: 1 Max Tests: 8 Mean Tests: 3.625731 . MAD: 0.2615184 .[+++++++++++-]..[++++++++++++++++++++]…[++++++++++++++-]..[+++++++++++-]..[++++++++++-]..[++++++-+-+-].[+++++++++-].[+++++++-].[+++-].[+++–+-+–]20 Tested: 174 Avg. Selected: 38.9 Min Tests: 2 Max Tests: 14 Mean Tests: 7.126437 . MAD: 0.2558425 .[+++++++++++-+–+-]..[++++++++-+-].[++++++++-].[+++++++++++++++-+-]..[+++++++++-+++-+++-]..[+++++++++-].[++++++++++-++—]..[+++++++++-].[++—].[++-]30 Tested: 174 Avg. Selected: 37.33333 Min Tests: 5 Max Tests: 18 Mean Tests: 10.68966 . MAD: 0.2560108 .[++++++-].[++–++-+-].[++++++++++++++++++++]…[+++++++++-++++++-+]..[++++++++++++++++++++]…[++++-].[++++++++++-+++++-]..[++++++-+—++-].[++++++–].[+++++-]40 Tested: 174 Avg. Selected: 38.1 Min Tests: 7 Max Tests: 25 Mean Tests: 14.25287 . MAD: 0.2555855 .[++++++++++++++++++++]…[++++++++++-]..[++++++++++++-]..[++++++++-].[++++++++++++++++++++]…[++++++++–].[+++++—].[++++++-].[+++-+-].[+++++++++–]50 Tested: 174 Avg. Selected: 37.94 Min Tests: 9 Max Tests: 27 Mean Tests: 17.81609 . MAD: 0.2577091 .[+++++++++++-+—]..[++++++++–].[+++++++-].[++++++++++++++++++-]..[++++++++++++++++-]..[+++++++++++-+++-++]..[+++++-++-].[+++-].[++++++++++++-]..[+++–+-]60 Tested: 174 Avg. Selected: 38.15 Min Tests: 12 Max Tests: 32 Mean Tests: 21.37931 . MAD: 0.2555041 .[++++++++-+-].[++++++-].[++++++++++++–]..[+++++++++++++++++-]..[+++++++++++++-]..[++++++++-].[++++++++-++-++++-]..[+++++++++++++++-++-]..[++++++++++-]..[++++++—]70 Tested: 174 Avg. Selected: 38.65714 Min Tests: 15 Max Tests: 38 Mean Tests: 24.94253 . MAD: 0.2552179 .[+++++++++++++++-++-]..[++++++++++++++++++++]…[++++++++++++++++++++]…[+++++++++++++++++++-]..[++++++++-++-]..[++-+-].[++++++++++++-+-]..[++-].[+++++++++++++++++++-]..[+++++++++++-].80 Tested: 174 Avg. Selected: 39.9375 Min Tests: 16 Max Tests: 42 Mean Tests: 28.50575 . MAD: 0.2539662 .[+++++++++-].[+++++++++++-]..[+++++++-++++++-+-]..[++++++++++-]..[++++++++++++++++-]..[+++-++-].[++++++++++-++–]..[+++++++++++-+++++-]..[++++++++++++-]..[+++++++++-]90 Tested: 174 Avg. Selected: 40.28889 Min Tests: 20 Max Tests: 45 Mean Tests: 32.06897 . MAD: 0.2539906 .[+++++++++++++++++–]..[++++++++++–]..[+++++-].[++++-+++++++++++++-]..[++++++++++++++++++-]..[++++++++++++-++++++]..[+++++-].[+++++++++++++++++-]..[+++++++++++++++++-+]..[+++-]100 Tested: 174 Avg. Selected: 40.6 Min Tests: 23 Max Tests: 49 Mean Tests: 35.63218 . MAD: 0.2546618 .[++++++++++-++-]..[+++++-+-].[+++++++++++++++-+-]..[+++++++–].[++++-].[++++++++++++++-+–]..[++++++++++-+++++-+]..[++++++++-+–].[++++-++++++++++++++]..[++-]110 Tested: 174 Avg. Selected: 40.40909 Min Tests: 26 Max Tests: 54 Mean Tests: 39.1954 . MAD: 0.2540901 .[++++++++++++-]..[++++++++++++++-]..[+++++++++++++++++-]..[++++++++++-+++-]..[++++-++++-+++–]..[+++++++++++++-]..[+++++++++++++++++–]..[++++++++++-+–]..[+++++++-].[+++++++++++++-].120 Tested: 174 Avg. Selected: 40.99167 Min Tests: 29 Max Tests: 58 Mean Tests: 42.75862 . MAD: 0.2539299 .[++++-++–].[++++++-++-].[+–++++–].[++++++++++++++++++++]…[+++-+-].[+++++-+-].[++++++++++++++++++++]…[++–].[++++++++-].[+++++++++-++++++-+].130 Tested: 174 Avg. Selected: 40.63077 Min Tests: 33 Max Tests: 60 Mean Tests: 46.32184 . MAD: 0.252978 .[++++++++-+-].[++++++++++++-++-]..[+++++++++++++++-]..[+++-+–].[+++++-+-].[++++++++++++–]..[+++++++++++++++-+-]..[++++-+-].[++++++++++-]..[+++++++++++++-].140 Tested: 174 Avg. Selected: 40.36429 Min Tests: 38 Max Tests: 66 Mean Tests: 49.88506 . MAD: 0.252622 .[++++++-+–++-].[+++++++++++++++–+]..[+++++-].[+++++++++++-]..[++++-+++++++-]..[++-].[++++++++++-+-]..[++++++++++++-]..[+++-+++-].[++++++++++++++++++-].150 Tested: 174 Avg. Selected: 40.26 Min Tests: 40 Max Tests: 68 Mean Tests: 53.44828 . MAD: 0.2521148
bpraw <- predictionStats_binary(cvBSWiMSRaw$medianTest,"BSWiMS RAW",cex=0.60)BSWiMS RAW
pander::pander(bpraw$CM.analysis$tab)| Outcome + | Outcome - | Total | |
|---|---|---|---|
| Test + | 73 | 11 | 84 |
| Test - | 16 | 74 | 90 |
| Total | 89 | 85 | 174 |
pander::pander(bpraw$accc)| est | lower | upper |
|---|---|---|
| 0.845 | 0.782 | 0.895 |
pander::pander(bpraw$aucs)| est | lower | upper |
|---|---|---|
| 0.947 | 0.918 | 0.976 |
pander::pander(bpraw$berror)| 50% | 2.5% | 97.5% |
|---|---|---|
| 0.153 | 0.102 | 0.209 |
## The validation with Outcome-driven Decorrelation
cvBSWiMSDeCor <- randomCV(DARWIN,
"class",
trainSampleSets= cvBSWiMSRaw$trainSamplesSets,
fittingFunction= filteredFit,
fitmethod=BSWiMS.model,
filtermethod=NULL,
DECOR = TRUE,
DECOR.control=list(Outcome="class",thr=0.8)
).[+++++-].[+++++-].[++-++++–].[++++++-].[+++++++-].[++++++++++++++-]..[++—].[++-].[++++++++-+-++-++-]..[+++++-+–]10 Tested: 171 Avg. Selected: 25.8 Min Tests: 1 Max Tests: 8 Mean Tests: 3.625731 . MAD: 0.2608507 .[++-].[++++++++++++++++-]..[+++-].[+++-+—].[+++++-+—-].[++++++-].[+++++++++-++-]..[++++++++++-]..[++++-+-].[+++–++–]20 Tested: 174 Avg. Selected: 27.55 Min Tests: 2 Max Tests: 14 Mean Tests: 7.126437 . MAD: 0.2533841 .[+++++-].[+++++—].[++++++++-].[+++-].[++++-].[+++++-].[+++++-].[+++++++–].[+++++++++-++-]..[+++-]30 Tested: 174 Avg. Selected: 26.46667 Min Tests: 5 Max Tests: 18 Mean Tests: 10.68966 . MAD: 0.2434923 .[+++–++-].[+++-].[++++++-].[+++++++++++++–]..[++++++++++++++++++++]…[++++++++++-]..[+-++-].[++++++-].[++++++–].[++++-]40 Tested: 174 Avg. Selected: 27.725 Min Tests: 7 Max Tests: 25 Mean Tests: 14.25287 . MAD: 0.241383 .[+++++++++++++++++++-]..[++++++++++-]..[+-++++++++-].[+++++-].[+++++++-].[++++++++-].[+++++-].[++++-].[++–+++++-].[++++-++-]50 Tested: 174 Avg. Selected: 28.8 Min Tests: 9 Max Tests: 27 Mean Tests: 17.81609 . MAD: 0.2438322 .[++++++++++–]..[+++++–].[+++++++-].[++++++-+-].[++++++-].[++++++++-].[+++++++-++-].[+++++-].[++++-++-].[++-++-+-]60 Tested: 174 Avg. Selected: 28.85 Min Tests: 12 Max Tests: 32 Mean Tests: 21.37931 . MAD: 0.2432394 .[++++++++-].[++++++++++++-]..[++++-+++++-+-]..[++++++++-+++-]..[+—].[+++++-].[++++++++–++—]..[+++++++-].[++++++++++++-]..[++++-]70 Tested: 174 Avg. Selected: 29.34286 Min Tests: 15 Max Tests: 38 Mean Tests: 24.94253 . MAD: 0.2436433 .[++++++++++-]..[+++++++++++++-+-]..[++++++++++-]..[++++++-++–].[+++++++-].[++++-++-].[++++++-].[+++++-].[++++++++-].[+++++-++-]80 Tested: 174 Avg. Selected: 30.05 Min Tests: 16 Max Tests: 42 Mean Tests: 28.50575 . MAD: 0.2461633 .[+++++-+++–].[++++++++-].[++++++++++++++++++++]…[+++-+–].[+-].[+++-].[+++++++++-].[++++++-].[+++++++++++-++++-]..[+++++-++–]90 Tested: 174 Avg. Selected: 30.13333 Min Tests: 20 Max Tests: 45 Mean Tests: 32.06897 . MAD: 0.2467647 .[+++++++++++++++-+-]..[+++++++++++-++-]..[+++-].[++++++++++++++–+-]..[+++++++++++++++-]..[++++-+-+-].[++++-++++–].[++++-+++-].[+++++++++-].[++++++++–+-]100 Tested: 174 Avg. Selected: 31.3 Min Tests: 23 Max Tests: 49 Mean Tests: 35.63218 . MAD: 0.2474804 .[+++++++++-].[+++-+–].[++++-].[++++-+–].[+++-].[++++++++++-+–]..[+++++++++++–++-]..[++++++-].[+++++++++–].[++++-]110 Tested: 174 Avg. Selected: 30.97273 Min Tests: 26 Max Tests: 54 Mean Tests: 39.1954 . MAD: 0.2478764 .[+++++++—].[++-].[++++++++++++++++++-]..[+++++++-+-].[+++++-++++-].[++++++++-+-].[++++++–++-].[++++-].[++++++++++-+++-]..[+++++-]120 Tested: 174 Avg. Selected: 31.275 Min Tests: 29 Max Tests: 58 Mean Tests: 42.75862 . MAD: 0.2482969 .[+++-+-].[++++–].[+++++++++-].[++++++++++-+++-+++]..[+++++-+-].[++-].[++++++++++++++++++++]…[+++–+++-].[++++-+++-+-].[++++++++++-++-++-].130 Tested: 174 Avg. Selected: 31.53846 Min Tests: 33 Max Tests: 60 Mean Tests: 46.32184 . MAD: 0.2487497 .[++-+-].[++++++++-].[+++++++–++-].[++++++++++++-++++-]..[+++-].[+++-].[+++++–+-].[++++-++-+-].[+++++-+++++-]..[+++++++-+-+++-].140 Tested: 174 Avg. Selected: 31.41429 Min Tests: 38 Max Tests: 66 Mean Tests: 49.88506 . MAD: 0.2503202 .[+++++-].[++++-].[++++++-+-].[++++++++-].[+++++++-++–].[++—++–].[+-].[+++++++-].[+-+–].[++++-+-]150 Tested: 174 Avg. Selected: 30.81333 Min Tests: 40 Max Tests: 68 Mean Tests: 53.44828 . MAD: 0.2514641
bpDecor <- predictionStats_binary(cvBSWiMSDeCor$medianTest,"Outcome-Driven GDSTM",cex=0.60)Outcome-Driven GDSTM
pander::pander(bpDecor$CM.analysis$tab)| Outcome + | Outcome - | Total | |
|---|---|---|---|
| Test + | 77 | 11 | 88 |
| Test - | 12 | 74 | 86 |
| Total | 89 | 85 | 174 |
pander::pander(bpDecor$accc)| est | lower | upper |
|---|---|---|
| 0.868 | 0.808 | 0.914 |
pander::pander(bpDecor$aucs)| est | lower | upper |
|---|---|---|
| 0.956 | 0.93 | 0.983 |
pander::pander(bpDecor$berror)| 50% | 2.5% | 97.5% |
|---|---|---|
| 0.132 | 0.0861 | 0.179 |
### Here we compute the probability that the outcome-driven decorrelation ROC is superior to the RAW ROC.
pander::pander(roc.test(bpDecor$ROC.analysis$roc.predictor,bpraw$ROC.analysis$roc.predictor,alternative = "greater"))| Test statistic | P value | Alternative hypothesis | AUC of roc1 | AUC of roc2 |
|---|---|---|---|---|
| 1.8 | 0.0363 * | greater | 0.956 | 0.947 |
### Testing improving proability
iprob <- .Call("improveProbCpp",cvBSWiMSRaw$medianTest[,2],
cvBSWiMSDeCor$medianTest[,2],
cvBSWiMSRaw$medianTest[,1]);
pander::pander(iprob)- z.idi: 0.15
- z.nri: -1.3
- idi: 0.0011
- nri: -0.196
### Testing improving accuracy
testRaw <- (cvBSWiMSRaw$medianTest[,1]-cvBSWiMSRaw$medianTest[,2])<0.5
testDecor <- (cvBSWiMSDeCor$medianTest[,1]-cvBSWiMSDeCor$medianTest[,2])<0.5
pander::pander(mcnemar.test(testRaw,testDecor))| Test statistic | df | P value |
|---|---|---|
| 2.25 | 1 | 0.134 |
## The validation of Decorrelation without the outcome restriction
cvBSWiMSDeCorU <- randomCV(DARWIN,
"class",
trainSampleSets= cvBSWiMSRaw$trainSamplesSets,
fittingFunction= filteredFit,
fitmethod=BSWiMS.model,
filtermethod=NULL,
DECOR = TRUE,
DECOR.control=list(thr=0.8)
).[+++++++-].[++++++++++++-]..[++++-+++++-+-]..[+++++++-].[+++++++-+-].[+++++++-].[++++++++++-]..[+++++++—].[+++++++++–+++-]..[+++++-]10 Tested: 171 Avg. Selected: 34.7 Min Tests: 1 Max Tests: 8 Mean Tests: 3.625731 . MAD: 0.258054 .[+++-].[++++++-++-].[++-++-].[+++-+-].[+++++-].[+++++++++–].[++++–].[++++++++++++-++-]..[++++++-].[++++++-]20 Tested: 174 Avg. Selected: 30.95 Min Tests: 2 Max Tests: 14 Mean Tests: 7.126437 . MAD: 0.2546943 .[++++++++++++++–]..[++++++++–].[+++++++++++-]..[+-+++—].[+++++++-+++–]..[++++-+-].[+++++++-].[+++++++++-].[+++++++-].[+++++-]30 Tested: 174 Avg. Selected: 31.46667 Min Tests: 5 Max Tests: 18 Mean Tests: 10.68966 . MAD: 0.2522787 .[++++++-+-].[++++++++++++++++-++]..[+++++-].[++++++++++-+–+-]..[+++++++++-].[++++++++++-]..[++++++++++++-]..[+++++-].[++++++-].[++++-]40 Tested: 174 Avg. Selected: 32.6 Min Tests: 7 Max Tests: 25 Mean Tests: 14.25287 . MAD: 0.2514554 .[+++++++++++-+++-]..[++++++–].[++-+-+++-].[++++++–++-].[+++++++-].[++++++++++++-]..[+++-].[++++-++++-].[+++++++++++++-+-]..[+++++++-+++-].50 Tested: 174 Avg. Selected: 33.36 Min Tests: 9 Max Tests: 27 Mean Tests: 17.81609 . MAD: 0.2555964 .[++++++++++-]..[++++++-].[++++++++-].[++++-++-].[+++++++++++-]..[++++++++-+-].[++++++++–+-].[+++++-].[+++++++++++++++++-]..[++++++-]60 Tested: 174 Avg. Selected: 33.88333 Min Tests: 12 Max Tests: 32 Mean Tests: 21.37931 . MAD: 0.2570975 .[+++++++-+-].[++++++++-].[+++-++++–].[+++-].[+++++++++++-]..[+++++–+++-].[++++++-++-+-].[++++++++++++++++-++]..[+++++++++-].[+++++–]70 Tested: 174 Avg. Selected: 34.05714 Min Tests: 15 Max Tests: 38 Mean Tests: 24.94253 . MAD: 0.2554043 .[++++++++++-+++-]..[++++++++++++++++++++]…[++++++++++++++++-]..[++++-++++–].[++++++++-].[++++-].[+++++++++-].[++++++++++—+-]..[+++++++++-].[++++++++-]80 Tested: 174 Avg. Selected: 35.2625 Min Tests: 16 Max Tests: 42 Mean Tests: 28.50575 . MAD: 0.25775 .[+++++++++++-]..[+++++++++-].[+++++++++++++++-]..[+++++++++-].[++++-].[++++++–].[+++++++++++++-]..[+++++++-++++-]..[++++++++++++++++++-]..[++++-]90 Tested: 174 Avg. Selected: 35.92222 Min Tests: 20 Max Tests: 45 Mean Tests: 32.06897 . MAD: 0.2574025 .[++++++++++++++++++++]…[+++++-].[++++—-].[+++++++++++++++-+++]..[+++++++++++-++–]..[++++++++++++-++++++]..[+++-].[+++++++-+++–]..[++++–].[+++++—-]100 Tested: 174 Avg. Selected: 36.26 Min Tests: 23 Max Tests: 49 Mean Tests: 35.63218 . MAD: 0.2570899 .[++++++++++-+–]..[++++-].[+++++–].[++++++-].[+++-].[++++++++++++++-]..[++++++-].[++++++++++-]..[+++++++++++++–]..[+++++++-+-+-]110 Tested: 174 Avg. Selected: 36.12727 Min Tests: 26 Max Tests: 54 Mean Tests: 39.1954 . MAD: 0.2559931 .[+++-+–].[++++++++++-++-++-]..[+++++++++++-++-+-]..[+++++++-].[+++-+++++-++–]..[+++++++++-].[++++++++–].[++++++-].[+++++++-].[+++++-+-+-]120 Tested: 174 Avg. Selected: 36.05 Min Tests: 29 Max Tests: 58 Mean Tests: 42.75862 . MAD: 0.2562526 .[++++++-].[+++++-++-].[+++++++++-].[++++++++++++++++-++]..[++++++-].[+++++++++—].[+++++++++++++++++-+]..[++-+-].[+++++++++-].[++++++++++++++++-].130 Tested: 174 Avg. Selected: 36.26154 Min Tests: 33 Max Tests: 60 Mean Tests: 46.32184 . MAD: 0.2578297 .[++++++++-].[++-].[+++++-+-].[++++++++++++++++-]..[++++++++++-]..[+++++–+-+-].[+++++++++++++-]..[++++++++-].[+++++++++++-]..[++++++++++++++-].140 Tested: 174 Avg. Selected: 36.4 Min Tests: 38 Max Tests: 66 Mean Tests: 49.88506 . MAD: 0.2572715 .[+++-].[+++++++++-].[++++++++++++-++-]..[+++++-].[+++++++++++-]..[+-++-].[++++-++-+-].[++++++++—].[+++++++-].[++++++++++++-].150 Tested: 174 Avg. Selected: 36.19333 Min Tests: 40 Max Tests: 68 Mean Tests: 53.44828 . MAD: 0.2573273
bpDecorU <- predictionStats_binary(cvBSWiMSDeCorU$medianTest,"Blind Decorrelation",cex=0.60)Blind Decorrelation
pander::pander(bpDecorU$CM.analysis$tab)| Outcome + | Outcome - | Total | |
|---|---|---|---|
| Test + | 80 | 9 | 89 |
| Test - | 9 | 76 | 85 |
| Total | 89 | 85 | 174 |
pander::pander(bpDecorU$accc)| est | lower | upper |
|---|---|---|
| 0.897 | 0.841 | 0.938 |
pander::pander(bpDecorU$aucs)| est | lower | upper |
|---|---|---|
| 0.958 | 0.933 | 0.983 |
pander::pander(bpDecorU$berror)| 50% | 2.5% | 97.5% |
|---|---|---|
| 0.103 | 0.0623 | 0.154 |
### Here we compute the probability that the blind decorrelation ROC is superior to the RAW ROC.
pander::pander(roc.test(bpDecorU$ROC.analysis$roc.predictor,bpraw$ROC.analysis$roc.predictor,alternative = "greater"))| Test statistic | P value | Alternative hypothesis | AUC of roc1 | AUC of roc2 |
|---|---|---|---|---|
| 1.97 | 0.0242 * | greater | 0.958 | 0.947 |
par(op)
## Testing probability improvement
iprob <- .Call("improveProbCpp",cvBSWiMSRaw$medianTest[,2],cvBSWiMSDeCorU$medianTest[,2],cvBSWiMSRaw$medianTest[,1]);
pander::pander(iprob)- z.idi: -1.23
- z.nri: -2.65
- idi: -0.0105
- nri: -0.393
## Testing accuracy improvement
testDecorU <- (cvBSWiMSDeCorU$medianTest[,1]-cvBSWiMSDeCorU$medianTest[,2])<0.5
pander::pander(mcnemar.test(testRaw,testDecorU))| Test statistic | df | P value |
|---|---|---|
| 5.14 | 1 | 0.0233 * |
The Raw Model vs. the Decorrelated-Based Model
After demonstrating that decorrelation is able to improve BSWiMS model performance, I’ll focus is showcasing the ability to discover new features associated with the outcome.
First, I’ll compute the BSWiMS models for the original data, and for the decorrelated data-set. The model estimation will be done using the training set and tested on the holdout test set, and repeated 10 times. After that, I’ll compare the statistical difference of both ROC curves.
par(op)
par(mfrow=c(1,3))
bm <- BSWiMS.model(class~.,trainSet,NumberofRepeats = 20)[+++++++++++++++++++++++++++++++++++++++++++++++++++++++-++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-+-++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++–+-++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++]………………………………..
bpraw <- predictionStats_binary(cbind(testSet$class,predict(bm,testSet)),"BSWiMS RAW",cex=0.60)BSWiMS RAW
bmd <- BSWiMS.model(class~.,deTrain,NumberofRepeats = 20)[++++++++++++++++++-+++++++++++++++++++-+++++++++++++-++++++++++++++++++++++-+++++++++++++++-++++++++++++++++++-+++++++++++++++-+++++++++++++++++-++++++++++++++-+++-++++++++++++++++-+++++++++++–+++++++++++++++++-++++++++++++-+++++-+++++++++++++++++-+++++++++++++–++++++++++++-++++++++++–+++++++++++-++++–+++++++++++-+++-+-++++++++++++++-]………………………….
bpdecor <- predictionStats_binary(cbind(deTest$class,predict(bmd,deTest)),"Outcome-Driven Decor",cex=0.60)Outcome-Driven Decor
## Comparing the two ROC curves
pander::pander(roc.test(bpdecor$ROC.analysis$roc.predictor,bpraw$ROC.analysis$roc.predictor,alternative = "greater"))| Test statistic | P value | Alternative hypothesis | AUC of roc1 | AUC of roc2 |
|---|---|---|---|---|
| 1.85 | 0.0321 * | greater | 0.954 | 0.917 |
## Comparing the test accuracies
testRaw <- (testSet$class-predict(bm,testSet))<0.5
testDecor <- (deTest$class-predict(bmd,deTest))<0.5
pander::pander(mcnemar.test(testRaw,testDecor))| Test statistic | df | P value |
|---|---|---|
| 1.33 | 1 | 0.248 |
bmdU <- BSWiMS.model(class~.,deTrainU,NumberofRepeats = 20)[+++-+++++-++++++++++++-+-+++++++++-++++++++++++-+–++++++++++++-+-++++++++–+-+++++-+++++++++++++–++++++-++++++++++++++-++++++-++++++++++–++++++-+-++++++++++—-++++++++-+++++++++++++-++++++++++++–++++++++++++–++++++-+-++++++-+++-++-]……………….
bpdecorU <- predictionStats_binary(cbind(deTest$class,predict(bmdU,deTestU)),"Blind Decorrrelation",cex=0.60)Blind Decorrrelation
## Comparing the test curves
pander::pander(roc.test(bpdecorU$ROC.analysis$roc.predictor,bpraw$ROC.analysis$roc.predictor,alternative = "greater"))| Test statistic | P value | Alternative hypothesis | AUC of roc1 | AUC of roc2 |
|---|---|---|---|---|
| 1.63 | 0.0514 | greater | 0.947 | 0.917 |
## Comparing the accuracies
testDecorU <- (deTestU$class-predict(bmdU,deTestU))<0.5
pander::pander(mcnemar.test(testRaw,testDecorU))| Test statistic | df | P value |
|---|---|---|
| 0 | 1 | 1 |
par(op)The Feature Associations
I’ll print the graph showing the association between features. Each feature cluster represents a logistic regression formula (formula nugget) discovered by the BSWiMS method. The figure will plot:
Raw formula network
Outcome-driven network
Blind network
The plots will show only formula networks with more than 50% of occurrence and 25% of feature to feature association.
par(op)
par(mfrow=c(1,3))
### The raw model
pander::pander(nrow(bm$bagging$formulaNetwork))112
cmax <- apply(bm$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.5])
cmax <- cmax[cmax>=0.5]
adma <- bm$bagging$formulaNetwork[cnames,cnames]
for (cx in c(1:nrow(namecode)))
{
cnames <- str_replace_all(cnames,namecode[cx,1],namecode[cx,2])
}
cnames <- str_replace_all(cnames,"_","")
cnames <- str_replace_all(cnames,"th","")
rownames(adma) <- cnames
colnames(adma) <- cnames
names(cmax) <- cnames
adma[adma<0.25] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr
fc <- cluster_optimal(gr)
plot(fc, gr,
vertex.size=20*cmax,
vertex.label.cex=0.5,
vertex.label.dist=0,
main="Original Feature Association")
### The Outcome Driven Model
pander::pander(nrow(bmd$bagging$formulaNetwork))103
cmax <- apply(bmd$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.5])
outcomeNames <- cnames
cmax <- cmax[cmax>=0.5]
adma <- bmd$bagging$formulaNetwork[cnames,cnames]
for (cx in c(1:nrow(namecode)))
{
cnames <- str_replace_all(cnames,namecode[cx,1],namecode[cx,2])
}
cnames <- str_replace_all(cnames,"_","")
cnames <- str_replace_all(cnames,"th","")
rownames(adma) <- cnames
colnames(adma) <- cnames
names(cmax) <- cnames
adma[adma<0.25] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr
fc <- cluster_optimal(gr)
clusterOutcome <- fc
clusterOutcome$names <- outcomeNames
plot(fc, gr,
vertex.size=20*cmax,
vertex.label.cex=0.5,
vertex.label.dist=0,
main="Outcome-Driven Decorrelation")
### The Blind Decorrelation
pander::pander(nrow(bmdU$bagging$formulaNetwork))83
cmax <- apply(bmdU$bagging$formulaNetwork,2,max)
cnames <- names(cmax[cmax>=0.5])
cmax <- cmax[cmax>=0.5]
adma <- bmdU$bagging$formulaNetwork[cnames,cnames]
for (cx in c(1:nrow(namecode)))
{
cnames <- str_replace_all(cnames,namecode[cx,1],namecode[cx,2])
}
cnames <- str_replace_all(cnames,"_","")
cnames <- str_replace_all(cnames,"th","")
rownames(adma) <- cnames
colnames(adma) <- cnames
names(cmax) <- cnames
adma[adma<0.25] <- 0;
gr <- graph_from_adjacency_matrix(adma,mode = "undirected",diag = FALSE,weighted=TRUE)
gr$layout <- layout_with_fr
fc <- cluster_optimal(gr)
plot(fc, gr,
vertex.size=20*cmax,
vertex.label.cex=0.5,
vertex.label.dist=0,
main="Blind Decorrelation")
Feature Analysis of Models
The analysis of the features required to predict the outcome will use the following:
Analysis of the BSWiMS bagged model using the summary function.
Analysis of the sparse GDSMT
Analysis of the univariate association of the model features of both models
Report the new features not found by the Original data analysis
par(op)
par(mfrow=c(1,1))
## 1 Get the Model Features
smOriginal <- summary(bm)
rawnames <- rownames(smOriginal$coefficients)
### From Drived Decorrelation
smDecor <- summary(bmd)
decornames <- rownames(smDecor$coefficients)
### From Blind Decorrelation
smDecorU <- summary(bmdU)
decornamesU <- rownames(smDecorU$coefficients)
## 2 Get the decorrelation matrix formulas
dc <- getDerivedCoefficients(deTrain)
### 2a Get only the ones that were decorrelated by the decorrelation-based model
deNames_in_dc <- decornames[decornames %in% names(dc)]
selectedlist <- dc[deNames_in_dc]
theDeFormulas <- selectedlist
pander::pander(selectedlist)De_gmrt_in_air19:
gmrt_in_air19 mean_speed_in_air19 1 -0.944 De_mean_jerk_in_air19:
mean_acc_in_air19 mean_jerk_in_air19 -1.14 1 De_mean_gmrt19:
gmrt_on_paper19 mean_gmrt19 mean_speed_in_air19 -0.398 1 -0.685 De_paper_time10:
disp_index10 paper_time10 -1.62 1 De_num_of_pendown21:
air_time21 num_of_pendown21 -0.803 1 De_pressure_mean5:
max_y_extension5 pressure_mean5 -0.889 1 De_mean_gmrt10:
gmrt_in_air10 mean_gmrt10 -0.706 1 De_mean_jerk_in_air7:
mean_acc_in_air7 mean_jerk_in_air7 -1.15 1 De_mean_acc_on_paper21:
mean_acc_on_paper21 mean_speed_on_paper21 1 0.61 De_mean_speed_on_paper15:
gmrt_on_paper15 mean_speed_on_paper15 -1.02 1 De_disp_index17:
disp_index17 max_y_extension17 1 -1.4 De_mean_jerk_on_paper5:
max_y_extension5 mean_jerk_on_paper5 0.513 1 De_mean_gmrt23:
gmrt_in_air23 mean_gmrt23 -0.845 1 De_mean_speed_on_paper9:
gmrt_on_paper9 mean_speed_on_paper9 -1.09 1 De_paper_time5:
max_y_extension5 mean_speed_on_paper5 paper_time5 -1.15 0.946 1 De_paper_time8:
disp_index8 paper_time8 -1.38 1 De_mean_jerk_on_paper4:
mean_acc_on_paper4 mean_jerk_on_paper4 -0.457 1 De_total_time10:
air_time10 total_time10 -0.632 1 De_max_y_extension24:
max_x_extension24 max_y_extension24 -0.987 1 De_mean_jerk_in_air2:
mean_acc_in_air2 mean_jerk_in_air2 -1.19 1
names(selectedlist) <- NULL
### 2b Get the the names of the original features
allDevar <- unique(c(names(unlist(selectedlist)),decornames))
allDevar <- allDevar[!str_detect(allDevar,"De_")]
allDevar <- str_remove(allDevar,"Ba_")
allDevar <- unique(allDevar)
# The analysis of the blind decorrelation
dcU <- getDerivedCoefficients(deTrainU)
### 2a Get only the ones that were decorrelated by the decorrelation-based model
deNames_in_dcU <- decornamesU[decornamesU %in% names(dcU)]
selectedlistU <- dcU[deNames_in_dcU]
pander::pander(selectedlistU)De_mean_gmrt23:
gmrt_in_air23 mean_gmrt23 -0.845 1 De_air_time9:
air_time9 total_time9 1 -1.58 De_disp_index17:
disp_index17 max_y_extension17 1 -1.4 De_paper_time10:
disp_index10 paper_time10 -1.62 1 De_mean_acc_on_paper21:
mean_acc_on_paper21 mean_speed_on_paper21 1 0.61 De_pressure_mean5:
max_y_extension5 pressure_mean5 -0.889 1 De_paper_time8:
disp_index8 paper_time8 -1.38 1 De_paper_time9:
paper_time9 total_time9 1 -0.737 De_paper_time1:
disp_index1 paper_time1 -1.22 1 De_mean_speed_in_air19:
gmrt_in_air19 mean_speed_in_air19 -1.03 1 De_total_time10:
air_time10 total_time10 -0.632 1 De_mean_jerk_in_air7:
mean_acc_in_air7 mean_jerk_in_air7 -1.15 1 De_mean_speed_in_air24:
gmrt_in_air24 mean_acc_in_air24 mean_speed_in_air24 -0.857 -0.0899 1 De_max_y_extension24:
max_x_extension24 max_y_extension24 -0.987 1
names(selectedlistU) <- NULL
### 2b Get the the names of the original features
allDevarU <- unique(c(names(unlist(selectedlistU)),decornamesU))
allDevarU <- allDevarU[!str_detect(allDevarU,"De_")]
allDevarU <- str_remove(allDevarU,"Ba_")
allDevarU <- unique(allDevarU)
pander::pander(c(length(rawnames),length(decornames),length(decornamesU)))95, 92 and 67
pander::pander(c(length(rawnames),length(allDevar),length(allDevarU)))95, 104 and 76
### 2c Get only the new feautres not found in the original analysis
dvar <- allDevar[!(allDevar %in% rawnames)]
### 2d Get the decorrelated variables that have new features
newvars <- character();
for (cvar in deNames_in_dc)
{
lvar <- dc[cvar]
names(lvar) <- NULL
lvar <- names(unlist(lvar))
if (length(lvar[lvar %in% dvar]) > 0)
{
newvars <- append(newvars,cvar)
}
}
## 3 Here is the univariate z values of the orignal set
#pander::pander(bm$univariate[dvar,])
## 4 Here is the univariate z values of the decorrelated set
#pander::pander(bmd$univariate[newvars,])
## 4a The scater plot of the decorrelated vs original Univariate values
zvalueNew <- bmd$univariate[newvars,]
rownames(zvalueNew) <- str_remove(rownames(zvalueNew),"De_")
rownames(zvalueNew) <- str_remove(rownames(zvalueNew),"Ba_")
zvaluePrePost <- bm$univariate[rownames(zvalueNew),c(1,3)]
zvaluePrePost$Name <- NULL
zvaluePrePost$NewZ <- zvalueNew[rownames(zvaluePrePost),"ZUni"]
pander::pander(zvaluePrePost)| ZUni | NewZ | |
|---|---|---|
| gmrt_in_air19 | 3.5727 | 2.82 |
| mean_jerk_in_air19 | 2.5727 | 1.16 |
| mean_gmrt19 | 3.1903 | 4.55 |
| paper_time10 | 5.1654 | 3.70 |
| num_of_pendown21 | 2.2029 | 2.30 |
| pressure_mean5 | 5.5292 | 5.14 |
| mean_gmrt10 | 4.5398 | 3.99 |
| mean_jerk_in_air7 | 2.8557 | 5.28 |
| mean_acc_on_paper21 | 4.4476 | 2.08 |
| mean_speed_on_paper15 | 5.0906 | 3.46 |
| disp_index17 | 4.2319 | 4.75 |
| mean_jerk_on_paper5 | 2.9614 | 4.16 |
| paper_time5 | 0.0963 | 3.31 |
| mean_jerk_on_paper4 | 2.0792 | 2.24 |
| total_time10 | 5.0610 | 3.08 |
| max_y_extension24 | 0.3149 | 2.80 |
| mean_jerk_in_air2 | 4.3791 | 2.93 |
plot(zvaluePrePost,
xlim=c(-0.5,6.5),
ylim=c(0,7),
xlab="Original Z",
ylab="Decorrelated Z",
main="Unviariate IDI Z Values",
pch=3,cex=0.5,
col="red")
abline(v=1.96,col="blue")
abline(h=1.96,col="blue")
text(zvaluePrePost$ZUni,zvaluePrePost$NewZ,rownames(zvaluePrePost),srt=65,cex=0.75)
Differences Between Blind vs. Outcome-Driven Decorrelation
In this section I will show the differences in unaltered basis vectors between the Outcome driven Transformation vs. the blind decorrelated transformation
par(op)
par(mfrow=c(1,1))
smDecorU <- summary(bmdU)
decornamesU <- rownames(smDecorU$coefficients)
get_De_names <- decornames[!str_detect(decornames,"De_")]
get_De_namesU <- decornamesU[!str_detect(decornamesU,"De_")]
unn <- bmd$univariate[,3]
names(unn) <- rownames(bmd$univariate)
pander::pander(as.matrix(unn[get_De_names]))| Ba_paper_time23 | 8.31 |
| Ba_paper_time9 | 7.47 |
| Ba_air_time22 | 6.20 |
| Ba_disp_index6 | 4.42 |
| num_of_pendown19 | 4.13 |
| Ba_mean_speed_in_air19 | 4.20 |
| Ba_total_time6 | 6.21 |
| Ba_mean_gmrt14 | 4.60 |
| pressure_mean1 | 3.73 |
| Ba_mean_speed_in_air25 | 5.87 |
| Ba_max_x_extension21 | 2.80 |
| Ba_pressure_mean8 | 4.45 |
| Ba_gmrt_in_air7 | 6.22 |
| Ba_air_time23 | 9.33 |
| Ba_num_of_pendown15 | 4.72 |
| Ba_mean_speed_on_paper11 | 4.92 |
| Ba_total_time8 | 5.24 |
| Ba_max_y_extension19 | 3.22 |
| disp_index7 | 4.45 |
| air_time9 | 3.95 |
| pressure_var19 | 2.94 |
| Ba_mean_jerk_on_paper21 | 4.54 |
| Ba_gmrt_on_paper15 | 4.15 |
| Ba_air_time17 | 7.30 |
| Ba_gmrt_in_air23 | 6.02 |
| Ba_mean_acc_in_air2 | 3.74 |
| Ba_total_time15 | 8.70 |
| Ba_total_time24 | 4.46 |
| Ba_mean_speed_on_paper25 | 3.91 |
| Ba_total_time18 | 5.47 |
| Ba_pressure_mean18 | 4.01 |
| Ba_air_time19 | 1.26 |
| Ba_air_time13 | 5.66 |
| Ba_total_time2 | 5.81 |
| num_of_pendown23 | 4.83 |
| Ba_num_of_pendown9 | 4.89 |
| Ba_gmrt_on_paper7 | 5.15 |
| Ba_pressure_mean4 | 4.99 |
| Ba_gmrt_on_paper9 | 5.82 |
| Ba_paper_time12 | 5.59 |
| Ba_total_time3 | 4.96 |
| paper_time17 | 5.96 |
| Ba_air_time5 | 5.22 |
| max_x_extension6 | 1.91 |
| Ba_air_time4 | 4.18 |
| Ba_gmrt_on_paper1 | 3.59 |
| Ba_total_time16 | 5.95 |
| Ba_pressure_var4 | 4.19 |
| Ba_mean_acc_in_air17 | 4.78 |
| pressure_mean7 | 4.39 |
| Ba_mean_jerk_on_paper9 | 3.30 |
| Ba_disp_index15 | 4.13 |
| pressure_mean9 | 4.41 |
| paper_time15 | 5.90 |
| Ba_paper_time24 | 3.72 |
| Ba_gmrt_on_paper22 | 4.57 |
| Ba_num_of_pendown5 | 5.21 |
| Ba_air_time7 | 6.78 |
| Ba_gmrt_in_air8 | 3.68 |
| Ba_mean_gmrt1 | 4.12 |
| Ba_pressure_mean15 | 4.31 |
| Ba_mean_jerk_on_paper24 | 3.32 |
| paper_time13 | 4.83 |
| pressure_var5 | 4.07 |
| max_y_extension25 | 1.92 |
| Ba_air_time11 | 4.04 |
| Ba_mean_acc_on_paper3 | 3.67 |
| paper_time2 | 4.73 |
| Ba_mean_speed_on_paper2 | 4.31 |
| air_time12 | 3.95 |
pander::pander(summary(unn[get_De_names]))| Min. | 1st Qu. | Median | Mean | 3rd Qu. | Max. |
|---|---|---|---|---|---|
| 1.26 | 4.02 | 4.5 | 4.77 | 5.56 | 9.33 |
unnU <- bmdU$univariate[,3]
names(unnU) <- rownames(bmdU$univariate)
pander::pander(as.matrix(unnU[get_De_namesU]))| Ba_total_time9 | 6.83 |
| Ba_disp_index6 | 4.42 |
| Ba_air_time6 | 5.86 |
| num_of_pendown19 | 4.13 |
| Ba_max_y_extension19 | 3.22 |
| Ba_gmrt_on_paper23 | 5.00 |
| Ba_air_time8 | 3.73 |
| Ba_air_time22 | 6.20 |
| Ba_air_time15 | 8.15 |
| pressure_var19 | 2.94 |
| Ba_num_of_pendown9 | 4.89 |
| Ba_air_time23 | 9.33 |
| Ba_num_of_pendown15 | 4.72 |
| Ba_max_x_extension21 | 2.80 |
| Ba_air_time5 | 5.22 |
| Ba_air_time2 | 5.07 |
| Ba_gmrt_in_air23 | 6.02 |
| Ba_pressure_mean18 | 4.01 |
| Ba_paper_time12 | 5.59 |
| num_of_pendown23 | 4.83 |
| Ba_air_time4 | 4.18 |
| Ba_air_time18 | 4.43 |
| Ba_gmrt_in_air8 | 3.68 |
| Ba_mean_acc_in_air25 | 5.01 |
| Ba_air_time17 | 7.30 |
| pressure_mean9 | 4.41 |
| Ba_pressure_mean4 | 4.99 |
| Ba_air_time7 | 6.78 |
| paper_time15 | 5.90 |
| Ba_mean_jerk_on_paper21 | 4.54 |
| Ba_air_time13 | 5.66 |
| Ba_pressure_mean15 | 4.31 |
| Ba_num_of_pendown5 | 5.21 |
| disp_index9 | 4.37 |
| pressure_var5 | 4.07 |
| Ba_mean_acc_on_paper24 | 1.96 |
| Ba_gmrt_on_paper9 | 5.82 |
| Ba_gmrt_on_paper1 | 3.59 |
| Ba_air_time24 | 3.97 |
| Ba_gmrt_in_air7 | 6.22 |
| Ba_mean_speed_on_paper11 | 4.92 |
| Ba_air_time16 | 5.67 |
| Ba_gmrt_on_paper7 | 5.15 |
| Ba_mean_jerk_on_paper9 | 3.30 |
| paper_time2 | 4.73 |
| Ba_mean_speed_in_air6 | 2.13 |
| max_x_extension6 | 1.91 |
| paper_time17 | 5.96 |
| Ba_mean_acc_in_air2 | 3.74 |
| Ba_mean_acc_in_air21 | 1.49 |
pander::pander(summary(unnU[get_De_namesU]))| Min. | 1st Qu. | Median | Mean | 3rd Qu. | Max. |
|---|---|---|---|---|---|
| 1.49 | 3.98 | 4.78 | 4.77 | 5.67 | 9.33 |
#boxplot(unn[get_De_names],unnU[get_De_namesU],xlab=c("Method"),ylab="Z",main="Z Values of Basis Features")
x1 <- unn[get_De_names]
x2 <- unnU[get_De_namesU]
X3 <- x1[!(get_De_names %in% get_De_namesU)]
X4 <- x2[!(get_De_namesU %in% get_De_names)]
vioplot(x1, x2, X3,X4,
names = c("Outcome-Driven",
"Blind",
"Not in Blind",
"Not in Outcome-Driven"),
ylab="Z IDI",
col="gold")
title("Violin Plots of Unaltered-Basis")
sameFeatures <- get_De_names[get_De_names %in% get_De_namesU]
pander::pander(as.matrix(unn[sameFeatures]))| Ba_air_time22 | 6.20 |
| Ba_disp_index6 | 4.42 |
| num_of_pendown19 | 4.13 |
| Ba_max_x_extension21 | 2.80 |
| Ba_gmrt_in_air7 | 6.22 |
| Ba_air_time23 | 9.33 |
| Ba_num_of_pendown15 | 4.72 |
| Ba_mean_speed_on_paper11 | 4.92 |
| Ba_max_y_extension19 | 3.22 |
| pressure_var19 | 2.94 |
| Ba_mean_jerk_on_paper21 | 4.54 |
| Ba_air_time17 | 7.30 |
| Ba_gmrt_in_air23 | 6.02 |
| Ba_mean_acc_in_air2 | 3.74 |
| Ba_pressure_mean18 | 4.01 |
| Ba_air_time13 | 5.66 |
| num_of_pendown23 | 4.83 |
| Ba_num_of_pendown9 | 4.89 |
| Ba_gmrt_on_paper7 | 5.15 |
| Ba_pressure_mean4 | 4.99 |
| Ba_gmrt_on_paper9 | 5.82 |
| Ba_paper_time12 | 5.59 |
| paper_time17 | 5.96 |
| Ba_air_time5 | 5.22 |
| max_x_extension6 | 1.91 |
| Ba_air_time4 | 4.18 |
| Ba_gmrt_on_paper1 | 3.59 |
| Ba_mean_jerk_on_paper9 | 3.30 |
| pressure_mean9 | 4.41 |
| paper_time15 | 5.90 |
| Ba_num_of_pendown5 | 5.21 |
| Ba_air_time7 | 6.78 |
| Ba_gmrt_in_air8 | 3.68 |
| Ba_pressure_mean15 | 4.31 |
| pressure_var5 | 4.07 |
| paper_time2 | 4.73 |
## The features by Outcome Drive not in Blind
pander::pander(as.matrix(x1[!(get_De_names %in% get_De_namesU)]))| Ba_paper_time23 | 8.31 |
| Ba_paper_time9 | 7.47 |
| Ba_mean_speed_in_air19 | 4.20 |
| Ba_total_time6 | 6.21 |
| Ba_mean_gmrt14 | 4.60 |
| pressure_mean1 | 3.73 |
| Ba_mean_speed_in_air25 | 5.87 |
| Ba_pressure_mean8 | 4.45 |
| Ba_total_time8 | 5.24 |
| disp_index7 | 4.45 |
| air_time9 | 3.95 |
| Ba_gmrt_on_paper15 | 4.15 |
| Ba_total_time15 | 8.70 |
| Ba_total_time24 | 4.46 |
| Ba_mean_speed_on_paper25 | 3.91 |
| Ba_total_time18 | 5.47 |
| Ba_air_time19 | 1.26 |
| Ba_total_time2 | 5.81 |
| Ba_total_time3 | 4.96 |
| Ba_total_time16 | 5.95 |
| Ba_pressure_var4 | 4.19 |
| Ba_mean_acc_in_air17 | 4.78 |
| pressure_mean7 | 4.39 |
| Ba_disp_index15 | 4.13 |
| Ba_paper_time24 | 3.72 |
| Ba_gmrt_on_paper22 | 4.57 |
| Ba_mean_gmrt1 | 4.12 |
| Ba_mean_jerk_on_paper24 | 3.32 |
| paper_time13 | 4.83 |
| max_y_extension25 | 1.92 |
| Ba_air_time11 | 4.04 |
| Ba_mean_acc_on_paper3 | 3.67 |
| Ba_mean_speed_on_paper2 | 4.31 |
| air_time12 | 3.95 |
## The features not in outcome driven
pander::pander(as.matrix(x2[!(get_De_namesU %in% get_De_names)]))| Ba_total_time9 | 6.83 |
| Ba_air_time6 | 5.86 |
| Ba_gmrt_on_paper23 | 5.00 |
| Ba_air_time8 | 3.73 |
| Ba_air_time15 | 8.15 |
| Ba_air_time2 | 5.07 |
| Ba_air_time18 | 4.43 |
| Ba_mean_acc_in_air25 | 5.01 |
| disp_index9 | 4.37 |
| Ba_mean_acc_on_paper24 | 1.96 |
| Ba_air_time24 | 3.97 |
| Ba_air_time16 | 5.67 |
| Ba_mean_speed_in_air6 | 2.13 |
| Ba_mean_acc_in_air21 | 1.49 |
The Final Table
I’ll create a table subset of the logistic model from the Outcome-Driven decorrelated data.
The table will have:
The top associated features described by the feature network, as well as, and the new features.
- For Decorrelated features it will provide the decorrelation formula
Nugget labels
- The label of nugget as found by the clustering procedure
The feature coefficient
The feature Odd ratios and their corresponding 95%CI
## The features in top nugget
clusterFeatures <- clusterOutcome$names
## The new features
discoveredFeatures <- newvars[zvaluePrePost$ZUni<1.96]
tablefinal <- smDecor$coefficients[unique(c(clusterFeatures,discoveredFeatures)),
c("Estimate","lower","OR","upper","z.IDI")]
nugget <- clusterOutcome$membership
names(nugget) <- clusterOutcome$names
tablefinal$Nugget <- nugget[rownames(tablefinal)]
tablefinal$Nugget[is.na(tablefinal$Nugget)] <- "D"
deFromula <- character(length(theDeFormulas))
names(deFromula) <- names(theDeFormulas)
for (dx in names(deFromula))
{
coef <- theDeFormulas[[dx]]
cname <- names(theDeFormulas[[dx]])
names(cname) <- cname
for (cf in names(coef))
{
if (cf != dx)
{
if (coef[cf]>0)
{
deFromula[dx] <- paste(deFromula[dx],
sprintf("+ %5.3f*%s",coef[cf],cname[cf]))
}
else
{
deFromula[dx] <- paste(deFromula[dx],
sprintf("%5.3f*%s",coef[cf],cname[cf]))
}
}
}
}
tablefinal$DecorFormula <- deFromula[rownames(tablefinal)]
pander::pander(tablefinal)| Estimate | lower | OR | upper | z.IDI | Nugget | DecorFormula | |
|---|---|---|---|---|---|---|---|
| Ba_air_time23 | 0.0589 | 1.0335 | 1.061 | 1.088 | 4.49 | 1 | NA |
| Ba_total_time15 | 0.0972 | 1.0514 | 1.102 | 1.155 | 4.06 | 1 | NA |
| Ba_paper_time23 | 0.7833 | 1.7139 | 2.189 | 2.795 | 6.29 | 2 | NA |
| De_mean_gmrt23 | 0.6458 | 1.3262 | 1.908 | 2.744 | 3.49 | 2 | -0.845gmrt_in_air23 + 1.000mean_gmrt23 |
| Ba_paper_time9 | 0.5798 | 1.4641 | 1.786 | 2.178 | 5.80 | 3 | NA |
| Ba_air_time17 | 0.1373 | 1.0764 | 1.147 | 1.223 | 4.20 | 2 | NA |
| Ba_gmrt_in_air23 | -0.6472 | 0.3876 | 0.524 | 0.707 | 4.16 | 3 | NA |
| De_mean_gmrt19 | 3.0693 | 4.8581 | 21.527 | 95.388 | 4.04 | 3 | -0.398gmrt_on_paper19 + 1.000mean_gmrt19 -0.685*mean_speed_in_air19 |
| Ba_air_time22 | 0.4542 | 1.3374 | 1.575 | 1.855 | 5.56 | 4 | NA |
| Ba_total_time6 | 0.4300 | 1.2967 | 1.537 | 1.823 | 5.01 | 4 | NA |
| Ba_max_x_extension21 | -1.9213 | 0.0646 | 0.146 | 0.332 | 4.63 | 3 | NA |
| num_of_pendown19 | -0.9902 | 0.2470 | 0.371 | 0.559 | 5.06 | 4 | NA |
| De_gmrt_in_air19 | 4.2867 | 11.9647 | 72.728 | 442.083 | 4.82 | 4 | + 1.000gmrt_in_air19 -0.944mean_speed_in_air19 |
| Ba_air_time7 | 0.0712 | 1.0331 | 1.074 | 1.116 | 3.45 | 4 | NA |
| Ba_mean_speed_in_air25 | -0.7592 | 0.3405 | 0.468 | 0.643 | 4.70 | 4 | NA |
| Ba_total_time8 | 0.2211 | 1.1249 | 1.247 | 1.383 | 4.40 | 4 | NA |
| Ba_gmrt_in_air7 | -0.2184 | 0.7288 | 0.804 | 0.886 | 4.52 | 5 | NA |
| Ba_total_time2 | 0.1246 | 1.0614 | 1.133 | 1.209 | 3.98 | 5 | NA |
| Ba_air_time5 | 0.0801 | 1.0406 | 1.083 | 1.128 | 3.82 | 5 | NA |
| pressure_var19 | -0.3574 | 0.5909 | 0.699 | 0.828 | 4.34 | 5 | NA |
| paper_time15 | 0.1230 | 1.0552 | 1.131 | 1.212 | 3.54 | 5 | NA |
| pressure_mean9 | -0.7915 | 0.2905 | 0.453 | 0.707 | 3.55 | 6 | NA |
| Ba_air_time13 | 0.0548 | 1.0275 | 1.056 | 1.086 | 3.98 | 7 | NA |
| Ba_total_time16 | 0.0666 | 1.0297 | 1.069 | 1.110 | 3.70 | 8 | NA |
| Ba_gmrt_on_paper9 | -0.0958 | 0.8629 | 0.909 | 0.957 | 3.85 | 7 | NA |
| Ba_paper_time12 | 0.1641 | 1.0828 | 1.178 | 1.282 | 3.84 | 7 | NA |
| Ba_mean_jerk_on_paper24 | -0.3081 | 0.6150 | 0.735 | 0.878 | 3.34 | 5 | NA |
| paper_time17 | 0.1015 | 1.0492 | 1.107 | 1.168 | 3.82 | 7 | NA |
| De_mean_jerk_in_air7 | 0.7530 | 1.3893 | 2.123 | 3.245 | 3.65 | 5 | -1.149mean_acc_in_air7 + 1.000mean_jerk_in_air7 |
| num_of_pendown23 | 0.8183 | 1.4931 | 2.267 | 3.441 | 3.94 | 7 | NA |
| Ba_num_of_pendown5 | 0.0541 | 1.0240 | 1.056 | 1.088 | 3.45 | 7 | NA |
| Ba_disp_index6 | 0.3630 | 1.2493 | 1.438 | 1.655 | 5.23 | 8 | NA |
| De_pressure_mean5 | -0.3331 | 0.6003 | 0.717 | 0.856 | 3.83 | 5 | -0.889max_y_extension5 + 1.000pressure_mean5 |
| Ba_total_time18 | 0.1231 | 1.0588 | 1.131 | 1.208 | 4.00 | 9 | NA |
| Ba_num_of_pendown9 | 0.0565 | 1.0264 | 1.058 | 1.091 | 3.94 | 7 | NA |
| Ba_total_time24 | 0.1504 | 1.0789 | 1.162 | 1.252 | 4.02 | 8 | NA |
| Ba_max_y_extension19 | -1.2828 | 0.1521 | 0.277 | 0.505 | 4.37 | 9 | NA |
| Ba_pressure_mean4 | -1.3352 | 0.1313 | 0.263 | 0.527 | 3.90 | 5 | NA |
| pressure_mean7 | -0.3221 | 0.6041 | 0.725 | 0.869 | 3.63 | 10 | NA |
| De_paper_time10 | 0.3464 | 1.1799 | 1.414 | 1.694 | 3.95 | 8 | -1.620disp_index10 + 1.000paper_time10 |
| Ba_mean_jerk_on_paper21 | 0.3979 | 1.2225 | 1.489 | 1.813 | 4.30 | 7 | NA |
| Ba_num_of_pendown15 | 0.2947 | 1.1667 | 1.343 | 1.545 | 4.49 | 9 | NA |
| De_mean_acc_on_paper21 | 0.3146 | 1.1525 | 1.370 | 1.628 | 3.60 | 5 | + 1.000mean_acc_on_paper21 + 0.610mean_speed_on_paper21 |
| De_num_of_pendown21 | -0.1223 | 0.8290 | 0.885 | 0.945 | 3.84 | 7 | -0.803air_time21 + 1.000num_of_pendown21 |
| Ba_air_time4 | 0.0334 | 1.0152 | 1.034 | 1.053 | 3.75 | 7 | NA |
| Ba_mean_jerk_on_paper9 | 0.2390 | 1.1112 | 1.270 | 1.451 | 3.62 | 8 | NA |
| Ba_mean_speed_on_paper11 | -0.1753 | 0.7719 | 0.839 | 0.912 | 4.47 | 9 | NA |
| Ba_gmrt_on_paper7 | -0.0296 | 0.9564 | 0.971 | 0.985 | 3.93 | 11 | NA |
| De_disp_index22 | 0.1689 | 1.0887 | 1.184 | 1.288 | 4.10 | 9 | NA |
| Ba_total_time3 | 0.0400 | 1.0176 | 1.041 | 1.064 | 3.83 | 12 | NA |
| paper_time13 | 0.0498 | 1.0216 | 1.051 | 1.081 | 3.32 | 9 | NA |
| De_gmrt_on_paper17 | -0.0467 | 0.9302 | 0.954 | 0.979 | 3.44 | 13 | NA |
| De_disp_index17 | 0.1156 | 1.0538 | 1.123 | 1.196 | 3.51 | 14 | + 1.000disp_index17 -1.396max_y_extension17 |
| Ba_mean_speed_in_air19 | -0.2775 | 0.6695 | 0.758 | 0.858 | 5.02 | 15 | NA |
| pressure_var5 | 0.0129 | 1.0050 | 1.013 | 1.021 | 3.30 | 16 | NA |
| Ba_air_time19 | -0.0377 | 0.9446 | 0.963 | 0.982 | 3.99 | 15 | NA |
| De_paper_time5 | -0.0551 | 0.9174 | 0.946 | 0.976 | 3.45 | D | -1.154max_y_extension5 + 0.946mean_speed_on_paper5 + 1.000*paper_time5 |
| De_max_y_extension24 | -0.2221 | 0.6975 | 0.801 | 0.919 | 3.20 | D | -0.987max_x_extension24 + 1.000max_y_extension24 |
Saving all the generated data
save.image("~/GitHub/FCA/DARWINDemo.RData")