Purpose and Scope

This report fetches LAOCC (Certificates of Compliance) data from the Hong Kong CSDI WFS, documents the dataset structure and quality, and presents statistics focused on residential units associated with issued certificates.

  • What is shown: counts of residential units and certificates across years, districts, and months.
  • How it is shown: validated data frame built from the WFS GeoJSON, with explicit field mappings, robust date parsing, and visualizations generated using ggplot2.

Fetch data (source, query, and raw shape)

This section downloads the GeoJSON from the public WFS endpoint and constructs a tabular data frame that combines properties with longitude/latitude.

library(httr)
library(jsonlite)
library(dplyr)
library(tidyr)
library(stringr)
library(lubridate)
library(ggplot2)
library(purrr)
library(slider)

wfs_url <- "https://portal.csdi.gov.hk/server/services/common/landsd_rcd_1631598950643_64107/MapServer/WFSServer"
wfs_query <- list(
  service = "wfs",
  request = "GetFeature",
  typenames = "LAOCC",
  outputFormat = "geojson",
  maxFeatures = 9999,
  srsName = "EPSG:4326",
  filter = "<Filter><Intersects><PropertyName>SHAPE</PropertyName><gml:Envelope srsName='EPSG:4326'><gml:lowerCorner>22.15 113.81</gml:lowerCorner><gml:upperCorner>22.62 114.45</gml:upperCorner></gml:Envelope></Intersects></Filter>"
)

request_url <- httr::modify_url(wfs_url, query = wfs_query)
res <- httr::GET(request_url, httr::add_headers(`Accept` = "application/geo+json, application/json, */*", `Accept-Charset` = "utf-8"))
stopifnot(status_code(res) == 200)
txt <- httr::content(res, as = "text", encoding = "UTF-8")
gj <- jsonlite::fromJSON(txt, simplifyVector = FALSE)
features <- gj$features
props_list <- lapply(features, `[[`, "properties")
coords_list <- lapply(features, function(f) f$geometry$coordinates)

# Robust properties and coordinates binding
props_df <- purrr::map_dfr(
  props_list,
  function(rec) {
    if (is.null(rec)) rec <- list()
    tibble::as_tibble(as.data.frame(rec, stringsAsFactors = FALSE))
  }
)
coords_mat <- purrr::map(coords_list, function(cxy) {
  if (is.null(cxy) || length(cxy) < 2) return(c(NA_real_, NA_real_))
  c(as.numeric(cxy[[1]]), as.numeric(cxy[[2]]))
}) %>% do.call(rbind, .)
coords_df <- tibble::as_tibble(coords_mat)
names(coords_df) <- c("lon", "lat")

laocc_raw <- dplyr::bind_cols(props_df, coords_df)
dim(laocc_raw)
## [1] 287  23
head(laocc_raw)

What the table shows (above)

  • First 6 rows of the raw dataset with joined geometry, for spot-checking field names and types.
  • How computed: each feature’s properties are row-bound; geometry coordinates are extracted and named lon/lat.

Normalize key fields (field mapping)

This section creates stable, analysis-friendly columns using explicit fallbacks from English/Chinese field variants.

coalesce_cols <- function(df, choices, new_name) {
  available <- intersect(choices, names(df))
  if (length(available) == 0) {
    df[[new_name]] <- NA_character_
  } else {
    vectors <- df[available]
    vectors <- lapply(vectors, function(v) { v[is.character(v) & trimws(v) == ""] <- NA_character_; v })
    df[[new_name]] <- dplyr::coalesce(!!!vectors)
  }
  df
}

field_map <- list(
  lot_number = c("NAME_EN", "Lot_Number"),
  lot_number_tc = c("NAME_TC", "地段編號"),
  address_en = c("ADDRESS_EN", "Location"),
  address_tc = c("ADDRESS_TC", "地點"),
  district_en = c("SEARCH01_EN", "Relevant_District_Council"),
  district_tc = c("SEARCH01_TC", "所屬區議會"),
  issuance_year = c("SEARCH02_EN", "Year_of_Issuance_of_Certificate_of_Compliance"),
  certificate_date = c("NSEARCH01_EN", "Date_of_Certificate_of_Compliance"),
  residential_units = c("NSEARCH02_EN", "No._of_Residential_Units_Involved")
)

