Merge pull request #5 from nyuglobalties/feature/recoding-improvements

Add blueprintr variable decoration support

Author: psanker

DESCRIPTION

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

NEWS.md

@@ -1,3 +1,7 @@
+# rcoder 0.1.2
+
+* Adds {blueprintr} variable decoration support during assigning coding or recoding of vectors
+
 # rcoder 0.1.1
 
 * Adds `recode_vec` and `assign_coding`, simple interfaces for recoding vectors and embedding codings as attributes in vectors, respectively

R/recoding.R

@@ -82,13 +82,17 @@ make_recode_query <- function(linked_codings, from = 1, to_suffix = "to", ...) {
 #'   of the vector. Defaults to the "rcoder.coding" attribute value
 #' @param .embed If `TRUE`, `from` will be stored in the "rcoder.coding"
 #'   attribute
+#' @param .bpr If `TRUE`, adds the _character_ representation of
+#'   the coding to the "bpr.coding" attribute. Used for interop with
+#'   blueprintr variable decorations
 #' @return The recoded vector
 #' @export 
 recode_vec <- function(
   vec,
   to,
   from = get_attr(vec, "rcoder.coding"),
-  .embed = TRUE
+  .embed = TRUE,
+  .bpr = TRUE
 ) {
   if (is.null(from)) {
     rc_err("Use `rcoder::assign_coding` to embed a `coding` to a vector")
@@ -101,14 +105,13 @@ recode_vec <- function(
     "{substitute(from)} is not a `coding`"
   )
 
-
   linked <- link_codings(to, from)
   recode_func <- make_recode_query(linked)
 
   recoded_vec <- recode_func(vec)
 
   if (isTRUE(.embed)) {
-    recoded_vec <- assign_coding(recoded_vec, to)
+    recoded_vec <- assign_coding(recoded_vec, to, .bpr)
   }
 
   recoded_vec
@@ -120,11 +123,18 @@ recode_vec <- function(
 #' 
 #' @param vec A vector
 #' @param .coding A `coding` object
+#' @param .bpr Also overwrite the "bpr.coding" attribute with the character
+#'   representation of `.coding`. Used for interop with blueprintr
+#'   variable decorations.
 #' @return The vector with its "rcoder.coding" attribute set to `.coding`
 #' @export 
-assign_coding <- function(vec, .coding) {
+assign_coding <- function(vec, .coding, .bpr = TRUE) {
   rc_assert(is.atomic(vec), "{substitute(vec)} must be a vector")
   rc_assert(is.coding(.coding), "{substitute(.coding)} must be a `coding`")
 
-  set_attrs(vec, rcoder.coding = .coding)
+  set_attrs(
+    vec,
+    rcoder.coding = .coding,
+    bpr.coding = if (isTRUE(.bpr)) as.character(.coding) else NULL
+  )
 }

man/assign_coding.Rd

@@ -84,14 +84,19 @@ test_that("Vector recoding works", {
   vec <- assign_coding(vec, coding_1)
   expect_true(!is.null(get_attr(vec, "rcoder.coding")))
   expect_identical(get_attr(vec, "rcoder.coding"), coding_1)
+  expect_identical(
+    get_attr(vec, "bpr.coding"),
+    as.character(coding_1)
+  )
 
   coding_2 <- coding(
     # Using 10 & 11 for no common value overlap
     code("Uncommon", 10, links_from = c("Never", "Rarely")),
     code("Common", 11, links_from = c("Sometimes", "Frequently"))
   )
 
-  vec <- recode_vec(vec, to = coding_2)
+  vec <- recode_vec(vec, to = coding_2, .bpr = FALSE)
   expect_identical(get_attr(vec, "rcoder.coding"), coding_2)
+  expect_null(get_attr(vec, "bpr.coding"))
   expect_true(all(vec %in% c(10, 11)))
 })