{"metadata":{"kernelspec":{"name":"ir","display_name":"R","language":"R"},"language_info":{"name":"R","codemirror_mode":"r","pygments_lexer":"r","mimetype":"text/x-r-source","file_extension":".r","version":"4.0.5"}},"nbformat_minor":4,"nbformat":4,"cells":[{"cell_type":"code","source":"# This R environment comes with many helpful analytics packages installed\n# It is defined by the kaggle/rstats Docker image: https://github.com/kaggle/docker-rstats\n# For example, here's a helpful package to load\ninstall.packages('RcppNumerical')\nlibrary(tidyverse) # metapackage of all tidyverse packages\nlibrary(data.table)\nlibrary(caret)\nlibrary(arrow)\nlibrary(RcppNumerical)\n# Input data files are available in the read-only \"../input/\" directory\n# For example, running this (by clicking run or pressing Shift+Enter) will list all files under the input directory\n\nlist.files(path = \"../input\")\n\n# You can write up to 20GB to the current directory (/kaggle/working/) that gets preserved as output when you create a version using \"Save & Run All\" \n# You can also write temporary files to /kaggle/temp/, but they won't be saved outside of the current session","metadata":{"_uuid":"051d70d956493feee0c6d64651c6a088724dca2a","_execution_state":"idle","execution":{"iopub.status.busy":"2022-06-03T09:42:07.533454Z","iopub.execute_input":"2022-06-03T09:42:07.535027Z","iopub.status.idle":"2022-06-03T09:42:45.738103Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"### I am using data in parquet format using this link https://www.kaggle.com/datasets/raddar/amex-data-integer-dtypes-parquet-format?select=train.parquet. \n### For now i am only using numeric variables to build final logistic regression.","metadata":{}},{"cell_type":"code","source":"xtrain <- read_parquet('../input/amex-data-integer-dtypes-parquet-format/train.parquet')\n\n# make vectors of factor an numeric variables\nfact_var <- c('B_30', 'B_38', 'D_114', 'D_116', 'D_117', 'D_120', 'D_126', 'D_63', 'D_64', 'D_66', 'D_68')\nnum_var <- names(xtrain)[!names(xtrain) %in% c(fact_var,'customer_ID')]\n\n# keeping only numeric variables and customer id\nxtrain <- xtrain[, setdiff(colnames(xtrain), fact_var), with=FALSE]\n\n# arrange rows by S_2 and select only last observation (X[order(-Value), .SD, by = Name])\nxtrain <- setDT(xtrain)[order(S_2), .SD[c(.N)], by= customer_ID]","metadata":{"execution":{"iopub.status.busy":"2022-06-03T09:42:45.748065Z","iopub.execute_input":"2022-06-03T09:42:45.749567Z","iopub.status.idle":"2022-06-03T09:45:34.201977Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"\namex_metric <- function(target, prediction) {\n  \n  top_four_percent_captured <- function(target, prediction) {\n    \n    dat <- data.frame(target, prediction)\n    \n    dat %>% \n      arrange(-prediction) %>% \n      mutate(weight = case_when(target == 0 ~ 20,\n                                target == 1 ~ 1)) -> dat\n    \n    four_pct_cutoff <- as.integer(0.04 * sum(dat['weight']))\n    dat['cumsum_weight'] <- cumsum(dat$weight)\n    \n    df_cutoff <- dat[dat['cumsum_weight'] <= four_pct_cutoff,]\n    \n    return(sum(df_cutoff['target'] == 1)/sum(dat['target'] == 1))\n  }\n  \n  weighted_gini <- function(target, prediction) {\n    \n    dat <- data.frame(target, prediction)\n    dat %>% \n      arrange(-prediction) %>% \n      mutate(weight = case_when(target == 0 ~ 20,\n                                target == 1 ~ 1)) -> dat\n    \n    dat['random'] <- cumsum(dat['weight']/sum(dat['weight']))\n    \n    total_pos <- sum(dat['target'] * dat['weight'])\n    dat['cum_pos_found'] <- cumsum(dat['target'] * dat['weight'])\n    dat['lorentz'] <- dat['cum_pos_found'] / total_pos\n    dat['gini'] <- (dat['lorentz'] - dat['random']) * dat['weight']\n    \n    return(sum(dat['gini']))\n    \n  }\n  \n  normalized_weighted_gini <- function(target, prediction) {\n    return(weighted_gini(target, prediction) / weighted_gini(target, target))\n  }\n  \n  g <- normalized_weighted_gini(target, prediction)\n  d <- top_four_percent_captured(target, prediction)\n  \n  return(0.5 * (g + d))\n  \n}\n","metadata":{"execution":{"iopub.status.busy":"2022-06-03T09:52:55.587952Z","iopub.execute_input":"2022-06-03T09:52:55.5897Z","iopub.status.idle":"2022-06-03T09:52:55.604731Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"# consider only numeric variables and count NA \n\n#sapply(xtrain[, ..num_var], function(x) sum(is.na(x))) %>% sort()\n#(sapply(xtrain[, ..num_var], function(x) sum(is.na(x))) > 0) %>% table()\n\n# vars with missing data (100 vars) extract names\n(sapply(xtrain[, ..num_var], function(x) sum(is.na(x))) > 0) -> missing_vars\nnames(missing_vars)[missing_vars == T] -> missing_vars","metadata":{"execution":{"iopub.status.busy":"2022-06-03T09:54:35.748395Z","iopub.execute_input":"2022-06-03T09:54:35.751883Z","iopub.status.idle":"2022-06-03T09:54:36.115452Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"# create particiption\n\nytrain <- fread('../input/amex-default-prediction/train_labels.csv')\nxtrain <- left_join(xtrain, ytrain)\nrm(ytrain)\nxtrain$kfold <- createFolds(xtrain$target, k = 10, list = F)\n","metadata":{"execution":{"iopub.status.busy":"2022-06-03T09:54:37.679693Z","iopub.execute_input":"2022-06-03T09:54:37.683167Z","iopub.status.idle":"2022-06-03T09:54:40.219159Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"### Now building logistic regression for all 10 folds. Instead of glm(), i am using fastLR function from package RcppNumerical, which is very fast in calculation.","metadata":{}},{"cell_type":"code","source":"pre_proc <- list()\nsave_beta <- list()\ntrain_metric <- vector(mode = \"numeric\", length = 10)\nvalid_metric <- vector(mode = \"numeric\", length = 10)\n\nfor (i in c(1:10)) {\n  \n    ###### split into train and validation\n\n    train <- xtrain[xtrain$kfold != i] %>% select(-customer_ID, -kfold, -S_2)\n    valid <- xtrain[xtrain$kfold == i] %>% select(-customer_ID, -kfold, -S_2)\n\n    ####  finding mean of columns with missing\n\n    #sapply(xtrain[, ..missing_vars], function(x) mean(x, na.rm = T))\n    train[, sapply(.SD, mean, na.rm = T), .SDcols = missing_vars] -> mean_miss_var\n\n    # replace with training mean        \n    for (col in missing_vars) train[is.na(get(col)), (col) := mean_miss_var[col]]\n    for (col in missing_vars) valid[is.na(get(col)), (col) := mean_miss_var[col]]\n    \n    pre_proc[[i]] <- mean_miss_var\n\n    # model\n \n    \n  log_model <- fastLR(as.matrix(train[,-178]), train$target)\n  train_metric[i] <- amex_metric(train$target, fitted.values(log_model))\n  #print(\n  #  paste0('train_set', '=', amex_metric(train$target, fitted.values(log_model)))\n  #)\n  \n  # val_pred <- predict(log_model, valid, type=\"response\")\n  xb <- as.matrix(valid[,-178]) %*% log_model$coefficients\n  p <- 1 / (1 + exp(-xb))\n  valid_metric[i] <- amex_metric(valid$target, p)\n  #print(\n  #  paste0('valid_set', '=', print(amex_metric(valid$target, p)))\n  #)\n    \n    \n  save_beta[[i]] <- xb\n  rm(train, valid, log_model, xb, p)  \n    \n}\n\npaste0('train_set_mean', '=',mean(train_metric)); paste0('train_set_sd', '=', sd(train_metric))\npaste0('valid_set_mean', '=',mean(valid_metric)); paste0('valid_set_sd', '=',sd(train_metric))\n","metadata":{"execution":{"iopub.status.busy":"2022-06-03T09:55:51.772805Z","iopub.execute_input":"2022-06-03T09:55:51.776759Z","iopub.status.idle":"2022-06-03T10:03:16.029939Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"# saving model and preprocessing things\nsave(save_beta,pre_proc,missing_vars, num_var, fact_var, file=\"logit_preproc.RData\")","metadata":{"execution":{"iopub.status.busy":"2022-06-03T10:06:29.561797Z","iopub.execute_input":"2022-06-03T10:06:29.563816Z","iopub.status.idle":"2022-06-03T10:06:29.806679Z"},"trusted":true},"execution_count":null,"outputs":[]}]}