laocc_norm <- laocc_raw
for (nm in names(field_map)) {
  laocc_norm <- coalesce_cols(laocc_norm, field_map[[nm]], nm)
}

names(laocc_norm)
##  [1] "GmlID"                                        
##  [2] "OBJECTID"                                     
##  [3] "Dataset"                                      
##  [4] "數據集"                                       
##  [5] "Lot_Number"                                   
##  [6] "Location"                                     
##  [7] "地段編號"                                     
##  [8] "地點"                                         
##  [9] "Relevant_District_Council"                    
## [10] "所屬區議會"                                   
## [11] "Year_of_Issuance_of_Certificate_of_Compliance"
## [12] "合約完成證明書簽發年度"                       
## [13] "Date_of_Certificate_of_Compliance"            
## [14] "合約完成證明書日期"                           
## [15] "No._of_Residential_Units_Involved"            
## [16] "涉及住宅單位數目"                             
## [17] "Northing___坐標北"                            
## [18] "Easting___坐標東"                             
## [19] "Latitude___緯度"                              
## [20] "Longitude___經度"                             
## [21] "Last_Updated_Date___最後更新日期"             
## [22] "lon"                                          
## [23] "lat"                                          
## [24] "lot_number"                                   
## [25] "lot_number_tc"                                
## [26] "address_en"                                   
## [27] "address_tc"                                   
## [28] "district_en"                                  
## [29] "district_tc"                                  
## [30] "issuance_year"                                
## [31] "certificate_date"                             
## [32] "residential_units"
head(laocc_norm[names(field_map)])

What the table shows (above)

  • The normalized columns used throughout the analysis.
  • How computed: coalesce() across likely field variants for each canonical name.

Parse dates and units (validation-ready types)

parse_flexible_date <- function(x) {
  if (is.na(x) || x == "") return(NA_Date_)
  en1 <- suppressWarnings(lubridate::dmy(x))
  if (!is.na(en1)) return(en1)
  en2 <- suppressWarnings(lubridate::mdy(x))
  if (!is.na(en2)) return(en2)
  m <- stringr::str_match(x, "(\\d{4})\\D+(\\d{1,2})\\D+(\\d{1,2})")
  if (!any(is.na(m))) return(as.Date(sprintf("%04d-%02d-%02d", as.integer(m[2]), as.integer(m[3]), as.integer(m[4]))))
  suppressWarnings(as.Date(x))
}

ensure_date_vector <- function(v) {
  if (inherits(v, "Date")) return(v)
  if (is.numeric(v)) return(as.Date(v, origin = "1970-01-01"))
  suppressWarnings(as.Date(v))
}

parsed_dates_tmp <- vapply(laocc_norm$certificate_date, parse_flexible_date, FUN.VALUE = as.Date(NA))
laocc_validated <- laocc_norm %>%
  mutate(
    certificate_date_parsed = ensure_date_vector(parsed_dates_tmp),
    issuance_year_numeric = suppressWarnings(as.integer(stringr::str_extract(issuance_year, "\\d{4}"))),
    residential_units_numeric = suppressWarnings(as.integer(stringr::str_replace_all(residential_units, "[^0-9-]", "")))
  )

summary(laocc_validated[, c("certificate_date_parsed", "issuance_year_numeric", "residential_units_numeric")])
##  certificate_date_parsed issuance_year_numeric residential_units_numeric
##  Min.   :2018-01-15      Min.   :2018          Min.   :   1.00          
##  1st Qu.:2019-06-26      1st Qu.:2019          1st Qu.:  47.25          
##  Median :2021-08-11      Median :2021          Median : 261.50          
##  Mean   :2021-08-09      Mean   :2021          Mean   : 474.80          
##  3rd Qu.:2023-06-19      3rd Qu.:2023          3rd Qu.: 667.00          
##  Max.   :2025-06-27      Max.   :2025          Max.   :4585.00          
##                                                NA's   :77

