Merge pull request #6 from nyuglobalties/fix/include-bpr-info-without…

…-rcoder

Allow "bpr.coding" to be a source

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: rcoder
 Type: Package
 Title: Lightweight Data Structure for Recoding Categorical Data without Factors
-Version: 0.1.2
+Version: 0.1.3
 Authors@R: 
     c(person(
             given = "Patrick", 

NEWS.md

@@ -1,3 +1,7 @@
+# rcoder 0.1.3
+
+* Allows "bpr.coding" attributes to be suitable sources for recoding if "rcoder.coding" is not defined
+
 # rcoder 0.1.2
 
 * Adds {blueprintr} variable decoration support during assigning coding or recoding of vectors

R/recoding.R

@@ -70,6 +70,17 @@ make_recode_query <- function(linked_codings, from = 1, to_suffix = "to", ...) {
   recode_function(subset[[from_value]], subset[[to_value]], ...)
 }
 
+get_vector_attrib <- function(vec) {
+  attrib <- get_attr(vec, "rcoder.coding")
+  bpr_attrib <- get_attr(vec, "bpr.coding")
+
+  if (is.null(attrib) && !is.null(bpr_attrib)) {
+    attrib <- eval_coding(rlang::parse_expr(bpr_attrib))
+  }
+
+  attrib
+}
+
 #' Recode a vector
 #' 
 #' A simple interface to recoding a vector based on the coding linking
@@ -79,7 +90,9 @@ make_recode_query <- function(linked_codings, from = 1, to_suffix = "to", ...) {
 #' @param vec A vector
 #' @param to A coding object to which the vector will be recoded
 #' @param from A coding object that describes the current coding
-#'   of the vector. Defaults to the "rcoder.coding" attribute value
+#'   of the vector. Defaults to the "rcoder.coding" attribute value, if
+#'   it exists, _or_ the "bpr.coding" value (from blueprintr). If neither
+#'   are found, `from` stays `NULL` and the function errors.
 #' @param .embed If `TRUE`, `from` will be stored in the "rcoder.coding"
 #'   attribute
 #' @param .bpr If `TRUE`, adds the _character_ representation of
@@ -90,12 +103,16 @@ make_recode_query <- function(linked_codings, from = 1, to_suffix = "to", ...) {
 recode_vec <- function(
   vec,
   to,
-  from = get_attr(vec, "rcoder.coding"),
+  from = NULL,
   .embed = TRUE,
   .bpr = TRUE
 ) {
   if (is.null(from)) {
-    rc_err("Use `rcoder::assign_coding` to embed a `coding` to a vector")
+    from <- get_vector_attrib(vec)
+
+    if (is.null(from)) {
+      rc_err("Use `rcoder::assign_coding` to embed a `coding` to a vector")
+    }
   }
 
   rc_assert(is.atomic(vec), "{substitute(vec)} must be a vector")

tests/testthat/test-recoding.R

@@ -70,7 +70,7 @@ test_that("Vector recoding works", {
   set.seed(9001)
 
   vec <- sample(0:3, 20, replace = TRUE)
-  expect_null(get_attr(vec, "rcoder.coding"))
+  expect_null(get_vector_attrib(vec))
 
   coding_1 <- coding(
     code("Never", 0),
@@ -79,6 +79,14 @@ test_that("Vector recoding works", {
     code("Frequently", 3)
   )
 
+  # Allows "bpr.coding" to be used as a suitable source
+  vec2 <- sample(0:3, 20, replace = TRUE)
+  vec2 <- set_attrs(
+    vec2,
+    bpr.coding = as.character(coding_1)
+  )
+  expect_identical(get_vector_attrib(vec2), coding_1)
+
   expect_error(recode_vec(vec, to = coding_1))
 
   vec <- assign_coding(vec, coding_1)