[Lme4-commits] r1530 - branches/roxygen/R

[noreply at r-forge.r-project.org]

Author: dmbates
Date: 2012-01-28 19:57:02 +0100 (Sat, 28 Jan 2012)
New Revision: 1530

Modified:
   branches/roxygen/R/AllClass.R
Log:
Add a deep copy method.


Modified: branches/roxygen/R/AllClass.R
===================================================================
--- branches/roxygen/R/AllClass.R	2012-01-27 23:49:54 UTC (rev 1529)
+++ branches/roxygen/R/AllClass.R	2012-01-28 18:57:02 UTC (rev 1530)
@@ -144,6 +144,22 @@
                          'fixed-effects coefficients for step factor fac'
                          .Call(merPredDbeta, ptr(), as.numeric(fac))
                      },
+                     copy         = function(shallow = FALSE) {
+                         def <- .refClassDef
+                         selfEnv <- as.environment(.self)
+                         vEnv    <- new.env(parent=emptyenv())
+                         for (field in setdiff(names(def at fieldClasses), "Ptr")) {
+                             if (shallow) 
+                                 assign(field, get(field, envir = selfEnv), envir = vEnv)
+                             else {
+                                 current <- get(field, envir = selfEnv)
+                                 if (is(current, "envRefClass")) 
+                                     current <- current$copy(FALSE)
+                                 assign(field, current, envir = vEnv)
+                             }
+                         }
+                         do.call(new, c(as.list(vEnv), Class=def))
+                     },
                      ldL2         = function() {
                          'twice the log determinant of the sparse Cholesky factor'
                          .Call(merPredDldL2, ptr())
@@ -319,6 +335,22 @@
                              as.numeric(ll$sqrtrwt) else sqrt(weights)
                          wtres   <<- sqrtrwt * (y - mu)
                      },
+                     copy         = function(shallow = FALSE) {
+                         def <- .refClassDef
+                         selfEnv <- as.environment(.self)
+                         vEnv    <- new.env(parent=emptyenv())
+                         for (field in setdiff(names(def at fieldClasses), "Ptr")) {
+                             if (shallow) 
+                                 assign(field, get(field, envir = selfEnv), envir = vEnv)
+                             else {
+                                 current <- get(field, envir = selfEnv)
+                                 if (is(current, "envRefClass")) 
+                                     current <- current$copy(FALSE)
+                                 assign(field, current, envir = vEnv)
+                             }
+                         }
+                         do.call(new, c(as.list(vEnv), Class=def))
+                     },
                      ptr       = function() {
                          'returns the external pointer, regenerating if necessary'
                          if (length(y)) {