What the output shows (above)

  • Summaries confirming dates, years, and units are in numeric/Date form and ready for analysis.
  • How computed: flexible parsers handle both English and Chinese date formats; non-numeric unit values are stripped before integer conversion.

Key statistics (overview)

overall_stats <- list(
  total_certificates = nrow(laocc_validated),
  certificates_with_units = sum(!is.na(laocc_validated$residential_units_numeric)),
  units_total = sum(laocc_validated$residential_units_numeric, na.rm = TRUE),
  date_range = range(laocc_validated$certificate_date_parsed, na.rm = TRUE)
)
overall_stats
## $total_certificates
## [1] 287
## 
## $certificates_with_units
## [1] 210
## 
## $units_total
## [1] 99708
## 
## $date_range
## [1] "2018-01-15" "2025-06-27"

What the list shows (above)

  • High-level metrics for quick orientation: counts and time span.
  • How computed: straightforward counts and range.

Bar chart: Residential Units by Year

units_by_year <- laocc_validated %>%
  group_by(issuance_year_numeric) %>%
  summarise(certificates = n(), units_sum = sum(residential_units_numeric, na.rm = TRUE), .groups = "drop") %>%
  arrange(desc(issuance_year_numeric))

head(units_by_year, 10)
ggplot(units_by_year, aes(x = issuance_year_numeric, y = units_sum)) +
  geom_col(fill = "#007AFF") +
  labs(title = "Residential Units by Year", x = "Year", y = "Units") +
  theme_minimal()

What the chart shows

  • Total residential units associated with certificates in each year (descending order in the preview table).
  • How computed: sum of residential_units_numeric grouped by issuance_year_numeric.

Heatmap: Units by Year × District

units_year_district_long <- laocc_validated %>%
  group_by(issuance_year_numeric, district_en) %>%
  summarise(units_sum = sum(residential_units_numeric, na.rm = TRUE), .groups = "drop") %>%
  filter(!is.na(issuance_year_numeric), !is.na(district_en))

ggplot(units_year_district_long, aes(x = factor(issuance_year_numeric), y = district_en, fill = units_sum)) +
  geom_tile(color = "white") +
  scale_fill_gradient(low = "#f0f9e8", high = "#0868ac", name = "Units") +
  labs(title = "Residential Units Heatmap: Year × District", x = "Year", y = "District") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 0, hjust = 0.5, vjust = 0.5))

What the heatmap shows

  • Intensity of residential units by district and year (darker = more units).
  • How computed: tiles colored by summed units for each (year, district) combination.

Monthly volume with 18-month moving average

monthly_volume <- laocc_validated %>%
  mutate(month = floor_date(certificate_date_parsed, unit = "month")) %>%
  group_by(month) %>%
  summarise(units_sum = sum(residential_units_numeric, na.rm = TRUE), .groups = "drop") %>%
  arrange(month)

monthly_volume <- monthly_volume %>%
  mutate(
    units_ma_18m = slider::slide_dbl(
      .x = units_sum,
      .f = ~ mean(.x, na.rm = TRUE),
      .before = 17,
      .complete = TRUE
    )
  )

head(monthly_volume, 24)
ggplot(monthly_volume, aes(x = month)) +
  geom_col(aes(y = units_sum), fill = "#9ecae1") +
  geom_line(aes(y = units_ma_18m), color = "#e31a1c", linewidth = 1.1, na.rm = TRUE) +
  labs(title = "Monthly Residential Units with 18-Month Moving Average",
       x = "Month", y = "Units") +
  theme_minimal()

What the chart shows

  • Monthly units (bars) and the 18‑month moving average (red line) to reveal medium-term trend.
  • How computed: month aggregation by certificate date; rolling mean over a 18‑month window.

Box plot: Units per Certificate by Year (Median and IQR)

