mountainMath · mountainMath · Feb 4, 2025 · Feb 4, 2025 · Mar 7, 2025 · Mar 7, 2025
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -18,3 +18,4 @@
 ^cran-comments\.md$
 ^data_raw/
 ^data_raw/*
+.DS_Store
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: cmhc
 Type: Package
 Title: Access, Retrieve, and Work with CMHC Data
-Version: 0.2.10
+Version: 0.2.11
 Authors@R:
     c(person(given = "Jens",
              family = "von Bergmann",

diff --git a/NEWS.md b/NEWS.md
@@ -56,3 +56,10 @@
 
 * enable data access to more tables
 
+## cmhc v0.2.11
+### Minor changes
+
+* enable data access to SAAR tables
+* more informative error messages when data is not available
+* code cleaning to adhere to tidyselect updates
+
diff --git a/R/cmhc.R b/R/cmhc.R
@@ -83,8 +83,8 @@ get_cmhc <- function(survey,series, dimension, breakdown,geoFilter="Default",
                     paste0(unique(selectedSurvey$Series),collapse = ", "),"."))
       }
       selectedDimension <- table_list %>%
-        filter(.data$Survey==survey, .data$Series==series, .data$Dimension==dimension)
-      if (nrow(selectedDimension)==0 && !is.na(dimension)) {
+        filter(.data$Survey==survey, .data$Series==series, is.null(dimension)||is.na(dimension)||.data$Dimension==dimension)
+      if (nrow(selectedDimension)==0 && !(is.null(dimension)||is.na(dimension))) {
         stop(paste0("Dimension ",dimension," for ",series," and survey ",survey,
                     " does not exist or is not supported. Valid dimensions are ",
                     paste0(unique(selectedSeries$Dimension),collapse = ", "),"."))
@@ -133,6 +133,24 @@ get_cmhc <- function(survey,series, dimension, breakdown,geoFilter="Default",
     if (selectedTable$TableCode=="5.7.2") selectedTable$TableCode="5.7.1"
   }
 
+  if (selectedTable$Series=="Starts (SAAR)") {
+    codes <- selectedTable$TableCode |> strsplit("\\.") |>
+      unlist()
+    if (!(region_params$geography_type_id %in% c("1","2","3"))) {
+      stop("SAAR tables are only available for Canada, Provinces and CMAs.")
+    }
+    if (region_params$geography_type_id %in% c("1","2") && selectedTable$GeoFilter == "Default") {
+      warning("SAAR tables for Canada and the Provinces are only available for All or 10k geographies, changing to 10k.")
+      codes[2]="1"
+    }
+    if (region_params$geography_type_id %in% c("3") && selectedTable$GeoFilter != "Default") {
+      warning("SAAR tables for Metro Areas are only available for Default geographies, changing to Default")
+      codes[2]="3"
+    }
+    codes[3]=region_params$geography_type_id
+    selectedTable$TableCode=paste0(codes,collapse = ".")
+  }
+
   query_params <- list(
     TableId=selectedTable$TableCode,
     GeographyId=region_params$geography_id,
@@ -191,13 +209,22 @@ get_cmhc <- function(survey,series, dimension, breakdown,geoFilter="Default",
     )
     if (response$status_code != 200) {
       if (file.exists(data_file)) file.remove(data_file)
-      warning(paste0("Invalid response, status ",response$status_code,"."))
+      warning(paste0("Invalid response, status ",response$status_code,".","\n",
+                     "This can happen when CMHC HMIP does not have data for the given geography ",geo_uid,"."))
       return(NULL)
     }
   }
   dat=readLines(data_file, encoding="latin1") # yes, CMHC does not use UTF-8...
   last_row=match("",dat)
   range=grep("^,.+$",dat)
+  have_saar_table = FALSE
+  if (length(range)==0) {
+    range=grep("^ \u2014 Starts \\(SAAR\\)",dat)
+    if (length(range)==1) {
+      range[1]=range[1] + 1
+      have_saar_table=TRUE
+    }
+  }
   if (length(range)==0) {
     warning("Problem reading response.")
     warning(paste0(dat,collapse = "\n"))
@@ -215,6 +242,9 @@ get_cmhc <- function(survey,series, dimension, breakdown,geoFilter="Default",
     mutate(clean=ifelse(raw==""&lag(raw)!="",paste0(lag(raw)," - ","Quality"),raw)) |>
     mutate(clean=na_if(.data$clean,""))
   if (is.na(header$clean[1])) header$clean[1]="XX"
+  if (nrow(header)==1&&have_saar_table) {
+    header <- tibble::tibble(clean=c("XX","Starts (SAAR)"))
+  }
 
   result=readr::read_csv(data_file,skip = range[1],n_max=range[2]-range[1],
                                           locale = readr::locale(encoding = "latin1"),
@@ -257,7 +287,15 @@ get_cmhc <- function(survey,series, dimension, breakdown,geoFilter="Default",
 
   table <- table |>
     mutate(Metric=factor(.data$Metric, levels= regular_vars))
-  if (!is.na(dimension) && !is.null(dimension)) table <- table |> rename(!!dimension:=.data$Metric)
+
+
+  if (!(is.null(dimension) || is.na(dimension))) table <- table |> rename(!!dimension:=.data$Metric)
+
+  if (have_saar_table) {
+    table <- table |> mutate(`Dwelling Type`="Total")
+    #table <- table |> select(-"Dwelling Type")
+  }
+
 
   if (breakdown=="Historical Time Periods") {
     if (length(names(geo_uid))>0) {

diff --git a/R/cmhc_tables.R b/R/cmhc_tables.R
@@ -78,8 +78,14 @@ list_cmhc_tables <- function(short=TRUE){
     "Scss","Completions","Intended Market","Historical Time Periods",scss_filters,"1.16.2.5","50k",
     "Scss","Completions","Dwelling Type","Historical Time Periods",scss_filters,"1.2.2.4","Metro",
     "Scss","Completions","Intended Market","Historical Time Periods",scss_filters,"1.16.2.4","Metro",
+    # "Scss","Starts (SAAR)","Dwelling Type","Distorical Time Periods",list(),"5.1.2", "PR 10k",
+    # "Scss","Starts (SAAR)","Dwelling Type","Distorical Time Periods",list(),"5.2.2", "PR All",
+    # "Scss","Starts (SAAR)","Dwelling Type","Distorical Time Periods",list(),"5.3.3", "Metro Default",
+    # "Scss","Starts (SAAR)","Dwelling Type","Distorical Time Periods",list(),"5.1.1", "Canada 10k",
+    # "Scss","Starts (SAAR)","Dwelling Type","Distorical Time Periods",list(),"5.2.1", "Canada All",
   )
 
+
   scss_snapshot1 <- tibble::tribble(
     ~Survey,~SurveyCode,~Series,~SeriesCode,~GeoCodes,~Dimension,~DimensionCode,~Filters,~h,
     "Scss","1","Starts","1","1","Dwelling Type","1",scss_filters,"2",
@@ -114,24 +120,23 @@ list_cmhc_tables <- function(short=TRUE){
     left_join(tibble(GeoCodes=c(rep("1",length(cmhc_type_codes1)),rep("2",length(cmhc_type_codes2))),
                      Breakdown=c(names(cmhc_type_codes1),names(cmhc_type_codes2)),
                      BreakdownCode=as.character(c(cmhc_type_codes1,cmhc_type_codes2))),
-              by="GeoCodes") |>
-    select(-.data$GeoCodes) |>
+              by="GeoCodes", relationship="many-to-many") |>
+    select(-"GeoCodes") |>
     mutate(TableCode=paste0(.data$SurveyCode,".",.data$DimensionCode,".",
                             .data$SeriesCode,".",.data$BreakdownCode))
 
-
   scss_timeseries <- scss_snapshot |>
-    select(-.data$TableCode,-.data$Breakdown,-.data$BreakdownCode) |>
+    select(-"TableCode",-"Breakdown",-"BreakdownCode") |>
     unique() %>%
     mutate(DimensionCode=.data$h) |>
     mutate(TableCode=paste0(.data$SurveyCode,".",.data$DimensionCode,".",.data$SeriesCode)) |>
     mutate(Breakdown="Historical Time Periods") |>
-    select(-.data$h) |>
+    select(-"h") |>
     mutate(TableCode=case_when(.data$Series=="Length of Construction" & .data$Dimension=="Intended Market" ~ "1.2.8",
                                .data$Series=="Share absorbed at completion" & .data$Dimension=="Dwelling Type" ~ "1.2.6",
                                TRUE ~ .data$TableCode))
 
-  scss_snapshot <- scss_snapshot |> select(-.data$h)
+  scss_snapshot <- scss_snapshot |> select(-"h")
 
   scss_snapshot3 <- tibble::tribble(
     ~Survey,~SurveyCode,~Series,~SeriesCode,~Dimension,~DimensionCode,~Filters,
@@ -172,12 +177,12 @@ list_cmhc_tables <- function(short=TRUE){
                      Breakdown=c(names(cmhc_type_codes3),names(cmhc_type_codes4)),
                      BreakdownCode=as.character(c(cmhc_type_codes3,cmhc_type_codes4))),
               by="GeoCodes") |>
-    select(-.data$GeoCodes) |>
+    select(-"GeoCodes") |>
     mutate(TableCode=paste0(.data$SurveyCode,".",.data$SeriesCode,".",
                             .data$DimensionCode,".",.data$BreakdownCode))
 
   rms_timeseries <- rms_snapshot |>
-    select(-.data$TableCode,-.data$Breakdown,-.data$BreakdownCode) |>
+    select(-"TableCode",-"Breakdown",-"BreakdownCode") |>
     unique() %>%
     mutate(SeriesCode="2") |>
     mutate(TableCode=paste0(.data$SurveyCode,".",.data$SeriesCode,".",.data$DimensionCode)) |>
@@ -383,19 +388,21 @@ list_cmhc_tables <- function(short=TRUE){
                 filter(.data$Series=="Starts",
                        .data$Dimension=="Dwelling Type",
                        .data$Breakdown=="Provinces")  |>
-                mutate(TableCode="5.5.1",GeoFilter="All"))
+                mutate(TableCode="5.5.1",GeoFilter="All")) |>
+    bind_rows(tibble::tibble(Survey="Scss",Series="Starts (SAAR)",Dimension="Dwelling Type",Breakdown="Historical Time Periods",
+                     GeoFilter=c("Default","10k","All"),TableCode=c("5.3.3","5.1.3","5.2.3")))
 
   # Sanity check
   d<-table_list |>
-    select(.data$Survey,.data$Series,.data$Dimension,.data$Breakdown,.data$Filters,.data$TableCode,.data$GeoFilter) |>
+    select("Survey","Series","Dimension","Breakdown","Filters","TableCode","GeoFilter") |>
     full_join(bind_rows(scss_snapshot_all |> mutate(GeoFilter="Default"),
                         scss_timeseries_all),
               by = c("Survey", "Series", "Dimension", "Breakdown", "Filters", "GeoFilter"))
   stopifnot(d |> filter(!is.na(.data$Table) & .data$Table != .data$TableCode) |> nrow()==0)
 
   if (short) {
     table_list <- table_list |>
-      select(.data$Survey,.data$Series,.data$Dimension,.data$Breakdown,.data$GeoFilter,.data$Filters)
+      select("Survey","Series","Dimension","Breakdown","GeoFilter","Filters")
   }
 
   table_list
@@ -411,7 +418,7 @@ list_cmhc_tables <- function(short=TRUE){
 #' @export
 list_cmhc_surveys <- function(){
   list_cmhc_tables() |>
-    select(.data$Survey) |>
+    select("Survey") |>
     unique()
 }
 
@@ -426,7 +433,7 @@ list_cmhc_surveys <- function(){
 #' @export
 list_cmhc_series <- function(survey=NULL){
   l <- list_cmhc_tables() |>
-    select(.data$Survey,.data$Series) |>
+    select("Survey","Series") |>
     unique()
 
   if (!is.null(survey)) {
@@ -450,7 +457,7 @@ list_cmhc_series <- function(survey=NULL){
 #' @export
 list_cmhc_dimensions <- function(survey=NULL,series=NULL){
   l <- list_cmhc_tables() |>
-    select(.data$Survey,.data$Series,.data$Dimension) |>
+    select("Survey","Series","Dimension") |>
     unique()
 
   if (!is.null(survey)) {
@@ -483,7 +490,7 @@ list_cmhc_dimensions <- function(survey=NULL,series=NULL){
 #' @export
 list_cmhc_breakdowns <- function(survey=NULL,series=NULL,dimension=NULL){
   l <- list_cmhc_tables() |>
-    select(.data$Survey,.data$Series,.data$Dimension,.data$Breakdown) |>
+    select("Survey","Series","Dimension","Breakdown") |>
     unique()
 
   if (!is.null(survey)) {
@@ -521,7 +528,7 @@ list_cmhc_breakdowns <- function(survey=NULL,series=NULL,dimension=NULL){
 #' @export
 list_cmhc_filters <- function(survey=NULL,series=NULL,dimension=NULL, breakdown=NULL){
   l <- list_cmhc_tables() |>
-    select(.data$Survey,.data$Series,.data$Dimension,.data$Breakdown,.data$Filters) |>
+    select("Survey","Series","Dimension","Breakdown","Filters") |>
     unique()
 
   if (!is.null(survey)) {

diff --git a/README.md b/README.md
@@ -37,7 +37,6 @@ for vacancy rate data by bedroom type for the Vancouver Census Metropolitan Area
 library(cmhc)
 vacancy_data <- get_cmhc(survey="Rms",series="Vacancy Rate",dimension="Bedroom Type",
                          breakdown="Historical Time Periods",  geo_uid="59933")
-
 ```
 
 Starting with version v.0.3.2 the package has an interactive query builder helper function `select_cmhc_table()` that interactively walks through the available data and builds parameters for `get_cmhc()` like the example above. This makes it easy to discover data and build function calls to CMHC tables.
@@ -51,7 +50,7 @@ Starting with version v.0.3.2 the package has an interactive query builder helpe
 
 If you wish to cite cmhc:
 
-  von Bergmann, J. (2025) cmhc: R package to access, retrieve, and work with CMHC data. v0.2.10. DOI: 10.32614/CRAN.package.cmhc
+  von Bergmann, J. (2025) cmhc: R package to access, retrieve, and work with CMHC data. v0.2.11. DOI: 10.32614/CRAN.package.cmhc
 
 
 A BibTeX entry for LaTeX users is
@@ -61,7 +60,7 @@ A BibTeX entry for LaTeX users is
     title = {cmhc: R package to access, retrieve, and work with CMHC data},
     year = {2025},
     doi = {10.32614/CRAN.package.cmhc},
-    note = {R package version 0.2.10},
+    note = {R package version 0.2.11},
     url = {https://mountainmath.github.io/cmhc/},
   }
 ```

diff --git a/cran-comments.md b/cran-comments.md
@@ -1,3 +1,10 @@
+## cmhc v0.2.11
+### Minor changes
+
+* enable data access to SAAR tables
+* more informative error messages when data is not available
+* code cleaning to adhere to tidyselect updates
+
 ## cmhc v0.2.10
 ### Minor changes