CUNY SPS DATA-606 Final Project

Data Collection

The NYS Office of Real Property Services (NYS RPS) collects sales price data. This administrative record data was scrapped using a web scrapper in early November of 2018 (Monroe County 2018). At that time, the data was as of 22 October 2018.

The NYS GIS clearinghouse compiles data on housing attributes (NYS GIS Clearinghouse 2017). This data originates from local assessors. The 2017 data (latest available) was used. The square footage of living space is the measurement of size in this study. It is a quantitative measure.

Data on the age of the home are transformed into eras (a categorical variable). These eras come from an article authored by Trulia’s Chief Economist. They are:

1. Before 1940s
2. Post-War Boom (1940 to 1979)
3. Last 30+ Years (1980+)

This study is purely observational in nature. It does not assert these variables have a causal relationship.

Data Preparation

The scrapped data is in a SQLite database stored on GitHub. The first step is to download and extract this database locally.

library(DBI)
library(dplyr)

# Download the database
if(!file.exists("Monroe Real Property Data.db")){
  if(!file.exists("Monroe Real Property Data.db.tar.gz")){
    # Download this specific commit from my GitHub repo
    download.file("https://github.com/mikeasilva/CUNY-SPS/raw/9a2023b57a466550646c9190076a53d51ef09ef2/data/Monroe%20Real%20Property%20Data.db.tar.gz", "Monroe Real Property Data.db.tar.gz")
  }
  # Decompress the file
  untar("Monroe Real Property Data.db.tar.gz")
  # Remove the file
  unlink("Monroe Real Property Data.db.tar.gz")
}

Now that the data is downloaded it is time to pull the sales price. Each parcel is identified by a SWIS (Statewide Information System) and SBL (Section, Block, Lot) code. Using this identifier, the next step is to find the latest sale date.

# Connect to the database
con <- dbConnect(RSQLite::SQLite(), "Monroe Real Property Data.db")

# Get the date of the latest sale for each property
results <- dbSendQuery(con, "SELECT MAX(sale_date) AS sale_date, SWIS, SBL FROM sales_data GROUP BY SWIS, SBL HAVING sale_date BETWEEN '2017-01-01' AND '2017-12-31'")
df <- dbFetch(results) 

dbClearResult(results)

Now the sale price can be pulled. There should be 8,444 sale prices in the data set after the next step.

df <- dbReadTable(con, "sales_data") %>% # Pull all the records
  distinct() %>% # remove any duplicates
  merge(df) %>% # Merge with the latest sale dates
  rename(Price = price)

The observations total 8,460. It appears the merging process introduced some duplication into the data set. This needs to be corrected. Any parcel with more than one record will be dropped from the dataset.

df <- df %>%
  select(SWIS, SBL) %>% # Select the unique identifiers
  group_by(SWIS, SBL) %>% 
  summarise(count = n()) %>% # Get the number of records
  ungroup() %>%
  filter(count == 1) %>% # Only keep the observations with one price
  select(-count) %>% # Drop the count variable
  merge(df) # Merge it with the original data frame to subset it

This leaves 8,428 unduplicated observations in the data set. Now that we have the outcome variable, it is time to add in the housing attributes.

# Add in the housing attributes
df <- dbReadTable(con, "property_info") %>% # Pull all the records
  distinct() %>% # remove any duplicates
  merge(df) # Merge with the sale price

# Disconnect from the database
dbDisconnect(con)

There are 8,428 observations in the data set. This indicates the merging process did not introduce any duplication. Now that the housing attributes are added in, some odd observations need to be filtered out.

df <- df %>% # First filter out some obviously weird data
  filter(YR_BLT > 0) %>%
  filter(SQFT_LIV > 0) %>%
  filter(NBR_KITCHN > 0) %>%
  filter(NBR_BEDRM > 0)

After filtering there are 8,421 observations. This is the final count of cases for the study. The next step is to translate the year of construction into an era.

get_era <- function(year){
  if(year < 1940){
    return("1. Before 1940s")
  } else if(year < 1980){
    return("2. Post-War Boom")
  }else{
    return("3. Last 30+ Years")
  }
}

df <- df %>% 
  rowwise() %>%
  mutate(Era = get_era(YR_BLT)) %>%
  ungroup() %>%
  mutate(Era = as.factor(Era))

The last data preparation step is renaming and selecting the variables of interest.

df <- df %>%
  rename(Size = SQFT_LIV) %>%
  select(Price, Size, Era)

Sanity Check

The American Community survey asks respondents about their home value. Assuming the sale price is comparable to the home value, how well does the study data represent the housing stock? The following figure takes the study data and compares with with Monroe County’s housing stock (U.S. Census Bureau 2017).

# Log transformation
df <- df %>%
  mutate(Log_Price = log(Price))

# Remove the outliers
remove_outliers <- function(x, na.rm = TRUE, ...) {
  qnt <- quantile(x, probs=c(.25, .75), na.rm = na.rm, ...)
  H <- 1.5 * IQR(x, na.rm = na.rm)
  y <- x
  y[x < (qnt[1] - H)] <- NA
  y[x > (qnt[2] + H)] <- NA
  y
}

valid_prices <- unique(remove_outliers(df$Log_Price))
min_price <- min(valid_prices, na.rm=TRUE)
max_price <- max(valid_prices, na.rm=TRUE)

df <- df %>%
  filter(Log_Price > min_price) %>%
  filter(Log_Price < max_price)

Study Data

As previously stated there are 8,144 observations in this data set. Each case represents the most recent sale price for a residential property occuring in 2017, ranging in price from $45,000 to $536,000. On a log scale these prices range from $10.71442 to $13.19189.

Figure 4: Log Sales Price and Size by Era

It is clear that price and size are related. The relationship between price and era is not as clear The following visualization and summary table examines this relationship further:

Figure 5: Log Sales Price by Era

Table 2: Log Sales Price by Era Summary

The older houses tend to fetch less in the market than the newer houses. There also does not seem to be much difference between the pre and post-war housing.

Checking for Multicollinearity

The two explanatory variables might be related. It is reasonable to believe that homes increased in size over time. The plot below will display how the size and era are related.

Residual Examination

Generalization

In order to assess how well this model generalizes, predictions for the testing data set will be made and compared to the actual.

predictions <- predict(fit, testing, interval = "confidence")
testing$Log_Price_hat <- predictions[, 1]
testing$Price_hat <- exp(testing$Log_Price_hat)
testing$Log_Price_hat_lower <- predictions[, 2]
testing$Price_hat_lower <- exp(testing$Log_Price_hat_lower)
testing$Log_Price_hat_upper <- predictions[, 3]
testing$Price_hat_upper <- exp(testing$Log_Price_hat_upper)

Let’s visualize the predictions vs the actual sales prices. In the following plot the sales price is on the x-axis and the prediction is on the y-axis. Values are per one thousand. The black dashed line represents where the prediction and the actual values are the same. The blue are under estimates, red are over estimates, and the green points have a price that falls within the prediction’s confidence interval.

testing <- testing %>%
  mutate(Error = Price_hat - Price)

testing <- testing %>%
  mutate(Error_Share = (abs(Error) / Price) * 100)