added 2402 characters in body

Source Link

edited Aug 22, 2019 at 11:11

51
7

The following is the code that seems to work (it produces more reasonable results for AUC, here the best scores are somewhere in the 0.96 range). I would be thankful for any comments whether the approach is reasonable (besides a lot of basic concerns like whether Oversampling should generally be performed when working with XGBoost for example, which I'm also trying to figure out).

smotevalue <- function(x)  {
  
  # Split The Data Into Training/Test
  inTraining <- createDataPartition(bankruptcy.train$class, p = .67, list = FALSE)
  training <- bankruptcy.train[ inTraining,]
  testing  <- bankruptcy.train[-inTraining,]
  
  # SMOTE -> K and dup_size will be varied for optimization
  data_train <- SMOTE(training[,-65], training$class, K = x[1], dup_size = x[2]) 
  data_train <- data_train[["data"]]
  
  xgbLinear_grid <- expand.grid(nrounds = c(150), 
                                lambda = c(1e-04),
                                alpha = c(0),
                                eta = c(0.3))
  # K-fold Cross Validation
  ctrl <- trainControl(method = "repeatedcv", number = 3, repeats = 1, classProbs = TRUE, 
                       summaryFunction = twoClassSummary) #twoClassSummary gives AUC, sensitivity and specificity using default probability cutoff (50%) as performance measure
  
  ## BUILD THE MODELS ##
  
  # outcome variable as a factor for classification in train function
  data_train$class <- factor(data_train$class)
  # in order to avoid error in train function
  levels(data_train$class) <- make.names(levels(factor(data_train$class)))
  
  # xgbLinear (Extreme Gradient Boosting)
  xgbLinear_tune <- train(class ~ ., data = data_train, method = "xgbLinear", 
                          distribution = "bernoulli", trControl = ctrl, tuneGrid = xgbLinear_grid,
                          verbose = FALSE, metric = "ROC") 
  
  test.pred.xgbLinear <- predict(xgbLinear_tune, newdata=testing, type = "prob")
  pred_xgbLinear <- test.pred.xgbLinear[,-1]
  
  # Calculate AUC For Prediction
  roc_obj = roc(testing[,65], pred_xgbLinear)
  auc(roc_obj)*(-1) #negative of AUC as function output in order to perform 
  #maximization instead of minimization with DEoptim
}

The following is the code that seems to work (it produces more reasonable results for AUC, here the best scores are somewhere in the 0.96 range). I would be thankful for any comments whether the approach is reasonable (besides a lot of basic concerns like whether Oversampling should generally be performed when working with XGBoost for example, which I'm also trying to figure out).

smotevalue <- function(x)  {
  
  # Split The Data Into Training/Test
  inTraining <- createDataPartition(bankruptcy.train$class, p = .67, list = FALSE)
  training <- bankruptcy.train[ inTraining,]
  testing  <- bankruptcy.train[-inTraining,]
  
  # SMOTE -> K and dup_size will be varied for optimization
  data_train <- SMOTE(training[,-65], training$class, K = x[1], dup_size = x[2]) 
  data_train <- data_train[["data"]]
  
  xgbLinear_grid <- expand.grid(nrounds = c(150), 
                                lambda = c(1e-04),
                                alpha = c(0),
                                eta = c(0.3))
  # K-fold Cross Validation
  ctrl <- trainControl(method = "repeatedcv", number = 3, repeats = 1, classProbs = TRUE, 
                       summaryFunction = twoClassSummary) #twoClassSummary gives AUC, sensitivity and specificity using default probability cutoff (50%) as performance measure
  
  ## BUILD THE MODELS ##
  
  # outcome variable as a factor for classification in train function
  data_train$class <- factor(data_train$class)
  # in order to avoid error in train function
  levels(data_train$class) <- make.names(levels(factor(data_train$class)))
  
  # xgbLinear (Extreme Gradient Boosting)
  xgbLinear_tune <- train(class ~ ., data = data_train, method = "xgbLinear", 
                          distribution = "bernoulli", trControl = ctrl, tuneGrid = xgbLinear_grid,
                          verbose = FALSE, metric = "ROC") 
  
  test.pred.xgbLinear <- predict(xgbLinear_tune, newdata=testing, type = "prob")
  pred_xgbLinear <- test.pred.xgbLinear[,-1]
  
  # Calculate AUC For Prediction
  roc_obj = roc(testing[,65], pred_xgbLinear)
  auc(roc_obj)*(-1) #negative of AUC as function output in order to perform 
  #maximization instead of minimization with DEoptim
}

added 428 characters in body

Source Link

edited Aug 22, 2019 at 9:40

Internetmann

51
7

Edit:

In the end the models are trained within k-fold cross validation through the "caret" package. When I use the k-fold cross validation within the "smotevalue" function the results get feasible, but the computation takes way too long as you might imagine. But it seems as if the problem would be connected to my use of the XGBoost function here..in the end my aim is to imitate the "xgbLinear" method I use within "caret".

Source Link

asked Aug 22, 2019 at 9:00

Internetmann

51
7

Problems with SMOTE optimizing function

I am new to machine learning or R and tried to code a function "smotevalue" in R in order to fine-tune the parameters of SMOTE for binary classification/prediction in imbalanced data. The idea is to vary the two parameters of SMOTE (K and dup_size) in order to optimize the AUC score of predictions for testdata.

Something seems to be wrong here, as the optimization function reports perfect AUC scores at every iteration. I tested the code within the "smotevalue" function in isolation, and it also gives me unreasonably high AUC scores when predicting the test data. (For example I changed the data-split to 5%/95% training/test, I still got an AUC of about 0.99 for the predictions on test)

Is the testdata somehow used to train the model here? Where is my mistake?

# Libraries
library(smotefamily) #SMOTE
library(caret) #Data Splitting
library(pROC) #AUC Metric
library(DEoptim) #Differential Evolution Optimization

# Set Seed
set.seed(123)

# Read Training Data Into R
bankruptcy.train <- read.csv(file=".../bankruptcy_Train.csv", header=TRUE, sep=",")

# Read Test Data Into R
bankruptcy.test <- read.csv(file=".../bankruptcy_Test_X.csv", header=TRUE, sep=",")


## SMOTUNE ##

smotevalue <- function(x)  {
  
  inTraining <- createDataPartition(bankruptcy.train$class, p = .05, list = FALSE)
  training <- bankruptcy.train[ inTraining,]
  testing  <- bankruptcy.train[-inTraining,]
  
  data_train <- SMOTE(training[,-65], training$class, K = x[1], dup_size = x[2]) 
  data_train <- data_train[["data"]]
  
  data_train <- data.matrix(data_train)
  data_train <- xgb.DMatrix(data = data_train, label=data_train[,65])
  
  bst <- xgboost(data=data_train, booster = "gblinear", nthread = 4, lambda = 1e-04, alpha = 0, 
                 eta = 0.3, nrounds=150, eval.metric = "auc", objective = "binary:logistic")
  
  data_test <- data.matrix(testing)
  data_test <- xgb.DMatrix(data = data_test, label=data_test[,65])
  test.pred.bst <- predict(bst, newdata=data_test)
  
  roc_obj = roc(testing[,65], test.pred.bst)
  auc(roc_obj)*(-1) 
}


# Specify That SMOTE Parameters Will Be Tuned In Discrete Steps

Integer <- function(x){
  x[1:2] <- round(x[1:2]) #k and dup_size -> integer values
}

# Differential Evolution Optimization of function smotevalue,
# varying K and dup_size for highest AUROC value
smote_de_obj <- DEoptim(smotevalue, lower = c(1, 1), upper = c(15, 50), 
                        control = DEoptim.control(NP = 20, itermax = 50, 
                                                  CR = 0.3, F = 0.7), 
                        fnMap = Integer) 


# Report Tuned SMOTE Parameters
fitted_params <- smote_de_obj$optim$bestmem

Stack Exchange Network

Return to Question

Problems with SMOTE optimizing function