Skip to content

Commit

Permalink
Add clone method to each object
Browse files Browse the repository at this point in the history
  • Loading branch information
@wch
wch committed Jun 23, 2015
1 parent 42556cb commit 560ded3
Show file tree
Hide file tree
Showing 6 changed files with 191 additions and 215 deletions.
1 change: 0 additions & 1 deletion NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,4 +3,3 @@
S3method(print,R6)
S3method(print,R6ClassGenerator)
export(R6Class)
export(clone)
198 changes: 81 additions & 117 deletions R/clone.R
View file
Original file line number Diff line number Diff line change
@@ -1,72 +1,85 @@
#' Clone an R6 object
#'
#' This function clones an R6 object, with a few limitations. It can be called
#' with \code{clone(obj)}, or you can add a public \code{clone} method to your
#' class, like this: \code{clone = function() clone(self)}.
#'
#' Note that for non-portable R6 classes, \code{clone = function() clone(self)}
#' will result in the method attempting to call itself. In this case, you will
#' need to use \code{clone = function() R6::clone(self)}.
#'
#' @section Limitations:
#'
#' \code{clone()} only makes shallow copies. If your object has any fields
#' with reference semantics (e.g., environments, RefClass objects, or R6
#' objects), then clone will point to those same objects, not copies of those
#' objects.
#'
#' @param obj An R6 object to clone.
#'
#' @examples
#' AC <- R6Class("AC",
#' public = list(
#' x = 1,
#' gety = function() private$y,
#' sety = function(y) private$y <- y
#' ),
#' private = list(
#' y = 1
#' )
#' )
#'
#' a <- AC$new()
#' b <- clone(a)
#' b$x # 1
#' b$gety() # 1
#'
#' # Changing values in a doesn't affect b
#' a$x <- 2
#' a$sety(2)
#' b$x # 1
#' b$gety() # 1
#'
#' # Changing values in b does affect b
#' b$x <- 3
#' b$sety(3)
#' b$x # 3
#' b$gety() # 3
#'
#'
#'
#' # A class with a built-in clone() method
#' Cloner <- R6Class("Cloner",
#' public = list(
#' x = 1,
#' clone = function() clone(self)
#' )
#' )
#'
#' a <- Cloner$new()
#' b <- a$clone()
#' a$x <- 2
#' b$x # 1
#'
#' @export
clone <- encapsulate(function(obj) {
old_enclos_env <- obj$`.__enclos_env__`
# This function will be added as a method to R6 objects, with the name 'clone',
# and with the environment changed.
generator_funs$clone_method <- function() {

# Need to embed these utility functions inside this closure because the
# environment of this function will change.
assign_func_envs <- function(objs, target_env) {
if (is.null(target_env)) return(objs)

lapply(objs, function(x) {
if (is.function(x)) environment(x) <- target_env
x
})
}

list2env2 <- function(x, envir = NULL, parent = emptyenv(),
hash = (length(x) > 100),
size = max(29L, length(x)),
empty_to_null = TRUE) {
if (is.null(envir)) {
envir <- new.env(hash = hash, parent = parent, size = size)
}
if (length(x) == 0) {
if (empty_to_null)
return(NULL)
else
return(envir)
}
list2env(x, envir)
}


clone_super <- function(old_enclos_env, new_enclos_env, public_bind_env) {
old_super_bind_env <- old_enclos_env$super
if (is.null(old_super_bind_env))
return()

# Copy all the methods from the old super binding env to the new one, and
# set their enclosing env to a new one.
super_copies <- as.list.environment(old_super_bind_env, all.names = TRUE)

# Degenerate case: super env is empty
if (length(super_copies) == 0) {
new_enclos_env$super <- new.env(parent = emptyenv(), hash = FALSE)
return()
}

# All items in the old_super_bind_env must be functions; to get the
# old_super_enclos_env, simply call environment() on one of them. Doing it
# this way lets us avoid storing an explicit pointer to the super_enclos_env
# in the original super_bind_env. This doesn't work as well for avoiding
# storing the enclos_env in the original public_bind_env, because there are
# many possible items there. We can't assume that just any item is a
# function -- and even if we do find a function, it's not guaranteed that
# it's a method. It may be a function (with a different parent env) that was
# added after the object was created.
old_super_enclos_env <- environment(super_copies[[1]])

# Create new super enclos env and populate with self and private.
new_super_enclos_env <- new.env(parent = parent.env(old_super_enclos_env),
hash = FALSE)
new_super_enclos_env$self <- public_bind_env
if (!is.null(new_enclos_env$private))
new_super_enclos_env$private <- new_enclos_env$private

new_super_bind_env <- new.env(parent = emptyenv(), hash = FALSE)

# Copy over the methods and fix up their environments
super_copies <- assign_func_envs(super_copies, new_super_enclos_env)
list2env2(super_copies, new_super_bind_env)


new_enclos_env$super <- new_super_bind_env

# Recurse
clone_super(old_super_enclos_env, new_super_enclos_env, public_bind_env)
}


old_enclos_env = parent.env(environment())
if (!is.environment(old_enclos_env)) {
stop("`obj` must be an R6 object.")
stop("clone() must be called from an R6 object.")
}

old_public_bind_env <- old_enclos_env$self
Expand Down Expand Up @@ -165,53 +178,4 @@ clone <- encapsulate(function(obj) {
class(public_bind_env) <- class(old_public_bind_env)

public_bind_env
})


encapsulate({
clone_super <- function(old_enclos_env, new_enclos_env, public_bind_env) {
old_super_bind_env <- old_enclos_env$super
if (is.null(old_super_bind_env))
return()

# Copy all the methods from the old super binding env to the new one, and
# set their enclosing env to a new one.
super_copies <- as.list.environment(old_super_bind_env, all.names = TRUE)

# Degenerate case: super env is empty
if (length(super_copies) == 0) {
new_enclos_env$super <- new.env(parent = emptyenv(), hash = FALSE)
return()
}

# All items in the old_super_bind_env must be functions; to get the
# old_super_enclos_env, simply call environment() on one of them. Doing it
# this way lets us avoid storing an explicit pointer to the super_enclos_env
# in the original super_bind_env. This doesn't work as well for avoiding
# storing the enclos_env in the original public_bind_env, because there are
# many possible items there. We can't assume that just any item is a
# function -- and even if we do find a function, it's not guaranteed that
# it's a method. It may be a function (with a different parent env) that was
# added after the object was created.
old_super_enclos_env <- environment(super_copies[[1]])

# Create new super enclos env and populate with self and private.
new_super_enclos_env <- new.env(parent = parent.env(old_super_enclos_env),
hash = FALSE)
new_super_enclos_env$self <- public_bind_env
if (!is.null(new_enclos_env$private))
new_super_enclos_env$private <- new_enclos_env$private

new_super_bind_env <- new.env(parent = emptyenv(), hash = FALSE)

# Copy over the methods and fix up their environments
super_copies <- assign_func_envs(super_copies, new_super_enclos_env)
list2env2(super_copies, new_super_bind_env)


new_enclos_env$super <- new_super_bind_env

# Recurse
clone_super(old_super_enclos_env, new_super_enclos_env, public_bind_env)
}
})
}
54 changes: 47 additions & 7 deletions R/r6_class.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,13 @@
#' classes: inheritance across packages will not work well, and \code{self}
#' and \code{private} are not necessary for accessing fields.
#'
#' @section Cloning objects:
#'
#' R6 objects have a method named \code{clone} by default. To disable this,
#' use \code{cloneable=FALSE}. Having the \code{clone} method present will
#' slightly increase the memory footprint of R6 objects, but since the method
#' will be shared across all R6 objects, the memory use will be negligible.
#'
#' @section S3 details:
#'
#' Normally the public environment will have two classes: the one supplied in
Expand Down Expand Up @@ -94,6 +101,8 @@
#' it will be possible to add more members with \code{$set}. The methods
#' \code{$is_locked}, \code{$lock}, and \code{$unlock} can be used to query
#' and change the locked state of the class.
#' @param cloneable If \code{TRUE} (the default), the generated objects will
#' have method named \code{$clone}, which makes a copy of the object.
#' @param lock Deprecated as of version 2.1; use \code{lock_class} instead.
#' @examples
#' # A queue ---------------------------------------------------------
Expand Down Expand Up @@ -293,6 +302,30 @@
#' s$x
#' s$getx2()
#'
#'
#' # Cloning objects -------------------------------------------------
#' a <- Queue$new(5, 6)
#' a$remove()
#' #> [1] 5
#'
#' # Clone a. New object gets a's state.
#' b <- a$clone()
#'
#' # Can add to each queue separately now.
#' a$add(10)
#' b$add(20)
#'
#' a$remove()
#' #> [1] 6
#' a$remove()
#' #> [1] 10
#'
#' b$remove()
#' #> [1] 6
#' b$remove()
#' #> [1] 20
#'
#'
#' # Debugging -------------------------------------------------------
#' \dontrun{
#' # This will enable debugging the getx() method for objects of the 'Simple'
Expand Down Expand Up @@ -320,15 +353,19 @@ R6Class <- encapsulate(function(classname = NULL, public = list(),
private = NULL, active = NULL,
inherit = NULL, lock_objects = TRUE,
class = TRUE, portable = TRUE,
lock_class = FALSE,
lock_class = FALSE, cloneable = TRUE,
parent_env = parent.frame(), lock) {

if (!all_named(public) || !all_named(private) || !all_named(active))
stop("All elements of public, private, and active must be named.")

if (any(duplicated(c(names(public), names(private), names(active)))))
allnames <- c(names(public), names(private), names(active))
if (any(duplicated(allnames)))
stop("All items in public, private, and active must have unique names.")

if ("clone" %in% allnames)
stop("Cannot add a member with reserved name 'clone'.")

if (any(c("self", "private", "super") %in%
c(names(public), names(private), names(active))))
stop("Items cannot use reserved names 'self', 'private', and 'super'.")
Expand All @@ -352,6 +389,11 @@ R6Class <- encapsulate(function(classname = NULL, public = list(),

generator$self <- generator

# Set the generator functions to eval in the generator environment, and copy
# them into the generator env.
generator_funs <- assign_func_envs(generator_funs, generator)
list2env2(generator_funs, generator)

generator$classname <- classname
generator$active <- active
generator$portable <- portable
Expand All @@ -366,18 +408,16 @@ R6Class <- encapsulate(function(classname = NULL, public = list(),
generator$public_methods <- get_functions(public)
generator$private_methods <- get_functions(private)

if (cloneable)
generator$public_methods$clone <- generator_funs$clone_method

# Capture the unevaluated expression for the superclass; when evaluated in
# the parent_env, it should return the superclass object.
generator$inherit <- substitute(inherit)

# Names of methods for which to enable debugging
generator$debug_names <- character(0)

# Set the generator functions to eval in the generator environment, and copy
# them into the generator env.
generator_funs <- assign_func_envs(generator_funs, generator)
list2env2(generator_funs, generator)

attr(generator, "name") <- paste0(classname, "_generator")
class(generator) <- "R6ClassGenerator"

Expand Down
39 changes: 38 additions & 1 deletion man/R6Class.Rd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,8 @@
\usage{
R6Class(classname = NULL, public = list(), private = NULL,
active = NULL, inherit = NULL, lock_objects = TRUE, class = TRUE,
portable = TRUE, lock_class = FALSE, parent_env = parent.frame(), lock)
portable = TRUE, lock_class = FALSE, cloneable = TRUE,
parent_env = parent.frame(), lock)
}
\arguments{
\item{classname}{Name of the class. The class name is useful primarily for S3
Expand Down Expand Up @@ -43,6 +44,9 @@ it will be possible to add more members with \code{$set}. The methods
\code{$is_locked}, \code{$lock}, and \code{$unlock} can be used to query
and change the locked state of the class.}
\item{cloneable}{If \code{TRUE} (the default), the generated objects will
have method named \code{$clone}, which makes a copy of the object.}
\item{parent_env}{An environment to use as the parent of newly-created
objects.}
Expand Down Expand Up @@ -105,6 +109,15 @@ instantiate the object and assign it.
and \code{private} are not necessary for accessing fields.
}

\section{Cloning objects}{


R6 objects have a method named \code{clone} by default. To disable this,
use \code{cloneable=FALSE}. Having the \code{clone} method present will
slightly increase the memory footprint of R6 objects, but since the method
will be shared across all R6 objects, the memory use will be negligible.
}

\section{S3 details}{


Expand Down Expand Up @@ -319,6 +332,30 @@ s <- Simple$new()
s$x
s$getx2()


# Cloning objects -------------------------------------------------
a <- Queue$new(5, 6)
a$remove()
#> [1] 5

# Clone a. New object gets a's state.
b <- a$clone()

# Can add to each queue separately now.
a$add(10)
b$add(20)

a$remove()
#> [1] 6
a$remove()
#> [1] 10

b$remove()
#> [1] 6
b$remove()
#> [1] 20


# Debugging -------------------------------------------------------
\dontrun{
# This will enable debugging the getx() method for objects of the 'Simple'
Expand Down
Loading

0 comments on commit 560ded3

Please sign in to comment.