Ava Yang, Mango Solutions

Recap

In part 1 of this post I set out to find a flat to rent based on three simple criteria:

• Café density
• Tube station density
• Monthly rent

So far I have made use of the baidumap and REmap packages to create a nice visualisation of available flats and coffee shops in Shanghai.

Calculation and scoring

Now let’s do some basic math and programming. Three measures ( derived from original variables to quantify my preferences.

For density of café and tube station, the closer the better; the more the better. Geographic distances were calculated by function distm from package geosphere.

library(dplyr)
library(geosphere)
library(knitr)
library(baidumap)

load('data/ziroom.rds') # raw data
load("data/sh_cafe.rds")
load("data/sh_station.rds")

# 1. Generate names to represent flats
# 2. Extract longitude and lattitude
sh_ziroom <- ziroom %>%
mutate(name=paste("Room", rownames(ziroom), sep="_")) %>%
mutate(lon=getCoordinate(flat, city="上海", formatted = T)[, 'longtitude']) %>%
mutate(lat=getCoordinate(flat, city="上海", formatted = T)[, 'latitude']) %>%
na.omit() %>%
select(c(lon, lat, name, price_promotion, flat))

# distance matrices: between cafe and flat, between station and flat

dist_cafe_flat <- distm(sh_cafe[,c("lon", "lat")], sh_ziroom[,c("lon", "lat")]) %>%

as.data.frame()

dist_station_flat <- distm(sh_station[,c("lon", "lat")], sh_ziroom[,c("lon", "lat")]) %>%

as.data.frame()

As an upper limit I’m willing to walk as far as 750 metres (about 0.5 mile) from a café. Thus, cafe_idx and station_idx were then given by

For this job I wrote a small custom function called calIdx.

# Function to calculate cafe_idx and station_idx

calIdx <- function(tmpcol) {

tmpcol <- tmpcol[which(tmpcol < 750)]

return(sum(1/log(tmpcol)))

}

Rent is a negative indicator, and so rent_idx could be obtained from

The weighted score was calculated by

# 1. cafeIdx = 1/log(dis1) + 1/log(dis2) +...+ 1/log(disN)

# 2. stationIdx = 1/log(dis1) + 1/log(dis2) +...+ 1/log(disN)

# 3. rentIdx = 1/log(price_promotion)

# 4. score = 0.3*cafeIdx + 0.2*stationIdx + 0.5*rentIdx

sh_ziroom_top10 <- sh_ziroom %>%

mutate(cafeIdx = sapply(dist_cafe_flat, calIdx)) %>%

mutate(stationIdx = sapply(dist_station_flat, calIdx)) %>%

filter(price_promotion <= 4000) %>%

mutate(rentIdx = 1/log(as.numeric(price_promotion))) %>%

mutate(score = 0.4*cafeIdx + 0.2*stationIdx + 0.4*rentIdx) %>%

arrange(desc(score)) %>%

slice(1:10)

Summary

kable(sh_ziroom_top10[, c("name", "score", "cafeIdx", "stationIdx", "rentIdx")], align="c")

 
<table width="100%">
<tbody>
<tr>
<th>name</th>
<th>score</th>
<th>cafeIdx</th>
<th>stationIdx</th>
<th>rentIdx</th>
</tr>
<tr>
<td>Room_34</td>
<td>0.6480966</td>
<td>1.3262957</td>
<td>0.3380904</td>
<td>0.1249006</td>
</tr>
<tr>
<td>Room_35</td>
<td>0.6470510</td>
<td>1.3262957</td>
<td>0.3380904</td>
<td>0.1222865</td>
</tr>
<tr>
<td>Room_80</td>
<td>0.6054141</td>
<td>1.2216344</td>
<td>0.3378458</td>
<td>0.1229781</td>
</tr>
<tr>
<td>Room_79</td>
<td>0.6048128</td>
<td>1.2216344</td>
<td>0.3378458</td>
<td>0.1214746</td>
</tr>
<tr>
<td>Room_22</td>
<td>0.5729428</td>
<td>1.1430015</td>
<td>0.3349634</td>
<td>0.1218737</td>
</tr>
<tr>
<td>Room_24</td>
<td>0.5729428</td>
<td>1.1430015</td>
<td>0.3349634</td>
<td>0.1218737</td>
</tr>
<tr>
<td>Room_45</td>
<td>0.5292036</td>
<td>0.9617378</td>
<td>0.4709076</td>
<td>0.1258173</td>
</tr>
<tr>
<td>Room_46</td>
<td>0.5284566</td>
<td>0.9617378</td>
<td>0.4709076</td>
<td>0.1239499</td>
</tr>
<tr>
<td>Room_59</td>
<td>0.4334636</td>
<td>0.8012006</td>
<td>0.3237803</td>
<td>0.1205684</td>
</tr>
<tr>
<td>Room_57</td>
<td>0.3836545</td>
<td>0.6721137</td>
<td>0.3302977</td>
<td>0.1218737</td>
</tr>
</tbody>
</table>

Done! See above for the top 10 room candidates. The mechanism I used is not difficult and makes my life so much easier. Moving to a new area which fulfils all my social needs is no longer such a big challenge!