R/under.sample_Function.R

In Ehsan-F/R-Mixtape: Mixtape: Enhancing the model making process

under.sample <- function(df_train = ds1, y = 't_Paid', minority_perc = 20) {
  require(unbalanced)
  
  df_train <- as.data.frame(df_train)
  
  prop <- df_train[, y] %>% table() %>% prop.table()
  if((minority_perc/100) < min(prop)) {
    paste('Desired Minority Class Percentage =', minority_perc, '%') %>% print()
    paste('Current Minority Class Percentage =', signif(min(prop)*100, 2), '%') %>% print()
    stop('Please make sure the desired percentage of the minority class is higher than the current percentage.')
  }
  
  df_under <- ubUnder(X = df_train[, -which(colnames(ds1) == y) ],
                      Y = as.factor(df_train[, y]),
                      perc = minority_perc)
  
  df_under <- bind_cols(target = as.nlevels(df_under$Y), df_under$X) %>% as.data.frame()
  
  colnames(df_under)[colnames(df_under) == 'target'] <- y
  
  W <- sum(df_train[, y] == 0)/sum(df_under[, y] == 0)
  
  df_under$w_Weight <- 1
  df_under$w_Weight[df_under[, y] == 0] <- W
  
  df_under
  # assign(deparse(substitute(ds1_under)), df_under, envir = .GlobalEnv)
}