{
  "cells": [
    {
      "cell_type": "markdown",
      "metadata": {
        "_cell_guid": "5fbae1a8-bf8c-eadb-c0cb-a1c288daa726"
      },
      "source": [
        "---\n",
        "title: \"RENTHOP_VISUALIZING_INTEREST\"\n",
        "\n",
        "---\n",
        "\n",
        "Hi Kagglers, this competition has been running already for a while with some good EDA kernels already made public. So I will try not to repeat known facts, just to add some -hopefully- usefull insights and visualization. Ok, let's get the data adapting Dan J's code [here](https://www.kaggle.com/danjordan/two-sigma-connect-rental-listing-inquiries/how-to-correctly-load-data-into-r):"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "f524f3fe-e2b1-8f3b-96ea-2c0ec1d4c89c"
      },
      "outputs": [],
      "source": [
        "\n",
        "# Load packages and data\n",
        "packages <- c(\"jsonlite\", \"tidyverse\", \"purrr\", \"lubridate\", \"gridExtra\", \"RColorBrewer\")\n",
        "purrr::walk(packages, library, character.only = TRUE, warn.conflicts = FALSE)\n",
        "\n",
        "#TRAIN DATA:\n",
        "data <- fromJSON(\"../input/train.json\")\n",
        "# unlist every variable except `photos` and `features` and convert to tibble\n",
        "vars <- setdiff(names(data), c(\"photos\", \"features\"))\n",
        "data <- map_at(data, vars, unlist) %>% tibble::as_tibble(.)\n",
        "\n",
        "# (WE ALSO GET TEST DATA):\n",
        "data_test <- fromJSON(\"../input/test.json\")\n",
        "# unlist every variable except `photos` and `features` and convert to tibble\n",
        "vars <- setdiff(names(data_test), c(\"photos\", \"features\"))\n",
        "data_test <- map_at(data_test, vars, unlist) %>% tibble::as_tibble(.)\n"
      ]
    },
    {
      "cell_type": "markdown",
      "metadata": {
        "_cell_guid": "d7360678-d6e7-f11f-0810-f392bf73557e"
      },
      "source": [
        "Before going further **there is something important about how this dataset has been split that should be emphasized because of its implications**. You probably have noticed, but let's make sure:\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "c0f7e208-b19b-1007-cd7d-dbd3344d1984"
      },
      "outputs": [],
      "source": [
        "train_unique_dates <- data %>% \n",
        "  select(-features, - photos) %>% \n",
        "  transmute(\n",
        "  date_created = as.Date(ymd_hms(created))\n",
        ") %>% \n",
        "distinct()\n",
        "\n",
        "test_unique_dates <- data_test %>% \n",
        "  select(-features, - photos) %>% \n",
        "  transmute(\n",
        "  date_created = as.Date(ymd_hms(created))\n",
        ") %>% \n",
        "distinct() \n",
        "\n",
        "#TIME SPAN OF TRAIN AND TEST\n",
        "#train timespan: \n",
        "range(train_unique_dates$date_created)\n",
        "#test timespan: \n",
        "range(test_unique_dates$date_created)\n",
        "\n",
        "#\u00bfANY GAP IN DATES?:\n",
        "#TRAIN:\n",
        "all_days <- seq(ymd(\"2016-04-01\"), ymd(\"2016-06-29\"),  by = \"day\")\n",
        "#gaps in  train dates:\n",
        "all_days[!(all_days %in% train_unique_dates$date_created)]\n",
        "\n",
        "#gaps in  test dates:\n",
        "all_days[!(all_days %in% test_unique_dates$date_created)]\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "aa9d5839-81ab-d023-3812-03911daf2256"
      },
      "outputs": [],
      "source": [
        ""
      ]
    },
    {
      "cell_type": "markdown",
      "metadata": {
        "_cell_guid": "34cdf295-7de3-2d8a-ffb0-5a8969b79876"
      },
      "source": [
        "So, **train and test have been taken from exactly the same time period**. I don't know the reason why organizers of this competition chose this split of data (would be interesting to know). What I know is that this split will strongly shape modelling in two ways:\n",
        " \n",
        " * models performance for the dataset \n",
        " * more critically: models usability in out of sample (real future) data\n",
        "\n",
        "\n",
        "A couple of **mental experiments**, here, just to make my point clear:\n",
        "\n",
        " * Let's suppose that a bank owns a a group of huge buildings in a not demanded, depressed neibourhood. The bank (not cleverly, just for this example) chooses only one day, the first monday  of june, to list all those rentals. \u00bfWhat will our model learn about that day with train? \u00bfWhat will our model predict about that date when predicting test?. Our model will probably lower predicted interest for listings on that date and yes, it will be correct because test set shares all timestamps with train. Depending on how many of this particular circumstances add during train and test timespan models performance will appear to increase a lot. But none of this learnings will improve real time future performance, quite the contrary. So by design this competition has included some leakage by using exactly the same time period for train and test. Even if its effect is not too strong in the leaderboard  it will probably lower performance in real life.\n",
        " \n",
        " * Another one, from a different angle. Let's suppose a relationship (not completely unreasonable but invented for the example) between future interest level and the evolution of average listing prices. The rationale for this relationship would be, listing prices go up because of demand pressure increases and demand pressure implies more interest. It doesn't matter if this relationship exists as long as we can accept that such a kind of relationship between predictors **in the future** and interest level of a listing **in the present time** can exist. If we accept that even if in a subtle and complex way this relationships can exist then, also by design, we have many future values of predictors that we will not have in real life modelling. So for me this is another level of leakage that can also imply different performance of the model.\n",
        " \n",
        " \n",
        " As I said, there must be some advantages of this kind of data split, maybe models will be implemented in a different way I am thinking of, or maybe Im missing something. It would be interesting to know more about the reasons for the split, maybe we will know more about it when competition ends.\n",
        " \n",
        "Ok, let's visualize data. I will be using train for visualizations.:\n",
        " \n",
        "Lets begin wondering if there is a relationship between the number of daily listings and the average interest level for those listings:\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "e18cb42b-70f0-fecf-e985-1eb8f8cc37e8"
      },
      "outputs": [],
      "source": [
        "datos <- data %>% \n",
        "  select(-features, - photos) %>% \n",
        "  mutate(\n",
        "  datetime_created = ymd_hms(created),\n",
        "  date_created = as.Date(datetime_created),\n",
        "  year_created = year(datetime_created),\n",
        "  month_created = month(datetime_created),\n",
        "  week_created = week(datetime_created),\n",
        "  day_of_year_created = yday(datetime_created),\n",
        "  day_of_week = wday(datetime_created),\n",
        "  day_created = day(datetime_created)\n",
        ")\n",
        "\n",
        "datos$interest_level <- factor(datos$interest_level, levels = c(\"low\",\"medium\", \"high\"))\n",
        "\n",
        "#WE GET RID OF SOME KNOWN OUTLIERS \n",
        "datos <- datos %>% \n",
        "  mutate(\n",
        "    latitude = replace(latitude, latitude == 0, NA),\n",
        "    longitude = replace(longitude, longitude == 0, NA),\n",
        "    longitude = replace(longitude, longitude <= (-100), NA)\n",
        "  )\n",
        "datos <- datos %>% \n",
        "  mutate(\n",
        "    price = replace(price, price == 111111, NA)\n",
        "  )\n",
        "\n",
        "\n",
        "\n",
        "datos %>% \n",
        "  group_by(day_of_year_created) %>% \n",
        "  mutate(n_listings = n()) %>% \n",
        "  filter(n_listings > 10) %>% \n",
        "  ungroup() %>% \n",
        "  group_by(n_listings) %>% \n",
        "  summarise(\n",
        "            avg_interest = mean(as.numeric(interest_level), na.rm = TRUE)\n",
        ")%>% \n",
        "  ggplot(aes(x=n_listings, y = avg_interest)) +\n",
        "  geom_jitter() + geom_smooth()\n"
      ]
    },
    {
      "cell_type": "markdown",
      "metadata": {
        "_cell_guid": "bae28ce3-f68f-b9e9-8010-93d41dd12cc4"
      },
      "source": [
        "A slight  relationship can be observed for central values of n. Lets visualize n for the timespan:\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "38abf7a6-c9e0-5127-ca2e-d7949f243069"
      },
      "outputs": [],
      "source": [
        "\n",
        "datos %>% \n",
        "  group_by(day_of_year_created) %>% \n",
        "  summarise(n_listings = n()) %>% \n",
        "  ggplot(aes(x=day_of_year_created, y = n_listings)) +\n",
        "  geom_line()\n",
        "\n"
      ]
    },
    {
      "cell_type": "markdown",
      "metadata": {
        "_cell_guid": "a5f6a0da-5244-05a8-0d0d-74b760bd0ebc"
      },
      "source": [
        "There is strong seasonality in number of listings per day, weekly and possibly monthly. Let's find out:\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "afd85def-ff97-439b-1c5e-8b39c0b925ea"
      },
      "outputs": [],
      "source": [
        "\n",
        "plot_est_sem_n_listings <- datos %>% \n",
        "  group_by(day_of_week, month_created) %>% \n",
        "  summarise(n_listings = n()) %>% \n",
        "  ggplot(aes(x=day_of_week, y = n_listings)) +\n",
        "  geom_line(aes(color = factor(month_created)), size = 1) +\n",
        "  geom_smooth(color = \"black\", se = FALSE) \n",
        "\n",
        "plot_est_mens_n_listings <- datos %>% \n",
        "  group_by(day_created, month_created) %>% \n",
        "  summarise(n_listings = n()) %>% \n",
        "  ggplot(aes(x=day_created, y = n_listings)) +\n",
        "  geom_point(aes(color = factor(month_created)), size = 1)+\n",
        "  geom_smooth(aes(color = factor(month_created)), se = FALSE) + \n",
        "  geom_smooth(color = \"black\", se = FALSE) \n",
        "\n",
        "plot_est_sem_interes_prom <- datos %>% \n",
        "  group_by(day_of_week, month_created) %>% \n",
        "  summarise(avg_interest = mean(as.numeric(interest_level), na.rm = TRUE)) %>% \n",
        "  ggplot(aes(x=day_of_week, y = avg_interest)) +\n",
        "  geom_line(aes(color = factor(month_created)), size = 1) +\n",
        "  geom_smooth(color = \"black\", se = FALSE) \n",
        "  \n",
        "\n",
        "plot_est_mens_interes_prom <- datos %>% \n",
        "  group_by(day_created, month_created) %>% \n",
        "  summarise(avg_interest = mean(as.numeric(interest_level), na.rm = TRUE)) %>% \n",
        "  ggplot(aes(x=day_created, y = avg_interest)) +\n",
        "  geom_point(aes(color = factor(month_created)), size = 1)+\n",
        "  geom_smooth(aes(color = factor(month_created)), se = FALSE) + \n",
        "  geom_smooth(color = \"black\", se = FALSE) +\n",
        "  coord_cartesian(ylim = c(1.25, 1.75))\n",
        "\n",
        "\n",
        "\n",
        "gridExtra::grid.arrange(plot_est_sem_n_listings,\n",
        "                        plot_est_mens_n_listings,\n",
        "                        plot_est_sem_interes_prom,\n",
        "                        plot_est_mens_interes_prom\n",
        "                        )\n",
        "\n"
      ]
    },