{
  "cells": [
    {
      "cell_type": "markdown",
      "metadata": {
        "_cell_guid": "87c6a8e2-61d9-52de-8d08-188e1ae0c130"
      },
      "source": [
        "Hi everyone, this is my first Kernel so all your feedback is welcome. I wanna avoid the most powerfull models like the popular xgb (present in almost every kernel) and focus on the interpretability of some variables and transformations"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "945cba2f-0ca2-8eae-cb80-2df5086a7bf7"
      },
      "outputs": [],
      "source": [
        "library(jsonlite) ##To handle .json files\n",
        "library(ggplot2) ##To make a pair of cute images\n",
        "library(dplyr)  ##To some transformations\n",
        "library(caret)  ##To train simple models"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "33bca8eb-9be2-8b62-800e-5dbdd3d54753"
      },
      "outputs": [],
      "source": [
        "##Now, we will upload the database, transform in a dataframe and specify the variable classes\n",
        "db<-fromJSON(\"../input/train.json\")\n",
        "colnames<-names(db)\n",
        "db<-cbind(db$bathrooms,db$bedrooms,db$building_id,db$created,\n",
        "\tdb$description,db$display_address,db$features,db$latitude,\n",
        "\tdb$listing_id,db$longitude,db$manager_id,db$photos,db$price,\n",
        "\tdb$street_address,\n",
        "\tdb$interest_level)\n",
        "db<-as.data.frame(db,row.names=NULL)\n",
        "names(db)<-colnames\n",
        "rm(colnames)\n",
        "db<-db[-4]\n",
        "class(db$bathrooms)<-\"numeric\"\n",
        "class(db$bedrooms)<-\"numeric\"\n",
        "class(db$building_id)<-\"character\"\n",
        "class(db$description)<-\"character\"\n",
        "class(db$display_address)<-\"character\"\n",
        "class(db$latitude)<-\"numeric\"\n",
        "class(db$listing_id)<-\"numeric\"\n",
        "class(db$longitude)<-\"numeric\"\n",
        "class(db$manager_id)<-\"character\"\n",
        "class(db$price)<-\"numeric\"\n",
        "class(db$street_address)<-\"character\"\n",
        "class(db$interest_level)<-\"character\"\n",
        "db$interest_level<-as.factor(db$interest_level)"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "479ca559-990b-ee0b-9e07-63e4fa37f9e8"
      },
      "outputs": [],
      "source": [
        "## What is the participation of each level in the interest level?\n",
        "pie(table(db$interest_level))"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "7ec0b660-87bd-39bc-3207-a5cda686c065"
      },
      "outputs": [],
      "source": [
        "##In the previous image we can see a huge mayority of properties in the low interest level, just the\n",
        "##7.8% reach the high interest level.\n",
        "\n",
        "##Empirically we know the location is very important in real state then we will see the relation between\n",
        "##location removing the 1% outliers in both tails (lower and upper) for latitude and longitude\n",
        "\n",
        "xlim<-quantile(db$longitude,c(0.01,0.99))\n",
        "ylim<-quantile(db$latitude,c(0.01,0.99))\n",
        "qplot(longitude,latitude,data=db,colour=interest_level,xlim=xlim,ylim=ylim)\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "ec7b21a6-81f7-bbf3-2fa6-377a355fe778"
      },
      "outputs": [],
      "source": [
        "##Apparently we have some sectors with higer interest level, specially in the south of the city and a\n",
        "##very particular apartment located right in the middle of central park (the empty rectangle in\n",
        "##north-west)\n",
        "\n",
        "##Also the comparison is important so we will make a cluster analysis based on location for make\n",
        "##comparisons and use them to transformations. Let's see the cluster map\n",
        "\n",
        "cluster<-kmeans(cbind(db$latitude,db$longitude),centers=61)\n",
        "db$borough<-cluster$cluster\n",
        "qplot(longitude,latitude,data=db,colour=borough,xlim=xlim,ylim=ylim)\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "526525bf-935c-7af0-3042-76f823d82e12"
      },
      "outputs": [],
      "source": [
        "##We could expect a higher interest in the apartments with a better cost/benefit relationship then we\n",
        "##will calculate the relation between the bedrooms \n",
        "\n",
        "db$price_bed<-db$price/db$bedrooms\n",
        "db$price_bed[db$price_bed==Inf]<-0.001 ##Correcting the 0 bedrooms apartments\n",
        "db$log_pricebed<-log(db$price_bed)\n",
        "boxplot(price_bed~interest_level,data=db,outline=FALSE)\n",
        "##Have the better cost/benefit apartments a higher interest level?\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "6269d081-ec3c-6dea-192f-68a6485ef02d"
      },
      "outputs": [],
      "source": [
        "##Returning the comparison point: If you find an apartment with one bedrooms in Marble Hill and\n",
        "##other with two in the same sector (based location cluster) is most likely the second one have a higher\n",
        "##interest level\n",
        "\n",
        "standar<-summarize(group_by(db,borough),bedrooms_mean=mean(bedrooms),\n",
        "\tprice_mean=mean(price))\n",
        "db<-merge(db,standar,by=\"borough\",all.x=TRUE)\n",
        "db$bedrooms_diff<-db$bedrooms-db$bedrooms_mean\n",
        "##Calculating the difference between the average in each cluster and the apartment\n",
        "db$price_diff<-db$price-db$price_mean\n",
        "boxplot(bedrooms_diff~interest_level,data=db,outline=FALSE)\n",
        "##If an apartment have less bedrroms than the cluster average. Have it a lower interest level?\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "899e93f5-6022-62f7-c171-d4d90e9415d6"
      },
      "outputs": [],
      "source": [
        "##What about the features? I saw in previous kernels the count of features in each propertie but you\n",
        "##can find cases with useless features or undesirable features like (in a extreme cases) 'rats',\n",
        "##'cockroaches'. Then we need to mesure the quality of the feature and with that purpose we will\n",
        "##calculate a NPS for each propertie. If the propertie have a high interest level all its features will\n",
        "##receive a +1 because we infer those features are desirable features.\n",
        "##At the same time if the apartment have a low interest level its features will receive a -1 because\n",
        "##probably have undesirable features.\n",
        "\n",
        "interest_level<-c()\n",
        "listing_id<-c()\n",
        "features<-c()\n",
        "\n",
        "for(i in 1:length(db$interest_level)){\n",
        "\tfeatures<-c(features,db$features[[i]])\n",
        "\tlisting_id<-c(listing_id,rep(db$listing_id[i],length(db$features[[i]])))\n",
        "\tinterest_level<-c(interest_level,rep(db$interest_level[i],\n",
        "\t\tlength(db$features[[i]])))\n",
        "}\n",
        "db_features<-cbind(listing_id,features,interest_level)\n",
        "db_features<-as.data.frame(db_features)\n",
        "class(db_features$features)<-\"character\"\n",
        "class(db_features$listing_id)<-\"numeric\"\n",
        "db_features$nps<-0\n",
        "db_features$nps[db_features$interest_level==1]<-1\n",
        "db_features$nps[db_features$interest_level==2]<--1\n",
        "nps_features<-summarize(group_by(db_features,features),total_nps=sum(nps))\n",
        "db_features<-merge(db_features,nps_features,by=\"features\",all.x=TRUE)\n",
        "db_features<-summarize(group_by(db_features,listing_id),total_nps=sum(total_nps))\n",
        "db<-merge(db,db_features,by=\"listing_id\",all.x=TRUE)\n",
        "db$total_nps[is.na(db$total_nps)]<-0\n",
        "boxplot(total_nps~interest_level,data=db,outline=FALSE)\n",
        "\n",
        "##Have the properties with higher NPS a higher interest level?\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "e54d11f3-1961-9349-75e9-cfb9f2404cc0"
      },
      "outputs": [],
      "source": [
        "##In order to make cross validation of the model we partition the database in train, test and validate\n",
        "##sets\n",
        "inTrain<-createDataPartition(db$interest_level,p=0.6,list=FALSE)\n",
        "train<-db[inTrain,]\n",
        "test<-db[-inTrain,]\n",
        "rm(db)\n",
        "inTrain<-createDataPartition(test$interest_level,p=0.6,list=FALSE)\n",
        "validate<-test[-inTrain,]\n",
        "test<-test[inTrain,]"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "e92647b1-f8a9-ecb2-a968-960465a6edeb"
      },
      "outputs": [],
      "source": [
        "##Before that prove the complete model we will see the accuracy of a simple model without the proposed\n",
        "##transformations\n",
        "mod<-train(interest_level~latitude+longitude+bathrooms+price,data=train,\n",
        "\tmethod=\"rpart\")\n",
        "table<-table(predict(mod),train$interest_level)\n",
        "accuracy<-sum(diag(table))/sum(table)\n",
        "failure<-(1-accuracy)/2\n",
        "##Creating a prediction dataframe to measure logloss\n",
        "pred<-data.frame(pred=predict(mod,newdata=test))\n",
        "pred$pred_high<-failure;pred$pred_medium<-failure;pred$pred_low<-failure\n",
        "pred$pred_high[pred$pred==\"high\"]<-accuracy\n",
        "pred$pred_medium[pred$pred==\"medium\"]<-accuracy\n",
        "pred$pred_low[pred$pred==\"low\"]<-accuracy\n",
        "##Making a function to logloss because we will use it later\n",
        "logloss<-function(test,pred){\n",
        "\ttmp<-data.frame(interest_level=test$interest_level)\n",
        "\ttmp$high<-0;tmp$medium<-0;tmp$low<-0\n",
        "\ttmp$high[tmp$interest_level==\"high\"]<-1\n",
        "\ttmp$medium[tmp$interest_level==\"medium\"]<-1\n",
        "\ttmp$low[tmp$interest_level==\"low\"]<-1\n",
        "\ttmp<-cbind(tmp,pred)\n",
        "\ttmp$pred_high[tmp$pred_high<0.001]<-0.001\n",
        "\ttmp$pred_high[tmp$pred_high>0.999]<-0.999\n",
        "\ttmp$pred_medium[tmp$pred_medium<0.001]<-0.001\n",
        "\ttmp$pred_medium[tmp$pred_medium>0.999]<-0.999\n",
        "\ttmp$pred_low[tmp$pred_low<0.001]<-0.001\n",
        "\ttmp$pred_low[tmp$pred_low>0.999]<-0.999\n",
        "\ttmp$pred_total<-tmp$pred_high+tmp$pred_medium+tmp$pred_low\n",
        "\ttmp$pred_high<-tmp$pred_high/tmp$pred_total\n",
        "\ttmp$pred_medium<-tmp$pred_medium/tmp$pred_total\n",
        "\ttmp$pred_low<-tmp$pred_low/tmp$pred_total\n",
        "\tlogloss<--sum(log(tmp$pred_high)*tmp$high,log(tmp$pred_medium)*tmp$medium,\n",
        "\t\tlog(tmp$pred_low)*tmp$low)/length(tmp$interest_level)\n",
        "\treturn(logloss)\n",
        "}\n",
        "##Why do I use the 'accuracy' and 'failure' percentages instead the traditional 1 and 0?\n",
        "##I have two reasons. First, to minimize the logloss function. Second and more important, we know\n",
        "##that the accuracy% of the observations was correctly clasified so you don't have a 100% certainty  \n",
        "logloss(test,pred)"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "ddc82954-8dee-5ac1-2379-ad0f9c07f6aa"
      },
      "outputs": [],
      "source": [
        "##Now, we will train our complete model waiting for a improve in logloss. Like we said initially we will\n",
        "##avoid complex methods and use a simple decision trees model what decide the interest level of an\n",
        "##apartment based on its: location (latitude and longitude), characteristics (bathrooms and price),\n",
        "##benefit/cost relation (price_bed and log_pricebed), comparison with the borough (bedrooms_diff and \n",
        "##price_diff)\n",
        "mod<-train(interest_level~latitude+longitude+bathrooms+price+total_nps+price_bed\n",
        "\t+bedrooms_diff+log_pricebed,data=train,method=\"rpart\")\n",
        "table<-table(predict(mod),train$interest_level)\n",
        "accuracy<-sum(diag(table))/sum(table)\n",
        "failure<-(1-accuracy)/2\n",
        "pred<-data.frame(pred=predict(mod,newdata=test))\n",
        "pred$pred_high<-failure;pred$pred_medium<-failure;pred$pred_low<-failure\n",
        "pred$pred_high[pred$pred==\"high\"]<-accuracy\n",
        "pred$pred_low[pred$pred==\"low\"]<-accuracy\n",
        "pred$pred_medium[pred$pred==\"medium\"]<-accuracy\n",
        "logloss(test,pred)"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "6f3e8d61-d9f4-d431-98ae-ebb878ba996b"
      },
      "outputs": [],
      "source": [
        "##We had a improve in the logloss with the transformations.\n",
        "##Finally we will make a homemade boosting just because the simple decission trees model doesn't look\n",
        "##sexy.\n",
        "\n",
        "##We will train the residual for each interest level\n",
        "pred$interest_level<-test$interest_level\n",
        "pred$high<-0;pred$medium<-0;pred$low<-0\n",
        "pred$high[pred$interest_level==\"high\"]<-1\n",
        "pred$medium[pred$interest_level==\"medium\"]<-1\n",
        "pred$low[pred$interest_level==\"low\"]<-1\n",
        "pred$res_high<-pred$high-pred$pred_high\n",
        "pred$res_medium<-pred$medium-pred$pred_medium\n",
        "pred$res_low<-pred$low-pred$pred_low\n",
        "res<-pred[9:11]\n",
        "test<-cbind(test,res)\n",
        "mod_h<-train(res_high~latitude+longitude+bathrooms+price+total_nps+price_bed\n",
        "\t+bedrooms_diff+log_pricebed,data=test,method=\"gbm\")\n",
        "mod_m<-train(res_medium~latitude+longitude+bathrooms+price+total_nps+price_bed\n",
        "\t+bedrooms_diff+log_pricebed,data=test,method=\"gbm\")\n",
        "mod_l<-train(res_low~latitude+longitude+bathrooms+price+total_nps+price_bed\n",
        "\t+bedrooms_diff+log_pricebed,data=test,method=\"gbm\")\n",
        "pred2<-data.frame(pred=predict(mod,newdata=validate))\n",
        "pred2$pred_high<-failure;pred2$pred_medium<-failure;pred2$pred_low<-failure\n",
        "pred2$pred_high[pred2$pred==\"high\"]<-accuracy\n",
        "pred2$pred_low[pred2$pred==\"low\"]<-accuracy\n",
        "pred2$pred_medium[pred2$pred==\"medium\"]<-accuracy\n",
        "pred2$pred_high<-pred2$pred_high+predict(mod_h,newdata=validate)\n",
        "pred2$pred_medium<-pred2$pred_medium+predict(mod_m,newdata=validate)\n",
        "pred2$pred_low<-pred2$pred_low+predict(mod_l,newdata=validate)\n",
        "##And obtain another improvement in the logloss result\n",
        "logloss(validate,pred2)"
      ]
    }
  ],
  "metadata": {
    "_change_revision": 0,
    "_is_fork": false,
    "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.3.3"
    }
  },
  "nbformat": 4,
  "nbformat_minor": 0
}