{"cells":[{"metadata":{"_uuid":"6438afd5934837a8c1b5ac12f54a7d786d840378","_cell_guid":"d5f90b55-a108-4c28-a917-7ecda14f2560"},"cell_type":"markdown","source":"This competition serves the purpose to predict if an app will be downloaded or not given some mobile marketing channel. The problem is thus a classification problem of binary nature i.e. the user clicked the download button to download the app fraudulently or not.\n\nThe majority of the data provided is masked, meaning codes or replacement values have been used to deal with the sensitivity and privacy of the data. Masked data is hard to perform feature engineering on and the only field that feature engineering will be applicable on, atleast that we can understand will be on the ``attributed_time`` and ``click_time``features.\n\nOther feature engineering techniques can be used on the masked data but it might prove complicated to understand the results.\n\nI will first analyse the sample training data set and then only train models on the sample training set."},{"metadata":{"_kg_hide-output":true,"_uuid":"487e9503230eec63355d752c61c9643d2e4b98fc","trusted":true,"_cell_guid":"bb8515ce-70c7-497f-9bfd-24000a07b7f7"},"cell_type":"code","source":"library(data.table) # Data load and wrangling\nlibrary(ggplot2) # Visualization\nlibrary(mlr) # Machine learning library\nlibrary(sqldf) # Data wrangling\nlibrary(lubridate) # Date and times\nlibrary(knitr) # Used for html tables\nlibrary(gridExtra) # Combine plots into one page\nlibrary(Information) # Calculate information values\nlibrary(pROC) # ROC calculation\n\ntrain <- fread('../input/train_sample.csv', showProgress = FALSE, stringsAsFactors = FALSE, data.table = FALSE)\ntest <- fread('../input/test.csv', showProgress = FALSE, stringsAsFactors = FALSE, data.table = FALSE)\n\n# Define some functions for use later\ndataSummary <- function(x){\n    \n    summary <- data.frame(Feature = names(x),\n                         Class = sapply(x, class),\n                         Missing = sapply(x, function(x) sum(is.na(x))),\n                         Unique = sapply(x, function(x) length(unique(x)))\n                         )\n    row.names(summary) <- NULL\n    return(summary)\n}\n                                          \nclipOutliers <- function(x){\n    upper <- quantile(x, probs = 0.975, na.rm = TRUE)[[1]]\n    lower <- quantile(x, probs = 0.025, na.rm = TRUE)[[1]]\n    \n    x <- ifelse(x > upper | x < lower, median(x, na.rm = TRUE),x)\n    return(x)\n}\n                                          \n plotROC <- function(actual,predicted){\n  library(pacman)\n  p_load(pROC)\n  roc <- pROC::roc(response =actual ,\n                predictor = predicted)\n\n  plot(roc,\n     col = '#2e6691', \n     main = paste0(\"AUC :\",round(pROC::auc(roc),3)),\n     print.thres = 'best',\n       print.thres.best.method = 'closest.topleft',\n     grid = 1)\n  \n  detach(\"package:pROC\", unload=TRUE)\n}                                         \n                                          \nminLevels <- function(x, minPercentage = 0.025){\n    \n    props <- data.frame(prop.table(table(x)))\n    props[,1] <- as.character(props[,1])\n    names(props) <- c(\"Level\",\"Proportion\")\n    \n    max <- as.character(props[which.max(props$Proportion),1])\n    ind <- props[which(props$Proportion < minPercentage),1]\n    \n    temp <- subset(props, props$Level %in% ind)\n    \n    if(sum(temp$Proportion) > minPercentage){\n        x <- ifelse(x %in% ind,\"OTHER\",x)\n    } else {\n        x <- ifelse(x %in% ind,max,x)\n    }\n    return(x)\n}                                          \n                                                                                 \nggBoxPlot <- function(df, x, y, rotateLabels = FALSE){\n    p <- ggplot(df, aes(x = df[,y], y = df[,x], color = df[,y])) + \n            geom_boxplot() + \n            ggtitle(paste0(y,\" by \",x)) +\n            labs(x = y, y = x) +\n            guides(fill=guide_legend(title=x))\n    \n    if(rotateLabels == TRUE){\n        p <- p + theme(axis.text.x = element_text(angle = 90, hjust = 1))\n    }\n    return(p)\n}\n                                          \nggBar <- function(df, x, y){\n    ggplot(data = df, aes(x = df[,y], fill = df[,x])) + \n        geom_bar(position = \"fill\") + \n        ggtitle(paste0(y,\" by \",x)) + \n        labs(x = x, y = \"Relative frequency\") +\n        guides(fill=guide_legend(title=x))\n}\n                                                                          \ndataSummary(train)\nhead(train)","execution_count":1,"outputs":[]},{"metadata":{"_uuid":"3ba9aa6b23eeee77ec5e027951320537e04c98e5","_cell_guid":"3a0b2f90-de9d-454f-97fd-0fd697f1b4ad"},"cell_type":"markdown","source":"From the summary table above we get a quick glance of the sample training set with the following key characteristics:\n\n* No missing values are present in the dataset\n* The attributed_time feature has a low number of unique values vs click_time\n* It seems that there were 156 apps that were being promoted on 99 different devices\n* A total number of 162 marketing channels were used in this campaign\n\nHowever when peaking at the first 5 observations in the training set, we observe that attributed_time contains blank fields. This is to be expected since there will only be a date and time stamp when a user did in fact download an app.\n\nKeep in mind that these statistics might differ when analysising the full training set.\n\nBecause features such as app, device and channel are essentially categorical of nature, they exhibit a large number of unique categories (encoded). Generally models tend to provide poor performance when they are met with such features, this is something that will need to be corrected before modelling the data.\n\nLets determine how imbalanced the problem is:"},{"metadata":{"scrolled":true,"_uuid":"a9b92c745877a6972af78456928dd4169ae9f2a2","trusted":true,"_cell_guid":"79415526-18c8-47a4-852b-31270e7ba260"},"cell_type":"code","source":"kable(table(train$is_attributed))\nkable(prop.table(table(train$is_attributed)))","execution_count":2,"outputs":[]},{"metadata":{"_uuid":"7de736312e4335baabdfc072dd5962a9c450ff6c","_cell_guid":"fcf75cf5-a8a7-41ff-9567-a8a561eadb13"},"cell_type":"markdown","source":"From the table above we observe that 99.75% of the time no fraud was recorded and a mere 0.25% fraud was recorded.\n\nThis will prove to make the modelling task quite difficult as the data is extremely balanced and we should adjust our modelling techniques to cater for this.\n\nNext we engineer some features on the time features and then perform a bivariate analysis of all the features of relevance."},{"metadata":{"_uuid":"ad574a59185797065a7ccd0f12a613506896319e","trusted":true,"_cell_guid":"9ce131a2-9639-40a5-bfc9-a5eb07b498e0"},"cell_type":"code","source":"train$click_time <- as_datetime(train$click_time)\ntrain$attributed_time <- as_datetime(train$attributed_time)\n\ntrain$TimeDifference <- abs(as.numeric(difftime(train$click_time, train$attributed_time, units = \"secs\")))\n\ntrain$ClickYear <- year(train$click_time)\ntrain$ClickMonth <- month(train$click_time)\ntrain$ClickWeekday <- weekdays(train$click_time)\ntrain$ClickHour <- hour(train$click_time)\ntrain$ClickMinute <- minute(train$click_time)\n\ntemp <- sqldf(\"select ip, count(ip) as FreqIP from train group by ip\")\ntrain <- merge(x = train,\n              y = temp,\n              by.x = \"ip\",\n              all.x = TRUE)\n\ntrain <- train[,setdiff(names(train),c(\"click_time\",\"attributed_time\"))]\ndataSummary(train)","execution_count":3,"outputs":[]},{"metadata":{"_uuid":"f9c1cbedc08490b5dcce1c868d92ec54289ac68a","_cell_guid":"11f32ecb-592b-4f57-92bc-49e7a4374db2"},"cell_type":"markdown","source":"For apps that have been downloaded, the time difference between click and download will be visualized."},{"metadata":{"_uuid":"27319cf34391305bd67d529d570e202471f0fe21","trusted":true,"_cell_guid":"e836f3ff-f0da-4f42-898c-7015e5f5c66d"},"cell_type":"code","source":"p1 <- ggplot(data = train, aes(x = TimeDifference)) + \n    geom_histogram(bins = 30)\np2 <- ggplot(data = train, aes(y = TimeDifference, x = 1)) + \n    geom_boxplot(bins = 30)\ngrid.arrange(p1,p2,nrow = 2)\nsummary(train$TimeDifference)\ntrain$TimeDifference <- NULL","execution_count":4,"outputs":[]},{"metadata":{"_uuid":"9fe68eb60866b981a78094f99e7e8e74dc0d30b1","_cell_guid":"364e52e7-1fd2-4a35-a672-7d5ad7575112"},"cell_type":"markdown","source":"For the 251 apps that were downloaded, the difference in time in seconds between click and download has the following statistics:\n\n* Minimum of 4 seconds \n* Median of 303 seconds or 5.05 minutes\n* Average of 4212 seconds or 70.2 minutes\n* Maximum of 71944 seconds or 1199 minutes or +/- 20 hours\n\nThe distribution is rather strange with only 50% of the data having downloaded the app after clicking on the advertisement in under +/- 5 minutes. 75% of the data shows that they downloaded the app after clicking in under 70.2 minutes.\n\nNext we will calculate the information values for each feature before and after \"correcting\" some of the features in the dataset to determine predictive power."},{"metadata":{"_uuid":"24e53fdf39313d131e0c7aea26396458ad964801","trusted":true,"_cell_guid":"6d8a4c66-cc35-4ee3-b0ee-733806ce6ff4"},"cell_type":"code","source":"IV <- create_infotables(data = train, y = \"is_attributed\")\nIV$Summary","execution_count":5,"outputs":[]},{"metadata":{"_uuid":"5a0ce704e295e2b3d03d3cc858629512bd839d3e","_cell_guid":"fa1e3e77-b4cf-4319-a0d4-0ad38a387cb9"},"cell_type":"markdown","source":"Generally IV values are interpreted as follow:\n\n* No predictive power: IV < 2%\n* Weak predictive power:  2% <= IV < 10%\n* Medium predictive power: 10% <= IV < 30%\n* Strong predictive power: 30% <= IV < 50%\n* Very strong predictive power: 50% <= IV\n\nFrom the IV table above not one variable exhibits predictive power. Let's see if some \"cleaning\" can improve the IV values."},{"metadata":{"scrolled":true,"_uuid":"6ab8d33af20008a1c538ea7e32a872d97a52b816","trusted":true,"_cell_guid":"e3f0a746-a9c2-41fb-b626-841f906eae70"},"cell_type":"code","source":"trainNew <- train\ntrainNew$app <- minLevels(trainNew$app)\ntrainNew$device <- minLevels(trainNew$device)\ntrainNew$channel <- minLevels(trainNew$channel)\ntrainNew$os <- minLevels(trainNew$os)\ntrainNew$FreqIP <- clipOutliers(trainNew$FreqIP)\n\nIV <- create_infotables(data = trainNew, y = \"is_attributed\")\nIV$Summary\nIV$Tables\n\ntrain <- trainNew\ntrain$is_attributed <- as.factor(train$is_attributed)","execution_count":6,"outputs":[]},{"metadata":{"_uuid":"2bf0bb1b406578235f523a1d08dd75f175846e72","_cell_guid":"fbce5eb1-d47a-4041-a284-b5c528510703"},"cell_type":"markdown","source":"Some of the features which levels were corrected hurt the predictive power. We might want to try and use a combination of the pre-processing functions and leave other features as is. \n\nHaving \"cleaned\" the data roughly, bivariate analysis can now be performed to quickly get an idea of how each feature is distributed with respect to the outcome feature. "},{"metadata":{"_uuid":"b657026ff2fa13961d39bd0a7c26b0a57498dd62","trusted":false,"_cell_guid":"6d22be44-7875-4170-88a2-4c427db9db10"},"cell_type":"code","source":"ggBar(df = train, x = \"app\", y = \"is_attributed\")","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"323450287b18100f34a0799465a2c423cf2570e7","_cell_guid":"159da133-e1ad-49f4-b683-f76b8987dd79"},"cell_type":"markdown","source":"When correcting the number of levels in the `app` feature, a total number of 9 levels are left. It appears that this feature will play a significant role in modelling the outcome feature."},{"metadata":{"_uuid":"3d0a3fadf0c0b73fbc0d9c96890cb680c632e342","trusted":false,"_cell_guid":"f9f7bb08-6db8-44ef-9f8e-c5ff828e229f"},"cell_type":"code","source":"ggBar(df = train, x = \"device\", y = \"is_attributed\")","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"15750a8ccdda72a678650d947cc723851cdd6e62","_cell_guid":"d5fdf8f4-6709-48f9-a687-4a8907662a6a"},"cell_type":"markdown","source":"It seems that there are only two devices that are most frequently used by users. However almost no occurrences of device 2 is present when the outcome feature is positive."},{"metadata":{"_uuid":"04f450234042c1a07243c404c70b8da864efc3cb","trusted":true,"_cell_guid":"91d7c60f-8e3c-44e5-93e6-5d4fe251d78b","scrolled":true},"cell_type":"code","source":"ggBar(df = train, x = \"channel\", y = \"is_attributed\")","execution_count":7,"outputs":[]},{"metadata":{"_uuid":"797993332a3b93185651505df2e231a025239596","_cell_guid":"ab441d9d-4b1d-4219-965f-66b306e3785c"},"cell_type":"markdown","source":"The majority of positive outcomes are correlated with channel levels of minimum percentage. This feature shows good spread between the outcome levels.\n\nOnly eleven channels are left after correcting minimum levels."},{"metadata":{"_uuid":"fa87dfdaafdc25c25602c75f8c8e63cc2af504ba","trusted":true,"_cell_guid":"9e0d1f2c-ec1d-43b1-80a1-16afeccc7f7a","scrolled":true},"cell_type":"code","source":"ggBar(df = train, x = \"os\", y = \"is_attributed\")","execution_count":8,"outputs":[]},{"metadata":{"_uuid":"0f0dc1fc8a7bc1cbf2fe87dd987d17daf27a5194","_cell_guid":"28cc4124-3704-461d-aea8-768427a9f9af"},"cell_type":"markdown","source":"Good seperation exists for `os` with respect to the outcome feature. Only 9 different types of operating systems are left after correcting the levels."},{"metadata":{"_uuid":"b61626ead9dc98762dcb5658297a46fd2e270b17","trusted":true,"_cell_guid":"6542b3b3-2e1f-4b31-9458-1fbbe4ec1f1a"},"cell_type":"code","source":"p1 <- ggBar(df = train, x = \"ClickYear\", y = \"is_attributed\")\np2 <- ggBar(df = train, x = \"ClickMonth\", y = \"is_attributed\")\ngrid.arrange(p1,p2,ncol = 2)","execution_count":9,"outputs":[]},{"metadata":{"_uuid":"a80f6bc8deb5df15fbb8cef9fa94be336c205354","_cell_guid":"ea3ecda3-46f6-4655-bc6b-a28dd071ff95"},"cell_type":"markdown","source":"It appears that the sample training set only contains data for November 2017. These features can be removed as they will add no extra information."},{"metadata":{"_uuid":"bf5a9b6279daf9a83b6cce8d2f45df31b15430dc","trusted":true,"_cell_guid":"e2a49b4a-9158-4f6e-a932-4d8be2e4c7e3"},"cell_type":"code","source":"train$ClickYear <- NULL\ntrain$ClickMonth <- NULL\nggBar(df = train, x = \"ClickWeekday\", y = \"is_attributed\")","execution_count":10,"outputs":[]},{"metadata":{"_uuid":"7b3fd414b6c053689f69bd9413b7d9050e1c3d63","_cell_guid":"16e18795-df58-4fff-a96b-b7703090a6ff"},"cell_type":"markdown","source":"The day of the week when outcomes were observed provides no seperation between outcome levels and thus will add no extra information and can be removed."},{"metadata":{"_uuid":"a01f4d188437e2762bba0e69a1ae413f273fab8c","trusted":true,"_cell_guid":"e3ea83a3-4281-4d4b-b002-87382b9e123a","scrolled":true},"cell_type":"code","source":"ggBoxPlot(df = train, x = \"ip\", y = \"is_attributed\")","execution_count":11,"outputs":[]},{"metadata":{"_uuid":"7aeaa8cfbec53c2e326eab7dd8fda24c719a7d6d","_cell_guid":"d00dde06-8bfc-4a45-840a-92432e1f0c15"},"cell_type":"markdown","source":"Looking at the IP address of a user, this feature shows significant spread between outcome classes and should boost the performance of the model."},{"metadata":{"_uuid":"abc45a83722e99ee20ced35946734cf3f07304d3","trusted":true,"_cell_guid":"aed746fa-b765-4354-948c-471134e2dcd7","scrolled":true},"cell_type":"code","source":"ggBoxPlot(df = train, x = \"FreqIP\", y = \"is_attributed\")","execution_count":12,"outputs":[]},{"metadata":{"_uuid":"0c4a89da8a112a70e946b6cfe55bafbe953f57ee","_cell_guid":"c36e2798-051f-4b3c-a51c-2f3c34b81238"},"cell_type":"markdown","source":"Analysing the number of times an IP address was recorded shows no significant value towards the outcome. It almost appears that observed fraud takes place by unique IP addresses or the data is thin."},{"metadata":{"_uuid":"a09938f97cf01d0493ba949fe4cc7a033df4a364","trusted":true,"_cell_guid":"3d63ac79-aae5-4419-aa28-2717325cf242","scrolled":true},"cell_type":"code","source":"ggBoxPlot(df = train, x = \"ClickHour\", y = \"is_attributed\")","execution_count":13,"outputs":[]},{"metadata":{"_uuid":"3898ade3001873aa83713fcf05e7f1f33bad98c9","_cell_guid":"d943f630-c760-4c6a-991a-8d77f2d02c4b"},"cell_type":"markdown","source":"Analysing the time of day when fraud was observed shows some spread between outcome classes. The median hour at which fraud is observed is close to 8am compared to 9am for non fraud."},{"metadata":{"_uuid":"3c362c34223c92c4914daf7b165ab1fc6adb14d5","trusted":true,"_cell_guid":"5f9aafd7-4004-4d1a-a83f-ae53c8e941a0"},"cell_type":"code","source":"ggBoxPlot(df = train, x = \"ClickMinute\", y = \"is_attributed\")","execution_count":14,"outputs":[]},{"metadata":{"_uuid":"c7627915c75b9bbf52ddcf158c6e2a96c3f1e5dc","_cell_guid":"21957150-f5b2-4c9c-9450-d2bd5e3d6fe1"},"cell_type":"markdown","source":"Not the best feature to create since hour captures most of the information but I included it for the sake of interest. The minute of the day for a certain hour at which fraud is recorded shows no significant spread for the outcome classes.\n\nNext we change the outcome feature to a factor and use stratified random sampling to create a validation set to test our future model(s) on."},{"metadata":{"_uuid":"1991f86724a20ef9ab4057dd2476958305df16fc","trusted":true,"_cell_guid":"49272e0b-cd7a-4c92-9068-63dc89f3f013"},"cell_type":"code","source":"remove <- c(\"ClickWeekday\",\"ClickMinute\",\"FreqIP\",\"ip\") # Remove features according to bivariate analysis\ntrain <- train[,setdiff(names(train),remove)] \n\nset.seed(1991)\nind <- caret::createDataPartition(y = train$is_attributed, p = 0.7, list = FALSE)\n\nvalid <- train[-ind,]\ntrain <- train[ind,]\n\nlogistic <- glm(is_attributed ~ ., data = train, family = \"binomial\")\n\np.train <- predict(logistic, train, type = \"response\")\np.valid <- predict(logistic, valid, type = \"response\")","execution_count":15,"outputs":[]},{"metadata":{"_uuid":"a804f1acc1ad4940305363e2fb89a0356b1e2fea","trusted":true,"_cell_guid":"f2dde3af-7da3-4c31-9840-031c28f32a4b","scrolled":true},"cell_type":"code","source":"plotROC(actual = train$is_attributed, predicted = p.train)\nplotROC(actual = valid$is_attributed, predicted = p.valid)","execution_count":18,"outputs":[]},{"metadata":{"_uuid":"fc077cf068b6e1cad35a14be2f3cc6bf6bbd6b51"},"cell_type":"markdown","source":"By using a simple logistic regression model to model fraudulent app downloads without performing any sampling techniques to reduce outcome class imbalances, the model achieves an ROCAUC of 0.91 on the sample training set and 0.905 on the validation set.\n\nThe cleaning and engineering of the feaures were kept simple and to a minimum."}],"metadata":{"kernelspec":{"display_name":"R","language":"R","name":"ir"},"language_info":{"mimetype":"text/x-r-source","name":"R","pygments_lexer":"r","version":"3.4.2","file_extension":".r","codemirror_mode":"r"}},"nbformat":4,"nbformat_minor":1}