{"cells":[
 {
  "cell_type": "markdown",
  "metadata": {},
  "source": "A simple script with some ideas on how to make the problem tractable even if you depend on your computer to do the processing. \nThis is not intended to be run on kaggle."
 },
 {
  "cell_type": "markdown",
  "metadata": {},
  "source": "The first script, reads the files and process them in blocks generating a file for each block that later scripts will consolidate to measure validation score and generate a submission.\nRun your script as Rscript modelPublic.R (1-10):\ni.e Rscript modelPublic.R 7"
 },
 {
  "cell_type": "code",
  "execution_count": null,
  "metadata": {
   "collapsed": false
  },
  "outputs": [],
  "source": "library(data.table)\nlibrary(plyr)\nlibrary(randomForest)\n\nrfMulticlass <- function(){\n  \n  i <- 0\n  \n  progress <- function(filename){\n    \n    #if (i %% 10 == 0) \n    cat(i,as.character(Sys.time()),filename,\"\\n\")\n    #cat(i,\"-\",n,\" \")\n    i <<- i + 1\n  }\n  \n  function(cellTrain) { #, cellsTest\n    \n    x1 <- cellTrain[1, ]\n    filename <- paste(x1$xB, x1$yB, x1$accDiscrete, sep=\".\") # label of the block to recover the test cell\n    \n    progress(filename)\n    \n    cellTest <- cellsTest[[filename]]\n    \n    if (nrow(cellTest)==0)  # if for some reason is empty we are done\n      return()\n    \n    cellTrain <- data.table(cellTrain)  # convert to data.table to ease managing the data\n    \n    cellTrain[ , N := .N, by=c(\"place_id\")]   # count occurrences of each place id\n    nCounts <- unique(cellTrain[, .(N), by = c(\"place_id\")])[order(-N)] # order by place_id\n    \n    if ( nrow(nCounts) > 50 )  # if there are more than 50 places in the block\n      cellTrain <- cellTrain[ N > nCounts[50, N]]      # get only the top 50\n    \n    cellTrain[ , place_id := factor(place_id)]   # factorize for randomForest\n    \n    rf <- randomForest(cellTrain[,.(x, y, accuracy, hour, dayOfWeek, monthOfYear, dayOfYear)], y = cellTrain$place_id,\n                       importance = T, do.trace = F)   # train, validation will be OOB\n    \n    val <- data.frame( row_id = cellTrain$row_id,\n                       place_id = as.character(cellTrain$place_id),\n                       get3best(rf$votes))   # get the 3 best for each entry (OOB)\n    \n    write.csv(val, file=paste0(\"./output/valid/\",filename,\".csv\"), row.names = F)  # write validation file for the block\n    \n    predsTest <- predict( rf, cellTest, \"prob\")   # generate predictions\n    \n    df <- data.frame(row_id = cellTest$row_id, get3best(predsTest) )   # get the 3 best for the test set\n    write.csv(df, file = paste0(\"./output/test/\", filename, \".csv\"), row.names = F)  # write test file for the block\n    \n  }\n}\n\n\nfeatureGenerationAcc <- function(data, filter){  # make the splits and filter for processing\n  # filter is applied in X so that the cuts are as similar in time processing as possible.\n  \n  data[, xB := cut(x, NBREAKS_X, labels=seq(1,NBREAKS_X, 1))]   # random evently spaced cuts\n  \n  data<-data[ xB %in% filter, ]  # filter  \n  \n  data[, accDiscrete := cut( accuracy, \n                             breaks = c(0, 42, 133, 188, max(accuracy)), # cuts based on a previous script\n                             labels = c(1,2,3,4))]\n  \n  data[, yB := cut(y, NBREAKS_Y, labels=seq(1,NBREAKS_Y, 1))]  # random evenly spaced cuts\n  \n}  \n\nfeatureGenerationTime <- function(data){    # generate time features\n  data[, hour := as.integer((time %% (60*24)) / 60)]\n  data[, dayOfWeek := as.integer((time %% (60*24*7)) / (60*24))]\n  data[, monthOfYear := as.integer((time %% (60*24*30*12)) / (60*24*30))]  # approximate\n  data[, dayOfYear := as.integer((time %% (60*24*365)) / (60*24))]\n  \n  data[, time := NULL]  # get rid of this as the test set is in a different interval\n}\n\nget3best <- function( classProbs ){   # get the 3 place_ids with higher probability\n  \n  t( apply( classProbs, 1, function(x) names( sort(x, decreasing = T))[1:3]))\n  \n}\n\n\nDATA_PATH <- \"./data/\"   # at home\n#DATA_PATH <- \"../input/\" # at kaggle, but I don't want this script to run as it does not make sense\n\nNBREAKS_X <- 10\nNBREAKS_Y <- 100\nTRAIN_FILE <- paste0(DATA_PATH,\"train.csv\")\nTEST_FILE <- paste0(DATA_PATH,\"test.csv\")\n\n# data preparation\nargs <- commandArgs(trailingOnly = TRUE)\n\nfilter <- ParseNClusterArg(args)\n#filter <- \"4\"  # for RStudio\ncat(\"Filter:\",filter)\n\ntrain <- fread( TRAIN_FILE, header = T, sep = \",\", showProgress = T, #nrows = 2911802,  # read 10% of the file\n                colClasses = c(\"integer\",\"numeric\",\"numeric\",\"integer\",\"integer\",\"factor\"))\ntrain <- featureGenerationAcc(train,as.character(filter))\nfeatureGenerationTime(train)\ncat(\"train rows:\",nrow(train),\"\\n\")\n\ntest <- fread( TEST_FILE, header = T, sep = \",\", showProgress = T, #nrows = 2911802,  # read 10% of the file\n                colClasses = c(\"integer\",\"numeric\",\"numeric\",\"integer\",\"integer\"))\n\ntest <- featureGenerationAcc(test,filter)\nfeatureGenerationTime(test)\ncat(\"test rows:\",nrow(test),\"\\n\")\n\ncellsTest <- dlply(test, c(\"xB\",\"yB\",\"accDiscrete\"), function(x) {\n  x$xB <-NULL\n  x$yB <-NULL\n  x$accDiscrete <-NULL\n  x\n})\n\nrm(test)  # save memory\n\nprint(Sys.time())\npreds <- d_ply( train, c(\"xB\",\"yB\",\"accDiscrete\"), \n                rfMulticlass()\n               # parallelization has not worked because of the file generation because of file generation apparently\n                #, cellsTest , .parallel = T, \n                #.paropts=list(.packages=c(\"data.table\",\"randomForest\"), .export=c(\"get3best\"))\n)\n\nprint(Sys.time())  # it should take around 3 hours each block\n"
 },