add S3 methods (closes #50)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: SimDesign
 Title: Structure for Organizing Monte Carlo Simulation Designs
-Version: 2.17.6
+Version: 2.17.7
 Authors@R: c(person("Phil", "Chalmers", email = "[email protected]", role = c("aut", "cre"),
                     comment = c(ORCID="0000-0001-5332-2810")),
              person("Matthew", "Sigal", role = c("ctb")),

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("[",Design)
 S3method(plot,PBA)
 S3method(plot,RM)
 S3method(plot,SimSolve)
@@ -8,6 +9,7 @@ S3method(print,PBA)
 S3method(print,RM)
 S3method(print,SFA)
 S3method(print,SimDesign)
+S3method(rbind,Design)
 S3method(rbind,SimDesign)
 S3method(summary,SimDesign)
 S3method(summary,SimSolve)

NEWS.md

@@ -2,6 +2,10 @@
 
 ## Changes in SimDesign 2.18
 
+- Objects built by `createDesign()` gain `[]` and `rbind()` S3 functions for 
+  subsetting and combining by rows. Largely included so that internal attributes
+  such as `Design.ID` are better tracked (reported by Michael S. Truong)
+
 - `runArraySimulation(..., max_time)` now correctly applies the maximum 
   time across all subsetted conditions rather than over each condition, thereby
   matching, for example, SBATCH commands in SLURM (reported by Michael S. Truong)

R/Design.R

@@ -267,3 +267,35 @@ printDesign <- function(x, whichlist, ..., n = NULL, width = NULL, n_extra = NUL
     cat_line(ff)
     invisible(x)
 }
+
+#' @param x object of class \code{'Design'}
+#' @param i row index
+#' @param j column index
+#' @param drop logical; drop to lower dimension class?
+#' @rdname createDesign
+#' @export
+`[.Design` <- function(x, i, j, ..., drop = FALSE){
+    class(x) <- class(x)[-1]
+    x <- if(missing(i))
+        x[ ,j, drop=drop]
+    else if(missing(j))
+        x[i, , drop=drop]
+    else x[i,j, drop=drop]
+    if(!missing(i))
+        attr(x, 'Design.ID') <- attr(x, 'Design.ID')[i]
+    class(x) <- c('Design', class(x))
+    x
+}
+
+#' @rdname createDesign
+#' @export
+rbind.Design <- function(...){
+    dots <- list(...)
+    for(i in 1:length(dots))
+        class(dots[[i]]) <- class(dots[[i]])[-1]
+    x <- do.call(rbind, dots)
+    attr(x, 'Design.ID') <- 1:nrow(x)
+    class(x) <- c('Design', class(x))
+    x
+}
+

tests/tests/test-01-core.R

@@ -695,5 +695,24 @@ test_that('SimDesign', {
     expect_true(length(dir('mydirname')) == 4L)
     SimClean(dirs = 'mydirname')
 
+    # modifying Design object
+    Design <- createDesign(N = c(10, 20),
+                           SD = c(1, 2, 3))
+    expect_equal(attr(Design, 'Design.ID'), 1:6)
+
+    sDesign <- Design[2:3, ]
+    expect_equal(attr(sDesign, 'Design.ID'), 2:3)
+
+    Design2 <- createDesign(N = c(30),
+                            SD = c(1, 2, 3))
+    Design3 <- createDesign(N = c(40, 50),
+                            SD = c(1, 2, 3))
+
+    bDesign <- rbind(Design, Design2, Design3)
+    expect_equal(attr(bDesign, 'Design.ID'), 1:nrow(bDesign))
+
+    bDesign <- rbind(Design3, Design2, Design)
+    expect_equal(attr(bDesign, 'Design.ID'), 1:nrow(bDesign))
+
 })