Realis Part 05 Singapore Country, Bedok Area, NorthEast Region, and Punggol Area Calendar Heatmaps

Background

The data for this R script comes from the URA Realis web site (www.ura.gov.sg, click on Realis menu) The purpose of the web site
is to provide data and information about the caveats lodged for EVERY property transaction in Singapore.

The URA Realis web site contains a lot of data and we will only look at a small subset for this R script. The files for this
script are as follows:

(1) realis_residential_database_1995_jan.csv

Contains information about ALL properties and ALL sales for Singapore from January 1995 to current.

(2) realis_region_northeast_all_type_incl_ec_all_sales_2007_jan_2012_oct_27.csv

Contains information about ALL properties and ALL sales for NorthEast region from January 2007 to current.

(3) realis_area_punggol_all_type_incl_ec_all_sales_2007_jan_2012_oct_27.csv

Contains information about ALL properties and ALL sales for Punggol area from January 2007 to current.

source("C:/Users/denbrige/100 FxOption/103 FxOptionVerBack/080 Fx Git/R-source/PlusRealis.R", 
    echo = FALSE)

## Loading required package: MASS

## Loading required package: nnet

## Attaching package: 'car'

## The following object(s) are masked from 'package:psych':
## 
## logit

## Loading required package: msm

## Loading required package: mvtnorm

## Loading required package: polycor

## Loading required package: sfsmisc

## Attaching package: 'polycor'

## The following object(s) are masked from 'package:psych':
## 
## polyserial

## Attaching package: 'ltm'

## The following object(s) are masked from 'package:psych':
## 
## factor.scores

## Loading required package: cluster

## Loading required package: Rcpp

## Loading required package: Defaults

## Loading required package: xts

## Loading required package: zoo

## Attaching package: 'zoo'

## The following object(s) are masked from 'package:base':
## 
## as.Date, as.Date.numeric

## Attaching package: 'xts'

## The following object(s) are masked from 'package:sfsmisc':
## 
## last

## Loading required package: TTR

## Attaching package: 'ggplot2'

## The following object(s) are masked from 'package:psych':
## 
## %+%

## Attaching package: 'scales'

## The following object(s) are masked from 'package:psych':
## 
## alpha, rescale

PART ONE (1): How rational has the property market been in Singapore?

This part answers a really simple question: What is the volatility and mean psf since 1995?

#
# |------------------------------------------------------------------------------------------|
# | P A R T O N E P R O C E D U R E |
# |------------------------------------------------------------------------------------------|
# --- Init loading data
rawDfr <- RealisReadDfr("realis_residential_database_1995_jan", 400)
# --- Count of rows of data
nrow(rawDfr)

## [1] 373288


# --- Coerce character into numeric or date
rawDfr[, 4] <- suppressWarnings(as.numeric(rawDfr[, 4]))  # Area sqm
rawDfr[, 6] <- suppressWarnings(as.numeric(rawDfr[, 6]))  # Transacted Price
rawDfr[, 7] <- suppressWarnings(as.numeric(rawDfr[, 7]))  # Unit Price psm
rawDfr[, 8] <- suppressWarnings(as.numeric(rawDfr[, 8]))  # Unit Price psf
rawDfr[, 9] <- as.Date(rawDfr[, 9], "%d-%b-%Y")

# --- Filter NAs and date before 1995-01-01
rawDfr <- rawDfr[!is.na(rawDfr$Contract.Date), ]
rawDfr <- rawDfr[rawDfr$Contract.Date >= as.Date("1995-01-01", "%Y-%m-%d"), 
    ]

# --- Split address into parts and merge new columns
rawDfr <- cbind(rawDfr, RealisAddressSplitDfr(rawDfr[, 2]))

# --- Merge day into one row Prepare data for calendar heatmap
psf <- aggregate(rawDfr[, 8], list(yearmon = format(rawDfr$Contract.Date, "%Y-%m-%d")), 
    sd)
names(psf) <- c("date", "sd")
psf$date <- as.Date(psf$date, "%Y-%m-%d")

# and now for each monthblock we normalize the week to start at 1
psf <- cbind(psf, RealisDateSplitDfr(psf$date))
psf <- ddply(psf, .(yearmonthf), transform, monthweek = 1 + week - min(week))

