Data Quality Check

numMissingVal <-sapply(cost, function(x) sum(length(which(is.na(x)))))  
kable(as.data.frame(numMissingVal)) %>% kable_styling(bootstrap_options = c("striped", "hover", "responsive")) %>% scroll_box(width = "100%", height = "250px")

costCharCol <- colnames(cost %>% ungroup() %>% select_if(is.character))

costZeroNeg <-
  sapply(cost[, !(names(cost) %in% costCharCol)], function(x)
  count(x <= 0, na.rm = TRUE))
kable(as.data.frame(costZeroNeg)) %>% kable_styling(bootstrap_options = c("striped", "hover", "responsive")) %>% scroll_box(width = "100%", height = "250px")

cost[which(duplicated(cost) ==T),] 

Data Filtering

In order to reduce number of columns to human-interpretable level, cost price across every year between 1996-2017 is calculated and tabulated in a different table for analysis. Median is chosen as opposed to Mean to guard against large outlier values (2008 Recession/Housing Price crash) - which may lead to flawed assumptions.

How is it Achieved?

1. Account for Median Cost price across Individual years starting 1996 to 2017 tabulated into different table.
2. Analyze the median Cost price trends( 2 and 5 Years) across different regionNames for plausible pattern.
3. Make assumptions based on these trends to calculate a singular Median Cost value across various regionNames.
4. Join with original Cost.

Trivia
CityName, StartYear and endYear are derived from the values defined in config file. This scalable feature can account for other cities and years for newer dataset based on requirement.

#Selecting the city in the dataset
cost <- cost %>% filter(City == cityName)

#Creating a list of the years
yearList <- as.character(as.list(startYear:endYear))

medianYears <- data.frame()
for (i in yearList) {
  year <- i 
  medianYearCol <- cost %>% select(starts_with(i), RegionName) %>% mutate(Median = rowMedians(as.matrix(select(., -matches("RegionName")))))
  medianYearCol <- medianYearCol %>% select(RegionName,Median)
  medianYearCol$year<- rep(year, nrow(medianYearCol))
  medianYears<-rbind(medianYears,medianYearCol)
}

medianPriceAll <-
  medianYears %>% filter(year > (endYear - 5)) %>% ggplot(aes(
  x = year,
  y = Median,
  group = RegionName,
  colour = RegionName
  )) + geom_line() + geom_point() + scale_y_continuous(labels = scales::comma)
ggplotly(medianPriceAll)

medianPriceAll <-
  medianYears %>% filter(year > (endYear - 2)) %>% ggplot(aes(
  x = year,
  y = Median,
  group = RegionName,
  colour = RegionName
  )) + geom_line() + geom_point() + scale_y_continuous(labels = scales::comma)
ggplotly(medianPriceAll)

Clean Cost Data

From the above analysis, it is safe to assume that Median Cost Price for Homes have rather been stagnant for the past 2 years. To reduce the complexicity of data in hand, median cost price for year (2017) is chosen to be the actual price of the individual 2 bedroom properties across every regionName(zipcode). Decisions made here on will be based on this assumption.

# Choosing the Last One Year Median Price 
currentMedianPrice <- medianYears %>% filter(year == endYear)


cost <-
  cost %>% select(RegionName, CountyName, SizeRank) %>% inner_join(currentMedianPrice, by = "RegionName")
cost <- rename(cost, cost = Median)

kable(head(cost))  %>% kable_styling(bootstrap_options = c("striped", "hover", "responsive")) %>% scroll_box(width = "100%", height = "250px")

Data Quality Check

numMissingVal <-sapply(revenue, function(x) sum(length(which(is.na(x)))))  
kable(as.data.frame(numMissingVal)) %>% kable_styling(bootstrap_options = c("striped", "hover", "responsive")) %>% scroll_box(width = "100%", height = "250px")

revenue <-
  revenue %>% group_by(neighbourhood_group_cleansed) %>% fill(zipcode) %>% ungroup()

sum(is.array(revenue$zipcode))

## [1] 0

revenue$price <- as.numeric(gsub('[$,]','', revenue$price))
revenue$weekly_price <- as.numeric(gsub('[$,]','', revenue$weekly_price))
revenue$monthly_price <- as.numeric(gsub('[$,]','', revenue$monthly_price))
head(revenue[c("price","weekly_price","monthly_price")])

