Merge pull request #115 from mountainMath/v0.3.14

better deal with semi-long tables, more robust header parsing

Author: mountainMath

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: cansim
 Type: Package
 Title: Accessing Statistics Canada Data Table and Vectors
-Version: 0.3.13
+Version: 0.3.14
 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,8 @@
+# cansim 0.3.14
+## Minor changes
+* Better header parsing to avoid warning messages
+* Fix problem with some semi-wide tables
+
 # cansim 0.3.13
 ## Minor changes
 * Speed up access to cached sqlite tables

R/cansim.R

@@ -524,10 +524,27 @@ get_cansim <- function(cansimTableNumber, language="english", refresh=FALSE, tim
       value_column="VALEUR"
     }
 
+    header <- csv_reader(file.path(exdir, paste0(base_table, ".csv")), n_max=1,
+                                 na=na_strings,
+                                 locale=readr::locale(encoding="UTF-8"),
+                                 col_types = list(.default = "c"),
+                                 col_names = FALSE) %>%
+      as.character()
+
+    symbols <- which(header=="Symbol")
+
+    if (length(symbols)>1) {
+      header[symbols] <- paste0("Symbol ",seq(1,length(symbols)))
+    }
+
+
+
     data <- csv_reader(file.path(exdir, paste0(base_table, ".csv")),
                        na=na_strings,
                        locale=readr::locale(encoding="UTF-8"),
-                       col_types = list(.default = "c"))
+                       col_types = list(.default = "c"),
+                       skip=1,
+                       col_names = header)
 
     data <- data %>% transform_value_column(value_column)
 

R/cansim_helpers.R

@@ -215,7 +215,8 @@ add_provincial_abbreviations <- function(data){
     short_prov <- short_prov.fr
   }
   data <- data %>%
-    mutate(GEO.abb=factor(as.character(short_prov[!!as.name(data_geography_column)]), levels=c("CAN","BC","AB","SK","MB","ON","QC","NB","PE","NS","NL","YT","NT","NU","NTNU")))
+    mutate(GEO.abb=factor(as.character(short_prov[!!as.name(data_geography_column)]),
+                          levels=c("CAN","BC","AB","SK","MB","ON","QC","NB","PE","NS","NL","YT","NT","NU","NTNU")))
 }
 
 
@@ -262,44 +263,43 @@ get_cansim_code_set <- function(code_set=c("scalar", "frequency", "symbol", "sta
 # transforms the value column to nomeric. If table is in semi-wide form it converts the wide for dimension
 # to long form and creates and modifies the COORDINATE column as needed.
 transform_value_column <- function(data,value_column){
-  symbol_grep_string <- "^Symbol...\\d+$|^Symbol$|^Symbol_\\d+$"
-  if (!(value_column %in% names(data)) & sum(grepl(symbol_grep_string,names(data)))>1) {
-    symbols <- which(grepl(symbol_grep_string,names(data)))
-    dimension_grep_string <- paste0("^.+ \\(",length(symbols),"\\):.+\\[\\d+\\]$")
+  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+\\]$")
     dimensions <- which(grepl(dimension_grep_string,names(data)))
     if (sum(symbols!=dimensions+1)>0) {
       warning("Unable to identify dimensions")
     } else {
-      dimension_members <- gsub(paste0("^.+ \\(",length(symbols),"\\): *"),"",names(data)[dimensions]) %>%
+      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]) %>%
         gsub(" *\\[\\d+\\]$","",.)
       member_ids <- stringr::str_extract(names(data)[dimensions],"\\[\\d+\\]$") %>% gsub("\\[|\\]","",.)
-      dimension_name <- gsub(paste0(" \\(",length(symbols),"\\):.+\\[\\d+\\]"),"",names(data)[dimensions]) %>%
-        unique() %>% paste0(.," (",length(symbols),")")
+      dimension_name <- gsub(paste0(" \\(",length(symbols),"[A-Z]*\\):.+\\[\\d+\\]"),"",names(data)[dimensions]) %>%
+        unique() %>% paste0(.," ",count_type)
 
       if (length(dimension_name)>1) {
         warning("Unable to identify dimension name")
       } else {
-        data_short <- data %>%
-          select(-c(symbols,dimensions))
-        data <- data_short %>%
-          dplyr::left_join(
-            data %>%
-              dplyr::select(-symbols) %>%
-              tidyr::pivot_longer(matches(dimension_grep_string),names_to=dimension_name,values_to="VALUE") %>%
-              dplyr::mutate(!!paste0("Member ID: ",dimension_name):=
-                              stringr::str_extract(.data[[dimension_name]],"\\[\\d+\\]$") %>% gsub("\\[|\\]","",.)) %>%
-              dplyr::mutate_at(dimension_name,function(d)
-                gsub(paste0("^.+ \\(",length(symbols),"\\): *"),"",d) %>%
-                  gsub(" *\\[\\d+\\]$","",.)),
-            by=names(data_short))
+        renames <- c(setNames(names(data)[dimensions],paste0(member_ids," --- ",value_column)),
+                     setNames(names(data)[symbols],paste0(member_ids," --- Symbol")))
+
+        member_names <- dplyr::tibble(!!as.name(paste0("Member ID: ",dimension_name)):=member_ids,
+                                      !!as.name(dimension_name):=dimension_members)
+
+        data <- data %>%
+          dplyr::rename(!!!renames) %>%
+          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)) {
           data <- data %>%
             dplyr::mutate(COORDINATE = paste0(.data$Coordinate,".",!!as.name(paste0("Member ID: ",dimension_name)))) %>%
-            select(-.data$Coordinate)
+            dplyr::select(-.data$Coordinate)
         }
+
         data <- data %>%
           dplyr::select(-dplyr::all_of(paste0("Member ID: ",dimension_name)))
-        data_short <- NULL
       }
     }
   }