# Now for the plot Sequential color scheme: YlOrRd YlOrBr YlGnBu
titleChr <- "Singapore Residential Psf Volatility Heatmap"
n <- 9
palChr <- "YlOrRd"
pal <- colorRampPalette(brewer.pal(n, palChr))
lCol <- pal(n)[1]
hCol <- pal(n)[n]
P <- ggplot(psf, aes(monthweek, weekdayf, fill = psf$sd)) + geom_tile(colour = "white") + 
    facet_grid(year ~ monthf) + scale_fill_gradient(low = lCol, high = hCol, 
    na.value = "grey90") + opts(title = titleChr) + xlab("Week of Month") + 
    ylab("")

## Warning: 'opts' is deprecated. Use 'theme' instead. See help("Deprecated")

## Warning: Setting the plot title with opts(title="...") is deprecated. Use
## labs(title="...") or ggtitle("...") instead.

P

plot of chunk unnamed-chunk-2

PART TWO (2): How rational has the property market been in Bedok Area?

This part answers a really simple question: What is the volatility and mean psf since 2001?

#
# |------------------------------------------------------------------------------------------|
# | P A R T T W O P R O C E D U R E |
# |------------------------------------------------------------------------------------------|
# --- Init loading data
rawDfr <- rawDfr[rawDfr$Planning.Area == "Bedok", ]
# --- Count of rows of data
nrow(rawDfr)

## [1] 38267


# --- Filter date before 2001-01-01
rawDfr <- rawDfr[rawDfr$Contract.Date >= as.Date("2001-01-01", "%Y-%m-%d"), 
    ]

# --- Merge day into one row Prepare data for calendar heatmap
psf <- aggregate(rawDfr[, 8], list(yearmon = format(rawDfr$Contract.Date, "%Y-%m-%d")), 
    sd)
names(psf) <- c("date", "sd")
psf$date <- as.Date(psf$date, "%Y-%m-%d")

# and now for each monthblock we normalize the week to start at 1
psf <- cbind(psf, RealisDateSplitDfr(psf$date))
psf <- ddply(psf, .(yearmonthf), transform, monthweek = 1 + week - min(week))

# Now for the plot Sequential color scheme: YlOrRd YlOrBr YlGnBu
titleChr <- "Bedok Area Psf Volatility Heatmap"
n <- 9
palChr <- "YlOrRd"
pal <- colorRampPalette(brewer.pal(n, palChr))
lCol <- pal(n)[1]
hCol <- pal(n)[n]
P <- ggplot(psf, aes(monthweek, weekdayf, fill = psf$sd)) + geom_tile(colour = "white") + 
    facet_grid(year ~ monthf) + scale_fill_gradient(low = lCol, high = hCol, 
    na.value = "grey90") + opts(title = titleChr) + xlab("Week of Month") + 
    ylab("")

## Warning: 'opts' is deprecated. Use 'theme' instead. See help("Deprecated")

## Warning: Setting the plot title with opts(title="...") is deprecated. Use
## labs(title="...") or ggtitle("...") instead.

P

plot of chunk unnamed-chunk-3

PART THREE (3): How rational has the property market been in NorthEast Region?

This part answers a really simple question: What is the volatility and mean psf since 2007?

#
# |------------------------------------------------------------------------------------------|
# | P A R T T H R E E P R O C E D U R E |
# |------------------------------------------------------------------------------------------|
# --- Init loading data
rawDfr <- RealisReadDfr("realis_region_northeast_all_type_incl_ec_all_sales_2007_jan", 
    31)
# --- Count of rows of data
nrow(rawDfr)

## [1] 28366


# --- Coerce character into numeric or date
rawDfr[, 4] <- suppressWarnings(as.numeric(rawDfr[, 4]))  # Area sqm
rawDfr[, 6] <- suppressWarnings(as.numeric(rawDfr[, 6]))  # Transacted Price
rawDfr[, 7] <- suppressWarnings(as.numeric(rawDfr[, 7]))  # Unit Price psm
rawDfr[, 8] <- suppressWarnings(as.numeric(rawDfr[, 8]))  # Unit Price psf
rawDfr[, 9] <- as.Date(rawDfr[, 9], "%d-%b-%Y")

# --- Split address into parts and merge new columns
rawDfr <- cbind(rawDfr, RealisAddressSplitDfr(rawDfr[, 2]))

