{"cells":[{"metadata":{"_uuid":"4d62c1b83b60e162f6cc3133b6fa2b8467385187"},"cell_type":"markdown","source":"# Load the libraries and the data\n\nThe libraries used:\n- `quanteda` to do basic bag of words NLP operations. In R the `tm` package used to be most popular for this purpose. In my experience `quanteda` offers better functionality and it is much faster.\n- `LiblineaR` to do logistic regression or SVM. The package is very fast and offers a variety of optimization methods and regularizations. \n- `ROCR` to evaluate prediction performance and `ggplot2` to visualize performance evaluation results"},{"metadata":{"_uuid":"cda83eec96bcdf2d63fe256aa8184afce0faad7b","_execution_state":"idle","trusted":true},"cell_type":"code","source":"suppressMessages({\n    library(quanteda)\n    library(LiblineaR)\n    library(SparseM)\n    library(foreach)\n    library(doParallel)\n    library(dplyr)\n    library(tidyr)\n    library(ggplot2)\n    library(ROCR)\n})","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"b204e8e031d5c8ee0a287c2daaffc0d7334e04ff"},"cell_type":"markdown","source":"Read the data. Merge all of it into one data frame. That is to make one single dictionary from the train and test texts. That's a bit of a cheating, though, because we do not have access to new data text when model is deployed..."},{"metadata":{"trusted":true,"_uuid":"c0f300d17a5de687fb6792d9fd678f32eb73d53f"},"cell_type":"code","source":"dtr <- read.csv(\"../input/train.csv\", stringsAsFactors=FALSE)\ndts <- read.csv(\"../input/test.csv\", stringsAsFactors=FALSE)\ndts$target <- NA\nd <- rbind(dtr,dts)\ntrain_set <- which(!is.na(d$target))\nrm(dts,dtr)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"1d4831dfc7921e30285ab30628816d8fbdec25bd"},"cell_type":"markdown","source":"The number of samples:"},{"metadata":{"trusted":true,"_uuid":"f357894f1fe550e81616cef7aa54a4737f4fe829"},"cell_type":"code","source":"dim(d)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"e9277aee7d327884d4a0726c6c882eebb4bb3c6a"},"cell_type":"markdown","source":"# Make a document-term matrix\n\nIn `quanteda` they call it document-feature matrix, for good reasons. I am sticking with the traditional terminlogy. We make the document-term matrix (DTM) by tokenizing the text and counting terms frequencies. I am also making 2-word n-grams and 2-word skip-grams with the distance between terms up to 2.  \n\nDo the stemming and remove numbers and stop-words. However, keep punctuation. It may be significant to detect wrting style."},{"metadata":{"trusted":true,"_uuid":"26e5bb7cf2efdb21a090ef764bf2967ba74240da"},"cell_type":"code","source":"tokens(tolower(d$question_text), remove_numbers = TRUE,\n  remove_symbols = TRUE, remove_separators = TRUE,\n  remove_twitter = TRUE, remove_hyphens = TRUE, remove_url = TRUE) %>%\n  tokens_ngrams(n = 1:2, skip = 0:2) -> qtokens","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"38c91230e6fc5bbb182d4997116cfea8d2583a81"},"cell_type":"markdown","source":"Take a look at the tokens and n-grams to make sure the data looks sane."},{"metadata":{"trusted":true,"_uuid":"754ea818c115b04d6570d3fb2a8126f43346a70e"},"cell_type":"code","source":"head(qtokens, 3)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"2ff1de57804e81480e1521c344bb05a7dc8171a2"},"cell_type":"markdown","source":"Make a DTM. See how big is the dictionary. That's the second dimension. "},{"metadata":{"trusted":true,"_uuid":"bf00769823ed17fe6c5f945ca1a418af3c8f623d"},"cell_type":"code","source":"q_dtm <- dfm(qtokens)\ndim(q_dtm)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"ac6f3dd1a5a9800112a0ea19922a97f02474a621"},"cell_type":"markdown","source":"In this second version of the notebook I do not truncate DTM features. It seems that `LiblineaR` can handle 6M features with ease. "},{"metadata":{"_uuid":"c061f1bc33049902f721e46995f0a5bf290d96a8"},"cell_type":"markdown","source":"Prepare DTM in the form that `LiblineaR` can use"},{"metadata":{"trusted":true,"_uuid":"694c311a4d643ab7348c22f66605bd96dcf93c55"},"cell_type":"code","source":"# Liblinear want SparseM, Qunateda produces Matrix. Convert it here using SO advice:\n# From https://stackoverflow.com/questions/17375056/r-sparse-matrix-conversion\nMatrix_to_SparseM <- function(m) {\n  m2 <- new(\"matrix.csc\", ra = m@x, ja = m@i + 1L, ia = m@p + 1L, dimension = m@Dim)\n  as.matrix.csr(m2)\n}","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"71702eb6f135c369f0efc337c7215b687bb2d3db"},"cell_type":"code","source":"q_dtm_m <- Matrix_to_SparseM(q_dtm)\ngc()","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"d1ecbad278409dc82cfa9e48b30eb06b29512009"},"cell_type":"markdown","source":"# Tune model parameters\n\nThe parameters we can tune are:\n- regularization parameter\n- probability threshold\n\nAdding a helper function to evaluate maximum F1 performance value given predicted probabilities. Using `ROCR` functions to get the F1 values. Note that other measures supported by `ROCR` can be used, for example `acc` for accuracy. "},{"metadata":{"trusted":true,"_uuid":"190f3bc466b7cf68899e733608992edd23b05852"},"cell_type":"code","source":"max_perf <- function(pred, meas) {\n    ppf = performance(pred, meas)\n    max_pos = which.max(attr(ppf,\"y.values\")[[1]])\n    max_value = attr(ppf,\"y.values\")[[1]][max_pos]\n    max_cutoff = attr(ppf,\"x.values\")[[1]][max_pos]\n    list(cutoff=as.numeric(max_cutoff), value=max_value)\n}","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"f19c8da7f620d22bf6b810b441f41c2175e5ed43"},"cell_type":"markdown","source":"Another helper function, this is to execute a single run of Monte-Carlo cross validation. "},{"metadata":{"trusted":true,"_uuid":"6f688a5d01af98eab1bf4ddcaa3ca3aa2184191a"},"cell_type":"code","source":"test_cv <- function(subset, cost=1) {\n    train_set = sample(subset, length(subset)*0.9)\n    test_set = setdiff(subset, train_set)\n    fit = LiblineaR(data=q_dtm_m[train_set,], target=d$target[train_set], \n                    type=0, cost=cost, \n                    bias=TRUE,verbose=FALSE)\n    pred = predict(fit,q_dtm_m[test_set,],proba=TRUE)\n    pp = prediction(pred$probabilities[,\"1\"], d$target[test_set])\n    max_f1 = max_perf(pp,\"f\")\n    c(f1_cutoff=as.numeric(max_f1$cutoff), f1_value=as.numeric(max_f1$value))\n}","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"a9991cbeaab1885b55ec83e2c236e48dce4a0ef4"},"cell_type":"markdown","source":"Run multiple test/validate loops over a few cost parameters. The goal is to find a good probability threshold value that gives us the best F1 score on average.  I am using `foreach` below out of habit. I often do cross-validation in parallel with `dopar`. Not in this case though. This cross valiadtion may run out of memory on 16G box if run in parallel. Also, the `LiblineaR` seems to support multi-threading, so `dopar` may not be necessary."},{"metadata":{"trusted":true,"_uuid":"bc63d92fcfd75b9fb4d120d3a680aa02135ab59e"},"cell_type":"code","source":"foreach(cst=rep(c(0.1,0.5,1),times=5), .combine=rbind) %do% {\n    res = test_cv(train_set, cst)\n    c(cost=cst,res)\n} -> cost_tuning_cv_res1","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"a41cdec65a9abb9975c710f3374fbc3f659103fd"},"cell_type":"code","source":"cost_tuning_cv_df <- as.data.frame(cost_tuning_cv_res1) ","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"68f41d6f220bf0fc73d0922eeb4baa9bfb6c8e1f"},"cell_type":"markdown","source":"# Examine the performance tuning data, choose threshold"},{"metadata":{"trusted":true,"_uuid":"3321dcfc5b8c3182d70b20883a644b529a452a56"},"cell_type":"code","source":"cost_tuning_cv_df %>% \n  group_by(cost) %>% summarize(T=mean(f1_cutoff),F=mean(f1_value))\noptions(repr.plot.width=5, repr.plot.height=3)\ncost_tuning_cv_df %>% \n  gather(type,metric,-cost) %>% \n  ggplot() + geom_violin(aes(factor(cost),metric)) + facet_wrap(~type, scales=\"free\")","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"9d89e62395a407f1cfcc97decbd722e5a6131bab"},"cell_type":"markdown","source":"Looking at the data above, choose the cost and the thresholds. Note that the results may be slightly different across different runs of the kernel."},{"metadata":{"trusted":true,"_uuid":"6e00ac8a920b0549d3f4b21a26e1c2594dc9cf75"},"cell_type":"code","source":"model_cost = 0.1\nhigh_prec_th = 0.88","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"8f68792d43996fd1bead5d2164b6ab496cff2669"},"cell_type":"markdown","source":"# Make prediction, submit results"},{"metadata":{"trusted":true,"_uuid":"dcf4f0cee74422916186d3c1ce97f2e4c0fe2ced"},"cell_type":"code","source":"fit = LiblineaR(data=q_dtm_m[train_set,], target=d$target[train_set], \n                type=0, cost=model_cost, \n                bias=TRUE,verbose=FALSE)\npred = predict(fit,q_dtm_m[-train_set,],proba=TRUE)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"74200c5709f3281ec68ba4105d465da5be01a535"},"cell_type":"markdown","source":"Cast outcome target value to 0 and 1 levels."},{"metadata":{"trusted":true,"_uuid":"fe054b057eaae0304a995b2ceb288c2320cf620c"},"cell_type":"code","source":"high_prec_pred <- ifelse(pred$probabilities[,\"1\"]>high_prec_th,1,0)","execution_count":null,"outputs":[]},{"metadata":{"_uuid":"a3b61045d04ce724347efb472d587f74f70c9c1e"},"cell_type":"markdown","source":"Look at the data before submitting, make sure it looks sane."},{"metadata":{"trusted":true,"_uuid":"471b6d6bd51706df8da6be1597df5af20f25d2a5"},"cell_type":"code","source":"table(high_prec_pred)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"3dc42b3893a0353e4cfdffe85422b61a50e8d43a"},"cell_type":"code","source":"d$target[-train_set] <- high_prec_pred\nres <- d[-train_set, c(\"qid\",\"target\")]\nnames(res) <- c(\"qid\",\"prediction\")\nwrite.csv(res, file=\"submission.csv\", row.names=FALSE)","execution_count":null,"outputs":[]},{"metadata":{"trusted":true,"_uuid":"c47cf8083acdb9b1b6b085ecc0f54dee737ba3ef"},"cell_type":"code","source":"","execution_count":null,"outputs":[]}],"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}