Merge pull request #163 from mountainMath/v0.4.1

fix problem with api key and remove funky warning

Author: dshkol

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: cancensus
 Type: Package
 Title: Access, Retrieve, and Work with Canadian Census Data and Geography
-Version: 0.4.0
+Version: 0.4.1
 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"),

NEWS.md

@@ -1,3 +1,9 @@
+# cancensus 0.4.1
+
+## Minor changes
+- Fix minor problem where API key wasn't always picked up if not set correctly as environment variable.
+- Fix warning when `t` column not present in downloaded data.
+
 # cancensus 0.4.0
 
 ## Major changes

R/cancensus.R

@@ -47,7 +47,7 @@
 get_census <- function (dataset, regions, level=NA, vectors=c(), geo_format = NA, labels = "detailed",
                         use_cache=TRUE, quiet=FALSE, api_key=Sys.getenv("CM_API_KEY")) {
   api_key <- robust_api_key(api_key)
-  have_api_key <- !is.null(api_key)
+  have_api_key <- valid_api_key(api_key)
   result <- NULL
 
   if (is.na(level)) level="Regions"
@@ -95,8 +95,7 @@ get_census <- function (dataset, regions, level=NA, vectors=c(), geo_format = NA
                             digest::digest(param_string, algo = "md5"), ".rda")
     if (!use_cache || !file.exists(data_file)) {
       if (!have_api_key) {
-        stop(paste("No API key set. Use Sys.setenv(CM_API_KEY = '<your API key>') or",
-                   "options(cancensus.api_key = '<your API key>') to set one."))
+        stop(paste("No API key set. Use set_api_key('<your API ket>`) to set one, or set_api_key('<your API ket>`, install = TRUE) to save is permanently in our .Renviron."))
       }
       url <- paste0(base_url, "data.csv")
       response <- if (!quiet) {
@@ -147,8 +146,7 @@ get_census <- function (dataset, regions, level=NA, vectors=c(), geo_format = NA
     geo_file <- cache_path(geo_base_name, ".geojson")
     if (!use_cache || !file.exists(geo_file)) {
       if (!have_api_key) {
-        stop(paste("No API key set. Use Sys.setenv(CM_API_KEY = '<your API key>') or",
-                   "options(cancensus.api_key = '<your API key>') to set one."))
+        stop(paste("No API key set. Use set_api_key('<your API ket>`) to set one, or set_api_key('<your API ket>`, install = TRUE) to save is permanently in our .Renviron."))
       }
       url <- paste0(base_url, "geo.geojson")
       response <- if (!quiet) {
@@ -163,6 +161,7 @@ get_census <- function (dataset, regions, level=NA, vectors=c(), geo_format = NA
       if (!quiet) message("Reading geo data from local cache.")
     }
     geos <- geojsonsf::geojson_sf(geo_file) %>%
+      sf::st_sf() %>% #ust in case
       transform_geo(level)
 
     result <- if (is.null(result)) {
@@ -408,6 +407,57 @@ handle_cm_status_code <- function(response,path){
 }
 
 
+name_change_for_level <- function(level){
+  if (level=='DB') {
+    name_change <- c('DA_UID'='rpid',
+                     'CSD_UID'='rgid',
+                     'CT_UID'='ruid',
+                     'CMA_UID'='rguid')
+  } else  if (level=='DA'|level=='EA') {
+    name_change <- c('CSD_UID'='rpid',
+                     'CD_UID'='rgid',
+                     'CT_UID'='ruid',
+                     'CMA_UID'='rguid')
+  } else if (level=='CT') {
+    name_change <- c('CMA_UID'='rpid',
+                     'PR_UID'='rgid',
+                     'CSD_UID'='ruid',
+                     'CD_UID'='rguid')
+  } else if (level=='CSD') {
+    name_change <- c('CD_UID'='rpid',
+                     'PR_UID'='rgid',
+                     'CMA_UID'='ruid')
+  } else if (level=='CD') {
+    name_change <- c('PR_UID'='rpid',
+                     'C_UID'='rgid')
+  } else if (level=='CMA') {
+    name_change <- c('PR_UID'='rpid',
+                     'C_UID'='rgid')
+  } else if (level=='PR') {
+    name_change <- c('C_UID'='rpid')
+  } else {
+    name_change <- c()
+    warning(paste0("Unknown level ",level))
+  }
+  name_change
+}
+
+base_name_change <- c("GeoUID"="id",
+                      "Shape Area"="a",
+                      "Type"="t",
+                      "Dwellings"="dw",
+                      "Households"="hh",
+                      "Population"="pop",
+                      "Adjusted Population (previous Census)"="pop2",
+                      "NHS Non-Return Rate"="nrr",
+                      "Quality Flags"="q",
+                      "Population 2011"="pop11",
+                      "Population 2016"="pop16",
+                      "Households 2011"="hh11",
+                      "Households 2016"="hh16",
+                      "Dwellings 2011"="dw11",
+                      "Dwellings 2016"="dw16")
+
 # Transform and rename geometry data.
 transform_geo <- function(g, level) {
   as_character=c("id","rpid","rgid","ruid","rguid","q")
@@ -416,68 +466,32 @@ transform_geo <- function(g, level) {
   as_integer=c("pop","dw","hh","pop2","pop11","pop16","hh11","hh16","dw11","dw16")
   #as_character=c(as_character,as_numeric,as_integer)
 
+  to_remove <- c("rpid","rgid","ruid","rguid")
+  to_rename <- base_name_change[as.character(base_name_change) %in% names(g)]
+
   g <- g %>%
     dplyr::mutate_at(dplyr::intersect(names(g), as_character), as.character) %>%
     dplyr::mutate_at(dplyr::intersect(names(g), as_numeric), as.numeric)  %>%
     dplyr::mutate_at(dplyr::intersect(names(g), as_integer), as.int)  %>%
-    dplyr::mutate_at(dplyr::intersect(names(g), as_factor), as.factor)
-
-  # Change names
-  # Standard table
-  name_change <- dplyr::tibble(
-    old=c("id","a" ,"t" ,"dw","hh","pop","pop2","nrr","q","pop11","pop16","hh11","hh16","dw11","dw16"),
-    new=c("GeoUID","Shape Area" ,"Type" ,"Dwellings","Households","Population","Adjusted Population (previous Census)","NHS Non-Return Rate","Quality Flags","Population 2011","Population 2016","Households 2011","Households 2016","Dwellings 2011","Dwellings 2016")
-  )
-  # Geo UID name changes
-  if (level=='Regions') {
-    l=g$t %>% unique()
-    if (length(l)==1) level=l
-  }
-  if (level=='DB') {
-    name_change <- name_change %>% rbind(
-      c('rpid','DA_UID'),
-      c('rgid','CSD_UID'),
-      c('ruid','CT_UID'),
-      c('rguid','CMA_UID'))
+    dplyr::mutate_at(dplyr::intersect(names(g), as_factor), as.factor) %>%
+    dplyr::rename(!!to_rename)
+
+  if (level != "Regions") {
+    rc <- name_change_for_level(level)[as.character(name_change_for_level(level)) %in% names(g)]
+    if (length(rc)>0) g <- g %>%  dplyr::rename(!!!rc)
+  } else if ("Type" %in% names(g)) {
+    g <- g$Type %>%
+      unique %>%
+      lapply(function(t){
+        g <- g %>%  dplyr::filter(.data$Type==t)
+        rc <- name_change_for_level(t)[as.character(name_change_for_level(t)) %in% names(g)]
+        if (length(rc)>0) g <- g %>% dplyr::rename(!!!rc)
+        g
+      }) %>%
+      do.call(rbind,.) %>%
+      dplyr::select(-dplyr::one_of(to_remove[to_remove %in% names(.)]))
   }
-  if (level=='DA'|level=='EA') {
-    name_change <- name_change %>% rbind(
-      c('rpid','CSD_UID'),
-      c('rgid','CD_UID'),
-      c('ruid','CT_UID'),
-      c('rguid','CMA_UID'))
-  }
-  if (level=='CT') {
-    name_change <- name_change %>% rbind(
-      c('rpid','CMA_UID'),
-      c('rgid','PR_UID'),
-      c('ruid','CSD_UID'),
-      c('rguid','CD_UID'))
-  }
-  if (level=='CSD') {
-    name_change <- name_change %>% rbind(
-      c('rpid','CD_UID'),
-      c('rgid','PR_UID'),
-      c('ruid','CMA_UID'))
-  }
-  if (level=='CD') {
-    name_change <- name_change %>% rbind(c('rpid','PR_UID'),c('rgid','C_UID'))
-  }
-  if (level=='CMA') {
-    name_change <- name_change %>% rbind(c('rpid','PR_UID'),c('rgid','C_UID'))
-  }
-  if (level=='PR') {
-    name_change <- name_change %>% rbind(c('rpid','C_UID'))
-  }
-
-  used_names <- name_change %>%
-    dplyr::filter(.data$old %in% names(g))
-
-  if (nrow(used_names)>0) g <- g %>%
-    dplyr::rename(!!!setNames(used_names$old,used_names$new))
 
-  to_remove <- dplyr::intersect(names(g),c("rpid","rgid","ruid","rguid"))
-  if (length(to_remove)>0) g <- g %>% dplyr::select(-dplyr::one_of(to_remove))
 
   return(g)
 }

R/helpers.R

@@ -6,9 +6,13 @@ cancensus_base_url <- function(){
   url
 }
 
+valid_api_key <- function(api_key){
+  !is.null(api_key) && is.character(api_key) && substr(api_key,1,13)=="CensusMapper_"
+}
+
 robust_api_key <- function(api_key){
-  api_key <- if (is.null(api_key) && nchar(Sys.getenv("CM_API_KEY")) > 1) { Sys.getenv("CM_API_KEY") } else { api_key }
-  api_key <- if (is.null(api_key) && !is.null(getOption("cancensus.api_key"))) { getOption("cancensus.api_key") } else { api_key }
+  api_key <- if (!valid_api_key(api_key) && nchar(Sys.getenv("CM_API_KEY")) > 1) { Sys.getenv("CM_API_KEY") } else { api_key }
+  api_key <- if (!valid_api_key(api_key) && !is.null(getOption("cancensus.api_key"))) { getOption("cancensus.api_key") } else { api_key }
   api_key
 }
 

R/intersect_geometry.R

@@ -45,7 +45,7 @@ get_intersecting_geometries <- function(dataset, level, geometry, simplified = F
                                         use_cache = TRUE, quiet = FALSE,
                                         api_key=Sys.getenv("CM_API_KEY")) {
   api_key <- robust_api_key(api_key)
-  have_api_key <- !is.null(api_key)
+  have_api_key <- valid_api_key(api_key)
   result <- NULL
 
     if ("sf" %in% class(geometry)) {
@@ -74,8 +74,7 @@ get_intersecting_geometries <- function(dataset, level, geometry, simplified = F
 
   if (!use_cache || !file.exists(data_file)) {
     if (!have_api_key) {
-      stop(paste("No API key set. Use options(cancensus.api_key = 'XXX') or",
-                 "Sys.setenv(CM_API_KEY = 'XXX') to set one."))
+      stop(paste("No API key set. Use set_api_key('<your API ket>`) to set one, or set_api_key('<your API ket>`, install = TRUE) to save is permanently in our .Renviron."))
     }
     url <- paste0(cancensus_base_url(),"/api/v1/intersecting_geographies")
     body <- list(dataset=dataset,

README.md

@@ -112,7 +112,7 @@ We'd love to feature examples of work or projects that use cancensus.
 If you wish to cite cancensus:
 
   von Bergmann, J., Aaron Jacobs, Dmitry Shkolnik (2020). cancensus: R package to
-  access, retrieve, and work with Canadian Census data and geography. v0.4.0.
+  access, retrieve, and work with Canadian Census data and geography. v0.4.1.
 
 
 A BibTeX entry for LaTeX users is
@@ -121,7 +121,7 @@ A BibTeX entry for LaTeX users is
     author = {Jens {von Bergmann} and Dmitry Shkolnik and Aaron Jacobs},
     title = {cancensus: R package to access, retrieve, and work With Canadian Census data and geography},
     year = {2020},
-    note = {R package version 0.4.0},
+    note = {R package version 0.4.1},
     url = {https://mountainmath.github.io/cancensus/},
   }
 ```

cran-comments.md

@@ -1,3 +1,9 @@
+# Update - v0.4.1
+
+- CRAN check NOTES regarding marked UTF-8 strings are understood but use of non-ASCII characters is intentional due to bilingual EN/FR source data and metadata from national statistics agency. 
+- Fix minor problem where API key wasn't always picked up if not set correctly as environment variable.
+- Fix warning when `t` column not present in downloaded data.
+
 # Update - v.0.4.0
 
 - Added `get_intersecting_geometry` function for new CensusMapper endpoint
@@ -6,9 +12,9 @@
 
 ## Update - v.0.3.2
 
-- Add functionality for 1996 census and more refined geographies
-- Expanded vignettes
-- Fix minor bugs flagged by users
+- Add functionality for 1996 census and more refined geographies.
+- Expanded vignettes.
+- Fix minor bugs flagged by users.
 
 ## Update - v.0.3.1