
 {
  "cell_type": "markdown",
  "metadata": {},
  "source": "Collect all validation files and measure the performance:"
 },
 {
  "cell_type": "code",
  "execution_count": null,
  "metadata": {
   "collapsed": false
  },
  "outputs": [],
  "source": "########\n# validation.R: to be run separately to see the validation scores\n\nmapkS <- function(actual, X1, X2, X3) {  # scoring\n  if (actual==X1) return(1)\n  else if (actual==X2) return(1/2)\n  else if (actual==X3) return(1/3)\n  return(0)\n}\n      \nvalidTable <- buildTable(\"./output/valid\")\n\ntotalNrows <- 29118020\nvalidNnrows <- nrow(validTable)\npct <- validNnrows / totalNrows\n\nvalidTable[ ,points := mapply(mapkS, place_id, X1, X2, X3)]\n\nminScore <- sum(validTable$points)/totalNrows\n# the top 50 filter means we don't have all the rows, we are being optimistic here (very)\nmaxScore <- sum(validTable$points)/validNnrows  \n"
 },
 {
  "cell_type": "markdown",
  "metadata": {},
  "source": "Generate a submission file:"
 },
 {
  "cell_type": "code",
  "execution_count": null,
  "metadata": {
   "collapsed": false
  },
  "outputs": [],
  "source": "######\n# submission.R : to be run separately to generate the submission file\n\ntestTable <- buildTable(\"./output/test\")\n\ntestTable[, \":=\"(place_id = paste(X1, X2, X3), X1 = NULL, X2 = NULL, X3 = NULL) ]\n\nwrite.csv(testTable, file=\"./output/submission.csv\", row.names = F, sep=\",\", quote = F)"
 }
],"metadata":{"kernelspec":{"display_name":"R","language":"R","name":"ir"}}, "nbformat": 4, "nbformat_minor": 0}