From e47c61ceb7d1c9c44c63431640fb49611a71623a Mon Sep 17 00:00:00 2001
From: Patrick Anker <patricksanker@gmail.com>
Date: Sun, 28 Mar 2021 16:50:17 -0400
Subject: [PATCH] Allow "bpr.coding" to be a source

---
 DESCRIPTION                    |  2 +-
 NEWS.md                        |  4 ++++
 R/recoding.R                   | 23 ++++++++++++++++++++---
 man/recode_vec.Rd              | 12 ++++--------
 tests/testthat/test-recoding.R | 10 +++++++++-
 5 files changed, 38 insertions(+), 13 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 34aca43..55eaaec 100644
--- a/DESCRIPTION
+++ b/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", 
diff --git a/NEWS.md b/NEWS.md
index bebbf92..f9cee16 100644
--- a/NEWS.md
+++ b/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
diff --git a/R/recoding.R b/R/recoding.R
index b83e382..ba9bfdc 100644
--- a/R/recoding.R
+++ b/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")
diff --git a/man/recode_vec.Rd b/man/recode_vec.Rd
index e802aa1..6b1831f 100644
--- a/man/recode_vec.Rd
+++ b/man/recode_vec.Rd
@@ -4,13 +4,7 @@
 \alias{recode_vec}
 \title{Recode a vector}
 \usage{
-recode_vec(
-  vec,
-  to,
-  from = get_attr(vec, "rcoder.coding"),
-  .embed = TRUE,
-  .bpr = TRUE
-)
+recode_vec(vec, to, from = NULL, .embed = TRUE, .bpr = TRUE)
 }
 \arguments{
 \item{vec}{A vector}
@@ -18,7 +12,9 @@ recode_vec(
 \item{to}{A coding object to which the vector will be recoded}
 
 \item{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.}
 
 \item{.embed}{If `TRUE`, `from` will be stored in the "rcoder.coding"
 attribute}
diff --git a/tests/testthat/test-recoding.R b/tests/testthat/test-recoding.R
index 24970cc..47f1323 100644
--- a/tests/testthat/test-recoding.R
+++ b/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)