added cbs_add_unit_column

Author: edwindj

DESCRIPTION

@@ -23,5 +23,5 @@ Suggests:
     testthat (>= 2.1.0),
     sf
 VignetteBuilder: knitr
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)

NAMESPACE

@@ -13,6 +13,7 @@ export(cache_clear)
 export(cbs_add_date_column)
 export(cbs_add_label_columns)
 export(cbs_add_statcode_column)
+export(cbs_add_unit_column)
 export(cbs_download_data)
 export(cbs_download_meta)
 export(cbs_download_table)

NEWS.md

@@ -6,6 +6,8 @@
 
 * Bug fix for issue #37 cbs_download_data: catalog error, thanks to @guyhill for reporting
 
+* Added `cbs_add_unit_column` to add unit columns to the data set, thanks to Marieke Rensman en Martin van Elp for the suggestion
+
 # cbsodataR 1.0.1
 
 * fixed example in `cbs_get_catalogs`, which failed when catalog was temporarily 

R/add_column_labels.R

@@ -12,6 +12,21 @@ add_var_labels <- function(x, meta){
   x
 }
 
+
+# utility function adding units to columns
+add_var_units <- function(x, meta){
+  props <- meta$DataProperties
+  units <- stats::setNames(props$Unit, props$Key)
+  for (n in names(x)){
+    unit <- unname(units[n])
+    if (is.na(unit) || is.null(unit)){
+      next
+    }
+    attr(x[[n]], "unit") <- unname(units[n])
+  }
+  x
+}
+
 #View(add_label(x, meta))
 #x <- get_cbs_data("81819NED")
 #meta <- get_meta("81819NED", verbose = FALSE)

R/cbs_add_unit_column.R

@@ -0,0 +1,41 @@
+#' For each topic column add a unit column
+#' 
+#' Adds extra unit columns to the dataset that was retrieved using [cbs_get_data()].
+#' 
+#' The unit columns will be named `<topic_column>_unit`, and are a `character`
+#' 
+#' By default all code columns will be accompagnied with a label column. The name
+#' of each label column will be `<code_column>_label`.
+#' @export
+#' @param x `data.frame` retrieved using [cbs_get_data()].
+#' @param columns `character` with the names of the columns for which labels will be added
+#' @param ... not used.
+#' @return the original data.frame `x` with extra unit
+#' columns. (see description)
+#' @family data retrieval
+#' @family meta data
+cbs_add_unit_column <- function(x, columns=colnames(x), ...){
+  add <- list()
+  nms <- colnames(x)
+  N <- nrow(x)
+  
+  for (n in columns){
+    values <- x[[n]]
+    
+    if (is.null(values)){
+      warning("Column '", n, "' does not exist.")
+      next
+    }
+    
+    unit <- attr(x[[n]], "unit")
+    if (is.null(unit)){
+      next
+    }
+    un <- paste0(n, "_unit")
+    x[[un]] <- rep(unit, N)
+    add[[n]] <- un
+  }
+  # rearrange column order
+  cols <- unlist(lapply(nms, function(n){c(n, add[[n]])}))
+  x[,cols]
+}

R/cbs_get_data.R

@@ -88,6 +88,7 @@ cbs_get_data <- function( id
 
   if (add_column_labels){
     data <- add_var_labels(data, meta)
+    data <- add_var_units(data, meta)
   }
 
   is_time <- meta$DataProperties$Key[meta$DataProperties$Type == "TimeDimension"]