## # A tibble: 6 x 3
##   price weekly_price monthly_price
##   <dbl>        <dbl>         <dbl>
## 1    99           NA            NA
## 2   200           NA            NA
## 3   300           NA            NA
## 4   125          775            NA
## 5    69          350          1200
## 6   125          550            NA

revCharCol <- colnames(revenue %>% ungroup() %>% select_if(is.character))


revZeroNeg <-
  sapply(revenue[,!(names(revenue) %in% revCharCol)], function(x)
  count(x <= 0, na.rm = TRUE))
kable(as.data.frame(revZeroNeg)) %>% kable_styling(bootstrap_options = c("striped", "hover", "responsive")) %>% scroll_box(width = "100%", height = "250px")

revenue[which(duplicated(revenue) ==T),] 

Data Filtering

Inorder to remove columns that add little or no value to the analysis, some of the smart data munging techniques are incorporated. These include removing columns based on pattern matching with their names, imbalanced columns, character columns with 100 % variance etc.

How is it achieved?

1. Account for Zero Variance, Imbalanced, high NA valued and 100 percent variance character columns.
2. Use associated methods to remove these columns from revenue data. Worst case - Manually remove columns keeping the final outcome in mind.
3. Produce clean revenue data for further analysis.

zvdf <- nearZeroVar(revenue, saveMetrics = TRUE)
ZVnames=rownames(subset(zvdf, nzv== TRUE))
revenue <- revenue[ , !(names(revenue) %in% ZVnames)]

printlis(ZVnames)

## scrape_id 
## experiences_offered 
## host_acceptance_rate 
## host_has_profile_pic 
## state 
## market 
## country_code 
## country 
## bed_type 
## has_availability 
## requires_license 
## license 
## require_guest_profile_picture 
## require_guest_phone_verification

pattern <-
  colnames(
  revenue %>% select(
  starts_with("require"),
  starts_with("host"),
  starts_with("calendar"),
  ends_with("url"),
  ends_with("nights")
  )
  )
revenue <- revenue[,!(names(revenue) %in% pattern)]

printlis(pattern)

## host_id 
## host_url 
## host_name 
## host_since 
## host_location 
## host_about 
## host_response_time 
## host_response_rate 
## host_is_superhost 
## host_thumbnail_url 
## host_picture_url 
## host_neighbourhood 
## host_listings_count 
## host_total_listings_count 
## host_verifications 
## host_identity_verified 
## calendar_updated 
## calendar_last_scraped 
## listing_url 
## thumbnail_url 
## medium_url 
## picture_url 
## xl_picture_url 
## minimum_nights 
## maximum_nights

uniquedf <-
  revenue %>% select_if(is.character) %>% summarise_all(funs(n_distinct(.))) 

uniquedf <-
  uniquedf %>% gather(key = var_name, value = value, 1:ncol(uniquedf))

uniquedf$percentUnique <- round(uniquedf$value/nrow(revenue),2)
uniqueval <- uniquedf %>% filter(percentUnique > 0.2) %>% pull(var_name)
revenue <- revenue[,!(names(revenue) %in% uniqueval)]


printlis(uniqueval)

## name 
## summary 
## space 
## description 
## neighborhood_overview 
## notes 
## transit 
## access 
## interaction 
## house_rules 
## amenities

nadf <- revenue %>% summarise_all(funs(sum(is.na(.))))
nadf <- nadf %>% gather(key = var_name, value = value, 1:ncol(nadf))
nadf$numNa <- round(nadf$value/nrow(revenue),2)
naval <- nadf %>% filter(numNa > 0.5) %>% pull(var_name)
revenue <- revenue[,!(names(revenue) %in% naval)]

printlis(naval)

## square_feet 
## weekly_price 
## monthly_price 
## security_deposit 
## jurisdiction_names

dropCol <-
  c(
  'id',
  'street',
  'city',
  'CountyName',
  'cleaning_fee',
  'guests_included',
  'extra_people',
  'review_scores_communication',
  'review_scores_checkin',
  'review_scores_cleanliness',
  'review_scores_value',
  'reviews_per_month',
  'instant_bookable',
  'cancellation_policy',
  'smart_location',
  'is_location_exact',
  'calculated_host_listings_count'
  )

revenue <- revenue[,!(names(revenue) %in% dropCol)]

printlis(dropCol)

## id 
## street 
## city 
## CountyName 
## cleaning_fee 
## guests_included 
## extra_people 
## review_scores_communication 
## review_scores_checkin 
## review_scores_cleanliness 
## review_scores_value 
## reviews_per_month 
## instant_bookable 
## cancellation_policy 
## smart_location 
## is_location_exact 
## calculated_host_listings_count

Clean Revenue Data

kable(head(revenue))  %>% kable_styling(bootstrap_options = c("striped", "hover", "responsive")) %>% scroll_box(width = "100%", height = "250px")

Dimension of Data

Starting with 95 columns in Revenue Data and 262 columns in Zillow (total of 357 columns) are reduced to 28 columns in the final data set.

dim(final)

## [1] 1258   28

Data Type Handling

Convert ‘Character’ columns to Factors to ease the process of building discrete charts.

final <- final %>% mutate_if(sapply(final,is.character),as.factor)
str(final)

## 'data.frame':    1258 obs. of  28 variables:
##  $ zipcode                     : Factor w/ 22 levels "10003","10011",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ last_scraped                : Date, format: "2017-05-03" "2017-05-04" ...
##  $ neighbourhood               : Factor w/ 49 levels "Annadale","Boerum Hill",..: 13 13 13 17 13 NA 13 13 44 13 ...
##  $ neighbourhood_cleansed      : Factor w/ 51 levels "Arrochar","Boerum Hill",..: 16 16 16 20 16 16 16 16 5 16 ...
##  $ neighbourhood_group_cleansed: Factor w/ 4 levels "Brooklyn","Manhattan",..: 2 2 2 2 2 2 2 2 2 2 ...
##  $ latitude                    : num  40.7 40.7 40.7 40.7 40.7 ...
##  $ longitude                   : num  -74 -74 -74 -74 -74 ...
##  $ property_type               : Factor w/ 6 levels "Apartment","Condominium",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ room_type                   : Factor w/ 2 levels "Entire home/apt",..: 2 1 1 1 1 1 1 1 1 1 ...
##  $ accommodates                : int  4 4 2 3 4 2 4 5 4 4 ...
##  $ bathrooms                   : num  1 1 1 2 1.5 1 1 1 3 1 ...
##  $ bedrooms                    : int  2 2 2 2 2 2 2 2 2 2 ...
##  $ beds                        : int  2 4 2 2 2 2 2 2 2 2 ...
##  $ price                       : num  113 3750 200 500 200 199 200 300 800 180 ...
##  $ availability_30             : int  0 0 0 4 19 21 0 4 0 0 ...
##  $ availability_60             : int  0 0 0 18 49 51 0 26 0 0 ...
##  $ availability_90             : int  0 0 0 48 79 81 0 56 0 0 ...
##  $ availability_365            : int  0 0 0 79 79 356 0 146 0 0 ...
##  $ number_of_reviews           : int  306 0 3 1 1 31 4 32 0 2 ...
##  $ first_review                : Date, format: "2012-09-27" NA ...
##  $ last_review                 : Date, format: "2017-02-24" NA ...
##  $ review_scores_rating        : int  96 NA 100 100 60 92 80 86 NA 90 ...
##  $ review_scores_accuracy      : int  10 NA 10 10 10 9 9 9 NA 10 ...
##  $ review_scores_location      : int  10 NA 10 10 8 10 10 10 NA 10 ...
##  $ CountyName                  : Factor w/ 4 levels "Kings","New York",..: 2 2 2 2 2 2 2 2 2 2 ...
##  $ SizeRank                    : int  21 21 21 21 21 21 21 21 21 21 ...
##  $ cost                        : num  2005500 2005500 2005500 2005500 2005500 ...
##  $ year                        : Factor w/ 1 level "2017": 1 1 1 1 1 1 1 1 1 1 ...

Corrected Price by Room Type

Price of the daily rental in Revenue data is reflective of the space that is offered and not the entire property itself. The price must be specifically corrected to account for entire property to account the benefit.

Assumption Made: If the property type == Private Room, it is multipled by number of bedrooms to account for overall price. Correction applied is returned to original price column.

final <- final %>% mutate(price = if_else(room_type == "Private room",
                          price * bedrooms,
                          price)) 

Missing Values

Nothing too alarming, major chunk of columns look okay to proceed with the analysis.

plot_missing(final)

Number of properties by neighbourhood

Manhattan hosts highest number of properties followed by Brooklyn. Queens and Staten Island are outliers as far number is concerned.

ggplot(final, aes(neighbourhood_group_cleansed)) + geom_bar() + labs(x = "Neighbourhood", y = "Number of Properties") + geom_text(stat='count', aes(label=..count..), vjust= -0.3)  + theme_classic()

Choice - Number of properties by Zipcode

Higher the number of properties , higher the number of choices reassuring higher airbnb/rental activity in the area. Zipcodes 10003 10011,10013,10014,10025,10036,11201,11215,11217,11231 have higher volume of properties and they make the top 10 based on choice.

ggplot(final, aes(zipcode, fill = neighbourhood_group_cleansed)) + geom_bar() + labs(x = "Zipcode", y = "Number of Properties") + geom_text(stat='count', aes(label=..count..), vjust= -0.3) + theme(axis.text.x = element_text(angle = 90, hjust = 1))  + theme_bw() + theme(plot.background = element_blank(),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),panel.border = element_blank(),axis.text.x = element_text(angle = 90, hjust = 1))

Cost - Property cost by Zipcode

One of the primary constraint in making the choice is the cost, lower the cost - company can save a lot more and reach ROI faster .

Zipcodes in Manhattan walk away with highest property prices (My God! They are expensive) - the beast out scales rest of the neighbourhoods. Brooklyn comes second. Zipcodes in staten island and queens have comparable prices and they are far lower.

Zipcodes : 10025,10304,10305,10306,10308,11215,11217,11231,11234,11434 have lower property cost and they make the top 10 in this section.

medianCost1 <- final %>% select(zipcode,neighbourhood_group_cleansed, cost) %>% filter(neighbourhood_group_cleansed == c("Manhattan","Brooklyn"))  %>% group_by(neighbourhood_group_cleansed,zipcode) %>% summarise_all(funs(median)) %>% ggplot(aes(x = zipcode, y = cost, fill =neighbourhood_group_cleansed )) + geom_bar(stat = "identity") +scale_y_continuous(labels = scales::comma) + labs(y = "Cost", x = "Zipcode") + theme_bw() + theme(plot.background = element_blank(),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),panel.border = element_blank(),axis.text.x = element_text(angle = 90, hjust = 1)) + guides(fill = guide_legend(title = "Neighbourhood"))

medianCost2 <- final %>% select(zipcode,neighbourhood_group_cleansed, cost) %>% filter(neighbourhood_group_cleansed == c("Staten Island","Queens")) %>% group_by(neighbourhood_group_cleansed,zipcode) %>% summarise_all(funs(median)) %>% ggplot(aes(x = zipcode, y = cost, fill =neighbourhood_group_cleansed )) + geom_bar(stat = "identity") +scale_y_continuous(labels = scales::comma) + labs(x = "Cost", y = "Zipcode") + theme_bw() + theme(plot.background = element_blank(),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),panel.border = element_blank(),axis.text.x = element_text(angle = 90, hjust = 1)) + guides(fill = guide_legend(title = "Neighbourhood"))

cowplot::plot_grid(medianCost1, medianCost2, labels = "AUTO", ncol = 1, align = 'v')

Property type Vs Cost

In order to develop deeper understanding with the data (Just to make sure), property cost is measured across different property types: Apartment, House, Loft etc. There seems to be no clear pattern to claim a certain property type out prices another.

propTypeCost <- ggplot(final, aes(x=property_type, y=cost, fill = zipcode)) + scale_y_continuous(labels = scales::comma) + geom_point(aes(col = zipcode, size=cost)) + 
geom_smooth(method="loess", se=F) + labs( x="Property type", y="Cost") + theme(axis.text.x = element_text(angle = 90, hjust = 1))
ggplotly(propTypeCost)

Nightly Price by Neighbourhood

Beyond investment, company would look foward to make quick bucks. Higher the rental price, faster is the ROI and profits.

A general look at spread of price/Night reveals

1. Manhattan has a wider spread with price ranging to ($50-$1000)/Night.
2. Brooklyn has almost a perfect bell curve showing characterstics of normal real world behaviour.
3. Staten Island and Queens have lower price and narrower distribution and this is because of limited sample size.

pricebynbghrhood <- ggplot(final,aes(x=price, fill=neighbourhood_group_cleansed)) + geom_density(alpha = 0.3) + scale_x_continuous(limits = quantile(final$price, c(0, 0.99))) + labs(x = "Price/Night", y = "Density") + guides(fill = guide_legend(title = "Neighbourhood")) 
ggplotly(pricebynbghrhood)

Revenue - Nightly Price per property by Zipcode

Going back to listing zipcodes ,prices/Night have too many close contenders.

Looking at top 10 zipcodes which fetch high price/Night are: 10011,10013,10014,10022,10023,10028,10036,11201,11217,11231

