Merge pull request #68 from mountainMath/use-ref-date

Fix issues with change in StatCan API limit.

Author: mountainMath

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: cansim
 Type: Package
 Title: Accessing Statistics Canada Data Table and Vectors
-Version: 0.3.0
+Version: 0.3.1
 Authors@R: c(
     person("Jens", "von Bergmann", email = "jens@mountainmath.ca", role = c("cre")),
     person("Dmitry", "Shkolnik", email = "shkolnikd@gmail.com", role = c("aut")))

NEWS.md

@@ -1,3 +1,11 @@
+## cansim 0.3.1
+
+### Major changes
+- Fixes issues arising from StatCan changing their API row limit
+
+### Minor changes
+- Optimize vector retrieval by REF_DATE
+
 ## cansim 0.3.0
 
 ### Major changes

R/cansim_helpers.R

@@ -42,6 +42,10 @@ response_status_code_translation <- list(
   "8"="Invalid number of reference periods"
 )
 
+response_error_translation <- list(
+  "503"="StatCan website is currently unavailable"
+)
+
 get_with_timeout_retry <- function(url,timeout=200,retry=3,path=NA){
   if (!is.na(path)) {
     response <- purrr::safely(httr::GET)(url,httr::timeout(timeout),httr::write_disk(path,overwrite = TRUE))
@@ -56,6 +60,10 @@ get_with_timeout_retry <- function(url,timeout=200,retry=3,path=NA){
       message("Got timeout from StatCan, giving up")
       response=response$result
     }
+  } else if (response$result$status_code %in% names(response_error_translation)){
+    stop(sprintf("%s\nReturned status code %s",response_error_translation[[as.character(response$result$status_code)]], response$result$status_code),call.=FALSE)
+  } else if (response$result$status_code != 200){
+    stop(sprintf("Problem downloading data, returned status code %s.",response$result$status_code),call.=FALSE)
   } else {
     response=response$result
   }

R/cansim_vectors.R

@@ -1,3 +1,5 @@
+MAX_PERIODS = 6000
+
 extract_vector_data <- function(data1){
   vf=list("DECIMALS"="decimals",
           "VALUE"="value",
@@ -8,8 +10,10 @@ extract_vector_data <- function(data1){
           "frequencyCode"="frequencyCode",
           "SCALAR_ID"="scalarFactorCode")
   result <- purrr::map(data1,function(d){
+    vdp <- d$object$vectorDataPoint
+    if (length(vdp)==0) {return(NULL)}
     value_data = lapply(vf,function(f){
-      x=purrr::map(d$object$vectorDataPoint,function(cc)cc[[f]])
+      x=purrr::map(vdp,function(cc)cc[[f]])
       x[sapply(x, is.null)] <- NA
       unlist(x)
     }) %>%
@@ -75,37 +79,36 @@ rename_vectors <- function(data,vectors){
 #' @export
 get_cansim_vector<-function(vectors, start_time, end_time=Sys.Date(), use_ref_date=TRUE){
   start_time=as.Date(start_time)
-  end_time=as.Date(end_time)
-  if (!use_ref_date) {
-    time_format="%Y-%m-%dT%H:%m"
-    vectors=gsub("^v","",vectors) # allow for leading "v" by conditionally stripping it
-    url="https://www150.statcan.gc.ca/t1/wds/rest/getBulkVectorDataByRange"
-    vectors_string=paste0('"vectorIds":[',paste(purrr::map(as.character(vectors),function(x)paste0('"',x,'"')),collapse = ", "),"]")
-    time_string=paste0('"startDataPointReleaseDate": "',strftime(start_time,time_format),
-                       '","endDataPointReleaseDate": "',strftime(end_time,time_format),'"')
-    response <- post_with_timeout_retry(url, body=paste0("{",vectors_string,",",time_string,"}"))
-    if (is.null(response)) return(response)
-    if (response$status_code!=200) {
-      stop("Problem downloading data, status code ",response$status_code,"\n",httr::content(response))
-    }
-    data <- httr::content(response)
-    data1 <- Filter(function(x)x$status=="SUCCESS",data)
-    data2 <- Filter(function(x)x$status!="SUCCESS",data)
-    if (length(data2)>0) {
-      message(paste0("Failed to load data for ",length(data2)," vector(s)."))
-      data2 %>% purrr::map(function(x){
-        message(paste0("Problem downloading data: ",response_status_code_translation[as.character(x$object$responseStatusCode)]))
-      })
-    }
+  original_end_time=as.Date(end_time)
+  if (use_ref_date) end_time=Sys.Date() else end_time=original_end_time
+  time_format="%Y-%m-%dT%H:%m"
+  vectors=gsub("^v","",vectors) # allow for leading "v" by conditionally stripping it
+  url="https://www150.statcan.gc.ca/t1/wds/rest/getBulkVectorDataByRange"
+  vectors_string=paste0('"vectorIds":[',paste(purrr::map(as.character(vectors),function(x)paste0('"',x,'"')),collapse = ", "),"]")
+  time_string=paste0('"startDataPointReleaseDate": "',strftime(start_time,time_format),
+                     '","endDataPointReleaseDate": "',strftime(end_time,time_format),'"')
+  response <- post_with_timeout_retry(url, body=paste0("{",vectors_string,",",time_string,"}"))
+  if (is.null(response)) return(response)
+  if (response$status_code!=200) {
+    stop("Problem downloading data, status code ",response$status_code,"\n",httr::content(response))
+  }
+  data <- httr::content(response)
+  data1 <- Filter(function(x)x$status=="SUCCESS",data)
+  data2 <- Filter(function(x)x$status!="SUCCESS",data)
+  if (length(data2)>0) {
+    message(paste0("Failed to load data for ",length(data2)," vector(s)."))
+    data2 %>% purrr::map(function(x){
+      message(paste0("Problem downloading data: ",response_status_code_translation[as.character(x$object$responseStatusCode)]))
+    })
+  }
 
-    if (length(data1)>0)
-      result <- extract_vector_data(data1) %>%
-        rename_vectors(vectors)
-    else
-      result <- tibble::tibble()
-  } else {
-    result <- get_cansim_vector_for_latest_periods(vectors,periods=10000) %>%
-      filter(as.Date(.data$REF_DATE)>=start_time,as.Date(.data$REF_DATE)<=end_time)
+  if (length(data1)>0)
+    result <- extract_vector_data(data1) %>% rename_vectors(vectors)
+  else
+    result <- tibble::tibble()
+  if (use_ref_date) {
+    result <- result %>%
+      filter(as.Date(.data$REF_DATE)>=start_time,as.Date(.data$REF_DATE)<=original_end_time)
   }
   result
 }
@@ -124,6 +127,10 @@ get_cansim_vector<-function(vectors, start_time, end_time=Sys.Date(), use_ref_da
 #'
 #' @export
 get_cansim_vector_for_latest_periods<-function(vectors, periods=1){
+  if (periods*length(vectors)>MAX_PERIODS) {
+    periods=pmin(periods,floor(as.numeric(MAX_PERIODS)/length(vectors)))
+    warning(paste0("Can access at most ",MAX_PERIODS," data points, capping value to ",periods," periods per vector."))
+  }
   vectors=gsub("^v","",vectors) # allow for leading "v" by conditionally stripping it
   url="https://www150.statcan.gc.ca/t1/wds/rest/getDataFromVectorsAndLatestNPeriods"
   vectors_string=paste0("[",paste(purrr::map(as.character(vectors),function(x)paste0('{"vectorId":',x,',"latestN":',periods,'}')),collapse = ", "),"]")