
    {
      "cell_type": "markdown",
      "metadata": {
        "_cell_guid": "3a064303-9b4d-06b7-1c25-125e7f683716"
      },
      "source": [
        "Seasonality in number of listings is mostly weekly, and there is also a  weekly seasonal pattern in daily average interest.\n",
        "Lets try to display spatially price, interest and number of listings. We will do so binning latitude and longitude but, as density decreases as we get further from the center of the city we will adopt a compromise, forcing our bins not to be empty. So dimensions will be compressed outside the city and expanded in the center, but not too much:"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "95e19636-674d-42f1-54f6-04aba1a02493"
      },
      "outputs": [],
      "source": [
        "hm.palette <- colorRampPalette(rev(brewer.pal(9, 'YlOrRd')), space='Lab')  \n",
        "\n",
        "precio_med_zonal <- datos %>%\n",
        "  group_by(cut_number(longitude,30), cut_number(latitude, 30)) %>% \n",
        "  mutate(zone_avg_price = as.numeric(mean(price, na.rm = T))) %>% \n",
        "  filter(zone_avg_price< 15000) %>% \n",
        "  ggplot(aes(cut_number(longitude,30), cut_number(latitude, 30))) + geom_tile(aes(fill = zone_avg_price)) +\n",
        "  scale_fill_gradientn(colours = hm.palette(100))\n",
        "\n",
        "\n",
        "interes_med_zonal <- datos %>%\n",
        "  group_by(cut_number(longitude, 30), cut_number(latitude, 30)) %>% \n",
        "  mutate(zone_avg_interest = mean(as.numeric(interest_level), na.rm = T)) %>% \n",
        "  ggplot(aes(cut_number(longitude, 30), cut_number(latitude, 30))) + geom_tile(aes(fill = zone_avg_interest)) +\n",
        "  scale_fill_gradientn(colours = hm.palette(100))\n",
        "\n",
        "\n",
        "\n",
        "n_listings_tot_zonal <- datos %>%\n",
        "  group_by(cut_number(longitude, 30), cut_number(latitude, 30)) %>% \n",
        "  mutate(n_listings_per_zone = n()) %>% \n",
        "  ggplot(aes(cut_number(longitude, 30), cut_number(latitude, 30))) + geom_tile(aes(fill = n_listings_per_zone)) +\n",
        "  scale_fill_gradientn(colours = hm.palette(100))\n",
        "\n",
        "grid.arrange(precio_med_zonal, interes_med_zonal, n_listings_tot_zonal)  \n"
      ]
    },
    {
      "cell_type": "markdown",
      "metadata": {
        "_cell_guid": "32e5a9e9-c927-03d9-78a0-4336d2e15340"
      },
      "source": [
        "From the heatmap it can be observed a negative correlation between average zone interest and average zone prize. Also, less clear, a negative correlation between average zone interest and average zone number of listings. Lets make sure:\n"
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "b70b7bf8-6361-abb9-296d-79634f342aac"
      },
      "outputs": [],
      "source": [
        "interest_zone_price_zone <- datos %>%\n",
        "  group_by(cut_number(longitude,30), cut_number(latitude, 30)) %>% \n",
        "  mutate(zone_avg_price = as.numeric(mean(price, na.rm = T)),\n",
        "         zone_avg_interest = mean(as.numeric(interest_level), na.rm = T)\n",
        "         ) %>% \n",
        "  filter(zone_avg_price< 15000) %>% \n",
        "  ggplot( aes(zone_avg_price, zone_avg_interest)) + \n",
        "  geom_jitter() +\n",
        "  geom_smooth()\n",
        "\n",
        "interest_zone_nlist_zone <- datos %>%\n",
        "  group_by(cut_number(longitude,30), cut_number(latitude, 30)) %>% \n",
        "  mutate(\n",
        "         n_listings_per_zone = n(),\n",
        "         zone_avg_interest = mean(as.numeric(interest_level), na.rm = T)\n",
        "         ) %>% \n",
        "  ggplot( aes(n_listings_per_zone, zone_avg_interest)) + \n",
        "  geom_jitter() +\n",
        "  geom_smooth()\n",
        "\n",
        "grid.arrange(interest_zone_price_zone, interest_zone_nlist_zone, ncol = 2)  \n"
      ]
    },
    {
      "cell_type": "markdown",
      "metadata": {
        "_cell_guid": "1c51f279-2c94-b49f-6fe6-30937249cb14"
      },
      "source": [
        "And we observe the expected negative correlation for average interest level of a zone and average prices of that zone. Relationship with number of listings is  not clear, except maybe for zones with very few listings. But prices do matter.\n",
        "\n",
        "Ok, dear kagglers, **with little changes in the code you can play with binning number/size, make bigger/smaller neighborhood and explore this relationships of features and location**. I hope you enjoy it, and find it of some use!\n"
      ]
    },
    {
      "cell_type": "markdown",
      "metadata": {
        "_cell_guid": "8ace89be-a1ac-437e-1675-d86a635a6281"
      },
      "source": [
        ""
      ]
    },
    {
      "cell_type": "code",
      "execution_count": null,
      "metadata": {
        "_cell_guid": "1f0af54f-ce27-ca41-6ae2-7c934d7aca95"
      },
      "outputs": [],
      "source": [
        ""
      ]
    }
  ],
  "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
}