1 Intro

A recent blog post1 highlighted the applicability of logistic regression for a binary classification problem using a dataset with products bought by customers with the additional information whether the respective buyer was pregnant or not.

We will demonstrate how NNS multivariate regression is quite capable of such tasks, and how the other machine learning techniques NNS.stack based on the underlying regression do even better.

2 Install NNS (>= 10.2)

# remotes::install_github('OVVO-Financial/NNS', ref = "NNS-Beta-Version")
library(NNS)

3 Download and Read Data

Data: http://media.wiley.com/product_ancillary/6X/11186614/DOWNLOAD/ch06.zip

Save the first excel sheet Training Data w Dummy Vars as a "RetailMart_train.csv" and read into R.

Create independent variables.

4 Run NNS Multivariate Dimension Reduction Regression and Logistic Regression

NNS.stack cross-validates the n.best parameter in NNS.reg, as well as the threshold parameter for the dimension reduction method in NNS.reg.

nns_model <- NNS.stack(IVs.train = RetailMart_train_IV,
                       DV.train = RetailMart_train$PREGNANT + 1,
                       IVs.test = RetailMart_train_IV, 
                       balance = TRUE, order = "max", type = "CLASS")

nns_conf <- table(ifelse(nns_model$stack %% 1 < .5, floor(nns_model$stack), ceiling(nns_model$stack)), RetailMart_train$PREGNANT + 1)


logreg <- glm(RetailMart_train$PREGNANT ~ ., data = cbind(RetailMart_train_IV), family = binomial) 

pred <- ifelse(predict(logreg,RetailMart_train_IV , "response") < 0.5, 0, 1)

logistic_conf <- table(pred, RetailMart_train$PREGNANT)

nns_conf
##    
##       1   2
##   1 469 194
##   2  31 306
logistic_conf
##     
## pred   0   1
##    0 450 115
##    1  50 385

Pretty similar results, let’s see how they generalize to unseen data…

5 Test set

The data also offer a test set. So we will save that Test Set excel sheet as "RetailMart_test.csv" into R and compare prediction accuracy.

5.1 Logistic Regression

RetailMart_test <- read.csv("RetailMart_test.csv")
RetailMart_test_IV <- subset(RetailMart_test, select = names(RetailMart_test)%in%names(RetailMart_train_IV))
RetailMart_test_IV <- RetailMart_test_IV[complete.cases(RetailMart_test_IV),]

oos_pred <- ifelse(predict(logreg, RetailMart_test_IV , "response") < 0.5, 0, 1)

logistic_conf_oos <- table(oos_pred, na.omit(RetailMart_test$PREGNANT))

5.2 NNS Stack

nns_stack_oos <- NNS.stack(IVs.train = RetailMart_train_IV,
                           DV.train = RetailMart_train$PREGNANT + 1,
                           IVs.test = RetailMart_test_IV, 
                           balance = TRUE, order = "max", type = "CLASS")


nns_stack_conf_oos <- table(ifelse(nns_stack_oos$stack %% 1 < .5, floor(nns_stack_oos$stack),ceiling(nns_stack_oos$stack)), na.omit(RetailMart_test$PREGNANT) + 1)

5.3 Compare all Methods’ Confusion Matrices

5.3.1 Logistic Regression

logistic_conf_oos
##         
## oos_pred   0   1
##        0 830  13
##        1 110  47

5.3.2 NNS Stack

nns_stack_conf_oos
##    
##       1   2
##   1 881  26
##   2  59  34

5.4 Interpretability of NNS Results.

We can see the final equation used in the cross-validated NNS.reg function.

NNS.reg(x = RetailMart_train_IV,
        y = RetailMart_train$PREGNANT,
        point.est = RetailMart_test_IV,
        plot = FALSE,
        dim.red.method = "cor", 
        threshold = nns_stack_oos$NNS.dim.red.threshold)$equation

So after all of that, Folic.Acid alone is the best predictor of PREGNANT…

mean(na.omit(RetailMart_test$Folic.Acid) == na.omit(RetailMart_test$PREGNANT))
## [1] 0.952

Better than Pregnancy.Test!!!

mean(na.omit(RetailMart_test$Pregnancy.Test) == na.omit(RetailMart_test$PREGNANT))
## [1] 0.937

5.4.1 Random Forest

library(randomForest)

rf.fit <- randomForest(as.factor(as.character(PREGNANT)) ~ . , data=RetailMart_train, na.action = na.omit)

rf.pred <- predict(rf.fit, newdata = RetailMart_test_IV)
table(rf.pred, na.omit(RetailMart_test$PREGNANT))
##        
## rf.pred   0   1
##       0 832  14
##       1 108  46

5.4.2 xgboost

library(xgboost)

xgb.train = xgb.DMatrix(data=as.matrix(RetailMart_train_IV),label=RetailMart_train$PREGNANT)
xgb.test = xgb.DMatrix(data=as.matrix(RetailMart_test_IV),label=na.omit(RetailMart_test$PREGNANT))

num_class = 2

params = list(
  booster="gbtree",
  eta=0.001,
  max_depth=5,
  gamma=3,
  subsample=0.75,
  colsample_bytree=1,
  objective="multi:softprob",
  eval_metric="mlogloss",
  num_class=num_class
)

xgb.fit=xgb.train(
  params=params,
  data=xgb.train,
  nrounds=10000,
  nthreads=1,
  early_stopping_rounds=10,
  watchlist=list(val1=xgb.train),
  verbose=0
)
## [21:19:45] WARNING: src/learner.cc:767: 
## Parameters: { "nthreads" } are not used.
xgb.pred = predict(xgb.fit,as.matrix(RetailMart_test_IV),reshape = TRUE)
colnames(xgb.pred)= c(0,1)

xgb.pred$prediction = apply(xgb.pred,1,function(x) colnames(xgb.pred)[which.max(x)])
table(xgb.pred$prediction,na.omit(RetailMart_test$PREGNANT))
##    
##       0   1
##   0 835  15
##   1 105  45

6 Comments

NNS is a fully capable continuous regression and classification tool. NNS.reg is not a black-box ML solution, rather, NNS provides a theoretically sound solution to dynamically partitioning regressors, and finding conditional outputs from those partitions.

NNS is not a one-trick pony, as it has been demonstrated to excel in time-series forecasting, nonlinear continuous regressions, and provide solutions for econometric applications. See the following examples:

I look forward to further discussions and collaboration with those equally as passionate about these issues, and open to embracing alternative solutions. If you found this presentation interesting or useful, please feel free to reach out via e-mail:

Thanks for your interest!

  1. https://www.r-bloggers.com/learning-data-science-the-supermarket-knows-you-are-pregnant-before-your-dad-does/↩︎