From 4e534edf1ce1b6f878aaf7abfc4f7e1137cb75a6 Mon Sep 17 00:00:00 2001
From: Bill Denney <wdenney@humanpredictions.com>
Date: Tue, 26 Mar 2019 09:47:52 -0400
Subject: [PATCH] Allow assignment into an xpose_data object while maintaining
 the class

---
 NEWS.md                          |  4 ++++
 R/xpdb_edits.R                   | 13 +++++++++++++
 R/xpose_data.R                   |  8 --------
 tests/testthat/test-xpdb_edits.R | 11 +++++++++++
 4 files changed, 28 insertions(+), 8 deletions(-)
 create mode 100644 tests/testthat/test-xpdb_edits.R

diff --git a/NEWS.md b/NEWS.md
index e3690e03..9a963acb 100755
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,7 @@
+# xpose 0.4.4.9000
+### General
+* Assignment into an "xpose_data" object now keeps the class of "xpose_data" instead of reverting to "uneval" (@billdenney #134)
+
 # xpose 0.4.4
 ### General
 * Improved documentation for `xpose_data` (@billdenney #99)
diff --git a/R/xpdb_edits.R b/R/xpdb_edits.R
index 3de3e843..9acb1d46 100755
--- a/R/xpdb_edits.R
+++ b/R/xpdb_edits.R
@@ -350,3 +350,16 @@ irep <- function(x, quiet = FALSE) {
   msg(c('irep: ', max(x), ' simulations found.'), quiet)
   x
 }
+
+#' Allow assignment into xpose_data without conversion to class uneval
+#' @param x object from which to extract element(s) or in which to replace element(s).
+#' @param i index specifying element to replace.
+#' @param value typically an array-like R object of a similar class as x.
+#' @return The object with the value replaced.
+#' @noRd
+`[[<-.xpose_data` <- function(x, i, value) {
+  x <- unclass(x)
+  x[[i]] <- value
+  as.xpdb(x)
+}
+`$<-.xpose_data` <- `[[<-.xpose_data`
diff --git a/R/xpose_data.R b/R/xpose_data.R
index bca85446..aa21b038 100755
--- a/R/xpose_data.R
+++ b/R/xpose_data.R
@@ -168,11 +168,3 @@ xpose_data <- function(runno         = NULL,
                       manual_import = manual_import)) %>% 
     structure(class = c('xpose_data', 'uneval'))
 }
-
-# Allow assignment into xpose_data without conversion to class uneval
-# `[[<-.xpose_data` <- function(x, i, value) {
-#   x <- unclass(x)
-#   x[[i]] <- value
-#   as.xpdb(x)
-# }
-# `$<-.xpose_data` <- `[[<-.xpose_data`
diff --git a/tests/testthat/test-xpdb_edits.R b/tests/testthat/test-xpdb_edits.R
new file mode 100644
index 00000000..3be756b5
--- /dev/null
+++ b/tests/testthat/test-xpdb_edits.R
@@ -0,0 +1,11 @@
+context("test xpdb_edits")
+
+test_that('Allow assignment within object while maintaining the class', {
+  xpdb_dollar <- xpdb_ex_pk
+  xpdb_dollar$options$quiet <- TRUE
+  expect_equal(class(xpdb_dollar), class(xpdb_ex_pk))
+
+  xpdb_bracket <- xpdb_ex_pk
+  xpdb_bracket[["options"]]$quiet <- TRUE
+  expect_equal(class(xpdb_bracket), class(xpdb_ex_pk))
+})