Threats: Development

This vignette describes the first-look exploration and analysis with the BC Assessment data, providing sales history and values of real estate properties throughout British Columbia. The purpose for utilizing this data is to create some spatial layer for modelling development pressures on Bowen Island.

Data citation: BC Assessment, 2020, “BC Assessment Data Advice and Inventory Extracts, 2016-2022”, https://hdl.handle.net/11272.1/AB2/LAPUAB, Abacus Data Network, V6

library(bowen.biodiversity.webapp)
library(sf)
#> Linking to GEOS 3.11.1, GDAL 3.6.4, PROJ 9.1.1; sf_use_s2() is TRUE
library(terra)
#> terra 1.8.5
library(here)
#> here() starts at /home/jay/Programming_Projects/bowen.biodiversity.webapp
library(tidyverse)
#> ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
#> ✔ dplyr     1.1.4     ✔ readr     2.1.5
#> ✔ forcats   1.0.0     ✔ stringr   1.5.1
#> ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
#> ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
#> ✔ purrr     1.0.2
#> ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ tidyr::extract() masks terra::extract()
#> ✖ dplyr::filter()  masks stats::filter()
#> ✖ dplyr::lag()     masks stats::lag()
#> ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(leaflet)

BC Assessment Sales Data

This section deals with the data wrangling steps for the Bowen Island sales information. This data wrangling assumes that prices only increase, so lowest prices are associated with the earlier sale dates and vice versa.

bowen_sales_history <- here("data-raw/bc_assessment/bca_folios_spatial_file_20230103/bca_folios.gpkg.gpkg") %>%
  # Bowen Island Municipality JURISDICTION_CODE is 321
  st_read(query = 'SELECT * FROM WHSE_HUMAN_CULTURAL_ECONOMIC_BCA_FOLIO_SALES_SV WHERE JURISDICTION_CODE LIKE 321') 
#> Reading query `SELECT * FROM WHSE_HUMAN_CULTURAL_ECONOMIC_BCA_FOLIO_SALES_SV WHERE JURISDICTION_CODE LIKE 321'
#> from data source `/home/jay/Programming_Projects/bowen.biodiversity.webapp/data-raw/bc_assessment/bca_folios_spatial_file_20230103/bca_folios.gpkg.gpkg' 
#>   using driver `GPKG'
#> Simple feature collection with 5394 features and 23 fields
#> Geometry type: POLYGON
#> Dimension:     XY
#> Bounding box:  xmin: 1186718 ymin: 483237.4 xmax: 1195401 ymax: 492971.2
#> Projected CRS: NAD83 / BC Albers

# Assumes that first date is lowest price, last date is highest price
bowen_sales_summary  <- bowen_sales_history %>%
  # Drop spatial geometry, join back later
  st_drop_geometry() %>%
  # Remove invalid sales 
  filter(CONVEYANCE_TYPE_DESCRIPTION != "Reject - Not Suitable for Sales Analysis") %>%
  # Group by individual properties, since each transaction separate row
  group_by(FOLIO_ID) %>%
  summarise(first_date = min(CONVEYANCE_DATE),
            last_date = max(CONVEYANCE_DATE),
            lowest_price = min(CONVEYANCE_PRICE),
            highest_price = max(CONVEYANCE_PRICE),
            n_distinct = n_distinct(CONVEYANCE_TYPE_DESCRIPTION) # Show whether land was developed or sold as empty land
            ) %>%
  mutate(change_type = case_when(n_distinct > 1 ~ "changed", .default = "unchanged")) %>% # Show whether land was developed or sold as empty land
  mutate(days_span = as.double(last_date - first_date, units = "days")) %>% # Number of days between first available and most recent sale
  mutate(price_days_slope = (highest_price - lowest_price)/days_span) %>% # Change in price divided by number of days 
  filter(!is.infinite(price_days_slope) & !is.na(price_days_slope)) # Remove invalid price changes (ex. property has no records of being sold in open market)

BC Assessment Line Plot

Each property is one line segment on this plot with start and end points. The start point is the lowest price and first available sale date. The end point is the highest price and most recent sale date.

ggplot(bowen_sales_summary) +
  geom_segment(aes(x = first_date, xend = last_date, y = lowest_price, yend = highest_price, colour = change_type), alpha = 0.2) +
  xlab("Dates") +
  ylab("Price (CAD)")

BC Assessment Interactive Map

Properties that have available change in price over time are plotted on an interactive Leaflet map.

# Join with spatial data
bowen_folio_addresses <- here("data-raw/bc_assessment/bca_folios_spatial_file_20230103/bca_folios.gpkg.gpkg") %>%
  st_read(query = 'SELECT * FROM WHSE_HUMAN_CULTURAL_ECONOMIC_BCA_FOLIO_ADDRESSES_SV WHERE JURISDICTION_CODE LIKE 321') 
#> Reading query `SELECT * FROM WHSE_HUMAN_CULTURAL_ECONOMIC_BCA_FOLIO_ADDRESSES_SV WHERE JURISDICTION_CODE LIKE 321'
#> from data source `/home/jay/Programming_Projects/bowen.biodiversity.webapp/data-raw/bc_assessment/bca_folios_spatial_file_20230103/bca_folios.gpkg.gpkg' 
#>   using driver `GPKG'
#> Warning in CPL_read_ogr(dsn, layer, query, as.character(options), quiet, : GDAL
#> Message 1: Non-conformant content for record 1294783 in column WHEN_CREATED,
#> 2022-04-02T16:26:00Z, successfully parsed
#> Simple feature collection with 2811 features and 29 fields
#> Geometry type: POLYGON
#> Dimension:     XY
#> Bounding box:  xmin: 1119748 ymin: 482273.9 xmax: 1197521 ymax: 493626.9
#> Projected CRS: NAD83 / BC Albers

bowen_sales_summary_sf <- merge(bowen_sales_summary, bowen_folio_addresses) %>%
  rename(geometry = geom) %>%
  st_as_sf() %>%
  st_transform(4326)

# LEAFLET
bins <- c(0, 10, 20, 50, 100, 200, 500, 1000, Inf)
pal <- colorBin("YlOrRd", domain = bowen_sales_summary_sf$price_days_slope, bins = bins)
leaflet(bowen_sales_summary_sf) %>%
  addProviderTiles(providers$CartoDB.Positron) %>%
  addPolygons(color = "#444444", weight = 0.5,,
              fillColor = ~pal(price_days_slope),
              fillOpacity = 0.7
              ) %>%
  addLegend(pal = pal, values = ~price_days_slope)