Allow assignment into an xpose_data object while maintaining the class

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)

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`

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`

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))
+})