units_summary_by_year <- laocc_validated %>%
  filter(!is.na(issuance_year_numeric)) %>%
  filter(!is.na(residential_units_numeric)) %>%
  group_by(issuance_year_numeric) %>%
  summarise(
    n_certs = n(),
    median_units = median(residential_units_numeric, na.rm = TRUE),
    iqr_units = IQR(residential_units_numeric, na.rm = TRUE),
    p25 = quantile(residential_units_numeric, 0.25, na.rm = TRUE),
    p75 = quantile(residential_units_numeric, 0.75, na.rm = TRUE),
    .groups = "drop"
  ) %>%
  arrange(desc(issuance_year_numeric))

head(units_summary_by_year, 10)
ggplot(
  laocc_validated %>% filter(!is.na(issuance_year_numeric), !is.na(residential_units_numeric)),
  aes(x = factor(issuance_year_numeric), y = residential_units_numeric)
) +
  geom_boxplot(fill = "#cce5ff", color = "#0056b3", outlier.alpha = 0.4) +
  stat_summary(fun = median, geom = "point", shape = 21, size = 2.5, fill = "#e31a1c", color = "#e31a1c") +
  labs(title = "Units per Certificate by Year (Median and IQR)", x = "Year", y = "Units per Certificate") +
  theme_minimal()

What the plot shows

  • Distribution of units per certificate within each year; the box captures the IQR (25th–75th percentile), the line/dot marks the median.
  • How computed: raw per‑certificate unit counts grouped by year.

Wide monthly-by-year table

This final table arranges months as rows (January through December) and years as columns, with a “Total” row that sums across all months for each year.

monthly_by_year <- laocc_validated %>%
  mutate(
    year = lubridate::year(certificate_date_parsed),
    month_num = lubridate::month(certificate_date_parsed),
    month_name = factor(
      lubridate::month(certificate_date_parsed, label = TRUE, abbr = FALSE),
      levels = c("January","February","March","April","May","June","July","August","September","October","November","December"),
      ordered = TRUE
    )
  ) %>%
  filter(!is.na(year), !is.na(month_num)) %>%
  group_by(year, month_name) %>%
  summarise(units_sum = sum(residential_units_numeric, na.rm = TRUE), .groups = "drop") %>%
  arrange(year, month_name)

monthly_wide <- tidyr::pivot_wider(
  monthly_by_year,
  names_from = year,
  values_from = units_sum,
  values_fill = 0
) %>%
  arrange(month_name)

numeric_cols <- setdiff(names(monthly_wide), c("month_name"))
totals_row <- as.list(colSums(monthly_wide[numeric_cols], na.rm = TRUE))
monthly_wide_chr <- monthly_wide %>% mutate(month_name = as.character(month_name))
monthly_wide_tot <- dplyr::bind_rows(
  monthly_wide_chr,
  c(list(month_name = "Total"), totals_row)
) %>%
  mutate(
    month_name = factor(
      month_name,
      levels = c("January","February","March","April","May","June","July","August","September","October","November","December","Total"),
      ordered = TRUE
    )
  ) %>%
  arrange(month_name)

knitr::kable(
  monthly_wide_tot,
  caption = "Monthly residential units by year (rows = months, columns = years; final row is yearly total)."
)
Monthly residential units by year (rows = months, columns = years; final row is yearly total).
month_name 2018 2019 2020 2021 2022 2023 2024 2025
January 472 249 0 73 38 0 9 1
February 1908 630 1122 0 0 190 2303 0
March 947 1886 479 607 780 2600 163 2990
April 21 1270 2353 1999 414 56 58 4783
May 548 0 1765 0 117 387 1873 1365
June 14 732 3234 886 4308 4299 2921 2422
July 951 0 5746 735 1 1919 773 0
August 1851 946 1017 2621 2187 1247 1112 0
September 842 1405 181 248 323 0 566 0
October 2009 0 1995 1342 2011 335 304 0
November 1549 0 619 3401 692 705 742 0
December 506 390 1696 142 2445 770 112 0
Total 11618 7508 20207 12054 13316 12508 10936 11561

What the table shows

  • Units completed each calendar month, split by year, with a final row that sums across months per year.
  • How computed: group by (year, month) then pivot wider to years as columns; totals are column sums.