@@ -318,9 +318,12 @@ format_file_size <- function (x, units = "b", standard = "auto", digits = 1L, ..
 {
   known_bases <- c(legacy = 1024, IEC = 1024, SI = 1000)
   known_units <- list(SI = c("B", "kB", "MB", "GB", "TB", "PB",
-                             "EB", "ZB", "YB"), IEC = c("B", "KiB", "MiB", "GiB",
-                                                        "TiB", "PiB", "EiB", "ZiB", "YiB"), legacy = c("b", "Kb",
-                                                                                                       "Mb", "Gb", "Tb", "Pb"), LEGACY = c("B", "KB", "MB",
+                             "EB", "ZB", "YB"),
+                      IEC = c("B", "KiB", "MiB", "GiB",
+                              "TiB", "PiB", "EiB", "ZiB", "YiB"),
+                      legacy = c("b", "Kb",
+                                 "Mb", "Gb", "Tb", "Pb"),
+                      LEGACY = c("B", "KB", "MB",
                                                                                                                                            "GB", "TB", "PB"))
   units <- match.arg(units, c("auto", unique(unlist(known_units),
                                              use.names = FALSE)))

R/cansim_sql.R

@@ -142,12 +142,34 @@ get_cansim_sqlite <- function(cansimTableNumber, language="english", refresh=FAL
       hierarchy_name <- paste0(hierarchy_prefix," ", data_geography_column)
     }
 
+
+    header <- readr::read_delim(file.path(exdir, paste0(base_table, ".csv")),
+                                n_max=1,
+                                delim=delim,
+                                na=na_strings,
+                                locale=readr::locale(encoding="UTF-8"),
+                                col_types = list(.default = "c"),
+                                col_names = FALSE) %>%
+      as.character()
+
+    symbols <- which(grepl("^Symbol( .+)*$",header,ignore.case = TRUE))
+    sl <- length(symbols)
+
+    if (sl>1) {
+      header[symbols] <- paste0("Symbol ",seq(1,sl))
+    }
+
+    chunk_size=ceiling(5000000/pmax(sl,1))
+
     csv2sqlite(file.path(exdir, paste0(base_table, ".csv")),
                sqlite_file = sqlite_path,
                table_name=table_name,
                col_types = list(.default = "c"),
+               col_names = header,
+               skip=1,
                na = na_strings,
                delim = delim,
+               chunk_size=chunk_size,
                transform=function(data){
                  data <- data %>% transform_value_column(value_string)
                  if (length(geo_column_pos)==1)
@@ -442,12 +464,13 @@ create_index <- function(connection,table_name,field){
 #' @param na na character strings
 #' @param text_encoding encoding of csv file (default UTF-8)
 #' @param delim (Optional) csv deliminator, default is ","
+#' @param ... (Optional) additional parameters passed to `readr::read_delim_chunked`
 #'
 #' @return A database connection
 #' @keywords internal
 csv2sqlite <- function(csv_file, sqlite_file, table_name, transform=NULL,chunk_size=5000000,
                        append=FALSE,col_types=NULL,na=c(NA,"..","","...","F"),
-                       text_encoding="UTF-8",delim = ",") {
+                       text_encoding="UTF-8",delim = ",",...) {
   # Connect to database.
   if (!append && file.exists(sqlite_file)) file.remove(sqlite_file)
   con <- DBI::dbConnect(RSQLite::SQLite(), dbname=sqlite_file)
@@ -463,7 +486,8 @@ csv2sqlite <- function(csv_file, sqlite_file, table_name, transform=NULL,chunk_s
                           col_types=col_types,
                           chunk_size = chunk_size,
                           locale=readr::locale(encoding = text_encoding),
-                          na=na)
+                          na=na,
+                          ...)
 
   DBI::dbDisconnect(con)
 }

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.13.
+  von Bergmann, J., Dmitry Shkolnik (2022). cansim: functions and convenience tools for accessing Statistics Canada data tables. v0.3.14.
 
 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.13},
+    note = {R package version 0.3.14},
     url = {https://mountainmath.github.io/cansim/}
   }
 ```

cran-comments.md

@@ -1,6 +1,6 @@
 ## Test environments
-* local OS X install, R 4.0.5
-* GitHub Action macOS-latest, windows-lastest (3.6), ubuntu-16.04 (devel, release, oldrel), ubuntu-16.04 (3.4, 3.5)
+* local OS X install, R 4.2.2
+* GitHub Action macOS-latest, windows-lastest (3.6), ubuntu-20.04 (devel, release)
 
 ## R CMD check results
 There were no ERRORs or WARNINGs or NOTEs. 
@@ -91,4 +91,9 @@ There were no ERRORs or WARNINGs or NOTEs.
 * Speed up access to cached sqlite tables
 * Fix problem with `get_cansim_vector_info()`
 
+# cansim 0.3.13
+## Minor changes
+* Better header parsing to avoid warning messages
+* Fix problem with some semi-wide tables
+