# --- Merge day into one row Prepare data for calendar heatmap
psf <- aggregate(rawDfr[, 8], list(yearmon = format(rawDfr$Contract.Date, "%Y-%m-%d")), 
    sd)
names(psf) <- c("date", "sd")
psf$date <- as.Date(psf$date, "%Y-%m-%d")

# and now for each monthblock we normalize the week to start at 1
psf <- cbind(psf, RealisDateSplitDfr(psf$date))
psf <- ddply(psf, .(yearmonthf), transform, monthweek = 1 + week - min(week))

# Now for the plot Sequential color scheme: YlOrRd YlOrBr YlGnBu
titleChr <- "NorthEast Region Psf Volatility Heatmap"
n <- 9
palChr <- "YlOrRd"
pal <- colorRampPalette(brewer.pal(n, palChr))
lCol <- pal(n)[1]
hCol <- pal(n)[n]
P <- ggplot(psf, aes(monthweek, weekdayf, fill = psf$sd)) + geom_tile(colour = "white") + 
    facet_grid(year ~ monthf) + scale_fill_gradient(low = lCol, high = hCol, 
    na.value = "grey90") + opts(title = titleChr) + xlab("Week of Month") + 
    ylab("")

## Warning: 'opts' is deprecated. Use 'theme' instead. See help("Deprecated")

## Warning: Setting the plot title with opts(title="...") is deprecated. Use
## labs(title="...") or ggtitle("...") instead.

P

plot of chunk unnamed-chunk-4

PART FOUR (4): How rational has the property market been in Punggol Area?

This part answers a really simple question: What is the volatility and mean psf since 2007?

#
# |------------------------------------------------------------------------------------------|
# | P A R T F O U R P R O C E D U R E |
# |------------------------------------------------------------------------------------------|
# --- Init loading data
rawDfr <- RealisReadDfr("realis_area_punggol_all_type_incl_ec_all_sales_2007_jan_2012_oct_27", 
    5)
# --- Count of rows of data
nrow(rawDfr)

## [1] 4124


# --- Coerce character into numeric or date
rawDfr[, 4] <- suppressWarnings(as.numeric(rawDfr[, 4]))  # Area sqm
rawDfr[, 6] <- suppressWarnings(as.numeric(rawDfr[, 6]))  # Transacted Price
rawDfr[, 7] <- suppressWarnings(as.numeric(rawDfr[, 7]))  # Unit Price psm
rawDfr[, 8] <- suppressWarnings(as.numeric(rawDfr[, 8]))  # Unit Price psf
rawDfr[, 9] <- as.Date(rawDfr[, 9], "%d-%b-%Y")

# --- Split address into parts and merge new columns
rawDfr <- cbind(rawDfr, RealisAddressSplitDfr(rawDfr[, 2]))

# --- Merge day into one row Prepare data for calendar heatmap
psf <- aggregate(rawDfr[, 8], list(yearmon = format(rawDfr$Contract.Date, "%Y-%m-%d")), 
    sd)
names(psf) <- c("date", "sd")
psf$date <- as.Date(psf$date, "%Y-%m-%d")

# and now for each monthblock we normalize the week to start at 1
psf <- cbind(psf, RealisDateSplitDfr(psf$date))
psf <- ddply(psf, .(yearmonthf), transform, monthweek = 1 + week - min(week))

# Now for the plot Sequential color scheme: YlOrRd YlOrBr YlGnBu
titleChr <- "Punggol Area Psf Volatility Heatmap"
n <- 9
palChr <- "YlOrRd"
pal <- colorRampPalette(brewer.pal(n, palChr))
lCol <- pal(n)[1]
hCol <- pal(n)[n]
P <- ggplot(psf, aes(monthweek, weekdayf, fill = psf$sd)) + geom_tile(colour = "white") + 
    facet_grid(year ~ monthf) + scale_fill_gradient(low = lCol, high = hCol, 
    na.value = "grey90") + opts(title = titleChr) + xlab("Week of Month") + 
    ylab("")

## Warning: 'opts' is deprecated. Use 'theme' instead. See help("Deprecated")

## Warning: Setting the plot title with opts(title="...") is deprecated. Use
## labs(title="...") or ggtitle("...") instead.

P

plot of chunk unnamed-chunk-5 

#
# |------------------------------------------------------------------------------------------|
# | E N D O F S C R I P T |
# |------------------------------------------------------------------------------------------|