pricebyZipcode <- ggplot(final, aes(x = zipcode,y = price, fill = neighbourhood_group_cleansed)) + geom_boxplot() + scale_y_continuous(limits = quantile(final$price, c(0, 0.99))) + labs(x = "Zipcode", y = "Price/Night") + theme(axis.text.x = element_text(angle = 90, hjust = 1)) + guides(fill = guide_legend(title = "Neighbourhood")) 
ggplotly(pricebyZipcode)

Pair Wise Correlation

If a property is generously available for booking in the 30 days, it is most likely to be generously available during the rest of the year as well. There is strong positive correlation between (Availablity 30, Availablity 60,Availablity 90 & Availablity 365). The opposite is true. Booked out apartments tend to remain popular across the year.

Interestingly, Number of reviews also drive earlier bookings, which is clearly seen by it’s positive correlation with column: Availablity 365.

corCols <- c("availability_30","availability_60","availability_90","availability_365","number_of_reviews","price","cost")
plot_correlation(final[corCols], use ="pairwise.complete.obs")

Occupancy - Zipcode Vs Availability

Lower the availablity , higher the occupancy - indicating fast-filling properties.

Looking at Availablity for next 365 days, it is surprising to find a lot of properties booked ahead of time. The company can capitalize on this behavior and vary the price accordindingly to generate more revenue/profits.

Zipcodes that make top 10 from this list: 10021,10023,10025,10028,10128,10304,10312,11201,11215,11231

final %>% group_by(neighbourhood_group_cleansed,zipcode) %>% summarise_all(funs(mean)) %>% ggplot(aes(x =zipcode,y= availability_365, fill = neighbourhood_group_cleansed )) + geom_bar(stat = "identity") + scale_y_continuous(labels = scales::comma) +  scale_colour_brewer(palette = "Pastel2") + labs( y = "Availability", x = "Zipcode") + theme_bw() + theme(plot.background = element_blank(),panel.grid.major = element_blank(),panel.grid.minor = element_blank(),panel.border = element_blank(),axis.text.x = element_text(angle = 90, hjust = 1)) + guides(fill = guide_legend(title = "Neighbourhood")) 

Availability Vs Price

Stepping aside to understand availablity in terms of price, low prices don’t exactly drive faster bookings. Higher rental properties have minimal availablity (compared to next 365 days). It is satisfying to know that people are ready to pay higher ahead of time.

availablityPrice <- final %>% group_by(neighbourhood_group_cleansed,zipcode) %>% summarise_all(funs(mean)) %>% ggplot(aes(x=availability_365, y=price)) + scale_colour_brewer(palette = "Set1") + geom_point(aes(col=neighbourhood_group_cleansed, size=price)) +
labs(x="Availability", y="Price", shape="Price", colour= "Neighbourhood")

ggplotly(availablityPrice)

Review scores rating Vs Price

Are reviews driving the price ? Not likely. Trends are all over the place. Majority of the properties in are highly rated (10).

final$rating <- round(final$review_scores_rating/10,0)
final$rating <- as.factor(final$rating )

reviewPrice <- ggplot(data = subset(final, !is.na(rating)), aes(x=rating, y=price, colour = zipcode)) + geom_point(aes( size=price)) + scale_y_continuous(limits = quantile(final$price, c(0, 0.99))) + labs(x="Rating", y="Price")

ggplotly(reviewPrice)

Popularity - Number of Weeks Vs Number of Reviews by Zipcode

Popularity is measured in terms of number of reviews and it is a proponent of time. Higher reviews equate to popular properties and popular neighborhood/zipcode.

Top 10 zipcodes from the popular section are 10003,10014,10023,10025 10304,10306,10308,11201,11217,11231

numDayperReview <- final %>% mutate(diff = round(difftime(last_scraped, first_review, units = "weeks"),0)) %>% drop_na(diff) %>% group_by(neighbourhood_group_cleansed,zipcode) %>% summarise_all(funs(mean)) %>% ggplot(aes(x = number_of_reviews, y= diff, colour = zipcode)) + geom_point() + labs(x="Number Of Reviews", y="Number Of weeks")

ggplotly(numDayperReview)

Top 10 zipcodes by individual Metrics

Top 10 zipcodes are selected for each of these metrics based on the analysis and the final table looks like one below. Zipcodes that managed to make it to 3 or more metrics are highlighted. Individual zipcodes are given different colors to create a visual bifercation.

Top zipcodes fitting three or more metrics

The list is further reduced to top 8 zipcodes based on number of matches.