From 789a20c3ccce20274f31e09c3b22a9eb550f152a Mon Sep 17 00:00:00 2001 From: Jens von Bergmann Date: Mon, 3 Feb 2025 20:13:31 -0800 Subject: [PATCH 1/6] cosmetic --- README.md | 1 - 1 file changed, 1 deletion(-) diff --git a/README.md b/README.md index 29e4b25..8772e9e 100644 --- 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. From 49d5d7272d9da7d6c00b49d3c0bc23235e82ef2b Mon Sep 17 00:00:00 2001 From: Jens von Bergmann Date: Mon, 3 Feb 2025 20:14:18 -0800 Subject: [PATCH 2/6] bump version, set up stub for new version --- DESCRIPTION | 2 +- README.md | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c842352..bbff3d3 100644 --- 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/README.md b/README.md index 8772e9e..44a24fb 100644 --- a/README.md +++ b/README.md @@ -50,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 @@ -60,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/}, } ``` From d4ad1508e82053aaca5580b93fa7151bfaa20074 Mon Sep 17 00:00:00 2001 From: Jens von Bergmann Date: Fri, 7 Mar 2025 15:01:07 -0800 Subject: [PATCH 3/6] accommodate Starts SAAR --- R/cmhc.R | 15 +++++++++++++-- R/cmhc_tables.R | 4 +++- 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/R/cmhc.R b/R/cmhc.R index a88942b..0422888 100644 --- 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 = ", "),".")) @@ -198,6 +198,14 @@ get_cmhc <- function(survey,series, dimension, breakdown,geoFilter="Default", 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("^ — 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 +223,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"), diff --git a/R/cmhc_tables.R b/R/cmhc_tables.R index 9c38fc5..3a58710 100644 --- a/R/cmhc_tables.R +++ b/R/cmhc_tables.R @@ -383,7 +383,9 @@ 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)",Breakdown="Historical Time Periods", + GeoFilter="Default",TableCode="5.3.3")) # Sanity check d<-table_list |> From ad912fd4777c3cd1fd6a018d38a1036b020ca841 Mon Sep 17 00:00:00 2001 From: Jens von Bergmann Date: Fri, 7 Mar 2025 15:14:10 -0800 Subject: [PATCH 4/6] fix non-ascii characters --- R/cmhc.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/cmhc.R b/R/cmhc.R index 0422888..8d4057c 100644 --- a/R/cmhc.R +++ b/R/cmhc.R @@ -200,7 +200,7 @@ get_cmhc <- function(survey,series, dimension, breakdown,geoFilter="Default", range=grep("^,.+$",dat) have_saar_table = FALSE if (length(range)==0) { - range=grep("^ — Starts \\(SAAR\\)",dat) + range=grep("^ \u2014 Starts \\(SAAR\\)",dat) if (length(range)==1) { range[1]=range[1] + 1 have_saar_table=TRUE @@ -268,7 +268,14 @@ 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 |> select(-"Metric") + } + if (breakdown=="Historical Time Periods") { if (length(names(geo_uid))>0) { From 31d3883827ebd7a54c8b4d5657087ca08db8a295 Mon Sep 17 00:00:00 2001 From: Jens von Bergmann Date: Wed, 23 Jul 2025 20:43:04 -0700 Subject: [PATCH 5/6] more informative wanrning messages when data is not available, better support for SAAR tables. --- .Rbuildignore | 1 + .gitignore | 1 + R/cmhc.R | 24 ++++++++++++++++++++++-- R/cmhc_tables.R | 39 ++++++++++++++++++++++----------------- 4 files changed, 46 insertions(+), 19 deletions(-) diff --git a/.Rbuildignore b/.Rbuildignore index 1db1f72..aeb59aa 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -18,3 +18,4 @@ ^cran-comments\.md$ ^data_raw/ ^data_raw/* +.DS_Store diff --git a/.gitignore b/.gitignore index 1cae04d..e68f031 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,4 @@ helpers CRAN-SUBMISSION data_raw data_raw/* +.DS_Store diff --git a/R/cmhc.R b/R/cmhc.R index 8d4057c..0f98263 100644 --- a/R/cmhc.R +++ b/R/cmhc.R @@ -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,7 +209,8 @@ 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) } } @@ -273,7 +292,8 @@ get_cmhc <- function(survey,series, dimension, breakdown,geoFilter="Default", if (!(is.null(dimension) || is.na(dimension))) table <- table |> rename(!!dimension:=.data$Metric) if (have_saar_table) { - table <- table |> select(-"Metric") + table <- table |> mutate(`Dwelling Type`="Total") + #table <- table |> select(-"Dwelling Type") } diff --git a/R/cmhc_tables.R b/R/cmhc_tables.R index 3a58710..f0679e9 100644 --- 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)) |> @@ -384,12 +389,12 @@ list_cmhc_tables <- function(short=TRUE){ .data$Dimension=="Dwelling Type", .data$Breakdown=="Provinces") |> mutate(TableCode="5.5.1",GeoFilter="All")) |> - bind_rows(tibble::tibble(Survey="Scss",Series="Starts (SAAR)",Breakdown="Historical Time Periods", - GeoFilter="Default",TableCode="5.3.3")) + 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")) @@ -397,7 +402,7 @@ list_cmhc_tables <- function(short=TRUE){ 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 @@ -413,7 +418,7 @@ list_cmhc_tables <- function(short=TRUE){ #' @export list_cmhc_surveys <- function(){ list_cmhc_tables() |> - select(.data$Survey) |> + select("Survey") |> unique() } @@ -428,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)) { @@ -452,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)) { @@ -485,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)) { @@ -523,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)) { From 19d2a6bdde27fb1d1df508100708861cbf90e1d6 Mon Sep 17 00:00:00 2001 From: Jens von Bergmann Date: Wed, 23 Jul 2025 20:51:50 -0700 Subject: [PATCH 6/6] news and cran comments --- .gitignore | 1 - NEWS.md | 7 +++++++ cran-comments.md | 7 +++++++ 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index e68f031..1cae04d 100644 --- a/.gitignore +++ b/.gitignore @@ -13,4 +13,3 @@ helpers CRAN-SUBMISSION data_raw data_raw/* -.DS_Store diff --git a/NEWS.md b/NEWS.md index 17dc8b8..0315357 100644 --- 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/cran-comments.md b/cran-comments.md index 9a4f112..3a8d038 100644 --- 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