{"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":"# Implementation of AMEX metric in R","metadata":{"_uuid":"95debacb-b73b-42b7-acfd-2d933e878e39","_cell_guid":"3e70e56a-0d73-4912-9c0d-12744cd6e7ef","jupyter":{"outputs_hidden":false}}},{"cell_type":"markdown","source":"## Introduction","metadata":{}},{"cell_type":"markdown","source":"AMEX competition has become a off-work fun activity for me laterly. However, I have not found so many participants using R than the python users. Consequently, there is even not a publicly shared implementation on the AMEX metrics. In this report, I will share a R implementation that I created and tested.  Hopefully, it will save some time for the fellow R users in this competition.","metadata":{}},{"cell_type":"markdown","source":"## Implementation","metadata":{}},{"cell_type":"markdown","source":"My implementation is essentially a verbatim translation of the python implementation provided by the [competition host](https://www.kaggle.com/code/inversion/amex-competition-metric-python).","metadata":{}},{"cell_type":"code","source":"library(data.table)","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:07:37.200941Z","iopub.execute_input":"2022-06-10T14:07:37.20257Z","iopub.status.idle":"2022-06-10T14:07:37.289339Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"print_metric_result <- function(fn, y, pred, digits=6) {\n  metric_val <- do.call(fn, args=list(y=y, pred=pred))\n  cat(paste(as.character(fn), \": \", round(metric_val, digits), \"\\n\", sep=\"\"))\n  return(metric_val)\n}","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:07:37.291515Z","iopub.execute_input":"2022-06-10T14:07:37.292814Z","iopub.status.idle":"2022-06-10T14:07:37.304884Z"},"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}","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:07:37.307242Z","iopub.execute_input":"2022-06-10T14:07:37.308555Z","iopub.status.idle":"2022-06-10T14:07:37.320081Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"weighted_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}","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:07:37.322106Z","iopub.execute_input":"2022-06-10T14:07:37.323371Z","iopub.status.idle":"2022-06-10T14:07:37.334445Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"normalized_weighted_gini <- function(y, pred) {\n  return(weighted_gini(y, pred) / weighted_gini(y, y))\n}","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:07:37.336531Z","iopub.execute_input":"2022-06-10T14:07:37.337749Z","iopub.status.idle":"2022-06-10T14:07:37.352116Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"code","source":"\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","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:07:37.354199Z","iopub.execute_input":"2022-06-10T14:07:37.355474Z","iopub.status.idle":"2022-06-10T14:07:37.367331Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"## Test","metadata":{}},{"cell_type":"markdown","source":"In this section, we will test our implementation again the a [forked copy of the notebook of the competition host's](https://www.kaggle.com/code/stautxie/python-validation-on-amex-metrics-implemented-in-r/notebook).","metadata":{}},{"cell_type":"markdown","source":"### Test 1","metadata":{"execution":{"iopub.status.busy":"2022-06-10T13:59:51.463807Z","iopub.execute_input":"2022-06-10T13:59:51.467005Z","iopub.status.idle":"2022-06-10T13:59:51.576737Z"}}},{"cell_type":"code","source":"cat(\"Test 1\\n\")\ny <- c(0, 1, 0, 1, 0, 1)\npred <- c(0.1, 0.9, 0.2, 0.88, 0.3, 0.75)\n\ncat(\"Test 1\\n\")\ncat(paste0(\"pred = [\", paste0(pred, collapse=\", \"), \"]\\n\"))\ncat(paste0(\"y = [\", paste0(y, collapse=\", \"), \"]\\n\"))\n\ninvisible(print_metric_result(\"top_four_percent_captured\", y=y, pred=pred))\ninvisible(print_metric_result(\"normalized_weighted_gini\", y=y, pred=pred))\ninvisible(print_metric_result(\"amex_metric\", y=y, pred=pred))","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:07:37.369795Z","iopub.execute_input":"2022-06-10T14:07:37.371065Z","iopub.status.idle":"2022-06-10T14:07:37.512911Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"The results match the python version.","metadata":{}},{"cell_type":"markdown","source":"### Test 2","metadata":{}},{"cell_type":"code","source":"\npred <- c(0.9, 0.3, 0.8, 0.75, 0.65, 0.6, 0.78, 0.7, 0.05, 0.41, 0.42, 0.05, 0.5, 0.11, 0.12)\ny <- c(1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0)\n\ncat(\"Test 2\\n\")\ncat(paste0(\"pred = [\", paste0(pred, collapse=\", \"), \"]\\n\"))\ncat(paste0(\"y = [\", paste0(y, collapse=\", \"), \"]\\n\"))\n\ninvisible(print_metric_result(\"top_four_percent_captured\", y=y, pred=pred))\ninvisible(print_metric_result(\"normalized_weighted_gini\", y=y, pred=pred))\ninvisible(print_metric_result(\"amex_metric\", y=y, pred=pred))","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:07:37.51503Z","iopub.execute_input":"2022-06-10T14:07:37.516359Z","iopub.status.idle":"2022-06-10T14:07:37.580492Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"The results match the python version.","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:02:43.163803Z","iopub.execute_input":"2022-06-10T14:02:43.201105Z","iopub.status.idle":"2022-06-10T14:02:43.213213Z"}}},{"cell_type":"markdown","source":"### Test 3","metadata":{}},{"cell_type":"code","source":"set.seed(1234)\npred <- round(runif(n=10),2)\ny <- rbinom(n=10, size=1, prob=0.5)\n\ncat(\"Test 3\\n\")\ncat(paste0(\"pred = [\", paste0(pred, collapse=\", \"), \"]\\n\"))\ncat(paste0(\"y = [\", paste0(y, collapse=\", \"), \"]\\n\"))\n\ninvisible(print_metric_result(\"top_four_percent_captured\", y=y, pred=pred))\ninvisible(print_metric_result(\"normalized_weighted_gini\", y=y, pred=pred))\ninvisible(print_metric_result(\"amex_metric\", y=y, pred=pred))","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:07:37.582603Z","iopub.execute_input":"2022-06-10T14:07:37.583856Z","iopub.status.idle":"2022-06-10T14:07:37.660625Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"The results match the python version.","metadata":{}},{"cell_type":"markdown","source":"### AMEX test","metadata":{}},{"cell_type":"code","source":"\nDAT_DIR <- \"../input/amex-default-prediction\"\n\ntrain_dt <- fread(file.path(DAT_DIR, \"train_data.csv\"),\n                  select=c(\"customer_ID\", \"P_2\"))\n\ntrain_labels_dt <- fread(file.path(DAT_DIR, \"train_labels.csv\"))\n\nave_p2_dt <- train_dt[, .(P_2=mean(P_2, na.rm=TRUE)), by=c(\"customer_ID\")]\nave_p2_dt[, pred:=1.0 - (P_2 / max(P_2, na.rm=TRUE))]\n\ncat(paste(\"Test on AMEX data set: \\n\"))\ninvisible(print_metric_result(\"amex_metric\", y=train_labels_dt$target, pred=ave_p2_dt$pred, digits=6))","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:07:37.663012Z","iopub.execute_input":"2022-06-10T14:07:37.664443Z"},"trusted":true},"execution_count":null,"outputs":[]},{"cell_type":"markdown","source":"The result also matches the python version of the forked notebook. However, the results seem to be slightly off from the original author's result as is shown in the code comment.  While I am not completely sure about the cause, I did see the P_2 column contains a few thousands of NA values, which find their ways into ave_p2_dt.  This may create ambiguity in the sorting operations in both top_four_percent_captured() and normalized_weighted_gini() between different runs. \n\nAt this point, I am feeling good about my implementation and would like to invite fellow Kaggler to review it and leave me feedback. Thank you.","metadata":{}},{"cell_type":"code","source":"cat(paste(\"Number of NAs in ave_p2_dt: \", ave_p2_dt[, sum(is.na(P_2))], \"\\n\", sep=\"\"))","metadata":{"execution":{"iopub.status.busy":"2022-06-10T14:17:48.434267Z","iopub.execute_input":"2022-06-10T14:17:48.436069Z","iopub.status.idle":"2022-06-10T14:17:48.453768Z"},"trusted":true},"execution_count":null,"outputs":[]}]}