Merge branch 'main' into performance-improvements

Author: mountainMath

.Rbuildignore

@@ -22,7 +22,7 @@ lastMiKTeXException
 ^data-raw/*
 ^\.renviron
 ^\.rprofile
-
+.DS_Store
 ^doc$
 
 ^CRAN-SUBMISSION$

.github/workflows/R-CMD-check.yaml

@@ -10,6 +10,8 @@ on:
 
 name: R-CMD-check
 
+permissions: read-all
+
 jobs:
   R-CMD-check:
     runs-on: ${{ matrix.config.os }}
@@ -20,7 +22,7 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macOS-latest,   r: 'release'}
+          - {os: macos-latest,   r: 'release'}
           - {os: windows-latest, r: 'release'}
           - {os: ubuntu-latest,   r: 'devel', http-user-agent: 'release'}
           - {os: ubuntu-latest,   r: 'release'}
@@ -33,7 +35,7 @@ jobs:
       R_KEEP_PKG_SOURCE: yes
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
 
       - uses: r-lib/actions/setup-pandoc@v2
 
@@ -51,3 +53,4 @@ jobs:
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: cancensus
 Type: Package
 Title: Access, Retrieve, and Work with Canadian Census Data and Geography
-Version: 0.5.7
+Version: 0.5.10
 Authors@R: c(
     person("Jens", "von Bergmann", email = "jens@mountainmath.ca", role = c("aut"), comment = "API creator and maintainer"),
     person("Dmitry", "Shkolnik", email = "shkolnikd@gmail.com", role = c("aut", "cre"), comment = "Package maintainer, responsible for correspondence"),
@@ -12,29 +12,29 @@ Description: Integrated, convenient, and uniform access to Canadian
     for working with Census variables, variable hierarchies, and region selection. API
     keys are freely available with free registration at <https://censusmapper.ca/api>.
     Census data and boundary geometries are reproduced and distributed on an "as
-    is" basis with the permission of Statistics Canada (Statistics Canada 2001; 2006;
+    is" basis with the permission of Statistics Canada (Statistics Canada 1996; 2001; 2006;
     2011; 2016; 2021).
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: yes
 ByteCompile: yes
 NeedsCompilation: no
 Imports: digest (>= 0.1),
-    dplyr (>= 0.7),
+    dplyr (>= 1.0),
     httr (>= 1.0.0),
     jsonlite (>= 1.0),
-    rlang
-RoxygenNote: 7.2.3
+    sf,
+    geojsonsf,
+    rlang,
+    readr
+RoxygenNote: 7.3.3
 Suggests: knitr,
     ggplot2,
     leaflet,
     mapdeck,
     rmarkdown,
-    readr,
     scales,
     sp,
-    sf,
-    geojsonsf,
     tidyr,
     lwgeom,
     xml2,
@@ -44,4 +44,4 @@ VignetteBuilder: knitr
 URL: https://github.com/mountainMath/cancensus, https://mountainmath.github.io/cancensus/, https://censusmapper.ca/api
 BugReports: https://github.com/mountainMath/cancensus/issues
 Depends: 
-    R (>= 2.10)
+    R (>= 4.1)

LICENSE

@@ -1,3 +1,3 @@
-YEAR: 2022
+YEAR: 2025
 COPYRIGHT HOLDER: Jens von Bergmann
 

NEWS.md

@@ -1,4 +1,4 @@
-# cancensus 0.5.8 (Development)
+# cancensus 0.5.11
 
 ## Performance Improvements
 
@@ -21,6 +21,18 @@
 - No breaking changes to any function signatures or behavior
 - Added `microbenchmark` and `testthat` to Suggests
 
+# cancensus 0.5.10
+
+- ensure that cancensus won't trigger CRAN check errors if StatCan servers are down
+- replace shorthand function with regular function definition to address CRAN note
+
+# cancensus 0.5.8
+
+- clarify installing API key and cache path in "getting started" vignette
+- fix caching problem with get_statcan_wds_data
+- support health region level census data for 2021 via WDS
+- support download of dissemination block geographies from StatCan
+
 # cancensus 0.5.7
 
 - fix issue with path names not quoted properly when downoading and unpacking geosuite data

R/cancensus.R

@@ -340,7 +340,9 @@ VALID_LEVELS <- c("Regions","C","PR", "CMA", "CD", "CSD", "ADA","CT", "DA", 'EA'
 #' @examples
 #'
 #' # List available datasets in CensusMapper
+#' \dontrun{
 #' list_census_datasets()
+#' }
 list_census_datasets <- function(use_cache = TRUE, quiet = FALSE) {
   cache_file <- file.path(tempdir(),"cancensus_datasets.rda") #cache_path("datasets.rda")
   if (!use_cache || !file.exists(cache_file)) {
@@ -379,8 +381,10 @@ list_census_datasets <- function(use_cache = TRUE, quiet = FALSE) {
 #'
 #' @examples
 #'
+#' \dontrun{
 #' # Attribution string for the 2006 and 2016 census datasets
 #' dataset_attribution(c('CA06','CA16'))
+#' }
 dataset_attribution <- function(datasets){
   datasets <-   lapply(datasets,translate_dataset) %>% unlist()
   attribution <-list_census_datasets(quiet=TRUE) %>%

R/geo_suite.R

@@ -101,7 +101,7 @@ get_statcan_geography_relationships <- function(census_year="2021", refresh=FALS
   file_path <- cache_path(paste0("geography_relationship_",census_year,".zip"))
   if (refresh || !file.exists(file_path)) {
     url <- paste0("https://www12.statcan.gc.ca/census-recensement/",census_year,"/geo/sip-pis/dguid-idugd/files-fichiers/",census_year,"_98260004.zip")
-    utils::download.file(url,  file_path)
+    utils::download.file(url,  file_path,mode="wb")
   }
   readr::read_csv(file_path,
                   locale = readr::locale(encoding ="Windows-1252"),
@@ -146,7 +146,7 @@ get_statcan_geographic_attributes <- function(census_year="2021",refresh=FALSE){
     if (dir.exists(base_path_year)) unlink(base_path_year,recursive = TRUE)
     dir.create(base_path_year)
     tmp<-tempfile(fileext = ".zip")
-    utils::download.file(urls[[census_year]],tmp)
+    status <- utils::download.file(urls[[census_year]],tmp,mode="wb")
     utils::unzip(tmp,exdir = base_path_year)
   }
   if (census_year=="2021") file <- dir(base_path_year,pattern="\\.csv",full.names = TRUE)

R/geographies.R

@@ -5,7 +5,7 @@
 #'
 #' @param census_year census year to get the data for, right now only 2021 is supported
 #' @param level geographic level to return the data for, valid choices are
-#' "PR","CD","CMACA","CSD","CT","ADA","DA","ER","FED","DPL","POPCNTR", "FSA"
+#' "PR","CD","CMACA","CSD","CT","ADA","DA","DB,"ER","FED","DPL","POPCNTR", "FSA", "HR"
 #' @param type type of geographic data, valid choices area "cartographic" or "digital"
 #' @param cache_path optional path to cache the data. If the cancensus cache path is set the geographic data gets
 #' cached in the "geographies" subdirectory of the cancensus cache path.
@@ -24,7 +24,7 @@ get_statcan_geographies <- function(census_year,level,type="cartographic",
                                     cache_path = NULL,timeout=1000,
                                     refresh=FALSE,quiet=FALSE) {
   valid_census_years <- c("2021")
-  valid_levels <- c("PR","CD","CMACA","CMA","CA","CSD","CT","ADA","DA","ER","FED","DPL","POPCNTR","POPCTR","FSA")
+  valid_levels <- c("PR","CD","CMACA","CMA","CA","CSD","CT","ADA","DA","DB","ER","FED","DPL","POPCNTR","POPCTR","FSA","HR")
   valid_types <- c("cartographic","digital")
   if (!(census_year %in% valid_census_years)) {
     stop(paste0("Census year must be one of ",paste0(valid_census_years,collapse = ", "),"."))
@@ -51,6 +51,13 @@ get_statcan_geographies <- function(census_year,level,type="cartographic",
       stop(paste0("Problem, don't know how to get geographic data for level ",level,"."))
     }
     url <- paste0("https://www12.statcan.gc.ca/census-recensement/",census_year,"/geo/sip-pis/boundary-limites/files-fichiers/l",tolower(level),filler,typeID,"21a_e.zip")
+    if (level=="HR") {
+      if (type=="cartographic") {
+        url <- "https://www150.statcan.gc.ca/n1/en/pub/82-402-x/2024001/hrbf-flrs/carto/ArcGIS/HR_000b23a_e.zip?st=wQRRL7PQ"
+      } else {
+        url <- "https://www150.statcan.gc.ca/n1/en/pub/82-402-x/2024001/hrbf-flrs/digi/ArcGIS/HR_000a23a_e.zip"
+      }
+    }
     tmp <- tempfile()
     options(timeout = timeout)
     utils::download.file(url,tmp,mode="wb",quiet=quiet)

R/vector_discovery.R

@@ -12,8 +12,9 @@
 #' @export
 #'
 #' @examples
-#' search_census_vectors('Ojibway', 'CA16')
 #'\dontrun{
+#' search_census_vectors('Ojibway', 'CA16')
+#'
 #' # This will return a warning that no match was found, but will suggest similar terms.
 #' search_census_vectors('Ojibwe', 'CA16', 'Total')
 #' }
@@ -82,13 +83,13 @@ search_census_vectors <- function(searchterm, dataset, type=NA, ...) {
 #' @export
 #'
 #' @examples
+#'\dontrun{
 #' find_census_vectors('Oji-cree', dataset = 'CA16', type = 'total', query_type = 'exact')
 #'
 #' find_census_vectors('commuting duration', dataset = 'CA11', type = 'female', query_type = 'keyword')
 #'
 #' find_census_vectors('after tax income', dataset = 'CA16', type = 'total', query_type = 'semantic')
 #'
-#'\dontrun{
 #' # This incorrect spelling will return a warning that no match was found,
 #' # but will suggest trying semantic or keyword search.
 #' find_census_vectors('Ojibwey', dataset = 'CA16', type = 'total')

R/wds.R

@@ -6,7 +6,7 @@
 #'
 #' @param census_year census year to get the data for, right now only 2021 is supported
 #' @param level geographic level to return the data for, valid choices are
-#' "PR","CD","CMACA","CSD","CT","ADA","DA","ER","FED","DPL","POPCNTR", "FSA"
+#' "PR","CD","CMACA","CSD","CT","ADA","DA","ER","FED","DPL","POPCNTR", "FSA", "HR"
 #' @param version optionally specify a version of the data to download. For example, for FED level data, version 1.3 will
 #' access the 2013 represenation order, whereas version 2.0 will access the 2023 representation order. By default the latest
 #' available version is accessed.
@@ -21,7 +21,7 @@
 #' @export
 get_statcan_wds_metadata <- function(census_year,level,version=NULL,refresh=FALSE){
   valid_census_years <- c("2021")
-  valid_levels <- c("PR","CD","CMACA","CSD","CT","ADA","DA","ER","FED","DPL","POPCNTR","FSA")
+  valid_levels <- c("PR","CD","CMACA","CSD","CT","ADA","DA","ER","FED","DPL","POPCNTR","FSA","HR")
   if (!(census_year %in% valid_census_years)) {
     stop(paste0("Census year must be one of ",paste0(valid_census_years,collapse = ", "),"."))
   }
@@ -38,7 +38,7 @@ get_statcan_wds_metadata <- function(census_year,level,version=NULL,refresh=FALS
   d <- xml2::read_xml(metadata_tempfile)
   code_lists <- xml2::xml_find_all(d,"//structure:Codelist")
 
-  meta_data <- lapply(code_lists, \(cl){
+  meta_data <- lapply(code_lists, function(cl){
     codelist_id <- cl %>% xml2::xml_attr("id")
     agencyID <- cl %>% xml2::xml_attr("agencyID")
     codelist_en <- cl %>% xml2::xml_find_all("common:Name[@xml:lang='en']") %>% xml2::xml_text()
@@ -54,7 +54,7 @@ get_statcan_wds_metadata <- function(census_year,level,version=NULL,refresh=FALS
            en=codes %>% xml2::xml_find_all("common:Name[@xml:lang='en']") %>% xml2::xml_text(),
            fr=codes %>% xml2::xml_find_all("common:Name[@xml:lang='fr']") %>% xml2::xml_text(),
            `Parent ID`=codes %>% xml2::xml_find_all("structure:Parent/Ref",flatten=FALSE) %>%
-             lapply(\(d)ifelse(is.null(d),NA,xml2::xml_attr(d,"id")))  %>% unlist()
+             lapply(function(d)ifelse(is.null(d),NA,xml2::xml_attr(d,"id")))  %>% unlist()
              )
   }) %>%
     dplyr::bind_rows()
@@ -118,9 +118,17 @@ get_statcan_wds_data <- function(DGUIDs,
                           httr::accept("text/csv"),
                           httr::add_headers("Accept-Encoding"="deflate, gzip, br"),
                           httr::write_disk(wds_data_tempfile,overwrite = TRUE))
-  }
-  if (!response$status_code=="200") {
-    stop(paste0("Invalid request.\n",httr::content(response)))
+    if (!response$status_code=="200") {
+      if (!is.null(response$error) && ("curl_error_peer_failed_verification" %in% class(response$error))) {
+        stop(paste0(strwrap(gsub(".+\\): ","",as.character(response$error),80)),collapse = "\n"),"\n",
+             "This means that the authenticity of the StatCan API server can't be verified.\n",
+             "Statistics Canada has a history of failty SSL certificats on their API,\n",
+             "if you are reasonably sure that your connection is not getting hijacked you\n",
+             "can disable peer checking for the duration of the R session by typing\n\n",
+             "httr::set_config(httr::config(ssl_verifypeer=0,ssl_verifystatus=0))","\n\n","into the console.")
+      }
+      stop(paste0("Invalid request.\n",httr::content(response)))
+    }
   }
   census_year <- "2021"
   meta_data <- get_statcan_wds_metadata(census_year,level=level,version = version,refresh = refresh)