Merge pull request #116 from mountainMath/v0.3.15

accommodate quirky census division table

Author: mountainMath

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: cansim
 Type: Package
 Title: Accessing Statistics Canada Data Table and Vectors
-Version: 0.3.14
+Version: 0.3.15
 Authors@R: c(
     person("Jens", "von Bergmann", email = "jens@mountainmath.ca", role = c("cre")),
     person("Dmitry", "Shkolnik", email = "shkolnikd@gmail.com", role = c("aut")))
@@ -30,7 +30,7 @@ Imports: digest (>= 0.1),
     utils,
     DBI,
     RSQLite
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
 Suggests: knitr,
     rmarkdown,
     scales, 

NEWS.md

@@ -1,3 +1,7 @@
+# cansim 0.3.15
+## Minor changes
+* accommodate quirks in table 98-10-0017
+
 # cansim 0.3.14
 ## Minor changes
 * Better header parsing to avoid warning messages

R/cansim.R

@@ -414,6 +414,7 @@ fold_in_metadata_for_columns <- function(data,data_path,column_names){
 
   meta2 <- readRDS(paste0(data_path,"2"))
 
+
   if (!is.null(getOption("cansim.debug"))) message('Generating base hierarchy')
   hierarchy_data <- tibble(X=pull(data,coordinate_column) %>% unique) %>%
     setNames(coordinate_column) %>%
@@ -532,11 +533,21 @@ get_cansim <- function(cansimTableNumber, language="english", refresh=FALSE, tim
       as.character()
 
     symbols <- which(header=="Symbol")
+    if (length(symbols)==0) {
+      symbols <- which(header=="Symbols")
+    }
 
     if (length(symbols)>1) {
       header[symbols] <- paste0("Symbol ",seq(1,length(symbols)))
     }
 
+    coordinate_column <- ifelse(cleaned_language=="eng","COORDINATE",paste0("COORDONN",intToUtf8(0x00C9),"ES"))
+    if (!(coordinate_column %in% header)) {
+      ci <- which(grepl(coordinate_column,header,ignore.case = TRUE))
+      if (length(ci)==1) {
+        header[ci] <- coordinate_column
+      }
+    }
 
 
     data <- csv_reader(file.path(exdir, paste0(base_table, ".csv")),

R/cansim_helpers.R

@@ -266,16 +266,16 @@ transform_value_column <- function(data,value_column){
   symbols <- which(grepl("^Symbol( \\d+)*$",names(data)))
   if (!(value_column %in% names(data)) & length(symbols)>1) {
     #message("\nTransforming to long form.")
-    dimension_grep_string <- paste0("^.+ \\(",length(symbols),"[A-Z]*\\):.+\\[\\d+\\]$")
+    dimension_grep_string <- paste0("^.+ \\(",length(symbols),"[A-Za-z]*\\):.+\\[\\d+\\]$")
     dimensions <- which(grepl(dimension_grep_string,names(data)))
     if (sum(symbols!=dimensions+1)>0) {
       warning("Unable to identify dimensions")
     } else {
-      count_type <- stringr::str_match(names(data)[dimensions][1],paste0("(\\(",length(symbols),"[A-Z]*\\))"))[1,2]
-      dimension_members <- gsub(paste0("^.+ \\(",length(symbols),"[A-Z]*\\): *"),"",names(data)[dimensions]) %>%
+      count_type <- stringr::str_match(names(data)[dimensions][1],paste0("(\\(",length(symbols),"[A-Za-z]*\\))"))[1,2]
+      dimension_members <- gsub(paste0("^.+ \\(",length(symbols),"[A-Za-z]*\\): *"),"",names(data)[dimensions]) %>%
         gsub(" *\\[\\d+\\]$","",.)
       member_ids <- stringr::str_extract(names(data)[dimensions],"\\[\\d+\\]$") %>% gsub("\\[|\\]","",.)
-      dimension_name <- gsub(paste0(" \\(",length(symbols),"[A-Z]*\\):.+\\[\\d+\\]"),"",names(data)[dimensions]) %>%
+      dimension_name <- gsub(paste0(" \\(",length(symbols),"[A-Za-z]*\\):.+\\[\\d+\\]"),"",names(data)[dimensions]) %>%
         unique() %>% paste0(.," ",count_type)
 
       if (length(dimension_name)>1) {
@@ -292,10 +292,9 @@ transform_value_column <- function(data,value_column){
           tidyr::pivot_longer(matches(" --- "), names_pattern="^(.+) --- (.+)$",
                               names_to=c(paste0("Member ID: ",dimension_name),".value")) %>%
           dplyr::left_join(member_names,by=paste0("Member ID: ",dimension_name))
-        if ("Coordinate" %in% names(data)) {
+        if ("COORDINATE" %in% names(data)) {
           data <- data %>%
-            dplyr::mutate(COORDINATE = paste0(.data$Coordinate,".",!!as.name(paste0("Member ID: ",dimension_name)))) %>%
-            dplyr::select(-.data$Coordinate)
+            dplyr::mutate(COORDINATE = paste0(.data$COORDINATE,".",!!as.name(paste0("Member ID: ",dimension_name))))
         }
 
         data <- data %>%

R/cansim_sql.R

@@ -98,28 +98,11 @@ get_cansim_sqlite <- function(cansimTableNumber, language="english", refresh=FAL
                                                col_types = list(.default = "c")))
 
 
-    headers <- readr::read_delim(file.path(exdir, paste0(base_table, ".csv")),
-                                 delim=delim,
-                                 col_types = list(.default = "c"),
-                                 n_max = 1) %>%
-      names()
-
-    hd <- headers[duplicated(toupper(headers))]
-
-    if (length(hd)>0) {
-      dupes <- headers[toupper(headers) %in% hd]
-      unlink(exdir, recursive=TRUE)
-      stop(paste0("This table has duplicated columns names: ",paste0(dupes,collapse = ", "),
-                  ".\nThis is not allowed for SQLite databases, please use the 'get_cansim' method for this table."))
-    }
 
     meta_base_path <- paste0(base_path_for_table_language(cansimTableNumber,language,cache_path),".Rda")
     parse_metadata(meta,data_path = meta_base_path)
 
 
-    to_drop <- intersect(headers,"TERMINATED") # not in use yet
-
-
     scale_string <- ifelse(language=="fr","IDENTIFICATEUR SCALAIRE","SCALAR_ID")
     value_string <- ifelse(language=="fr","VALEUR","VALUE")
     # scale_string2 <- ifelse(language=="fr","FACTEUR SCALAIRE","SCALAR_FACTOR")
@@ -153,12 +136,34 @@ get_cansim_sqlite <- function(cansimTableNumber, language="english", refresh=FAL
       as.character()
 
     symbols <- which(grepl("^Symbol( .+)*$",header,ignore.case = TRUE))
+    if (length(symbols)==0) {
+      symbols <-  which(grepl("^Symbols( .+)*$",header,ignore.case = TRUE))
+    }
+
     sl <- length(symbols)
 
     if (sl>1) {
       header[symbols] <- paste0("Symbol ",seq(1,sl))
     }
 
+    if (!(coordinate_column %in% header)) {
+      ci <- which(grepl(coordinate_column,header,ignore.case = TRUE))
+        if (length(ci)==1) {
+          header[ci] <- coordinate_column
+        }
+    }
+
+    hd <- header[duplicated(toupper(header))]
+
+    if (length(hd)>0) {
+      dupes <- header[toupper(header) %in% hd]
+      unlink(exdir, recursive=TRUE)
+      stop(paste0("This table has duplicated columns names: ",paste0(dupes,collapse = ", "),
+                  ".\nThis is not allowed for SQLite databases, please use the 'get_cansim' method for this table."))
+    }
+
+
+
     chunk_size=ceiling(5000000/pmax(sl,1))
 
     csv2sqlite(file.path(exdir, paste0(base_table, ".csv")),

README.md

@@ -173,15 +173,15 @@ If you want to get in touch, we are pretty good at responding via email or via t
 
 If you wish to cite the `cansim` package in your work:
 
-  von Bergmann, J., Dmitry Shkolnik (2022). cansim: functions and convenience tools for accessing Statistics Canada data tables. v0.3.14.
+  von Bergmann, J., Dmitry Shkolnik (2023). cansim: functions and convenience tools for accessing Statistics Canada data tables. v0.3.15.
 
 A BibTeX entry for LaTeX users is
 ```
   @Manual{cansim,
     author = {Jens {von Bergmann} and Dmitry Shkolnik},
     title = {cansim: functions and convenience tools for accessing Statistics Canada data tables},
-    year = {2022},
-    note = {R package version 0.3.14},
+    year = {2023},
+    note = {R package version 0.3.15},
     url = {https://mountainmath.github.io/cansim/}
   }
 ```

cran-comments.md

@@ -1,5 +1,5 @@
 ## Test environments
-* local OS X install, R 4.2.2
+* local OS X install, R 4.3.1
 * GitHub Action macOS-latest, windows-lastest (3.6), ubuntu-20.04 (devel, release)
 
 ## R CMD check results
@@ -96,4 +96,8 @@ There were no ERRORs or WARNINGs or NOTEs.
 * Better header parsing to avoid warning messages
 * Fix problem with some semi-wide tables
 
+# cansim 0.3.14
+## Minor changes
+* accommodate quirks in table 98-10-0017
+