{"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":"markdown","source":"# AMEX Default Prediction - Final project","metadata":{"_uuid":"051d70d956493feee0c6d64651c6a088724dca2a","_execution_state":"idle"}},{"cell_type":"markdown","source":"## Data Preprocessing","metadata":{}},{"cell_type":"code","source":"devtools::install_github(\"edwindj/ffbase\", subdir=\"pkg\")","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:35:40.521646Z","iopub.execute_input":"2023-01-07T07:35:40.523669Z","iopub.status.idle":"2023-01-07T07:36:17.856250Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"library(ffbase)\nlibrary(magrittr)\nlibrary(data.table)\nlibrary(tictoc)\nlibrary(caret)\nlibrary(lightgbm)\n\noptions(DT.warn.size=FALSE)","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:36:17.861073Z","iopub.execute_input":"2023-01-07T07:36:17.863034Z","iopub.status.idle":"2023-01-07T07:36:21.512187Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"#~ Overall parameters\n\nPARQUET_DAT_DIR <- '../input/amex-data-integer-dtypes-parquet-format'\n\nCSV_DAT_DIR <- '../input/amex-default-prediction'\nSAVE_CV_MODEL_DIR <- '.'\nDEFAULT_DT_THREADS <- getDTthreads()\nDEFAULT_BATCHBYTES <- 536870912\ncat(paste(\"Number of threads for data.table: \", DEFAULT_DT_THREADS, \"\\n\", sep=\"\"))\ncat(paste(\"Default Batch Bytes for ffdfdply: \", DEFAULT_BATCHBYTES, \"\\n\", sep=\"\"))","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:36:21.514900Z","iopub.execute_input":"2023-01-07T07:36:21.517053Z","iopub.status.idle":"2023-01-07T07:36:21.549963Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"train_dt <- \n  arrow::read_parquet(file.path(PARQUET_DAT_DIR, \"train.parquet\")) \n\nsetDT(train_dt)\n\ntrain_dt[, S_2:=as.Date(S_2)]\ntrain_dt[, customer_ID:=factor(customer_ID)]\n\nsetorder(train_dt, customer_ID, S_2)\n\ncustomer_ID_levels <- levels(train_dt$customer_ID)\n","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:36:21.553051Z","iopub.execute_input":"2023-01-07T07:36:21.554863Z","iopub.status.idle":"2023-01-07T07:36:56.402943Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"test_dt <- \n  arrow::read_parquet(file.path(PARQUET_DAT_DIR, \"test.parquet\")) \n\nsetDT(test_dt)\n\ntest_dt[, S_2:=as.Date(S_2)]\ntest_dt[, customer_ID:=factor(customer_ID)]\n\nsetorder(test_dt, customer_ID, S_2)\n\ncustomer_ID_levels <- levels(test_dt$customer_ID)","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:36:56.405605Z","iopub.execute_input":"2023-01-07T07:36:56.407087Z","iopub.status.idle":"2023-01-07T07:37:49.005040Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"missing_cols <- c('D_87', 'D_88', 'D_108', 'D_110', 'D_111', 'B_39', 'D_73',\n                'B_42', 'D_134', 'D_135', 'D_136', 'D_137', 'D_138', 'B_29',\n                'D_76', 'D_82', 'R_9', 'D_106', 'D_132', 'D_49', 'R_26', \n                'D_42','D_142','D_53','D_50','B_17','D_105')\n\ntrain_dt[, c(missing_cols) :=NULL]\ntest_dt[, c(missing_cols) :=NULL]","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:37:49.008702Z","iopub.execute_input":"2023-01-07T07:37:49.010293Z","iopub.status.idle":"2023-01-07T07:37:49.034723Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"# num R_9、D_106、D_132、D_49、R_26、D_42、D_142、D_53、d_50、b_17、d_105\n# cat D_66、","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:37:49.038354Z","iopub.execute_input":"2023-01-07T07:37:49.040225Z","iopub.status.idle":"2023-01-07T07:37:49.052377Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"\n# unimp_cols <- \n#   c('B_29', 'D_117', 'R_12', 'D_141', 'R_8', 'D_134', 'D_110', 'D_120', 'D_76', \n#     'D_80', 'D_113', 'R_14', 'B_39', 'D_140', 'D_114', 'D_145', 'D_107', 'D_83', \n#     'D_81', 'D_125', 'S_6', 'D_138', 'S_20', 'R_21', 'D_136', 'D_63', 'D_82', \n#     'B_41', 'D_103', 'R_20', 'D_137', 'D_68', 'D_135', 'D_111', 'D_139', \n#     'D_108', 'B_32', 'R_13', 'R_24', 'S_18', 'D_143', 'D_89', 'R_15', 'D_96', \n#     'D_126', 'R_25', 'D_92', 'D_127', 'D_73', 'B_42', 'R_17', 'R_19', 'B_31', \n#     'D_86', 'R_22', 'D_88', 'D_94', 'D_93', 'D_87', 'D_116', 'D_109', 'R_23', \n#     'R_28')\n\n# train_dt[, c(unimp_cols) :=NULL]","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:37:49.055066Z","iopub.execute_input":"2023-01-07T07:37:49.056541Z","iopub.status.idle":"2023-01-07T07:37:49.068338Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"train_ff <- as.ffdf(train_dt)\nrm(train_dt)","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:37:49.070754Z","iopub.execute_input":"2023-01-07T07:37:49.072153Z","iopub.status.idle":"2023-01-07T07:38:29.254248Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"test_ff <- as.ffdf(test_dt)\nrm(test_dt)","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:38:29.257104Z","iopub.execute_input":"2023-01-07T07:38:29.259007Z","iopub.status.idle":"2023-01-07T07:41:05.289545Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"## Feature Engineering","metadata":{}},{"cell_type":"code","source":"cat_cols <- c(\n  \"B_30\",\n  \"B_38\",\n  \"D_114\",\n  \"D_116\",\n  \"D_117\",\n  \"D_120\",\n  \"D_126\",\n  \"D_63\",\n  \"D_64\",\n  \"D_68\"\n)\n\ncat_cols <- \n  base::intersect(cat_cols, names(train_ff))\n\ndate_cols <- c(\"S_2\")\nnum_cols <- setdiff(names(train_ff), c(\"customer_ID\", date_cols, cat_cols))\n\nfeature <- append(cat_cols, num_cols)","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:41:05.292484Z","iopub.execute_input":"2023-01-07T07:41:05.294096Z","iopub.status.idle":"2023-01-07T07:41:05.319974Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"calc_all_features <- function(df, feature){\n    dat_dt = as.data.table(df)\n    \n    cust_dat_list <- list(\n        last = dat_dt[, lapply(.SD, last), by=c(\"customer_ID\"), .SDcols=feature]\n    )\n\n  cust_dat_dt <-\n    setDT(unlist(cust_dat_list, recursive=FALSE))[]\n  \n  setnames(cust_dat_dt, \"last.customer_ID\", \"customer_ID\")\n  cust_dat_dt[, c(\"first.customer_ID\"):=NULL]\n  \n  rm(cust_dat_list)\n    \n  \n  # convert Inf/-Inf to NA so that tree boosting algorithms won't complain\n  invisible(lapply(names(cust_dat_dt),\n                   function(.name) set(cust_dat_dt, \n                                       which(is.infinite(cust_dat_dt[[.name]])), \n                                       j = .name,\n                                       value =NA)))  \n  \n                   \n  return(as.data.frame(cust_dat_dt))\n}","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:41:05.322695Z","iopub.execute_input":"2023-01-07T07:41:05.324218Z","iopub.status.idle":"2023-01-07T07:41:05.339054Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"tic()\nall_features_ff <-\n  ffdfdply(train_ff[c(\"customer_ID\", feature)], split=train_ff$customer_ID, \n           FUN=calc_all_features, feature=feature, BATCHBYTES = DEFAULT_BATCHBYTES)\ntoc()","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:41:05.341611Z","iopub.execute_input":"2023-01-07T07:41:05.343061Z","iopub.status.idle":"2023-01-07T07:42:33.521648Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"tic()\ntest_all_features_ff <-\n  ffdfdply(test_ff[c(\"customer_ID\", feature)], split=test_ff$customer_ID, \n           FUN=calc_all_features, feature=feature, BATCHBYTES = DEFAULT_BATCHBYTES)\ntoc()","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:42:33.524224Z","iopub.execute_input":"2023-01-07T07:42:33.525717Z","iopub.status.idle":"2023-01-07T07:48:06.115670Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"calc_all_cat_features <- function(df, cat_cols) {\n  dat_dt <- as.data.table(df)\n  cust_dat_list <-\n    list(   \n      last    = dat_dt[, lapply(.SD, last), by=c(\"customer_ID\"), .SDcols=cat_cols],\n      \n      first = dat_dt[, lapply(.SD, first), by=c(\"customer_ID\"), .SDcols=cat_cols]\n    )\n\n  cust_dat_dt <-\n    setDT(unlist(cust_dat_list, recursive=FALSE))[]\n  \n  setnames(cust_dat_dt, \"last.customer_ID\", \"customer_ID\")\n  cust_dat_dt[, c(\"first.customer_ID\"):=NULL]\n  \n  rm(cust_dat_list)\n  \n  # convert Inf/-Inf to NA so that tree boosting algorithms won't complain\n  invisible(lapply(names(cust_dat_dt),\n                   function(.name) set(cust_dat_dt, \n                                       which(is.infinite(cust_dat_dt[[.name]])), \n                                       j = .name,\n                                       value =NA)))  \n  \n  return(as.data.frame(cust_dat_dt))\n}\n","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:48:06.118408Z","iopub.execute_input":"2023-01-07T07:48:06.120308Z","iopub.status.idle":"2023-01-07T07:48:06.145259Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"tic()\ncat_features_ff <-\n  ffdfdply(train_ff[c(\"customer_ID\", cat_cols)], split=train_ff$customer_ID, \n           FUN=calc_all_cat_features, cat_cols=cat_cols, BATCHBYTES = DEFAULT_BATCHBYTES)\ntoc()","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:48:06.148630Z","iopub.execute_input":"2023-01-07T07:48:06.150105Z","iopub.status.idle":"2023-01-07T07:48:17.076413Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"tic()\ntest_cat_features_ff <-\n  ffdfdply(test_ff[c(\"customer_ID\", cat_cols)], split=test_ff$customer_ID, \n           FUN=calc_all_cat_features, cat_cols=cat_cols, BATCHBYTES = DEFAULT_BATCHBYTES)\ntoc()","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:48:17.080021Z","iopub.execute_input":"2023-01-07T07:48:17.081655Z","iopub.status.idle":"2023-01-07T07:48:39.217220Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"calc_all_num_features <- function(df, num_cols) {\n  dat_dt <- as.data.table(df)\n  cust_dat_list <- list(\n    mean = dat_dt[, lapply(.SD, mean, na.rm=TRUE), by = c(\"customer_ID\"), .SDcols=num_cols],\n      \n    first = dat_dt[, lapply(.SD, first), by = c(\"customer_ID\"), .SDcols=num_cols],\n    \n    last = dat_dt[, lapply(.SD, last), by = c(\"customer_ID\"), .SDcols=num_cols]\n  )\n  \n  cust_dat_dt <-\n    setDT(unlist(cust_dat_list, recursive=FALSE))[]\n  \n  setnames(cust_dat_dt, 'mean.customer_ID', 'customer_ID')\n  cust_dat_dt[, `:=`(first.customer_ID=NULL,\n                     last.customer_ID=NULL)]\n  \n  rm(cust_dat_list)\n    \n  #~ introduce the ratio of last to mean\n  \n  cust_dat_dt[, paste(\"last_div_mean.\", num_cols, sep=\"\") := \n                lapply(num_cols, \n                       function(x) {\n                         get(paste(\"last.\", x, sep=\"\")) / \n                           get(paste(\"mean.\", x, sep=\"\"))})]\n  \n  cust_dat_dt[, paste(\"last_sub_mean.\", num_cols, sep=\"\") := \n                lapply(num_cols, \n                       function(x) {\n                         get(paste(\"last.\", x, sep=\"\")) - \n                           get(paste(\"mean.\", x, sep=\"\"))})]\n  \n  # convert Inf/-Inf to NA so that tree boosting algorithms won't complain\n  invisible(lapply(names(cust_dat_dt),\n                   function(.name) set(cust_dat_dt, \n                                       which(is.infinite(cust_dat_dt[[.name]])), \n                                       j = .name,\n                                       value =NA)))\n                   \n  invisible(lapply(names(cust_dat_dt),\n                   function(.name) set(cust_dat_dt, \n                                       which(is.nan(cust_dat_dt[[.name]])), \n                                       j = .name,\n                                       value =NA)))\n\n  return(as.data.frame(cust_dat_dt))\n}","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:10:12.762837Z","iopub.execute_input":"2023-01-06T20:10:12.764393Z","iopub.status.idle":"2023-01-06T20:10:12.783632Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"oldw <- getOption(\"warn\")\noptions(warn = -1)","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:10:12.788925Z","iopub.execute_input":"2023-01-06T20:10:12.791014Z","iopub.status.idle":"2023-01-06T20:10:12.808229Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"tic()\nnum_features_ff <-\n  ffdfdply(train_ff[c(\"customer_ID\", num_cols)], split=train_ff$customer_ID, \n           FUN=calc_all_num_features, num_cols=num_cols, \n           BATCHBYTES = DEFAULT_BATCHBYTES)\ntoc()","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:10:12.812316Z","iopub.execute_input":"2023-01-06T20:10:12.814055Z","iopub.status.idle":"2023-01-06T20:12:33.280476Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"num_features_ff","metadata":{"execution":{"iopub.status.busy":"2023-01-07T07:48:39.219680Z","iopub.execute_input":"2023-01-07T07:48:39.221158Z","iopub.status.idle":"2023-01-07T07:48:39.331342Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"tic()\ntest_num_features_ff <-\n  ffdfdply(test_ff[c(\"customer_ID\", num_cols)], split=test_ff$customer_ID, \n           FUN=calc_all_num_features, num_cols=num_cols, \n           BATCHBYTES = DEFAULT_BATCHBYTES)\ntoc()","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:12:33.284362Z","iopub.execute_input":"2023-01-06T20:12:33.285975Z","iopub.status.idle":"2023-01-06T20:20:32.828982Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"options(warn = oldw)","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:20:32.832766Z","iopub.execute_input":"2023-01-06T20:20:32.834466Z","iopub.status.idle":"2023-01-06T20:20:32.849947Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"oldw <- getOption(\"warn\")\noptions(warn = -1)","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:20:32.853962Z","iopub.execute_input":"2023-01-06T20:20:32.855719Z","iopub.status.idle":"2023-01-06T20:20:32.871713Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"calc_all_lag_features <- function(df, num_cols) {\n  \n  cust_dat_dt <- as.data.table(df)\n\n  #~ add derived features, (last - first) and (last / first)\n  \n  cust_dat_dt[, paste(\"last_sub.\", num_cols, sep=\"\") := \n                lapply(num_cols, \n                       function(x) {\n                         get(paste(\"last.\", x, sep=\"\")) -\n                           get(paste(\"first.\", x, sep=\"\"))\n                       })]\n  \n  cust_dat_dt[, paste(\"last_div.\", num_cols, sep=\"\") := \n                lapply(num_cols, \n                       function(x) {\n                         get(paste(\"last.\", x, sep=\"\")) /\n                           get(paste(\"first.\", x, sep=\"\"))\n                       })] \n  \n  cust_dat_dt[, paste(\"first.\", num_cols, sep=\"\") := NULL]\n  cust_dat_dt[, paste(\"last.\", num_cols, sep=\"\") := NULL]  \n  \n  # convert Inf/-Inf to NA so that tree boosting algorithms won't complain\n  invisible(lapply(names(cust_dat_dt),\n                   function(.name) set(cust_dat_dt, \n                                       which(is.infinite(cust_dat_dt[[.name]])), \n                                       j = .name,\n                                       value =NA)))\n  \n  invisible(lapply(names(cust_dat_dt),\n                   function(.name) set(cust_dat_dt, \n                                       which(is.nan(cust_dat_dt[[.name]])), \n                                       j = .name,\n                                       value =NA)))  \n  \n  return(as.data.frame(cust_dat_dt))\n}","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:20:32.875759Z","iopub.execute_input":"2023-01-06T20:20:32.877518Z","iopub.status.idle":"2023-01-06T20:20:32.893038Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"cat(\"Generating lag features\\n\")\ntic()\nlag_features_ff <-\n    ffdfdply(num_features_ff[c(\"customer_ID\", \n                             grep(\"first\\\\.\", names(num_features_ff), value=TRUE),\n                             grep(\"last\\\\.\", names(num_features_ff), value=TRUE))], split=num_features_ff$customer_ID,\n             FUN=calc_all_lag_features, num_cols=num_cols,\n             BATCHBYTES = DEFAULT_BATCHBYTES)\ntoc()","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:20:32.896978Z","iopub.execute_input":"2023-01-06T20:20:32.898654Z","iopub.status.idle":"2023-01-06T20:20:57.370450Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"cat(\"Generating lag features\\n\")\ntic()\ntest_lag_features_ff <-\n    ffdfdply(test_num_features_ff[c(\"customer_ID\", \n                             grep(\"first\\\\.\", names(test_num_features_ff), value=TRUE),\n                             grep(\"last\\\\.\", names(test_num_features_ff), value=TRUE))], split=test_num_features_ff$customer_ID,\n             FUN=calc_all_lag_features, num_cols=num_cols,\n             BATCHBYTES = DEFAULT_BATCHBYTES)\ntoc()","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:20:57.373047Z","iopub.execute_input":"2023-01-06T20:20:57.374526Z","iopub.status.idle":"2023-01-06T20:21:56.607546Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"options(warn = oldw)","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:21:56.610343Z","iopub.execute_input":"2023-01-06T20:21:56.612019Z","iopub.status.idle":"2023-01-06T20:21:56.625528Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"## Fitting Model","metadata":{}},{"cell_type":"code","source":"\ntrain_labels_dt <- fread(file.path(CSV_DAT_DIR, \"train_labels.csv\"), stringsAsFactors = TRUE)\ntrain_labels_dt[, customer_ID:=factor(customer_ID, customer_ID_levels)]\nsetorder(train_labels_dt, customer_ID)","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:21:56.628333Z","iopub.execute_input":"2023-01-06T20:21:56.630025Z","iopub.status.idle":"2023-01-06T20:21:58.023007Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"set.seed(1234)\nnum_folds <- 3\ntest_folds <- createFolds(train_labels_dt$target, k=num_folds, list=TRUE, returnTrain=FALSE)\n","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:21:58.026895Z","iopub.execute_input":"2023-01-06T20:21:58.029046Z","iopub.status.idle":"2023-01-06T20:21:58.207862Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"\ntop_four_percent_captured <- function(y, pred) {\n  dt <- data.table(y=y,\n                   pred=pred)\n  setorder(dt, -pred, na.last=TRUE)\n  \n  dt[, weight:=ifelse(y == 0, 20, 1)]\n  four_pct_cutoff <- as.integer(0.04 * dt[, sum(weight)])\n  dt[, weight_cumsum:=cumsum(weight)]\n  dt_cutoff <- dt[weight_cumsum <= four_pct_cutoff]\n  return(dt_cutoff[y == 1, .N] / dt[y==1, .N])\n}\n\n#~\n\nweighted_gini <- function(y, pred) {\n  dt <- data.table(y=y,\n                   pred=pred)\n  setorder(dt, -pred, na.last=TRUE)\n  dt[, weight:=ifelse(y==0, 20, 1)]\n  dt[, random:=cumsum(weight / sum(weight))]\n  total_pos <- dt[, sum(weight * y)]\n  dt[, cum_pos_found:=cumsum(y * weight)]\n  dt[, lorenz:=cum_pos_found/total_pos]\n  dt[, gini:=(lorenz - random)*weight]\n  \n  return(as.numeric(dt[, sum(gini)]))\n}\n\n#~\n\nnormalized_weighted_gini <- function(y, pred) {\n  return(weighted_gini(y, pred) / weighted_gini(y, y))\n}\n\n#~\n\namex_metric <- function(y, pred) {\n  return (0.5 * normalized_weighted_gini(y, pred) +\n            0.5 * top_four_percent_captured(y, pred))\n}\n\n#~\n\namex_metric_lgb <- function(y_pred, dtrain) {\n  y_true <- getinfo(dtrain, \"label\")\n  amex_metric_val <- amex_metric(y_true, y_pred)\n  return(list(name=\"AMEX metric\", \n              value=amex_metric_val,\n              higher_better=TRUE))\n}\n","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:21:58.212077Z","iopub.execute_input":"2023-01-06T20:21:58.213969Z","iopub.status.idle":"2023-01-06T20:21:58.578462Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"### Method 1","metadata":{}},{"cell_type":"code","source":"fold_result_list <- list()\n\nfor (fold in 1:num_folds) {\n  # get current fold\n  cat(paste(\"Processing fold \", fold, \"\\n\", sep=\"\"))\n  test_fold <- test_folds[[fold]]\n  \n  cat(paste(\"Creating training data\\n\"))\n  all_features_dt <- as.data.table(all_features_ff)\n  setorder(all_features_dt, customer_ID)\n  \n  tr_all_features_dt <- all_features_dt[-test_fold, -c(\"customer_ID\")]\n  \n    \n  tr_target <- train_labels_dt[-test_fold]$target\n  rm(all_features_dt); gc()\n  \n  tr_mat_dt <- setDT(unlist(list(tr_all_features_dt), recursive=FALSE))\n  \n  rm(tr_all_features_dt); gc()\n  \n  # write matrix to disk to save RAM\n  tr_mat_dt <-\n        setDT(unlist(list(data.table(label=tr_target),\n                          tr_mat_dt), recursive=FALSE))\n    \n   fwrite(tr_mat_dt, \"lgb_tr_mat_dt_1.csv\", col.names=FALSE)\n   rm(tr_mat_dt); gc() \n  \n  # load validation data\n  \n  cat(paste(\"Creating validation data\\n\"))\n  all_features_dt <- as.data.table(all_features_ff)\n  setorder(all_features_dt, customer_ID)\n  \n  va_all_features_dt <- all_features_dt[test_fold, -c(\"customer_ID\")]\n  \n  va_target <- train_labels_dt[test_fold]$target\n  rm(all_features_dt); gc()\n  \n  va_mat_dt <- setDT(unlist(list(va_all_features_dt), recursive=FALSE))\n  \n  rm(va_all_features_dt); gc()\n\n  # write matrix to disk to save RAM\n  va_mat_dt <-\n    setDT(unlist(list(data.table(label=va_target),\n                      va_mat_dt), recursive=FALSE))\n    \n  fwrite(va_mat_dt, \"lgb_va_mat_dt_1.csv\",\n      col.names=FALSE) \n  \n  va_mat_dt[, label:=NULL]\n  \n    # construct lgb data set\n  lgb_data_tr <- lgb.Dataset(\"lgb_tr_mat_dt_1.csv\", colnames = names(va_mat_dt))\n  lgb_data_va <- lgb.Dataset(\"lgb_va_mat_dt_1.csv\", colnames = names(va_mat_dt))\n  # lgb.Dataset.set.categorical(lgb_data_va, mat_cat_cols)\n  \n  # rm(va_mat_dt); gc()\n  \n  # Run lightgbm fitting\n  cat(paste(\"Predicting on the fold\\n\"))\n  set.seed(1234)\n  random_state <- 1234\n  \n  lgb_params = list(objective = 'binary',\n                    metric = \"binary_logloss\",\n                    boosting = 'dart',\n                    random_state = random_state,\n                    num_leaves = 100,\n                    learning_rate = 0.01,\n                    feature_fraction = 0.20,\n                    bagging_freq = 10,\n                    bagging_fraction = 0.50,\n                    n_jobs = -1,\n                    lambda_l2 = 2,\n                    min_data_in_leaf = 40,\n                    device_type='cpu')\n  \n  tic()\n  md_lgb_1 <- lgb.train(params=lgb_params,\n                      data=lgb_data_tr,\n                      eval=amex_metric_lgb,\n                      # eval='binary',\n                      nrounds=1000,\n                      valids=list(tune=lgb_data_va, train=lgb_data_tr),\n                      early_stopping_rounds = 100,\n                      reset_data=TRUE,\n                      eval_freq = 100)  \n  toc()\n  \n  # save the fitted model\n  print(\"save model\")\n  lgb.save(md_lgb_1, file.path(SAVE_CV_MODEL_DIR, paste(\"md_lgb_fold_1\", fold, \".txt\", sep=\"\")))\n  \n  # save weight for importance analysis\n  \n  importance_1 <- lgb.importance(md_lgb_1, percentage = TRUE)\n  \n  # save prediction\n  \n  va_pred <- predict(md_lgb_1, data = va_mat_dt %>% as.matrix())\n  cat(paste('Fold ', fold, ' AMEX metric: ',\n            amex_metric(va_target, va_pred), \"\\n\", sep = \"\"))\n  \n  # save log-odd prediction\n  \n  #va_pred_logodds <- predict(md_lgb, data = va_mat_dt %>% as.matrix(), rawscore = TRUE)\n  \n  # calculate AMEX metric\n  \n  model_score <- amex_metric(va_target, va_pred)\n  \n  # save to result object\n  cat(paste(\"Saving results and clean up\\n\"))\n  \n  fold_result_list[[fold]] <- \n    list(model_score = model_score,\n         va_target = va_target,\n         va_pred = va_pred\n         #, va_pred_logodds = va_pred_logodds\n        )\n  \n  # clean up\n  lgb.unloader(restore=TRUE, wipe=TRUE, envir=environment())\n  rm(va_mat_dt); gc()\n}","metadata":{"execution":{"iopub.status.busy":"2023-01-06T17:07:51.751095Z","iopub.execute_input":"2023-01-06T17:07:51.753057Z","iopub.status.idle":"2023-01-06T18:06:15.579838Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"importance_1","metadata":{"execution":{"iopub.status.busy":"2023-01-06T19:52:57.113750Z","iopub.execute_input":"2023-01-06T19:52:57.153499Z","iopub.status.idle":"2023-01-06T19:52:57.437489Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"fwrite(importance_1, \"importance_1.csv\")","metadata":{"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"### Method 3\n","metadata":{}},{"cell_type":"code","source":"fold_result_list <- list()\n\nfor (fold in 1:num_folds) {\n  # get current fold\n  cat(paste(\"Processing fold \", fold, \"\\n\", sep=\"\"))\n  test_fold <- test_folds[[fold]]\n  \n  cat(paste(\"Creating training data\\n\"))\n  cat_features_dt <- as.data.table(cat_features_ff)\n  setorder(cat_features_dt, customer_ID)\n  \n  num_features_dt <- as.data.table(num_features_ff)\n  setorder(num_features_dt, customer_ID)\n    \n  lag_features_dt <- as.data.table(lag_features_ff)\n  setorder(lag_features_dt, customer_ID)\n\n  \n  tr_cat_features_dt <- cat_features_dt[-test_fold, -c(\"customer_ID\")]\n  tr_num_features_dt <- num_features_dt[-test_fold, -c(\"customer_ID\")]\n  tr_lag_features_dt <- lag_features_dt[-test_fold, -c(\"customer_ID\")]\n  \n\n  tr_target <- train_labels_dt[-test_fold]$target\n  rm(cat_features_dt, num_features_dt, lag_features_dt); gc()\n  \n  tr_mat_dt <- setDT(unlist(list(tr_cat_features_dt,\n                                 tr_num_features_dt,\n                                 tr_lag_features_dt), recursive=FALSE))\n  \n  rm(tr_cat_features_dt, tr_num_features_dt, tr_lag_features_dt); gc()\n  \n  # write matrix to disk to save RAM\n  tr_mat_dt <-\n        setDT(unlist(list(data.table(label=tr_target),\n                          tr_mat_dt), recursive=FALSE))\n    \n   fwrite(tr_mat_dt, \"lgb_tr_mat_dt.csv\", col.names=FALSE)\n   rm(tr_mat_dt); gc() \n  \n  # load validation data\n  \n  cat(paste(\"Creating validation data\\n\"))\n  cat_features_dt <- as.data.table(cat_features_ff)\n  setorder(cat_features_dt, customer_ID)\n  \n  num_features_dt <- as.data.table(num_features_ff)\n  setorder(num_features_dt, customer_ID)\n    \n  lag_features_dt <- as.data.table(lag_features_ff)\n  setorder(lag_features_dt, customer_ID)\n    \n  \n  va_cat_features_dt <- cat_features_dt[test_fold, -c(\"customer_ID\")]\n  va_num_features_dt <- num_features_dt[test_fold, -c(\"customer_ID\")]\n  va_lag_features_dt <- lag_features_dt[test_fold, -c(\"customer_ID\")]\n\n\n  va_target <- train_labels_dt[test_fold]$target\n  rm(cat_features_dt, num_features_dt, lag_features_dt); gc()\n  \n  va_mat_dt <- setDT(unlist(list(va_cat_features_dt,\n                                 va_num_features_dt,\n                                 va_lag_features_dt), recursive=FALSE))\n  \n  rm(va_cat_features_dt, va_num_features_dt, va_lag_features_dt); gc()\n\n  # write matrix to disk to save RAM\n  va_mat_dt <-\n    setDT(unlist(list(data.table(label=va_target),\n                      va_mat_dt), recursive=FALSE))\n    \n  fwrite(va_mat_dt, \"lgb_va_mat_dt.csv\",\n      col.names=FALSE) \n    \n  va_mat_dt[, label:=NULL]\n    \n    # construct lgb data set\n  lgb_data_tr <- lgb.Dataset(\"lgb_tr_mat_dt.csv\", colnames = names(va_mat_dt))\n  lgb_data_va <- lgb.Dataset(\"lgb_va_mat_dt.csv\", colnames = names(va_mat_dt))\n  # lgb.Dataset.set.categorical(lgb_data_va, mat_cat_cols)\n  print(lgb_data_tr)\n  # rm(va_mat_dt); gc()\n  \n  # Run lightgbm fitting\n  cat(paste(\"Predicting on the fold\\n\"))\n  set.seed(1234)\n  random_state <- 1234\n  \n  lgb_params = list(objective = 'binary',\n                    metric = \"binary_logloss\",\n                    boosting = 'dart',\n                    random_state = random_state,\n                    num_leaves = 100,\n                    learning_rate = 0.01,\n                    feature_fraction = 0.20,\n                    bagging_freq = 10,\n                    bagging_fraction = 0.50,\n                    n_jobs = -1,\n                    lambda_l2 = 2,\n                    min_data_in_leaf = 40,\n                    device_type='cpu')\n  \n  tic()\n  md_lgb <- lgb.train(params=lgb_params,\n                      data=lgb_data_tr,\n                      eval=amex_metric_lgb,\n                      # eval='binary',\n                      nrounds=5000,\n                      valids=list(tune=lgb_data_va, train=lgb_data_tr),\n                      early_stopping_rounds = 100,\n                      reset_data=TRUE,\n                      eval_freq = 100)  \n  toc()\n  \n  # save the fitted model\n  \n  lgb.save(md_lgb, file.path(SAVE_CV_MODEL_DIR, paste(\"md_lgb_fold\", fold, \".txt\", sep=\"\")))\n  \n  # save weight for importance analysis\n  \n  importance <- lgb.importance(md_lgb, percentage = TRUE)\n  \n  # save prediction\n  \n  va_pred <- predict(md_lgb, data = va_mat_dt %>% as.matrix())\n  cat(paste('Fold ', fold, ' AMEX metric: ',\n            amex_metric(va_target, va_pred), \"\\n\", sep = \"\"))\n  \n  # save log-odd prediction\n  \n  #va_pred_logodds <- predict(md_lgb, data = va_mat_dt %>% as.matrix(), rawscore = TRUE)\n  \n  # calculate AMEX metric\n  \n  model_score <- amex_metric(va_target, va_pred)\n  \n  # save to result object\n  cat(paste(\"Saving results and clean up\\n\"))\n  \n  fold_result_list[[fold]] <- \n    list(model_score = model_score,\n         va_target = va_target,\n         va_pred = va_pred\n         #, va_pred_logodds = va_pred_logodds\n        )\n  \n  # clean up\n  lgb.unloader(restore=TRUE, wipe=TRUE, envir=environment())\n  rm(va_mat_dt); gc()\n}","metadata":{"execution":{"iopub.status.busy":"2023-01-06T20:21:58.581100Z","iopub.execute_input":"2023-01-06T20:21:58.582573Z","iopub.status.idle":"2023-01-07T03:54:19.140527Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"importance","metadata":{"execution":{"iopub.status.busy":"2023-01-07T03:54:19.154461Z","iopub.execute_input":"2023-01-07T03:54:19.159278Z","iopub.status.idle":"2023-01-07T03:54:19.426830Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"fwrite(importance, \"importance_2.csv\")","metadata":{"execution":{"iopub.status.busy":"2023-01-07T03:54:19.433381Z","iopub.execute_input":"2023-01-07T03:54:19.437578Z","iopub.status.idle":"2023-01-07T03:54:19.479713Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"gc()","metadata":{"execution":{"iopub.status.busy":"2023-01-07T03:54:19.493788Z","iopub.execute_input":"2023-01-07T03:54:19.498359Z","iopub.status.idle":"2023-01-07T03:54:21.517469Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"## Predict","metadata":{}},{"cell_type":"code","source":"fake_target <- 1:nrow(test_cat_features_ff)\nnum_parts <- 4\nall_parts <- split(fake_target, cut(seq_along(fake_target), breaks=num_parts, labels = FALSE))","metadata":{"execution":{"iopub.status.busy":"2023-01-06T06:09:47.202684Z","iopub.execute_input":"2023-01-06T06:09:47.205433Z","iopub.status.idle":"2023-01-06T06:09:47.295007Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"tic()\n\npart_pred_list <- list()\n\nfor (part_index in 1:length(all_parts)) {\n  # get current fold\n  cat(paste(\"Processing part \", part_index, \"\\n\", sep=\"\"))\n  part <- all_parts[[part_index]]\n  part_customer_IDs <- test_cat_features_ff[part, \"customer_ID\"]\n  \n  cat(paste(\"Creating training data\\n\"))\n  test_cat_features_dt <- as.data.table(test_cat_features_ff[part, ])\n  setorder(test_cat_features_dt, customer_ID)\n  \n  test_num_features_dt <- as.data.table(\n    subset(test_num_features_ff, customer_ID %in% part_customer_IDs))\n  setorder(test_num_features_dt, customer_ID)\n    \n     test_lag_features_dt <- as.data.table(\n    subset(test_lag_features_ff, customer_ID %in% part_customer_IDs))\n  setorder(test_lag_features_dt, customer_ID)\n  \n  \n  mat_dt <- setDT(unlist(list(test_cat_features_dt[, -c(\"customer_ID\")],\n                              test_num_features_dt[, -c(\"customer_ID\")],\n                              test_lag_features_dt[, -c(\"customer_ID\")]), recursive=FALSE))\n  \n  customer_IDs <- test_cat_features_dt$customer_ID\n  \n  rm(test_cat_features_dt, test_num_features_dt, test_lag_features_dt); gc()\n  \n  # load fitted model\n  best_cv_fold <- 2\n  best_md_lgb <- lgb.load(file.path(SAVE_CV_MODEL_DIR, paste(\"md_lgb_fold\", best_cv_fold, \".txt\", sep=\"\")))\n  \n  pred_target <- predict(best_md_lgb, data=mat_dt %>% as.matrix())\n  rm(mat_dt); gc()\n  \n  # save to result object\n  cat(paste(\"Saving results and clean up\\n\"))\n  \n  part_pred_list[[part_index]] <- \n    data.table(customer_ID=customer_IDs,\n               prediction=pred_target)\n  \n  # clean up\n  lgb.unloader(restore=TRUE, wipe=TRUE, envir=environment())\n}\ntoc()","metadata":{"execution":{"iopub.status.busy":"2023-01-06T06:09:53.676517Z","iopub.execute_input":"2023-01-06T06:09:53.678197Z","iopub.status.idle":"2023-01-06T06:24:02.073701Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"full_pred_dt <-\n  part_pred_list %>%\n  rbindlist()\n\nrm(part_pred_list); gc()\n\n# write the output\nfwrite(full_pred_dt[, c(\"customer_ID\", \"prediction\")], \"final_submission_dt.csv\")","metadata":{"execution":{"iopub.status.busy":"2023-01-06T07:21:44.047571Z","iopub.execute_input":"2023-01-06T07:21:44.091185Z","iopub.status.idle":"2023-01-06T07:21:44.128966Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"### Feature importance","metadata":{}},{"cell_type":"code","source":"model_1 <- lgb.load(file.path(SAVE_CV_MODEL_DIR, paste(\"md_lgb_fold\", best_cv_fold, \".txt\", sep=\"\")))\nmodel_2 <- lgb.load(file.path(SAVE_CV_MODEL_DIR, paste(\"md_lgb_1_fold\", best_cv_fold, \".txt\", sep=\"\")))","metadata":{"trusted":true},"execution_count":null,"outputs":[]}]}