DetailedWalkthrough4.ipynb

{
 "cells": [
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Autocorrelative Models"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "#### Even after extensive hyperparameter optimization, I was only able to get to 97th on the leaderboard. At this point, I decided that it was time to try something else. In general, I group model improvement techniques in the following buckets:\n",
    "\n",
    "1. Feature Engineering\n",
    "2. Model Ensembling\n",
    "3. Parameter Tuning\n",
    "\n",
    "Having already squeezed out the maximum performance from a single XGBoost model, the only way to further improve the model was via feature engineering and model ensembling. \n",
    "\n",
    "My initial forays into model ensembling weren't particularly successful. None of the other models reduced the error by much when combined with the XGBoost model. I decided that I needed new features to really vault me up the leaderboard"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "#### After giving it some thought, I settled on building an autocorrelative model. My rationale was that the demand at a given hour should be highly correlated to the demand in the hours just preceding. I decided to use previous hours as predictors for subsequent hours. This would be in addition to the other predictors like temperature, humidity etc. \n",
    "\n",
    "Normal scheme: Season + Holiday + Workingday + Weather + Temp + Atemp + Humidity + Windspeed + Year + Month + Day + Day of the Week + Hour\n",
    "\n",
    "Autocorrelative scheme: Season + Holiday + Workingday + Weather + Temp + Atemp + Humidity + Windspeed + Year + Month + Day + Day of the Week + Hour + **Predictions for the past 4 hours**\n",
    "\n",
    "\n",
    "While conceptually simple, this idea poses a few implementation challenges:\n",
    "\n",
    "1. Dealing with missing values: Certain hours are missing in the train/test dataset. This makes predictions challenging for subsequent hours which depend on the predictor for that hour. My solution was to impute these predictions using the median prediction for that hour\n",
    "\n",
    "2. Keeping track of past predictions: Usually, during the prediction process each test case can be presented in any order. Since we are trying to use past predictions as predictors for future predictions, we have to predict in temporal order."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Getting Previous Predictions\n",
    "\n",
    "I opted to do a straight lookup for the 4 previous predictions when provided with a data point. The function is shown below:\n",
    "\n",
    "```r\n",
    "#This function obtains the previous predictions for a given point in time\n",
    "#\n",
    "#PARAMETERS:\n",
    "#df - Data frame containing the data\n",
    "#window - How many previous predictions are desired\n",
    "#lookupColumn - Which column will serve as index?\n",
    "#valueColumn - Which column has the actual prediction?\n",
    "#impute - If missing values are found for the previous predictions, how should they be handled. If impute is TRUE, a  #median imputation will be performed\n",
    "#\n",
    "#RETURN:\n",
    "#A vector containing the previous predictions\n",
    "\n",
    "getPrevPreds <- function (df, lookupValue, window=4, lookupColumn=\"datetime\", \n",
    "                          valueColumn=\"registered\", impute=FALSE)\n",
    "{\n",
    "        df <- tbl_df (df)\n",
    "        dots <- list (lazyeval::interp (~lookupColumn, lookupColumn=as.name (lookupColumn)))\n",
    "        dots <- c(dots, lazyeval::interp (~ valueColumn, valueColumn=as.name (valueColumn)))\n",
    "        dots <- c(dots, lazyeval::interp (~ hour))\n",
    "                  \n",
    "        df <- select_(df, .dots=dots)\n",
    "        lowerLookupBound <- lookupValue - dhours (window)\n",
    "        upperLookupBound <- lookupValue - dhours (1)\n",
    "        \n",
    "        dots <- lazyeval::interp (~ lookupColumn >= lowerLookupBound & \n",
    "                                lookupColumn <= upperLookupBound, \n",
    "                                lookupColumn=as.name (lookupColumn),\n",
    "                                lowerLookupBound=lowerLookupBound,\n",
    "                                upperLookupBound=upperLookupBound)\n",
    "        \n",
    "        filteredDF <- filter_ (df, dots)\n",
    "        prevPreds <- filteredDF[[valueColumn]]\n",
    "        if (length (prevPreds) < window) {\n",
    "            if (length (prevPreds) > 0) {\n",
    "                prevPreds <- c(rep (mean (prevPreds, na.rm=TRUE), \n",
    "                                    window-length (prevPreds)), \n",
    "                               prevPreds)\n",
    "            } else if (impute==FALSE) {\n",
    "                prevPreds <- rep (NA, window)\n",
    "            }\n",
    "              else {\n",
    "                print (paste0 (lookupValue, \" : imputed\"))\n",
    "                subsetDF <- df[df$hour==hour (lookupValue),]\n",
    "                prevPreds <- rep (mean (subsetDF[[valueColumn]], \n",
    "                                        na.rm=TRUE), \n",
    "                                  window)\n",
    "              }\n",
    "        }\n",
    "        return (prevPreds)\n",
    "}\n",
    "```\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Using Previous Predictions as Predictors\n",
    "\n",
    "The code snippet below shows how the previous predictions can be built up in a sequential way and used to predict the next value.\n",
    "\n",
    "```r\n",
    "for (currentRow in 1:nrow (test.df)) {\n",
    "        print (currentRow)        \n",
    "        currentDataRow <- test.df[currentRow,]\n",
    "        currentDateTime <- currentDataRow[1,]$datetime\n",
    "        prevPreds <- getPrevPreds(composite.df, currentDateTime, window=4, \n",
    "                                  valueColumn=trainCol, impute=TRUE)\n",
    "        \n",
    "        relevantCols <- grep (paste0 (trainCol, \"_\"), colnames (composite.df))\n",
    "        currentDataRow[1,relevantCols] <- prevPreds\n",
    "        rowNumberInCompositeDF <- which (composite.df$datetime==currentDateTime)\n",
    "        preds[currentRow] <- predict (fit, currentDataRow)\n",
    "        composite.df[rowNumberInCompositeDF, trainCol] <- preds[currentRow]\n",
    "}\n",
    "```\n",
    "\n",
    "The code snippet steps through each row in the test data frame and obtains a prediction. It then saves the prediction into a data frame. These past predictions are then used for subsequent predictions"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "#### This model resulted in a 101st place finish\n",
    "\n",
    "![101st Place](files/images/xgb-prevPreds.png)"
   ]
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": "R",
   "language": "R",
   "name": "ir"
  },
  "language_info": {
   "codemirror_mode": "r",
   "file_extension": ".r",
   "mimetype": "text/x-r-source",
   "name": "R",
   "pygments_lexer": "r",
   "version": "3.2.4"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 0
}