R6/0000755000176200001440000000000013121163343010536 5ustar liggesusersR6/inst/0000755000176200001440000000000013117561013011514 5ustar liggesusersR6/inst/doc/0000755000176200001440000000000013117561013012261 5ustar liggesusersR6/inst/doc/Introduction.Rmd0000644000176200001440000004273113104125424015413 0ustar liggesusers--- title: "Introduction to R6 classes" output: html_document: theme: null css: mystyle.css toc: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Introduction to R6 classes} %\usepackage[utf8]{inputenc} --- ```{r echo = FALSE} library(pryr) knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ``` The R6 package provides a type of class which is similar to R's standard reference classes, but it is more efficient and doesn't depend on S4 classes and the methods package. ## R6 classes R6 classes are similar to R's standard reference classes, but are lighter weight, and avoid some issues that come along with using S4 classes (R's reference classes are based on S4). For more information about speed and memory footprint, see the Performance vignette. Unlike many objects in R, instances (objects) of R6 classes have reference semantics. R6 classes also support: * public and private methods * active bindings * inheritance (superclasses) which works across packages Why the name R6? When R's reference classes were introduced, some users, following the names of R's existing class systems S3 and S4, called the new class system R5 in jest. Although reference classes are not actually called R5, the name of this package and its classes takes inspiration from that name. The name R5 was also a code-name used for a different object system started by Simon Urbanek, meant to solve some issues with S4 relating to syntax and performance. However, the R5 branch was shelved after a little development, and it was never released. ### Basics Here's how to create a simple R6 class. The `public` argument is a list of items, which can be functions and fields (non-functions). Functions will be used as methods. ```{r} library(R6) Person <- R6Class("Person", public = list( name = NULL, hair = NULL, initialize = function(name = NA, hair = NA) { self$name <- name self$hair <- hair self$greet() }, set_hair = function(val) { self$hair <- val }, greet = function() { cat(paste0("Hello, my name is ", self$name, ".\n")) } ) ) ``` To instantiate an object of this class, use `$new()`: ```{r} ann <- Person$new("Ann", "black") ann ``` The `$new()` method creates the object and calls the `initialize()` method, if it exists. Inside methods of the class, `self` refers to the object. Public members of the object (all you've seen so far) are accessed with `self$x`, and assignment is done with `self$x <- y`. Note that by default, `self` is required to access members, although for non-portable classes which we'll see later, it is optional. Once the object is instantiated, you can access values and methods with `$`: ```{r} ann$hair ann$greet() ann$set_hair("red") ann$hair ``` Implementation note: The external face of an R6 object is basically an environment with the public members in it. This is also known as the *public environment*. An R6 object's methods have a separate *enclosing environment* which, roughly speaking, is the environment they "run in". This is where `self` binding is found, and it is simply a reference back to public environment. ### Private members In the previous example, all the members were public. It's also possible to add private members: ```{r} Queue <- R6Class("Queue", public = list( initialize = function(...) { for (item in list(...)) { self$add(item) } }, add = function(x) { private$queue <- c(private$queue, list(x)) invisible(self) }, remove = function() { if (private$length() == 0) return(NULL) # Can use private$queue for explicit access head <- private$queue[[1]] private$queue <- private$queue[-1] head } ), private = list( queue = list(), length = function() base::length(private$queue) ) ) q <- Queue$new(5, 6, "foo") ``` Whereas public members are accessed with `self`, like `self$add()`, private members are accessed with `private`, like `private$queue`. The public members can be accessed as usual: ```{r} # Add and remove items q$add("something") q$add("another thing") q$add(17) q$remove() q$remove() ``` However, private members can't be accessed directly: ```{r eval = FALSE} q$queue #> NULL q$length() #> Error: attempt to apply non-function ``` A useful design pattern is for methods to return `self` (invisibly) when possible, because it makes them chainable. For example, the `add()` method returns `self` so you can chain them together: ```{r} q$add(10)$add(11)$add(12) ``` On the other hand, `remove()` returns the value removed, so it's not chainable: ```{r} q$remove() q$remove() q$remove() q$remove() ``` ### Active bindings Active bindings look like fields, but each time they are accessed, they call a function. They are always publicly visible. ```{r} Numbers <- R6Class("Numbers", public = list( x = 100 ), active = list( x2 = function(value) { if (missing(value)) return(self$x * 2) else self$x <- value/2 }, rand = function() rnorm(1) ) ) n <- Numbers$new() n$x ``` When an active binding is accessed as if reading a value, it calls the function with `value` as a missing argument: ```{r} n$x2 ``` When it's accessed as if assigning a value, it uses the assignment value as the `value` argument: ```{r} n$x2 <- 1000 n$x ``` If the function takes no arguments, it's not possible to use it with `<-`: ```{r eval=FALSE} n$rand #> [1] 0.2648 n$rand #> [1] 2.171 n$rand <- 3 #> Error: unused argument (quote(3)) ``` Implementation note: Active bindings are bound in the public environment. The enclosing environment for these functions is also the public environment. ### Inheritance One R6 class can inherit from another. In other words, you can have super- and sub-classes. Subclasses can have additional methods, and they can also have methods that override the superclass methods. In this example of a queue that retains its history, we'll add a `show()` method and override the `remove()` method: ```{r} # Note that this isn't very efficient - it's just for illustrating inheritance. HistoryQueue <- R6Class("HistoryQueue", inherit = Queue, public = list( show = function() { cat("Next item is at index", private$head_idx + 1, "\n") for (i in seq_along(private$queue)) { cat(i, ": ", private$queue[[i]], "\n", sep = "") } }, remove = function() { if (private$length() - private$head_idx == 0) return(NULL) private$head_idx <<- private$head_idx + 1 private$queue[[private$head_idx]] } ), private = list( head_idx = 0 ) ) hq <- HistoryQueue$new(5, 6, "foo") hq$show() hq$remove() hq$show() hq$remove() ``` Superclass methods can be called with `super$xx()`. The `CountingQueue` (example below) keeps a count of the total number of objects that have ever been added to the queue. It does this by overriding the `add()` method -- it increments a counter and then calls the superclass's `add()` method, with `super$add(x)`: ```{r} CountingQueue <- R6Class("CountingQueue", inherit = Queue, public = list( add = function(x) { private$total <<- private$total + 1 super$add(x) }, get_total = function() private$total ), private = list( total = 0 ) ) cq <- CountingQueue$new("x", "y") cq$get_total() cq$add("z") cq$remove() cq$remove() cq$get_total() ``` ### Fields containing reference objects If your R6 class contains any fields that also have reference semantics (e.g., other R6 objects, and environments), those fields should be populated in the `initialize` method. If the field set to the reference object directly in the class definition, that object will be shared across all instances of the R6 objects. Here's an example: ```{r} SimpleClass <- R6Class("SimpleClass", public = list(x = NULL) ) SharedField <- R6Class("SharedField", public = list( e = SimpleClass$new() ) ) s1 <- SharedField$new() s1$e$x <- 1 s2 <- SharedField$new() s2$e$x <- 2 # Changing s2$e$x has changed the value of s1$e$x s1$e$x ``` To avoid this, populate the field in the `initialize` method: ```{r} NonSharedField <- R6Class("NonSharedField", public = list( e = NULL, initialize = function() self$e <- SimpleClass$new() ) ) n1 <- NonSharedField$new() n1$e$x <- 1 n2 <- NonSharedField$new() n2$e$x <- 2 # n2$e$x does not affect n1$e$x n1$e$x ``` ## Portable and non-portable classes In R6 version 1.0.1, the default was to create **non-portable** classes. In subsequent versions, the default is to create **portable** classes. The two most noticeable differences are that portable classes: * Support inheritance across different packages. Non-portable classes do not do this very well. * Always require the use of `self` and `private` to access members, as in `self$x` and `private$y`. Non-portable classes can access these members with just `x` and `y`, and do assignment to these members with the `<<-` operator. The implementation of the first point is such that it makes the second point necessary. ### Using `self` and `<<-` With reference classes, you can access the field without `self`, and assign to fields using `<<-`. For example: ```{r} RC <- setRefClass("RC", fields = list(x = 'ANY'), methods = list( getx = function() x, setx = function(value) x <<- value ) ) rc <- RC$new() rc$setx(10) rc$getx() ``` The same is true for non-portable R6 classes: ```{r} NP <- R6Class("NP", portable = FALSE, public = list( x = NA, getx = function() x, setx = function(value) x <<- value ) ) np <- NP$new() np$setx(10) np$getx() ``` But for portable R6 classes (this is the default), you must use `self` and/or `private`, and `<<-` assignment doesn't work -- unless you use `self`, of course: ```{r} P <- R6Class("P", portable = TRUE, # This is default public = list( x = NA, getx = function() self$x, setx = function(value) self$x <- value ) ) p <- P$new() p$setx(10) p$getx() ``` For more information, see the Portable vignette. ## Other topics ### Adding members to an existing class It is sometimes useful to add members to a class after the class has already been created. This can be done using the `$set()` method on the generator object. ```{r} Simple <- R6Class("Simple", public = list( x = 1, getx = function() self$x ) ) Simple$set("public", "getx2", function() self$x*2) # To replace an existing member, use overwrite=TRUE Simple$set("public", "x", 10, overwrite = TRUE) s <- Simple$new() s$x s$getx2() ``` The new members will be present only in instances that are created after `$set()` has been called. To prevent modification of a class, you can use `lock_class=TRUE` when creating the class. You can also lock and unlock a class as follows: ```{r} # Create a locked class Simple <- R6Class("Simple", public = list( x = 1, getx = function() self$x ), lock_class = TRUE ) # This would result in an error # Simple$set("public", "y", 2) # Unlock the class Simple$unlock() # Now it works Simple$set("public", "y", 2) # Lock the class again Simple$lock() ``` ### Cloning objects By default, R6 objects have method named `clone` for making a copy of the object. ```{r} Simple <- R6Class("Simple", public = list( x = 1, getx = function() self$x ) ) s <- Simple$new() # Create a clone s1 <- s$clone() # Modify it s1$x <- 2 s1$getx() # Original is unaffected by changes to the clone s$getx() ``` ```{r clone-size, echo=FALSE} # Calculate size of clone method in this block. Cloneable <- R6Class("Cloneable", cloneable = TRUE) NonCloneable <- R6Class("NonCloneable", cloneable = FALSE) c1 <- Cloneable$new() c2 <- Cloneable$new() # Bytes for each new cloneable object cloneable_delta <- object_size(c1, c2) - object_size(c2) nc1 <- NonCloneable$new() nc2 <- NonCloneable$new() # Bytes for each new noncloneable object noncloneable_delta <- object_size(nc1, nc2) - object_size(nc2) # Number of bytes used by each copy of clone method additional_clone_method_bytes <- cloneable_delta - noncloneable_delta additional_clone_method_bytes_str <- capture.output(print(additional_clone_method_bytes)) # Number of bytes used by first copy of a clone method first_clone_method_bytes <- object_size(c1) - object_size(nc1) # Need some trickery to get the nice output from pryr::print.bytes first_clone_method_bytes_str <- capture.output(print(first_clone_method_bytes)) ``` If you don't want a `clone` method to be added, you can use `cloneable=FALSE` when creating the class. If any loaded R6 object has a `clone` method, that function uses `r first_clone_method_bytes_str`, but for each additional object, the `clone` method costs a trivial amount of space (`r additional_clone_method_bytes` bytes). #### Deep cloning If there are any fields which are objects with reference sematics (environments, R6 objects, reference class objects), the copy will get a reference to the same object. This is sometimes desirable, but often it is not. For example, we'll create an object `c1` which contains another R6 object, `s`, and then clone it. Because the original's and the clone's `s` fields both refer to the same object, modifying it from one results in a change that is reflect in the other. ```{r} Simple <- R6Class("Simple", public = list(x = 1)) Cloneable <- R6Class("Cloneable", public = list( s = NULL, initialize = function() self$s <- Simple$new() ) ) c1 <- Cloneable$new() c2 <- c1$clone() # Change c1's `s` field c1$s$x <- 2 # c2's `s` is the same object, so it reflects the change c2$s$x ``` To make it so the clone receives a *copy* of `s`, we can use the `deep=TRUE` option: ```{r} c3 <- c1$clone(deep = TRUE) # Change c1's `s` field c1$s$x <- 3 # c2's `s` is different c3$s$x ``` The default behavior of `clone(deep=TRUE)` is to copy fields which are R6 objects, but not copy fields which are environments, reference class objects, or other data structures which contain other reference-type objects (for example, a list with an R6 object). If your R6 object contains these types of objects and you want to make a deep clone of them, you must provide your own function for deep cloning, in a private method named `deep_clone`. Below is an example of an R6 object with two fields, `a` and `b`, both of which which are environments, and both of which contain a value `x`. It also has a field `v` which is a regular (non-reference) value, and a private `deep_clone` method. The `deep_clone` method is be called once for each field. It is passed the name and value of the field, and the value it returns is be used in the clone. ```{r} CloneEnv <- R6Class("CloneEnv", public = list( a = NULL, b = NULL, v = 1, initialize = function() { self$a <- new.env(parent = emptyenv()) self$b <- new.env(parent = emptyenv()) self$a$x <- 1 self$b$x <- 1 } ), private = list( deep_clone = function(name, value) { # With x$clone(deep=TRUE) is called, the deep_clone gets invoked once for # each field, with the name and value. if (name == "a") { # `a` is an environment, so use this quick way of copying list2env(as.list.environment(value, all.names = TRUE), parent = emptyenv()) } else { # For all other fields, just return the value value } } ) ) c1 <- CloneEnv$new() c2 <- c1$clone(deep = TRUE) ``` When `c1$clone(deep=TRUE)` is called, the `deep_clone` method is called for each field in `c1`, and is passed the name of the field and value. In our version, the `a` environment gets copied, but `b` does not, nor does `v` (but that doesn't matter since `v` is not a reference object). We can test out the clone: ```{r} # Modifying c1$a doesn't affect c2$a, because they're separate objects c1$a$x <- 2 c2$a$x # Modifying c1$b does affect c2$b, because they're the same object c1$b$x <- 3 c2$b$x # Modifying c1$v doesn't affect c2$v, because they're not reference objects c1$v <- 4 c2$v ``` In the example `deep_clone` method above, we checked the name of each field to determine what to do with it, but we could also check the value, by using `inherits(value, "R6")`, or `is.environment()`, and so on. ### Printing R6 objects to the screen R6 objects have a default `print` method that lists all members of the object. If a class defines a `print` method, then it overrides the default one. ```{r} PrettyCountingQueue <- R6Class("PrettyCountingQueue", inherit = CountingQueue, public = list( print = function(...) { cat(" of ", self$get_total(), " elements\n", sep = "") invisible(self) } ) ) ``` ```{r} pq <- PrettyCountingQueue$new(1, 2, "foobar") pq ``` ### Finalizers Sometimes it's useful to run a function when the object is garbage collected. For example, you may want to make sure a file or database connection gets closed. To do this, you can define a `finalize()` method, which will be called with no arguments when the object is garbage collected. ```{r} A <- R6Class("A", public = list( finalize = function() { print("Finalizer has been called!") } )) # Instantiate an object: obj <- A$new() # Remove the single existing reference to it, and force garbage collection # (normally garbage collection will happen automatically from time # to time) rm(obj); gc() ``` Finalizers are implemented using the `reg.finalizer()` function, and they set `onexit=TRUE`, so that the finalizer will also be called when R exits. This is useful in some cases, like database connections. ## Summary R6 classes provide capabilities that are common in other object-oriented programming languages. They're similar to R's built-in reference classes, but are simpler, smaller, and faster, and they allow inheritance across packages. R6/inst/doc/Debugging.html0000644000176200001440000014741513117561005015057 0ustar liggesusers Debugging methods in R6 objects

Debugging methods in R6 objects

Debugging methods in R6 classes is somewhat different from debugging normal R functions.

RStudio breakpoints don’t work in R6 class methods. The simplest way to debug code is to insert a browser() line where you want to open a debugging console, reload the classes, and then step through your code. But this involves modifying your code, reloading it, and re-instantiating any objects you want to test.

Enabling debugging for all future instances of a class

R6 generator objects have a method called debug() which will enable debugging for a method. This will affect all instances of the class that are created after the debug() is called.

# An example class
Simple <- R6Class("Simple",
  public = list(
    x = 10,
    getx = function() self$x
  )
)

# This will enable debugging the getx() method for objects of the 'Simple'
# class that are instantiated in the future.
Simple$debug("getx")

s <- Simple$new()
s$getx()
# [Debugging prompt]

To disable debugging for future instances, use the generator’s undebug() method:

# Disable debugging for future instances:
Simple$undebug("getx")

s <- Simple$new()
s$getx()
#> [1] 10

Debugging methods in individual objects

To enable debugging for a method in a single instance of an object, use the debug() function (not the debug() method in the generator object).

s <- Simple$new()
debug(s$getx)
s$getx()
# [Debugging prompt]

Use undebug() to disable debugging on an object’s method.

undebug(s$getx)
s$getx()
#> [1] 10

You can also use the trace() function to specify where in a method you want to drop into the debugging console.

R6/inst/doc/Portable.html0000644000176200001440000016675513117561013014743 0ustar liggesusers Portable and non-portable R6 classes

Portable and non-portable R6 classes

One limitation to R’s reference classes is that class inheritance across package namespaces is limited. R6 avoids this problem when the portable option is enabled.

The problem

Here is an example of the cross-package inheritance problem with reference classes: Suppose you have ClassA in pkgA, and ClassB in pkgB, which inherits from ClassA. ClassA has a method foo which calls a non-exported function fun in pkgA.

If ClassB inherits foo, it will try to call fun – but since ClassB objects are created in pkgB namespace (which is an environment) instead of the pkgA namespace, it won’t be able to find fun.

Something similar happens with R6 when the portable=FALSE option is used. For example:

library(R6)
# Simulate packages by creating environments
pkgA <- new.env()
pkgB <- new.env()

# Create a function in pkgA but not pkgB
pkgA$fun <- function() 10

ClassA <- R6Class("ClassA",
  portable = FALSE,
  public = list(
    foo = function() fun()
  ),
  parent_env = pkgA
)

# ClassB inherits from ClassA
ClassB <- R6Class("ClassB",
  portable = FALSE,
  inherit = ClassA,
  parent_env = pkgB
)

When we create an instance of ClassA, it works as expected:

a <- ClassA$new()
a$foo()
#> [1] 10

But with ClassB, it can’t find the foo function:

b <- ClassB$new()
b$foo()
#> Error in b$foo() : could not find function "fun"

Portable R6

R6 supports inheritance across different packages, with the default portable=TRUE option. In this example, we’ll again simulate different packages by creating separate parent environments for the classes.

pkgA <- new.env()
pkgB <- new.env()

pkgA$fun <- function() {
  "This function `fun` in pkgA"
}

ClassA <- R6Class("ClassA",
  portable = TRUE,  # The default
  public = list(
    foo = function() fun()
  ),
  parent_env = pkgA
)

ClassB <- R6Class("ClassB",
  portable = TRUE,
  inherit = ClassA,
  parent_env = pkgB
)


a <- ClassA$new()
a$foo()
#> [1] "This function `fun` in pkgA"

b <- ClassB$new()
b$foo()
#> [1] "This function `fun` in pkgA"

When a method is inherited from a superclass, that method also gets that class’s environment. In other words, method “runs in” the superclass’s environment. This makes it possible for inheritance to work across packages.

When a method is defined in the subclass, that method gets the subclass’s environment. For example, here ClassC is a subclass of ClassA, and defines its own foo method which overrides the foo method from ClassA. It happens that the method looks the same as ClassA’s – it just calls fun. But this time it finds pkgC$fun instead of pkgA$fun. This is in contrast to ClassB, which inherited the foo method and environment from ClassA.

pkgC <- new.env()
pkgC$fun <- function() {
  "This function `fun` in pkgC"
}

ClassC <- R6Class("ClassC",
  portable = TRUE,
  inherit = ClassA,
  public = list(
    foo = function() fun()
  ),
  parent_env = pkgC
)

cc <- ClassC$new()
# This method is defined in ClassC, so finds pkgC$fun
cc$foo()
#> [1] "This function `fun` in pkgC"

Using self

One important difference between non-portable and portable classes is that with non-portable classes, it’s possible to access members with just the name of the member, and with portable classes, member access always requires using self$ or private$. This is a consequence of the inheritance implementation.

Here’s an example of a non-portable class with two methods: sety, which sets the private field y using the <<- operator, and getxy, which returns a vector with the values of fields x and y:

NP <- R6Class("NP",
  portable = FALSE,
  public = list(
    x = 1,
    getxy = function() c(x, y),
    sety = function(value) y <<- value
  ),
  private = list(
    y = NA
  )
)

np <- NP$new()

np$sety(20)
np$getxy()
#> [1]  1 20

If we attempt the same with a portable class, it results in an error:

P <- R6Class("P",
  portable = TRUE,
  public = list(
    x = 1,
    getxy = function() c(x, y),
    sety = function(value) y <<- value
  ),
  private = list(
    y = NA
  )
)

p <- P$new()

# No error, but instead of setting private$y, this sets y in the global
# environment! This is because of the sematics of <<-.
p$sety(20)
y
#> [1] 20

p$getxy()
#> Error in p$getxy() : object 'y' not found

To make this work with a portable class, we need to use self$x and private$y:

P2 <- R6Class("P2",
  portable = TRUE,
  public = list(
    x = 1,
    getxy = function() c(self$x, private$y),
    sety = function(value) private$y <- value
  ),
  private = list(
    y = NA
  )
)

p2 <- P2$new()
p2$sety(20)
p2$getxy()
#> [1]  1 20

There is a small performance penalty for using self$x as opposed to x. In most cases, this is negligible, but it can be noticeable in some situations where there are tens of thousands or more accesses per second. For more information, see the Performance vignette.

Potential pitfalls with cross-package inheritance

Inheritance happens when an object is instantiated with MyClass$new(). At that time, members from the superclass get copied to the new object. This means that when you instantiate R6 object, it will essentially save some pieces of the superclass in the object.

Because of the way that packages are built in R, R6’s inheritance behavior could potentially lead to surprising, hard-to-diagnose problems when packages change versions.

Suppose you have two packages, pkgA, containing ClassA, and pkgB, containing ClassB, and there is code in pkgB that instantiates ClassB in an object, objB, at build time. This is in contrast to instantiating ClassB at run-time, by calling a function. All of the code in the package is run when a binary package is built, and the resulting objects are saved in the package. (Generally, if the object can be accessed with pkgB:::objB, this means it was created at build time.)

When objB is created at package build time, pieces from the superclass, pkgA::ClassA, are saved inside of it. This is fine in and of itself. But imagine that pkgB was built and installed against pkgA 1.0, and then you upgrade to pkgA 2.0 without subsequently building and installing pkgB. Then pkgB::objB will contain some code from pkgA::ClassA 1.0, but the version of pkgA::ClassA that’s installed will be 2.0. This can cause problems if objB inherited code which uses parts of pkgA that have changed – but the problems may not be entirely obvious.

This scenario is entirely possible when installing packages from CRAN. It is very common for a package to be upgraded without upgrading all of its downstream dependencies. As far as I know, R does not have any mechanism to force downstream dependencies to be rebuilt when a package is upgraded on a user’s computer.

If this problem happens, the remedy is to rebuild pkgB against pkgA 2.0. I don’t know if CRAN rebuilds all downstream dependencies when a package is updated. If it doesn’t, then it’s possible for CRAN to have incompatible binary builds of pkgA and pkgB, and users would then have to install pkgB from source, with install.packages("pkgB", type = "source").

To avoid this problem entirely, objects of ClassB must not be instantiated at build time. You can either instantiate them only in functions, or at package load time, by adding an .onLoad function to your package. For example:

ClassB <- R6Class("ClassB",
  inherit = pkgA::ClassA,
  public = list(x = 1)
)

# We'll fill this at load time
objB <- NULL

.onLoad <- function(libname, pkgname) {
  # The namespace is locked after loading; we can still modify objB at this time.
  objB <<- ClassB$new()
}

You might be wondering why ClassB (the class, not the instance of the class objB) doesn’t save a copy of pkgA::ClassA inside of it when the package is built. This is because, for the inherit argument, R6Class saves the unevaluated expression, (pkgA::ClassA), and evaluates it when $new() is called.

Wrap-up

In summary:

R6/inst/doc/Debugging.R0000644000176200001440000000200213117561005014272 0ustar liggesusers## ----echo = FALSE-------------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ## ----eval=FALSE---------------------------------------------------------- # # An example class # Simple <- R6Class("Simple", # public = list( # x = 10, # getx = function() self$x # ) # ) # # # This will enable debugging the getx() method for objects of the 'Simple' # # class that are instantiated in the future. # Simple$debug("getx") # # s <- Simple$new() # s$getx() # # [Debugging prompt] ## ----eval=FALSE---------------------------------------------------------- # # Disable debugging for future instances: # Simple$undebug("getx") # # s <- Simple$new() # s$getx() # #> [1] 10 ## ----eval=FALSE---------------------------------------------------------- # s <- Simple$new() # debug(s$getx) # s$getx() # # [Debugging prompt] ## ----eval=FALSE---------------------------------------------------------- # undebug(s$getx) # s$getx() # #> [1] 10 R6/inst/doc/Debugging.Rmd0000644000176200001440000000377113104125424014626 0ustar liggesusers--- title: "Debugging methods in R6 objects" output: html_document: theme: null css: mystyle.css toc: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Debugging methods in R6 objects} %\usepackage[utf8]{inputenc} --- ```{r echo = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ``` Debugging methods in R6 classes is somewhat different from debugging normal R functions. RStudio breakpoints don't work in R6 class methods. The simplest way to debug code is to insert a `browser()` line where you want to open a debugging console, reload the classes, and then step through your code. But this involves modifying your code, reloading it, and re-instantiating any objects you want to test. ## Enabling debugging for all future instances of a class R6 generator objects have a method called `debug()` which will enable debugging for a method. This will affect all instances of the class that are created after the `debug()` is called. ```{r eval=FALSE} # An example class Simple <- R6Class("Simple", public = list( x = 10, getx = function() self$x ) ) # This will enable debugging the getx() method for objects of the 'Simple' # class that are instantiated in the future. Simple$debug("getx") s <- Simple$new() s$getx() # [Debugging prompt] ``` To disable debugging for future instances, use the generator's `undebug()` method: ```{r eval=FALSE} # Disable debugging for future instances: Simple$undebug("getx") s <- Simple$new() s$getx() #> [1] 10 ``` ## Debugging methods in individual objects To enable debugging for a method in a single instance of an object, use the `debug()` function (not the `debug()` method in the generator object). ```{r eval=FALSE} s <- Simple$new() debug(s$getx) s$getx() # [Debugging prompt] ``` Use `undebug()` to disable debugging on an object's method. ```{r eval=FALSE} undebug(s$getx) s$getx() #> [1] 10 ``` You can also use the `trace()` function to specify where in a method you want to drop into the debugging console. R6/inst/doc/Performance.Rmd0000644000176200001440000005606113104125424015174 0ustar liggesusers--- title: "R6 and Reference class performance tests" output: html_document: theme: null css: mystyle.css toc: yes fig_retina: false vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{R6 and Reference class performance tests} %\usepackage[utf8]{inputenc} --- ```{r echo = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 3.9, fig.height = 3.5) # Make sure vignette doesn't error on platforms where microbenchmark is not present. if (requireNamespace("microbenchmark", quietly = TRUE)) { library(microbenchmark) # Only print 3 significant digits print_microbenchmark <- function (x, unit, order = NULL, ...) { s <- summary(x, unit = unit) cat("Unit: ", attr(s, "unit"), "\n", sep = "") timing_cols <- c("min", "lq", "median", "uq", "max") s[timing_cols] <- lapply(s[timing_cols], signif, digits = 3) s[timing_cols] <- lapply(s[timing_cols], format, big.mark = ",") print(s, ..., row.names = FALSE) } assignInNamespace("print.microbenchmark", print_microbenchmark, "microbenchmark") } else { # Some dummy functions so that the vignette doesn't throw an error. microbenchmark <- function(...) { structure(list(), class = "microbenchmark_dummy") } summary.microbenchmark_dummy <- function(object, ...) { data.frame(expr = "", median = 0) } } ``` This document compares the memory costs and speed of R's reference classes against R6 classes and simple environments. For must uses, R6 and reference classes have comparable features, but as we'll see, R6 classes are faster and lighter weight. This document tests reference classes against R6 classes (in many variations), as well as against very simple reference objects: environments created by functino calls. ***** First we'll load some packages which will be used below: ```{r eval = FALSE} library(microbenchmark) options(microbenchmark.unit = "us") library(pryr) # For object_size function library(R6) ``` ```{r echo = FALSE} # The previous code block is just for appearances. This code block is the one # that gets run. The loading of microbenchmark must be conditional because it is # not available on all platforms. if (requireNamespace("microbenchmark", quietly = TRUE)) { library(microbenchmark) } options(microbenchmark.unit = "us") library(pryr) # For object_size function library(R6) ``` ```{r echo=FALSE} library(ggplot2) library(scales) # Set up ggplot2 theme my_theme <- theme_bw(base_size = 10) + theme(axis.title.x = element_blank(), axis.title.y = element_blank(), panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank() ) ``` ***** Class definitions ================= We'll start by defining a number of classes or class-like entities, using reference classes, R6 classes, and simple environments that are created directly by functions. There are a number of options for R6 that can affect the size of the resulting objects, so we will use a number of variants. These classes will be used for the speed and memory tests that follow. This is a lot of boring code, so you may want to skip ahead to the results. All of these classes have the same basic characteristics: * A field named `x` that contains a number. * An way of initializing the value of `x`. * A method named `getx` for retrieving the value of `x`. * A method named `inc` for incrementing the value of `x`. The fields and methods are accessed with the `$` operator, so if we have an object named `obj`, we could use `obj$x` or `obj$getx()`. ## R reference class ```{r} RC <- setRefClass("RC", fields = list(x = "numeric"), methods = list( initialize = function(x = 1) .self$x <- x, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ``` In reference classes, the binding that points back to the object is named `.self`. Within a method, assignment can be done by using `.self`, as in `.self$x <- 10`, or by using `<<-`, as in `x <<- 10`. To create an object, simply call `$new()` on the class: ```{r} RC$new() ``` ## R6 class Creating an R6 class is similar to the reference class, except that there's no need to separate the fields and methods, and you can't specify the types of the fields. ```{r} R6 <- R6Class("R6", public = list( x = NULL, initialize = function(x = 1) self$x <- x, getx = function() self$x, inc = function(n = 1) self$x <- x + n ) ) ``` Whereas reference classes use `.self`, R6 classes use `self` (without the leading period). As with reference classes, objects are instantiated by calling `$new()`: ```{r} R6$new() ``` An R6 object essentially just a set of environments structured in a particular way. The fields and methods for an R6 object have bindings (that is, they have names) in the *public environment*. There is also have a separate environment which is the *enclosing environment* for methods (they "run in" an environment that contains a binding named `self`, which is simply a reference to the public environment). ## R6 class, without class attribute By default, a class attribute is added to R6 objects. This attribute adds a slight performance penalty because R will attempt to use S3 dispatch when using `$` on the object. It's possible generate objects without the class attribute, by using `class=FALSE`: ```{r} R6NoClass <- R6Class("R6NoClass", class = FALSE, public = list( x = NULL, initialize = function(x = 1) self$x <- x, getx = function() self$x, inc = function(n = 1) self$x <- self$x + n ) ) ``` Note that without the class attribute, S3 method dispatch on the objects is not possible. ## R6 class, non-portable By default, R6 objects are *portable*. This means that inheritance can be in classes that are in different packages. However, it also requires the use of `self$` and `private$` to access members, and this incurs a small performance penalty. If `portable=FALSE` is used, members can be accessed without using `self$`, and assignment can be done with `<<-`: ```{r} R6NonPortable <- R6Class("R6NonPortable", portable = FALSE, public = list( x = NULL, initialize = function(value = 1) x <<- value, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ``` ## R6 class, with `cloneable=FALSE` By default, R6 objects have a `clone()` method, which is a fairly large function. If you do not need this feature, you can save some memory by using `cloneable=FALSE`. ```{r} R6NonCloneable <- R6Class("R6NonCloneable", cloneable = FALSE, public = list( x = NULL, initialize = function(x = 1) self$x <- x, getx = function() self$x, inc = function(n = 1) self$x <- self$x + n ) ) ``` ## R6 class, without class attribute, non-portable, and non-cloneable For comparison, we'll use a an R6 class that is without a class attribute, non-portable, and non-cloneable. This is the most stripped-down we can make an R6 object. ```{r} R6Bare <- R6Class("R6Bare", portable = FALSE, class = FALSE, cloneable = FALSE, public = list( x = NULL, initialize = function(value = 1) x <<- value, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ``` ## R6 class, with public and private members This variant has public and private members. ```{r} R6Private <- R6Class("R6Private", private = list(x = NULL), public = list( initialize = function(x = 1) private$x <- x, getx = function() private$x, inc = function(n = 1) private$x <- private$x + n ) ) ``` Instead of a single `self` object which refers to all items in an object, these objects have `self` (which refers to the public items) and `private`. ```{r} R6Private$new() ``` ## R6 class, with public and private, no class attribute, non-portable, and non-cloneable For comparison, we'll add a version that is without a class attribute, non-portable, and non-cloneable. ```{r} R6PrivateBare <- R6Class("R6PrivateBare", portable = FALSE, class = FALSE, cloneable = FALSE, private = list(x = NULL), public = list( initialize = function(x = 1) private$x <- x, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ``` ## Environment created by a function call, with class attribute In R, environments are passed by reference. A simple way to create an object that's passed by reference is to use the environment created by the invocation of a function. The function below captures that environment, attaches a class to it, and returns it: ```{r} FunctionEnvClass <- function(x = 1) { inc <- function(n = 1) x <<- x + n getx <- function() x self <- environment() class(self) <- "FunctionEnvClass" self } ``` Even though `x` isn't declared in the function body, it gets captured because it's an argument to the function. ```{r} ls(FunctionEnvClass()) ``` Objects created this way are very similar to those created by `R6` generator we created above. ## Environment created by a function call, without class attribute We can make an even simpler type of reference object to the previous one, by not having a a class attribute, and not having `self` object: ```{r} FunctionEnvNoClass <- function(x = 1) { inc <- function(n = 1) x <<- x + n getx <- function() x environment() } ``` This is simply an environment with some objects in it. ```{r} ls(FunctionEnvNoClass()) ``` ***** Tests ===== For all the timings using `microbenchmark()`, the results are reported in microseconds, and the most useful value is probably the median column. ## Memory footprint ```{r echo = FALSE} # Utility functions for calculating sizes obj_size <- function(expr, .env = parent.frame()) { size_n <- function(n = 1) { objs <- lapply(1:n, function(x) eval(expr, .env)) as.numeric(do.call(object_size, objs)) } data.frame(one = size_n(1), incremental = size_n(2) - size_n(1)) } obj_sizes <- function(..., .env = parent.frame()) { exprs <- as.list(match.call(expand.dots = FALSE)$...) names(exprs) <- lapply(1:length(exprs), FUN = function(n) { name <- names(exprs)[n] if (is.null(name) || name == "") paste(deparse(exprs[[n]]), collapse = " ") else name }) sizes <- mapply(obj_size, exprs, MoreArgs = list(.env = .env), SIMPLIFY = FALSE) do.call(rbind, sizes) } ``` How much memory does a single instance of each object take, and how much memory does each additional object take? We'll use the functions `obj_size` and `obj_sizes` (shown at the bottom of this document) to calculate the sizes. Sizes of each type of object, in bytes: ```{r} sizes <- obj_sizes( RC$new(), R6$new(), R6NoClass$new(), R6NonPortable$new(), R6NonCloneable$new(), R6Bare$new(), R6Private$new(), R6PrivateBare$new(), FunctionEnvClass(), FunctionEnvNoClass() ) sizes ``` The results are plotted below. Note that the plots have very different x scales. ```{r echo = FALSE, results = 'hold'} objnames <- c( "RC", "R6", "R6NoClass", "R6NonPortable", "R6NonCloneable", "R6Bare", "R6Private", "R6PrivateBare", "FunctionEnvClass", "FunctionEnvNoClass" ) obj_labels <- objnames obj_labels[1] <- "RC (off chart)" sizes$name <- factor(objnames, levels = rev(objnames)) ggplot(sizes, aes(y = name, x = one)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(sizes$one[-1]) * 1.5), expand = c(0, 0), oob = rescale_none) + scale_y_discrete( breaks = sizes$name, labels = obj_labels) + my_theme + ggtitle("First object") ggplot(sizes, aes(y = name, x = incremental)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + scale_x_continuous(limits = c(0, max(sizes$incremental) * 1.05), expand = c(0, 0)) + geom_point(size = 2) + my_theme + ggtitle("Additional objects") ``` Some preliminary observations about the first instance of various classes: Using a reference class consumes a large amount of memory. For R6 objects, the option with the largest impact is `cloneable`: not having the `clone()` method saves around 40 kB of memory. For subsequent instances of these classes, there isn't nearly as much difference between the different kinds. It appeared that using a reference class takes up a huge amount of memory, but much of that is shared between reference classes. Adding an object from a different reference class doesn't require much more memory --- around 38KB: ```{r} RC2 <- setRefClass("RC2", fields = list(x = "numeric"), methods = list( initialize = function(x = 2) .self$x <<- x, inc = function(n = 2) x <<- x * n ) ) # Calcualte the size of a new RC2 object, over and above an RC object as.numeric(object_size(RC$new(), RC2$new()) - object_size(RC$new())) ``` ## Object instantiation speed How much time does it take to create one of these objects? This shows the median time, in microseconds: ```{r} # Function to extract the medians from microbenchmark results mb_summary <- function(x) { res <- summary(x, unit="us") data.frame(name = res$expr, median = res$median) } speed <- microbenchmark( RC$new(), R6$new(), R6NoClass$new(), R6NonPortable$new(), R6NonCloneable$new(), R6Bare$new(), R6Private$new(), R6PrivateBare$new(), FunctionEnvClass(), FunctionEnvNoClass() ) speed <- mb_summary(speed) speed ``` The plot below shows the median instantiation time. ```{r echo = FALSE, results = 'hold', fig.width = 8} speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(speed$median) * 1.05), expand = c(0, 0)) + my_theme + ggtitle("Median time to instantiate object (\u0b5s)") p ``` Reference classes are much slower to instantiate than the other types of classes. Instantiating R6 objects is roughly 5 times faster. Creating an environment with a simple function call is another 20-30 times faster. ## Field access speed How much time does it take to access a field in an object? First we'll make some objects: ```{r} rc <- RC$new() r6 <- R6$new() r6noclass <- R6NoClass$new() r6noport <- R6NonPortable$new() r6noclone <- R6NonCloneable$new() r6bare <- R6Bare$new() r6priv <- R6Private$new() r6priv_bare <- R6PrivateBare$new() fun_env <- FunctionEnvClass() fun_env_nc <- FunctionEnvNoClass() ``` And then get a value from these objects: ```{r} speed <- microbenchmark( rc$x, r6$x, r6noclass$x, r6noport$x, r6noclone$x, r6bare$x, r6priv$x, r6priv_bare$x, fun_env$x, fun_env_nc$x ) speed <- mb_summary(speed) speed ``` ```{r echo = FALSE, results = 'hold', fig.width = 8} speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(speed$median) * 1.05), expand = c(0, 0)) + my_theme + ggtitle("Median time to access field (\u0b5s)") p ``` Accessing the field of a reference class is much slower than the other methods. There's also an obvious pattern where accessing the field of an environment (created by R6 or a function call) is slower when there is a class attribute. This is because, for the objects that have a class attribute, R attempts to look up an S3 method for `$`, and this lookup has a performance penalty. We'll see more about this below. ## Field setting speed How much time does it take to set the value of a field in an object? ```{r} speed <- microbenchmark( rc$x <- 4, r6$x <- 4, r6noclass$x <- 4, r6noport$x <- 4, r6noclone$x <- 4, r6bare$x <- 4, # r6priv$x <- 4, # Can't set private field directly, # r6priv_nc_np$x <- 4, # so we'll skip these two fun_env$x <- 4, fun_env_nc$x <- 4 ) speed <- mb_summary(speed) speed ``` ```{r echo = FALSE, results = 'hold', fig.width = 8} speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(speed$median) * 1.05), expand = c(0, 0)) + my_theme + ggtitle("Median time to set field (\u0b5s)") p ``` Reference classes are significantly slower than the others, again. In this case, there's additional overhead due to type-checking the value. Once more, the no-class objects are significantly faster than the others, again probably due to attempted S3 dispatch on the `` `$<-` `` function. ## Speed of method call that accesses a field How much overhead is there when calling a method from one of these objects? All of these `getx()` methods simply return the value of `x` in the object. When necessary, this method uses `self$x` (for R6 classes, when `portable=TRUE`), and in others, it just uses `x` (when `portable=FALSE`, and in reference classes). ```{r} speed <- microbenchmark( rc$getx(), r6$getx(), r6noclass$getx(), r6noport$getx(), r6noclone$getx(), r6bare$getx(), r6priv$getx(), r6priv_bare$getx(), fun_env$getx(), fun_env_nc$getx() ) speed <- mb_summary(speed) speed ``` ```{r echo = FALSE, results = 'hold', fig.width = 8} speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + my_theme + ggtitle("Median time to call method that accesses field (\u0b5s)") p ``` The reference class is the slowest. `r6` is also somewhat slower than the others. There are two reasons for this: first, it uses `self$x` which adds some time, and second, it has a class attribute, which slows down the access of both `r6$getx` and `self$x`. One might expect `r6priv` to be the same speed as `r6`, but it is faster. Although accessing `r6priv$getx` is slow because `r6priv` has a class attribute, accessing `private$x` is faster because it does not have a class attribute. The objects which can access `x` directly (without `self` or `private`) and which lack a class attribute are the fastest. ## Assignment using `self$x <-` vs. `x <<-` With reference classes, you can modify fields using the `<<-` operator, or by using the `.self` object. For example, compare the `setx()` methods of these two classes: ```{r} RCself <- setRefClass("RCself", fields = list(x = "numeric"), methods = list( initialize = function() .self$x <- 1, setx = function(n = 2) .self$x <- n ) ) RCnoself <- setRefClass("RCnoself", fields = list(x = "numeric"), methods = list( initialize = function() x <<- 1, setx = function(n = 2) x <<- n ) ) ``` Non-portable R6 classes are similar, except they use `self` instead of `.self`. ```{r} R6self <- R6Class("R6self", portable = FALSE, public = list( x = 1, setx = function(n = 2) self$x <- n ) ) R6noself <- R6Class("R6noself", portable = FALSE, public = list( x = 1, setx = function(n = 2) x <<- n ) ) ``` ```{r} rc_self <- RCself$new() rc_noself <- RCnoself$new() r6_self <- R6self$new() r6_noself <- R6noself$new() speed <- microbenchmark( rc_self$setx(), rc_noself$setx(), r6_self$setx(), r6_noself$setx() ) speed <- mb_summary(speed) speed ``` ```{r echo = FALSE, results = 'hold', fig.width = 8} speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + my_theme + ggtitle("Assignment to a field using self vs <<- (\u0b5s)") p ``` For both reference and non-portable R6 classes, assignment using `.self$x <-` is somewhat slower than using `x <<-`. Bear in mind that, by default, R6 classes are portable, and can't use assignment with `x <<-`. ## Overhead from using `$` on objects with a class attribute There is some overhead when using `$` on an object that has a class attribute. In the test below, we'll create three different kinds of objects: 1. An environment with no class attribute. 1. An environment with a class `"e2"`, but without a `$.e2` S3 method. 1. An environment with a class `"e3"`, which has a `$.e3` S3 method that simply returns `NULL`. Each one of these environments will contain an object `x`. ```{r} e1 <- new.env(hash = FALSE, parent = emptyenv()) e2 <- new.env(hash = FALSE, parent = emptyenv()) e3 <- new.env(hash = FALSE, parent = emptyenv()) e1$x <- 1 e2$x <- 1 e3$x <- 1 class(e2) <- "e2" class(e3) <- "e3" # Define an S3 method for class e3 `$.e3` <- function(x, name) { NULL } ``` Now we can run timing tests for calling `$` on each type of object. Note that for the `e3` object, the `$` function does nothing --- it simply returns `NULL`. ```{r} speed <- microbenchmark( e1$x, e2$x, e3$x ) speed <- mb_summary(speed) speed ``` Using `$` on `e2` and `e3` is much slower than on `e1`. This is because `e2` and `e3` have a class attribute. Even though there's no `$` method defined for `e2`, doing `e2$x` still about 6 times slower than `e1$x`, simply because R looks for an appropriate S3 method. `e3$x` is slightly faster than `e2$x`; this is probably because the `$.e3` function doesn't actually do anything other than return NULL. If an object has a class attribute, R will attempt to look for a method every time `$` is called. This can slow things down considerably, if `$` is used often. ## Lists vs. environments, and `$` vs. `[[` Lists could also be used for creating classes (albeit not with reference semantics). How much time does it take to access items using `$` for lists vs. environments? We'll also compare using `obj$x` to `obj[['x']]`. ```{r} lst <- list(x = 10) env <- new.env() env$x <- 10 mb_summary(microbenchmark( lst = lst$x, env = env$x, lst[['x']], env[['x']] )) ``` Performance is comparable across environments and lists. The `[[` operator is slightly faster than `$`, probably because it doesn't need to convert the unevaluated symbol to a string. ***** Wrap-up ======= R6 objects take less memory and are significantly faster than R's reference class objects, and they also have some options that provide for even more speed. In these tests, the biggest speedup for R6 classes comes from not using a class attribute; this speeds up the use of `$`. Non-portable R6 classes can also access fields without `$` at all, which provides another modest speed boost. In most cases, these speed increases are negligible -- they are on the order of microseconds and will be noticeable only when tens or even hundreds of thousands of class member accesses are performed. ***** Appendix ======== ## Functions for calculating object sizes ```{r eval=FALSE} # Utility functions for calculating sizes obj_size <- function(expr, .env = parent.frame()) { size_n <- function(n = 1) { objs <- lapply(1:n, function(x) eval(expr, .env)) as.numeric(do.call(object_size, objs)) } data.frame(one = size_n(1), incremental = size_n(2) - size_n(1)) } obj_sizes <- function(..., .env = parent.frame()) { exprs <- as.list(match.call(expand.dots = FALSE)$...) names(exprs) <- lapply(1:length(exprs), FUN = function(n) { name <- names(exprs)[n] if (is.null(name) || name == "") paste(deparse(exprs[[n]]), collapse = " ") else name }) sizes <- mapply(obj_size, exprs, MoreArgs = list(.env = .env), SIMPLIFY = FALSE) do.call(rbind, sizes) } ``` ## System information ```{r} sessionInfo() ``` R6/inst/doc/Introduction.R0000644000176200001440000002356113117561007015077 0ustar liggesusers## ----echo = FALSE-------------------------------------------------------- library(pryr) knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ## ------------------------------------------------------------------------ library(R6) Person <- R6Class("Person", public = list( name = NULL, hair = NULL, initialize = function(name = NA, hair = NA) { self$name <- name self$hair <- hair self$greet() }, set_hair = function(val) { self$hair <- val }, greet = function() { cat(paste0("Hello, my name is ", self$name, ".\n")) } ) ) ## ------------------------------------------------------------------------ ann <- Person$new("Ann", "black") ann ## ------------------------------------------------------------------------ ann$hair ann$greet() ann$set_hair("red") ann$hair ## ------------------------------------------------------------------------ Queue <- R6Class("Queue", public = list( initialize = function(...) { for (item in list(...)) { self$add(item) } }, add = function(x) { private$queue <- c(private$queue, list(x)) invisible(self) }, remove = function() { if (private$length() == 0) return(NULL) # Can use private$queue for explicit access head <- private$queue[[1]] private$queue <- private$queue[-1] head } ), private = list( queue = list(), length = function() base::length(private$queue) ) ) q <- Queue$new(5, 6, "foo") ## ------------------------------------------------------------------------ # Add and remove items q$add("something") q$add("another thing") q$add(17) q$remove() q$remove() ## ----eval = FALSE-------------------------------------------------------- # q$queue # #> NULL # q$length() # #> Error: attempt to apply non-function ## ------------------------------------------------------------------------ q$add(10)$add(11)$add(12) ## ------------------------------------------------------------------------ q$remove() q$remove() q$remove() q$remove() ## ------------------------------------------------------------------------ Numbers <- R6Class("Numbers", public = list( x = 100 ), active = list( x2 = function(value) { if (missing(value)) return(self$x * 2) else self$x <- value/2 }, rand = function() rnorm(1) ) ) n <- Numbers$new() n$x ## ------------------------------------------------------------------------ n$x2 ## ------------------------------------------------------------------------ n$x2 <- 1000 n$x ## ----eval=FALSE---------------------------------------------------------- # n$rand # #> [1] 0.2648 # n$rand # #> [1] 2.171 # n$rand <- 3 # #> Error: unused argument (quote(3)) ## ------------------------------------------------------------------------ # Note that this isn't very efficient - it's just for illustrating inheritance. HistoryQueue <- R6Class("HistoryQueue", inherit = Queue, public = list( show = function() { cat("Next item is at index", private$head_idx + 1, "\n") for (i in seq_along(private$queue)) { cat(i, ": ", private$queue[[i]], "\n", sep = "") } }, remove = function() { if (private$length() - private$head_idx == 0) return(NULL) private$head_idx <<- private$head_idx + 1 private$queue[[private$head_idx]] } ), private = list( head_idx = 0 ) ) hq <- HistoryQueue$new(5, 6, "foo") hq$show() hq$remove() hq$show() hq$remove() ## ------------------------------------------------------------------------ CountingQueue <- R6Class("CountingQueue", inherit = Queue, public = list( add = function(x) { private$total <<- private$total + 1 super$add(x) }, get_total = function() private$total ), private = list( total = 0 ) ) cq <- CountingQueue$new("x", "y") cq$get_total() cq$add("z") cq$remove() cq$remove() cq$get_total() ## ------------------------------------------------------------------------ SimpleClass <- R6Class("SimpleClass", public = list(x = NULL) ) SharedField <- R6Class("SharedField", public = list( e = SimpleClass$new() ) ) s1 <- SharedField$new() s1$e$x <- 1 s2 <- SharedField$new() s2$e$x <- 2 # Changing s2$e$x has changed the value of s1$e$x s1$e$x ## ------------------------------------------------------------------------ NonSharedField <- R6Class("NonSharedField", public = list( e = NULL, initialize = function() self$e <- SimpleClass$new() ) ) n1 <- NonSharedField$new() n1$e$x <- 1 n2 <- NonSharedField$new() n2$e$x <- 2 # n2$e$x does not affect n1$e$x n1$e$x ## ------------------------------------------------------------------------ RC <- setRefClass("RC", fields = list(x = 'ANY'), methods = list( getx = function() x, setx = function(value) x <<- value ) ) rc <- RC$new() rc$setx(10) rc$getx() ## ------------------------------------------------------------------------ NP <- R6Class("NP", portable = FALSE, public = list( x = NA, getx = function() x, setx = function(value) x <<- value ) ) np <- NP$new() np$setx(10) np$getx() ## ------------------------------------------------------------------------ P <- R6Class("P", portable = TRUE, # This is default public = list( x = NA, getx = function() self$x, setx = function(value) self$x <- value ) ) p <- P$new() p$setx(10) p$getx() ## ------------------------------------------------------------------------ Simple <- R6Class("Simple", public = list( x = 1, getx = function() self$x ) ) Simple$set("public", "getx2", function() self$x*2) # To replace an existing member, use overwrite=TRUE Simple$set("public", "x", 10, overwrite = TRUE) s <- Simple$new() s$x s$getx2() ## ------------------------------------------------------------------------ # Create a locked class Simple <- R6Class("Simple", public = list( x = 1, getx = function() self$x ), lock_class = TRUE ) # This would result in an error # Simple$set("public", "y", 2) # Unlock the class Simple$unlock() # Now it works Simple$set("public", "y", 2) # Lock the class again Simple$lock() ## ------------------------------------------------------------------------ Simple <- R6Class("Simple", public = list( x = 1, getx = function() self$x ) ) s <- Simple$new() # Create a clone s1 <- s$clone() # Modify it s1$x <- 2 s1$getx() # Original is unaffected by changes to the clone s$getx() ## ----clone-size, echo=FALSE---------------------------------------------- # Calculate size of clone method in this block. Cloneable <- R6Class("Cloneable", cloneable = TRUE) NonCloneable <- R6Class("NonCloneable", cloneable = FALSE) c1 <- Cloneable$new() c2 <- Cloneable$new() # Bytes for each new cloneable object cloneable_delta <- object_size(c1, c2) - object_size(c2) nc1 <- NonCloneable$new() nc2 <- NonCloneable$new() # Bytes for each new noncloneable object noncloneable_delta <- object_size(nc1, nc2) - object_size(nc2) # Number of bytes used by each copy of clone method additional_clone_method_bytes <- cloneable_delta - noncloneable_delta additional_clone_method_bytes_str <- capture.output(print(additional_clone_method_bytes)) # Number of bytes used by first copy of a clone method first_clone_method_bytes <- object_size(c1) - object_size(nc1) # Need some trickery to get the nice output from pryr::print.bytes first_clone_method_bytes_str <- capture.output(print(first_clone_method_bytes)) ## ------------------------------------------------------------------------ Simple <- R6Class("Simple", public = list(x = 1)) Cloneable <- R6Class("Cloneable", public = list( s = NULL, initialize = function() self$s <- Simple$new() ) ) c1 <- Cloneable$new() c2 <- c1$clone() # Change c1's `s` field c1$s$x <- 2 # c2's `s` is the same object, so it reflects the change c2$s$x ## ------------------------------------------------------------------------ c3 <- c1$clone(deep = TRUE) # Change c1's `s` field c1$s$x <- 3 # c2's `s` is different c3$s$x ## ------------------------------------------------------------------------ CloneEnv <- R6Class("CloneEnv", public = list( a = NULL, b = NULL, v = 1, initialize = function() { self$a <- new.env(parent = emptyenv()) self$b <- new.env(parent = emptyenv()) self$a$x <- 1 self$b$x <- 1 } ), private = list( deep_clone = function(name, value) { # With x$clone(deep=TRUE) is called, the deep_clone gets invoked once for # each field, with the name and value. if (name == "a") { # `a` is an environment, so use this quick way of copying list2env(as.list.environment(value, all.names = TRUE), parent = emptyenv()) } else { # For all other fields, just return the value value } } ) ) c1 <- CloneEnv$new() c2 <- c1$clone(deep = TRUE) ## ------------------------------------------------------------------------ # Modifying c1$a doesn't affect c2$a, because they're separate objects c1$a$x <- 2 c2$a$x # Modifying c1$b does affect c2$b, because they're the same object c1$b$x <- 3 c2$b$x # Modifying c1$v doesn't affect c2$v, because they're not reference objects c1$v <- 4 c2$v ## ------------------------------------------------------------------------ PrettyCountingQueue <- R6Class("PrettyCountingQueue", inherit = CountingQueue, public = list( print = function(...) { cat(" of ", self$get_total(), " elements\n", sep = "") invisible(self) } ) ) ## ------------------------------------------------------------------------ pq <- PrettyCountingQueue$new(1, 2, "foobar") pq ## ------------------------------------------------------------------------ A <- R6Class("A", public = list( finalize = function() { print("Finalizer has been called!") } )) # Instantiate an object: obj <- A$new() # Remove the single existing reference to it, and force garbage collection # (normally garbage collection will happen automatically from time # to time) rm(obj); gc() R6/inst/doc/Performance.R0000644000176200001440000003421513117561012014651 0ustar liggesusers## ----echo = FALSE-------------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 3.9, fig.height = 3.5) # Make sure vignette doesn't error on platforms where microbenchmark is not present. if (requireNamespace("microbenchmark", quietly = TRUE)) { library(microbenchmark) # Only print 3 significant digits print_microbenchmark <- function (x, unit, order = NULL, ...) { s <- summary(x, unit = unit) cat("Unit: ", attr(s, "unit"), "\n", sep = "") timing_cols <- c("min", "lq", "median", "uq", "max") s[timing_cols] <- lapply(s[timing_cols], signif, digits = 3) s[timing_cols] <- lapply(s[timing_cols], format, big.mark = ",") print(s, ..., row.names = FALSE) } assignInNamespace("print.microbenchmark", print_microbenchmark, "microbenchmark") } else { # Some dummy functions so that the vignette doesn't throw an error. microbenchmark <- function(...) { structure(list(), class = "microbenchmark_dummy") } summary.microbenchmark_dummy <- function(object, ...) { data.frame(expr = "", median = 0) } } ## ----eval = FALSE-------------------------------------------------------- # library(microbenchmark) # options(microbenchmark.unit = "us") # library(pryr) # For object_size function # library(R6) ## ----echo = FALSE-------------------------------------------------------- # The previous code block is just for appearances. This code block is the one # that gets run. The loading of microbenchmark must be conditional because it is # not available on all platforms. if (requireNamespace("microbenchmark", quietly = TRUE)) { library(microbenchmark) } options(microbenchmark.unit = "us") library(pryr) # For object_size function library(R6) ## ----echo=FALSE---------------------------------------------------------- library(ggplot2) library(scales) # Set up ggplot2 theme my_theme <- theme_bw(base_size = 10) + theme(axis.title.x = element_blank(), axis.title.y = element_blank(), panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank() ) ## ------------------------------------------------------------------------ RC <- setRefClass("RC", fields = list(x = "numeric"), methods = list( initialize = function(x = 1) .self$x <- x, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ## ------------------------------------------------------------------------ RC$new() ## ------------------------------------------------------------------------ R6 <- R6Class("R6", public = list( x = NULL, initialize = function(x = 1) self$x <- x, getx = function() self$x, inc = function(n = 1) self$x <- x + n ) ) ## ------------------------------------------------------------------------ R6$new() ## ------------------------------------------------------------------------ R6NoClass <- R6Class("R6NoClass", class = FALSE, public = list( x = NULL, initialize = function(x = 1) self$x <- x, getx = function() self$x, inc = function(n = 1) self$x <- self$x + n ) ) ## ------------------------------------------------------------------------ R6NonPortable <- R6Class("R6NonPortable", portable = FALSE, public = list( x = NULL, initialize = function(value = 1) x <<- value, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ## ------------------------------------------------------------------------ R6NonCloneable <- R6Class("R6NonCloneable", cloneable = FALSE, public = list( x = NULL, initialize = function(x = 1) self$x <- x, getx = function() self$x, inc = function(n = 1) self$x <- self$x + n ) ) ## ------------------------------------------------------------------------ R6Bare <- R6Class("R6Bare", portable = FALSE, class = FALSE, cloneable = FALSE, public = list( x = NULL, initialize = function(value = 1) x <<- value, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ## ------------------------------------------------------------------------ R6Private <- R6Class("R6Private", private = list(x = NULL), public = list( initialize = function(x = 1) private$x <- x, getx = function() private$x, inc = function(n = 1) private$x <- private$x + n ) ) ## ------------------------------------------------------------------------ R6Private$new() ## ------------------------------------------------------------------------ R6PrivateBare <- R6Class("R6PrivateBare", portable = FALSE, class = FALSE, cloneable = FALSE, private = list(x = NULL), public = list( initialize = function(x = 1) private$x <- x, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ## ------------------------------------------------------------------------ FunctionEnvClass <- function(x = 1) { inc <- function(n = 1) x <<- x + n getx <- function() x self <- environment() class(self) <- "FunctionEnvClass" self } ## ------------------------------------------------------------------------ ls(FunctionEnvClass()) ## ------------------------------------------------------------------------ FunctionEnvNoClass <- function(x = 1) { inc <- function(n = 1) x <<- x + n getx <- function() x environment() } ## ------------------------------------------------------------------------ ls(FunctionEnvNoClass()) ## ----echo = FALSE-------------------------------------------------------- # Utility functions for calculating sizes obj_size <- function(expr, .env = parent.frame()) { size_n <- function(n = 1) { objs <- lapply(1:n, function(x) eval(expr, .env)) as.numeric(do.call(object_size, objs)) } data.frame(one = size_n(1), incremental = size_n(2) - size_n(1)) } obj_sizes <- function(..., .env = parent.frame()) { exprs <- as.list(match.call(expand.dots = FALSE)$...) names(exprs) <- lapply(1:length(exprs), FUN = function(n) { name <- names(exprs)[n] if (is.null(name) || name == "") paste(deparse(exprs[[n]]), collapse = " ") else name }) sizes <- mapply(obj_size, exprs, MoreArgs = list(.env = .env), SIMPLIFY = FALSE) do.call(rbind, sizes) } ## ------------------------------------------------------------------------ sizes <- obj_sizes( RC$new(), R6$new(), R6NoClass$new(), R6NonPortable$new(), R6NonCloneable$new(), R6Bare$new(), R6Private$new(), R6PrivateBare$new(), FunctionEnvClass(), FunctionEnvNoClass() ) sizes ## ----echo = FALSE, results = 'hold'-------------------------------------- objnames <- c( "RC", "R6", "R6NoClass", "R6NonPortable", "R6NonCloneable", "R6Bare", "R6Private", "R6PrivateBare", "FunctionEnvClass", "FunctionEnvNoClass" ) obj_labels <- objnames obj_labels[1] <- "RC (off chart)" sizes$name <- factor(objnames, levels = rev(objnames)) ggplot(sizes, aes(y = name, x = one)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(sizes$one[-1]) * 1.5), expand = c(0, 0), oob = rescale_none) + scale_y_discrete( breaks = sizes$name, labels = obj_labels) + my_theme + ggtitle("First object") ggplot(sizes, aes(y = name, x = incremental)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + scale_x_continuous(limits = c(0, max(sizes$incremental) * 1.05), expand = c(0, 0)) + geom_point(size = 2) + my_theme + ggtitle("Additional objects") ## ------------------------------------------------------------------------ RC2 <- setRefClass("RC2", fields = list(x = "numeric"), methods = list( initialize = function(x = 2) .self$x <<- x, inc = function(n = 2) x <<- x * n ) ) # Calcualte the size of a new RC2 object, over and above an RC object as.numeric(object_size(RC$new(), RC2$new()) - object_size(RC$new())) ## ------------------------------------------------------------------------ # Function to extract the medians from microbenchmark results mb_summary <- function(x) { res <- summary(x, unit="us") data.frame(name = res$expr, median = res$median) } speed <- microbenchmark( RC$new(), R6$new(), R6NoClass$new(), R6NonPortable$new(), R6NonCloneable$new(), R6Bare$new(), R6Private$new(), R6PrivateBare$new(), FunctionEnvClass(), FunctionEnvNoClass() ) speed <- mb_summary(speed) speed ## ----echo = FALSE, results = 'hold', fig.width = 8----------------------- speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(speed$median) * 1.05), expand = c(0, 0)) + my_theme + ggtitle("Median time to instantiate object (\u0b5s)") p ## ------------------------------------------------------------------------ rc <- RC$new() r6 <- R6$new() r6noclass <- R6NoClass$new() r6noport <- R6NonPortable$new() r6noclone <- R6NonCloneable$new() r6bare <- R6Bare$new() r6priv <- R6Private$new() r6priv_bare <- R6PrivateBare$new() fun_env <- FunctionEnvClass() fun_env_nc <- FunctionEnvNoClass() ## ------------------------------------------------------------------------ speed <- microbenchmark( rc$x, r6$x, r6noclass$x, r6noport$x, r6noclone$x, r6bare$x, r6priv$x, r6priv_bare$x, fun_env$x, fun_env_nc$x ) speed <- mb_summary(speed) speed ## ----echo = FALSE, results = 'hold', fig.width = 8----------------------- speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(speed$median) * 1.05), expand = c(0, 0)) + my_theme + ggtitle("Median time to access field (\u0b5s)") p ## ------------------------------------------------------------------------ speed <- microbenchmark( rc$x <- 4, r6$x <- 4, r6noclass$x <- 4, r6noport$x <- 4, r6noclone$x <- 4, r6bare$x <- 4, # r6priv$x <- 4, # Can't set private field directly, # r6priv_nc_np$x <- 4, # so we'll skip these two fun_env$x <- 4, fun_env_nc$x <- 4 ) speed <- mb_summary(speed) speed ## ----echo = FALSE, results = 'hold', fig.width = 8----------------------- speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(speed$median) * 1.05), expand = c(0, 0)) + my_theme + ggtitle("Median time to set field (\u0b5s)") p ## ------------------------------------------------------------------------ speed <- microbenchmark( rc$getx(), r6$getx(), r6noclass$getx(), r6noport$getx(), r6noclone$getx(), r6bare$getx(), r6priv$getx(), r6priv_bare$getx(), fun_env$getx(), fun_env_nc$getx() ) speed <- mb_summary(speed) speed ## ----echo = FALSE, results = 'hold', fig.width = 8----------------------- speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + my_theme + ggtitle("Median time to call method that accesses field (\u0b5s)") p ## ------------------------------------------------------------------------ RCself <- setRefClass("RCself", fields = list(x = "numeric"), methods = list( initialize = function() .self$x <- 1, setx = function(n = 2) .self$x <- n ) ) RCnoself <- setRefClass("RCnoself", fields = list(x = "numeric"), methods = list( initialize = function() x <<- 1, setx = function(n = 2) x <<- n ) ) ## ------------------------------------------------------------------------ R6self <- R6Class("R6self", portable = FALSE, public = list( x = 1, setx = function(n = 2) self$x <- n ) ) R6noself <- R6Class("R6noself", portable = FALSE, public = list( x = 1, setx = function(n = 2) x <<- n ) ) ## ------------------------------------------------------------------------ rc_self <- RCself$new() rc_noself <- RCnoself$new() r6_self <- R6self$new() r6_noself <- R6noself$new() speed <- microbenchmark( rc_self$setx(), rc_noself$setx(), r6_self$setx(), r6_noself$setx() ) speed <- mb_summary(speed) speed ## ----echo = FALSE, results = 'hold', fig.width = 8----------------------- speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + my_theme + ggtitle("Assignment to a field using self vs <<- (\u0b5s)") p ## ------------------------------------------------------------------------ e1 <- new.env(hash = FALSE, parent = emptyenv()) e2 <- new.env(hash = FALSE, parent = emptyenv()) e3 <- new.env(hash = FALSE, parent = emptyenv()) e1$x <- 1 e2$x <- 1 e3$x <- 1 class(e2) <- "e2" class(e3) <- "e3" # Define an S3 method for class e3 `$.e3` <- function(x, name) { NULL } ## ------------------------------------------------------------------------ speed <- microbenchmark( e1$x, e2$x, e3$x ) speed <- mb_summary(speed) speed ## ------------------------------------------------------------------------ lst <- list(x = 10) env <- new.env() env$x <- 10 mb_summary(microbenchmark( lst = lst$x, env = env$x, lst[['x']], env[['x']] )) ## ----eval=FALSE---------------------------------------------------------- # # Utility functions for calculating sizes # obj_size <- function(expr, .env = parent.frame()) { # size_n <- function(n = 1) { # objs <- lapply(1:n, function(x) eval(expr, .env)) # as.numeric(do.call(object_size, objs)) # } # # data.frame(one = size_n(1), incremental = size_n(2) - size_n(1)) # } # # obj_sizes <- function(..., .env = parent.frame()) { # exprs <- as.list(match.call(expand.dots = FALSE)$...) # names(exprs) <- lapply(1:length(exprs), # FUN = function(n) { # name <- names(exprs)[n] # if (is.null(name) || name == "") paste(deparse(exprs[[n]]), collapse = " ") # else name # }) # # sizes <- mapply(obj_size, exprs, MoreArgs = list(.env = .env), SIMPLIFY = FALSE) # do.call(rbind, sizes) # } ## ------------------------------------------------------------------------ sessionInfo() R6/inst/doc/Introduction.html0000644000176200001440000021642513117561007015645 0ustar liggesusers Introduction to R6 classes

Introduction to R6 classes

The R6 package provides a type of class which is similar to R’s standard reference classes, but it is more efficient and doesn’t depend on S4 classes and the methods package.

R6 classes

R6 classes are similar to R’s standard reference classes, but are lighter weight, and avoid some issues that come along with using S4 classes (R’s reference classes are based on S4). For more information about speed and memory footprint, see the Performance vignette.

Unlike many objects in R, instances (objects) of R6 classes have reference semantics. R6 classes also support:

  • public and private methods
  • active bindings
  • inheritance (superclasses) which works across packages

Why the name R6? When R’s reference classes were introduced, some users, following the names of R’s existing class systems S3 and S4, called the new class system R5 in jest. Although reference classes are not actually called R5, the name of this package and its classes takes inspiration from that name.

The name R5 was also a code-name used for a different object system started by Simon Urbanek, meant to solve some issues with S4 relating to syntax and performance. However, the R5 branch was shelved after a little development, and it was never released.

Basics

Here’s how to create a simple R6 class. The public argument is a list of items, which can be functions and fields (non-functions). Functions will be used as methods.

library(R6)

Person <- R6Class("Person",
  public = list(
    name = NULL,
    hair = NULL,
    initialize = function(name = NA, hair = NA) {
      self$name <- name
      self$hair <- hair
      self$greet()
    },
    set_hair = function(val) {
      self$hair <- val
    },
    greet = function() {
      cat(paste0("Hello, my name is ", self$name, ".\n"))
    }
  )
)

To instantiate an object of this class, use $new():

ann <- Person$new("Ann", "black")
#> Hello, my name is Ann.
ann
#> <Person>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     greet: function () 
#>     hair: black
#>     initialize: function (name = NA, hair = NA) 
#>     name: Ann
#>     set_hair: function (val)

The $new() method creates the object and calls the initialize() method, if it exists.

Inside methods of the class, self refers to the object. Public members of the object (all you’ve seen so far) are accessed with self$x, and assignment is done with self$x <- y. Note that by default, self is required to access members, although for non-portable classes which we’ll see later, it is optional.

Once the object is instantiated, you can access values and methods with $:

ann$hair
#> [1] "black"
ann$greet()
#> Hello, my name is Ann.
ann$set_hair("red")
ann$hair
#> [1] "red"

Implementation note: The external face of an R6 object is basically an environment with the public members in it. This is also known as the public environment. An R6 object’s methods have a separate enclosing environment which, roughly speaking, is the environment they “run in”. This is where self binding is found, and it is simply a reference back to public environment.

Private members

In the previous example, all the members were public. It’s also possible to add private members:

Queue <- R6Class("Queue",
  public = list(
    initialize = function(...) {
      for (item in list(...)) {
        self$add(item)
      }
    },
    add = function(x) {
      private$queue <- c(private$queue, list(x))
      invisible(self)
    },
    remove = function() {
      if (private$length() == 0) return(NULL)
      # Can use private$queue for explicit access
      head <- private$queue[[1]]
      private$queue <- private$queue[-1]
      head
    }
  ),
  private = list(
    queue = list(),
    length = function() base::length(private$queue)
  )
)

q <- Queue$new(5, 6, "foo")

Whereas public members are accessed with self, like self$add(), private members are accessed with private, like private$queue.

The public members can be accessed as usual:

# Add and remove items
q$add("something")
q$add("another thing")
q$add(17)
q$remove()
#> [1] 5
q$remove()
#> [1] 6

However, private members can’t be accessed directly:

q$queue
#> NULL
q$length()
#> Error: attempt to apply non-function

A useful design pattern is for methods to return self (invisibly) when possible, because it makes them chainable. For example, the add() method returns self so you can chain them together:

q$add(10)$add(11)$add(12)

On the other hand, remove() returns the value removed, so it’s not chainable:

q$remove()
#> [1] "foo"
q$remove()
#> [1] "something"
q$remove()
#> [1] "another thing"
q$remove()
#> [1] 17

Active bindings

Active bindings look like fields, but each time they are accessed, they call a function. They are always publicly visible.

Numbers <- R6Class("Numbers",
  public = list(
    x = 100
  ),
  active = list(
    x2 = function(value) {
      if (missing(value)) return(self$x * 2)
      else self$x <- value/2
    },
    rand = function() rnorm(1)
  )
)

n <- Numbers$new()
n$x
#> [1] 100

When an active binding is accessed as if reading a value, it calls the function with value as a missing argument:

n$x2
#> [1] 200

When it’s accessed as if assigning a value, it uses the assignment value as the value argument:

n$x2 <- 1000
n$x
#> [1] 500

If the function takes no arguments, it’s not possible to use it with <-:

n$rand
#> [1] 0.2648
n$rand
#> [1] 2.171
n$rand <- 3
#> Error: unused argument (quote(3))

Implementation note: Active bindings are bound in the public environment. The enclosing environment for these functions is also the public environment.

Inheritance

One R6 class can inherit from another. In other words, you can have super- and sub-classes.

Subclasses can have additional methods, and they can also have methods that override the superclass methods. In this example of a queue that retains its history, we’ll add a show() method and override the remove() method:

# Note that this isn't very efficient - it's just for illustrating inheritance.
HistoryQueue <- R6Class("HistoryQueue",
  inherit = Queue,
  public = list(
    show = function() {
      cat("Next item is at index", private$head_idx + 1, "\n")
      for (i in seq_along(private$queue)) {
        cat(i, ": ", private$queue[[i]], "\n", sep = "")
      }
    },
    remove = function() {
      if (private$length() - private$head_idx == 0) return(NULL)
      private$head_idx <<- private$head_idx + 1
      private$queue[[private$head_idx]]
    }
  ),
  private = list(
    head_idx = 0
  )
)

hq <- HistoryQueue$new(5, 6, "foo")
hq$show()
#> Next item is at index 1 
#> 1: 5
#> 2: 6
#> 3: foo
hq$remove()
#> [1] 5
hq$show()
#> Next item is at index 2 
#> 1: 5
#> 2: 6
#> 3: foo
hq$remove()
#> [1] 6

Superclass methods can be called with super$xx(). The CountingQueue (example below) keeps a count of the total number of objects that have ever been added to the queue. It does this by overriding the add() method – it increments a counter and then calls the superclass’s add() method, with super$add(x):

CountingQueue <- R6Class("CountingQueue",
  inherit = Queue,
  public = list(
    add = function(x) {
      private$total <<- private$total + 1
      super$add(x)
    },
    get_total = function() private$total
  ),
  private = list(
    total = 0
  )
)

cq <- CountingQueue$new("x", "y")
cq$get_total()
#> [1] 2
cq$add("z")
cq$remove()
#> [1] "x"
cq$remove()
#> [1] "y"
cq$get_total()
#> [1] 3

Fields containing reference objects

If your R6 class contains any fields that also have reference semantics (e.g., other R6 objects, and environments), those fields should be populated in the initialize method. If the field set to the reference object directly in the class definition, that object will be shared across all instances of the R6 objects. Here’s an example:

SimpleClass <- R6Class("SimpleClass",
  public = list(x = NULL)
)

SharedField <- R6Class("SharedField",
  public = list(
    e = SimpleClass$new()
  )
)

s1 <- SharedField$new()
s1$e$x <- 1

s2 <- SharedField$new()
s2$e$x <- 2

# Changing s2$e$x has changed the value of s1$e$x
s1$e$x
#> [1] 2

To avoid this, populate the field in the initialize method:

NonSharedField <- R6Class("NonSharedField",
  public = list(
    e = NULL,
    initialize = function() self$e <- SimpleClass$new()
  )
)

n1 <- NonSharedField$new()
n1$e$x <- 1

n2 <- NonSharedField$new()
n2$e$x <- 2

# n2$e$x does not affect n1$e$x
n1$e$x
#> [1] 1

Portable and non-portable classes

In R6 version 1.0.1, the default was to create non-portable classes. In subsequent versions, the default is to create portable classes. The two most noticeable differences are that portable classes:

  • Support inheritance across different packages. Non-portable classes do not do this very well.
  • Always require the use of self and private to access members, as in self$x and private$y. Non-portable classes can access these members with just x and y, and do assignment to these members with the <<- operator.

The implementation of the first point is such that it makes the second point necessary.

Using self and <<-

With reference classes, you can access the field without self, and assign to fields using <<-. For example:

RC <- setRefClass("RC",
  fields = list(x = 'ANY'),
  methods = list(
    getx = function() x,
    setx = function(value) x <<- value
  )
)

rc <- RC$new()
rc$setx(10)
rc$getx()
#> [1] 10

The same is true for non-portable R6 classes:

NP <- R6Class("NP",
  portable = FALSE,
  public = list(
    x = NA,
    getx = function() x,
    setx = function(value) x <<- value
  )
)

np <- NP$new()
np$setx(10)
np$getx()
#> [1] 10

But for portable R6 classes (this is the default), you must use self and/or private, and <<- assignment doesn’t work – unless you use self, of course:

P <- R6Class("P",
  portable = TRUE,  # This is default
  public = list(
    x = NA,
    getx = function() self$x,
    setx = function(value) self$x <- value
  )
)

p <- P$new()
p$setx(10)
p$getx()
#> [1] 10

For more information, see the Portable vignette.

Other topics

Adding members to an existing class

It is sometimes useful to add members to a class after the class has already been created. This can be done using the $set() method on the generator object.

Simple <- R6Class("Simple",
  public = list(
    x = 1,
    getx = function() self$x
  )
)

Simple$set("public", "getx2", function() self$x*2)

# To replace an existing member, use overwrite=TRUE
Simple$set("public", "x", 10, overwrite = TRUE)

s <- Simple$new()
s$x
#> [1] 10
s$getx2()
#> [1] 20

The new members will be present only in instances that are created after $set() has been called.

To prevent modification of a class, you can use lock_class=TRUE when creating the class. You can also lock and unlock a class as follows:

# Create a locked class
Simple <- R6Class("Simple",
  public = list(
    x = 1,
    getx = function() self$x
  ),
  lock_class = TRUE
)

# This would result in an error
# Simple$set("public", "y", 2)

# Unlock the class
Simple$unlock()

# Now it works
Simple$set("public", "y", 2)

# Lock the class again
Simple$lock()

Cloning objects

By default, R6 objects have method named clone for making a copy of the object.

Simple <- R6Class("Simple",
  public = list(
    x = 1,
    getx = function() self$x
  )
)

s <- Simple$new()

# Create a clone
s1 <- s$clone()
# Modify it
s1$x <- 2
s1$getx()
#> [1] 2

# Original is unaffected by changes to the clone
s$getx()
#> [1] 1

If you don’t want a clone method to be added, you can use cloneable=FALSE when creating the class. If any loaded R6 object has a clone method, that function uses 48.1 kB, but for each additional object, the clone method costs a trivial amount of space (112 bytes).

Deep cloning

If there are any fields which are objects with reference sematics (environments, R6 objects, reference class objects), the copy will get a reference to the same object. This is sometimes desirable, but often it is not.

For example, we’ll create an object c1 which contains another R6 object, s, and then clone it. Because the original’s and the clone’s s fields both refer to the same object, modifying it from one results in a change that is reflect in the other.

Simple <- R6Class("Simple", public = list(x = 1))

Cloneable <- R6Class("Cloneable",
  public = list(
    s = NULL,
    initialize = function() self$s <- Simple$new()
  )
)

c1 <- Cloneable$new()
c2 <- c1$clone()

# Change c1's `s` field
c1$s$x <- 2

# c2's `s` is the same object, so it reflects the change
c2$s$x
#> [1] 2

To make it so the clone receives a copy of s, we can use the deep=TRUE option:

c3 <- c1$clone(deep = TRUE)

# Change c1's `s` field
c1$s$x <- 3

# c2's `s` is different
c3$s$x
#> [1] 2

The default behavior of clone(deep=TRUE) is to copy fields which are R6 objects, but not copy fields which are environments, reference class objects, or other data structures which contain other reference-type objects (for example, a list with an R6 object).

If your R6 object contains these types of objects and you want to make a deep clone of them, you must provide your own function for deep cloning, in a private method named deep_clone. Below is an example of an R6 object with two fields, a and b, both of which which are environments, and both of which contain a value x. It also has a field v which is a regular (non-reference) value, and a private deep_clone method.

The deep_clone method is be called once for each field. It is passed the name and value of the field, and the value it returns is be used in the clone.

CloneEnv <- R6Class("CloneEnv",
  public = list(
    a = NULL,
    b = NULL,
    v = 1,
    initialize = function() {
      self$a <- new.env(parent = emptyenv())
      self$b <- new.env(parent = emptyenv())
      self$a$x <- 1
      self$b$x <- 1
    }
  ),
  private = list(
    deep_clone = function(name, value) {
      # With x$clone(deep=TRUE) is called, the deep_clone gets invoked once for
      # each field, with the name and value.
      if (name == "a") {
        # `a` is an environment, so use this quick way of copying
        list2env(as.list.environment(value, all.names = TRUE),
                 parent = emptyenv())
      } else {
        # For all other fields, just return the value
        value
      }
    }
  )
)

c1 <- CloneEnv$new()
c2 <- c1$clone(deep = TRUE)

When c1$clone(deep=TRUE) is called, the deep_clone method is called for each field in c1, and is passed the name of the field and value. In our version, the a environment gets copied, but b does not, nor does v (but that doesn’t matter since v is not a reference object). We can test out the clone:

# Modifying c1$a doesn't affect c2$a, because they're separate objects
c1$a$x <- 2
c2$a$x
#> [1] 1

# Modifying c1$b does affect c2$b, because they're the same object
c1$b$x <- 3
c2$b$x
#> [1] 3

# Modifying c1$v doesn't affect c2$v, because they're not reference objects
c1$v <- 4
c2$v
#> [1] 1

In the example deep_clone method above, we checked the name of each field to determine what to do with it, but we could also check the value, by using inherits(value, "R6"), or is.environment(), and so on.

Printing R6 objects to the screen

R6 objects have a default print method that lists all members of the object. If a class defines a print method, then it overrides the default one.

PrettyCountingQueue <- R6Class("PrettyCountingQueue",
  inherit = CountingQueue,
  public = list(
    print = function(...) {
      cat("<PrettyCountingQueue> of ", self$get_total(), " elements\n", sep = "")
      invisible(self)
    }
  )
)
pq <- PrettyCountingQueue$new(1, 2, "foobar")
pq
#> <PrettyCountingQueue> of 3 elements

Finalizers

Sometimes it’s useful to run a function when the object is garbage collected. For example, you may want to make sure a file or database connection gets closed. To do this, you can define a finalize() method, which will be called with no arguments when the object is garbage collected.

A <- R6Class("A", public = list(
  finalize = function() {
    print("Finalizer has been called!")
  }
))


# Instantiate an object:
obj <- A$new()

# Remove the single existing reference to it, and force garbage collection
# (normally garbage collection will happen automatically from time
# to time)
rm(obj); gc()
#> [1] "Finalizer has been called!"
#>           used (Mb) gc trigger (Mb) max used (Mb)
#> Ncells  550905 29.5     940480 50.3   940480 50.3
#> Vcells 1072054  8.2    2060183 15.8  1489990 11.4

Finalizers are implemented using the reg.finalizer() function, and they set onexit=TRUE, so that the finalizer will also be called when R exits. This is useful in some cases, like database connections.

Summary

R6 classes provide capabilities that are common in other object-oriented programming languages. They’re similar to R’s built-in reference classes, but are simpler, smaller, and faster, and they allow inheritance across packages.

R6/inst/doc/Portable.Rmd0000644000176200001440000002050013104125424014470 0ustar liggesusers--- title: "Portable and non-portable R6 classes" output: html_document: theme: null css: mystyle.css toc: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Portable and non-portable R6 classes} %\usepackage[utf8]{inputenc} --- ```{r echo = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ``` One limitation to R's reference classes is that class inheritance across package namespaces is limited. R6 avoids this problem when the `portable` option is enabled. ## The problem Here is an example of the cross-package inheritance problem with reference classes: Suppose you have ClassA in pkgA, and ClassB in pkgB, which inherits from ClassA. ClassA has a method `foo` which calls a non-exported function `fun` in pkgA. If ClassB inherits `foo`, it will try to call `fun` -- but since ClassB objects are created in pkgB namespace (which is an environment) instead of the pkgA namespace, it won't be able to find `fun`. Something similar happens with R6 when the `portable=FALSE` option is used. For example: ```{r} library(R6) # Simulate packages by creating environments pkgA <- new.env() pkgB <- new.env() # Create a function in pkgA but not pkgB pkgA$fun <- function() 10 ClassA <- R6Class("ClassA", portable = FALSE, public = list( foo = function() fun() ), parent_env = pkgA ) # ClassB inherits from ClassA ClassB <- R6Class("ClassB", portable = FALSE, inherit = ClassA, parent_env = pkgB ) ``` When we create an instance of ClassA, it works as expected: ```{r} a <- ClassA$new() a$foo() ``` But with ClassB, it can't find the `foo` function: ```{r eval=FALSE} b <- ClassB$new() b$foo() #> Error in b$foo() : could not find function "fun" ``` ## Portable R6 R6 supports inheritance across different packages, with the default `portable=TRUE` option. In this example, we'll again simulate different packages by creating separate parent environments for the classes. ```{r} pkgA <- new.env() pkgB <- new.env() pkgA$fun <- function() { "This function `fun` in pkgA" } ClassA <- R6Class("ClassA", portable = TRUE, # The default public = list( foo = function() fun() ), parent_env = pkgA ) ClassB <- R6Class("ClassB", portable = TRUE, inherit = ClassA, parent_env = pkgB ) a <- ClassA$new() a$foo() b <- ClassB$new() b$foo() ``` When a method is inherited from a superclass, that method also gets that class's environment. In other words, method "runs in" the superclass's environment. This makes it possible for inheritance to work across packages. When a method is defined in the subclass, that method gets the subclass's environment. For example, here ClassC is a subclass of ClassA, and defines its own `foo` method which overrides the `foo` method from ClassA. It happens that the method looks the same as ClassA's -- it just calls `fun`. But this time it finds `pkgC$fun` instead of `pkgA$fun`. This is in contrast to ClassB, which inherited the `foo` method and environment from ClassA. ```{r} pkgC <- new.env() pkgC$fun <- function() { "This function `fun` in pkgC" } ClassC <- R6Class("ClassC", portable = TRUE, inherit = ClassA, public = list( foo = function() fun() ), parent_env = pkgC ) cc <- ClassC$new() # This method is defined in ClassC, so finds pkgC$fun cc$foo() ``` ## Using `self` One important difference between non-portable and portable classes is that with non-portable classes, it's possible to access members with just the name of the member, and with portable classes, member access always requires using `self$` or `private$`. This is a consequence of the inheritance implementation. Here's an example of a non-portable class with two methods: `sety`, which sets the private field `y` using the `<<-` operator, and `getxy`, which returns a vector with the values of fields `x` and `y`: ```{r} NP <- R6Class("NP", portable = FALSE, public = list( x = 1, getxy = function() c(x, y), sety = function(value) y <<- value ), private = list( y = NA ) ) np <- NP$new() np$sety(20) np$getxy() ``` If we attempt the same with a portable class, it results in an error: ```{r eval=FALSE} P <- R6Class("P", portable = TRUE, public = list( x = 1, getxy = function() c(x, y), sety = function(value) y <<- value ), private = list( y = NA ) ) p <- P$new() # No error, but instead of setting private$y, this sets y in the global # environment! This is because of the sematics of <<-. p$sety(20) y #> [1] 20 p$getxy() #> Error in p$getxy() : object 'y' not found ``` To make this work with a portable class, we need to use `self$x` and `private$y`: ```{r} P2 <- R6Class("P2", portable = TRUE, public = list( x = 1, getxy = function() c(self$x, private$y), sety = function(value) private$y <- value ), private = list( y = NA ) ) p2 <- P2$new() p2$sety(20) p2$getxy() ``` There is a small performance penalty for using `self$x` as opposed to `x`. In most cases, this is negligible, but it can be noticeable in some situations where there are tens of thousands or more accesses per second. For more information, see the Performance vignette. ## Potential pitfalls with cross-package inheritance Inheritance happens when an object is instantiated with `MyClass$new()`. At that time, members from the superclass get copied to the new object. This means that when you instantiate R6 object, it will essentially save some pieces of the superclass in the object. Because of the way that packages are built in R, R6's inheritance behavior could potentially lead to surprising, hard-to-diagnose problems when packages change versions. Suppose you have two packages, pkgA, containing `ClassA`, and pkgB, containing `ClassB`, and there is code in pkgB that instantiates `ClassB` in an object, `objB`, at build time. This is in contrast to instantiating `ClassB` at run-time, by calling a function. All of the code in the package is run when a *binary* package is built, and the resulting objects are saved in the package. (Generally, if the object can be accessed with `pkgB:::objB`, this means it was created at build time.) When `objB` is created at package build time, pieces from the superclass, `pkgA::ClassA`, are saved inside of it. This is fine in and of itself. But imagine that pkgB was built and installed against pkgA 1.0, and then you upgrade to pkgA 2.0 without subsequently building and installing pkgB. Then `pkgB::objB` will contain some code from `pkgA::ClassA` 1.0, but the version of `pkgA::ClassA` that's installed will be 2.0. This can cause problems if `objB` inherited code which uses parts of `pkgA` that have changed -- but the problems may not be entirely obvious. This scenario is entirely possible when installing packages from CRAN. It is very common for a package to be upgraded without upgrading all of its downstream dependencies. As far as I know, R does not have any mechanism to force downstream dependencies to be rebuilt when a package is upgraded on a user's computer. If this problem happens, the remedy is to rebuild pkgB against pkgA 2.0. I don't know if CRAN rebuilds all downstream dependencies when a package is updated. If it doesn't, then it's possible for CRAN to have incompatible binary builds of pkgA and pkgB, and users would then have to install pkgB from source, with `install.packages("pkgB", type = "source")`. To avoid this problem entirely, objects of `ClassB` must not be instantiated at build time. You can either instantiate them only in functions, or at package load time, by adding an `.onLoad` function to your package. For example: ```{r eval=FALSE} ClassB <- R6Class("ClassB", inherit = pkgA::ClassA, public = list(x = 1) ) # We'll fill this at load time objB <- NULL .onLoad <- function(libname, pkgname) { # The namespace is locked after loading; we can still modify objB at this time. objB <<- ClassB$new() } ``` You might be wondering why `ClassB` (the class, not the instance of the class `objB`) doesn't save a copy of `pkgA::ClassA` inside of it when the package is built. This is because, for the `inherit` argument, `R6Class` saves the unevaluated expression, (`pkgA::ClassA`), and evaluates it when `$new()` is called. ## Wrap-up In summary: * Portable classes allow inheritance across different packages. * Portable classes always require the use of `self` or `private` to access members. This can incur a small performance penalty, since using `self$x` is slower than just `x`. R6/inst/doc/Portable.R0000644000176200001440000000625213117561013014161 0ustar liggesusers## ----echo = FALSE-------------------------------------------------------- knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ## ------------------------------------------------------------------------ library(R6) # Simulate packages by creating environments pkgA <- new.env() pkgB <- new.env() # Create a function in pkgA but not pkgB pkgA$fun <- function() 10 ClassA <- R6Class("ClassA", portable = FALSE, public = list( foo = function() fun() ), parent_env = pkgA ) # ClassB inherits from ClassA ClassB <- R6Class("ClassB", portable = FALSE, inherit = ClassA, parent_env = pkgB ) ## ------------------------------------------------------------------------ a <- ClassA$new() a$foo() ## ----eval=FALSE---------------------------------------------------------- # b <- ClassB$new() # b$foo() # #> Error in b$foo() : could not find function "fun" ## ------------------------------------------------------------------------ pkgA <- new.env() pkgB <- new.env() pkgA$fun <- function() { "This function `fun` in pkgA" } ClassA <- R6Class("ClassA", portable = TRUE, # The default public = list( foo = function() fun() ), parent_env = pkgA ) ClassB <- R6Class("ClassB", portable = TRUE, inherit = ClassA, parent_env = pkgB ) a <- ClassA$new() a$foo() b <- ClassB$new() b$foo() ## ------------------------------------------------------------------------ pkgC <- new.env() pkgC$fun <- function() { "This function `fun` in pkgC" } ClassC <- R6Class("ClassC", portable = TRUE, inherit = ClassA, public = list( foo = function() fun() ), parent_env = pkgC ) cc <- ClassC$new() # This method is defined in ClassC, so finds pkgC$fun cc$foo() ## ------------------------------------------------------------------------ NP <- R6Class("NP", portable = FALSE, public = list( x = 1, getxy = function() c(x, y), sety = function(value) y <<- value ), private = list( y = NA ) ) np <- NP$new() np$sety(20) np$getxy() ## ----eval=FALSE---------------------------------------------------------- # P <- R6Class("P", # portable = TRUE, # public = list( # x = 1, # getxy = function() c(x, y), # sety = function(value) y <<- value # ), # private = list( # y = NA # ) # ) # # p <- P$new() # # # No error, but instead of setting private$y, this sets y in the global # # environment! This is because of the sematics of <<-. # p$sety(20) # y # #> [1] 20 # # p$getxy() # #> Error in p$getxy() : object 'y' not found ## ------------------------------------------------------------------------ P2 <- R6Class("P2", portable = TRUE, public = list( x = 1, getxy = function() c(self$x, private$y), sety = function(value) private$y <- value ), private = list( y = NA ) ) p2 <- P2$new() p2$sety(20) p2$getxy() ## ----eval=FALSE---------------------------------------------------------- # ClassB <- R6Class("ClassB", # inherit = pkgA::ClassA, # public = list(x = 1) # ) # # # We'll fill this at load time # objB <- NULL # # .onLoad <- function(libname, pkgname) { # # The namespace is locked after loading; we can still modify objB at this time. # objB <<- ClassB$new() # } R6/inst/doc/Performance.html0000644000176200001440000114167613117561013015430 0ustar liggesusers R6 and Reference class performance tests

R6 and Reference class performance tests

This document compares the memory costs and speed of R’s reference classes against R6 classes and simple environments. For must uses, R6 and reference classes have comparable features, but as we’ll see, R6 classes are faster and lighter weight.

This document tests reference classes against R6 classes (in many variations), as well as against very simple reference objects: environments created by functino calls.

First we’ll load some packages which will be used below:

library(microbenchmark)
options(microbenchmark.unit = "us")
library(pryr)  # For object_size function
library(R6)

Class definitions

We’ll start by defining a number of classes or class-like entities, using reference classes, R6 classes, and simple environments that are created directly by functions. There are a number of options for R6 that can affect the size of the resulting objects, so we will use a number of variants. These classes will be used for the speed and memory tests that follow. This is a lot of boring code, so you may want to skip ahead to the results.

All of these classes have the same basic characteristics:

  • A field named x that contains a number.
  • An way of initializing the value of x.
  • A method named getx for retrieving the value of x.
  • A method named inc for incrementing the value of x.

The fields and methods are accessed with the $ operator, so if we have an object named obj, we could use obj$x or obj$getx().

R reference class

RC <- setRefClass("RC",
  fields = list(x = "numeric"),
  methods = list(
    initialize = function(x = 1) .self$x <- x,
    getx = function() x,
    inc = function(n = 1) x <<- x + n
  )
)

In reference classes, the binding that points back to the object is named .self. Within a method, assignment can be done by using .self, as in .self$x <- 10, or by using <<-, as in x <<- 10.

To create an object, simply call $new() on the class:

RC$new()
#> Reference class object of class "RC"
#> Field "x":
#> [1] 1

R6 class

Creating an R6 class is similar to the reference class, except that there’s no need to separate the fields and methods, and you can’t specify the types of the fields.

R6 <- R6Class("R6",
  public = list(
    x = NULL,
    initialize = function(x = 1) self$x <- x,
    getx = function() self$x,
    inc = function(n = 1) self$x <- x + n
  )
)

Whereas reference classes use .self, R6 classes use self (without the leading period). As with reference classes, objects are instantiated by calling $new():

R6$new()
#> <R6>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     getx: function () 
#>     inc: function (n = 1) 
#>     initialize: function (x = 1) 
#>     x: 1

An R6 object essentially just a set of environments structured in a particular way. The fields and methods for an R6 object have bindings (that is, they have names) in the public environment. There is also have a separate environment which is the enclosing environment for methods (they “run in” an environment that contains a binding named self, which is simply a reference to the public environment).

R6 class, without class attribute

By default, a class attribute is added to R6 objects. This attribute adds a slight performance penalty because R will attempt to use S3 dispatch when using $ on the object.

It’s possible generate objects without the class attribute, by using class=FALSE:

R6NoClass <- R6Class("R6NoClass",
  class = FALSE,
  public = list(
    x = NULL,
    initialize = function(x = 1) self$x <- x,
    getx = function() self$x,
    inc = function(n = 1) self$x <- self$x + n
  )
)

Note that without the class attribute, S3 method dispatch on the objects is not possible.

R6 class, non-portable

By default, R6 objects are portable. This means that inheritance can be in classes that are in different packages. However, it also requires the use of self$ and private$ to access members, and this incurs a small performance penalty.

If portable=FALSE is used, members can be accessed without using self$, and assignment can be done with <<-:

R6NonPortable <- R6Class("R6NonPortable",
  portable = FALSE,
  public = list(
    x = NULL,
    initialize = function(value = 1) x <<- value,
    getx = function() x,
    inc = function(n = 1) x <<- x + n
  )
)

R6 class, with cloneable=FALSE

By default, R6 objects have a clone() method, which is a fairly large function. If you do not need this feature, you can save some memory by using cloneable=FALSE.

R6NonCloneable <- R6Class("R6NonCloneable",
  cloneable = FALSE,
  public = list(
    x = NULL,
    initialize = function(x = 1) self$x <- x,
    getx = function() self$x,
    inc = function(n = 1) self$x <- self$x + n
  )
)

R6 class, without class attribute, non-portable, and non-cloneable

For comparison, we’ll use a an R6 class that is without a class attribute, non-portable, and non-cloneable. This is the most stripped-down we can make an R6 object.

R6Bare <- R6Class("R6Bare",
  portable = FALSE,
  class = FALSE,
  cloneable = FALSE,
  public = list(
    x = NULL,
    initialize = function(value = 1) x <<- value,
    getx = function() x,
    inc = function(n = 1) x <<- x + n
  )
)

R6 class, with public and private members

This variant has public and private members.

R6Private <- R6Class("R6Private",
  private = list(x = NULL),
  public = list(
    initialize = function(x = 1) private$x <- x,
    getx = function() private$x,
    inc = function(n = 1) private$x <- private$x + n
  )
)

Instead of a single self object which refers to all items in an object, these objects have self (which refers to the public items) and private.

R6Private$new()
#> <R6Private>
#>   Public:
#>     clone: function (deep = FALSE) 
#>     getx: function () 
#>     inc: function (n = 1) 
#>     initialize: function (x = 1) 
#>   Private:
#>     x: 1

R6 class, with public and private, no class attribute, non-portable, and non-cloneable

For comparison, we’ll add a version that is without a class attribute, non-portable, and non-cloneable.

R6PrivateBare <- R6Class("R6PrivateBare",
  portable = FALSE,
  class = FALSE,
  cloneable = FALSE,
  private = list(x = NULL),
  public = list(
    initialize = function(x = 1) private$x <- x,
    getx = function() x,
    inc = function(n = 1) x <<- x + n
  )
)

Environment created by a function call, with class attribute

In R, environments are passed by reference. A simple way to create an object that’s passed by reference is to use the environment created by the invocation of a function. The function below captures that environment, attaches a class to it, and returns it:

FunctionEnvClass <- function(x = 1) {
  inc <- function(n = 1) x <<- x + n
  getx <- function() x
  self <- environment()
  class(self) <- "FunctionEnvClass"
  self
}

Even though x isn’t declared in the function body, it gets captured because it’s an argument to the function.

ls(FunctionEnvClass())
#> [1] "getx" "inc"  "self" "x"

Objects created this way are very similar to those created by R6 generator we created above.

Environment created by a function call, without class attribute

We can make an even simpler type of reference object to the previous one, by not having a a class attribute, and not having self object:

FunctionEnvNoClass <- function(x = 1) {
  inc <- function(n = 1) x <<- x + n
  getx <- function() x
  environment()
}

This is simply an environment with some objects in it.

ls(FunctionEnvNoClass())
#> [1] "getx" "inc"  "x"

Tests

For all the timings using microbenchmark(), the results are reported in microseconds, and the most useful value is probably the median column.

Memory footprint

How much memory does a single instance of each object take, and how much memory does each additional object take? We’ll use the functions obj_size and obj_sizes (shown at the bottom of this document) to calculate the sizes.

Sizes of each type of object, in bytes:

sizes <- obj_sizes(
  RC$new(),
  R6$new(),
  R6NoClass$new(),
  R6NonPortable$new(),
  R6NonCloneable$new(),
  R6Bare$new(),
  R6Private$new(),
  R6PrivateBare$new(),
  FunctionEnvClass(),
  FunctionEnvNoClass()
)
sizes
#>                         one incremental
#> RC$new()             555688        1368
#> R6$new()              60776        1008
#> R6NoClass$new()       61480         896
#> R6NonPortable$new()   60368         952
#> R6NonCloneable$new()  13704         896
#> R6Bare$new()          12896         728
#> R6Private$new()       61680        1120
#> R6PrivateBare$new()   13904         840
#> FunctionEnvClass()    12816         624
#> FunctionEnvNoClass()  11392         512

The results are plotted below. Note that the plots have very different x scales.

Some preliminary observations about the first instance of various classes: Using a reference class consumes a large amount of memory. For R6 objects, the option with the largest impact is cloneable: not having the clone() method saves around 40 kB of memory.

For subsequent instances of these classes, there isn’t nearly as much difference between the different kinds.

It appeared that using a reference class takes up a huge amount of memory, but much of that is shared between reference classes. Adding an object from a different reference class doesn’t require much more memory — around 38KB:

RC2 <- setRefClass("RC2",
  fields = list(x = "numeric"),
  methods = list(
    initialize = function(x = 2) .self$x <<- x,
    inc = function(n = 2) x <<- x * n
  )
)

# Calcualte the size of a new RC2 object, over and above an RC object
as.numeric(object_size(RC$new(), RC2$new()) - object_size(RC$new()))
#> [1] 37176

Object instantiation speed

How much time does it take to create one of these objects? This shows the median time, in microseconds:

# Function to extract the medians from microbenchmark results
mb_summary <- function(x) {
  res <- summary(x, unit="us")
  data.frame(name = res$expr, median = res$median)
}

speed <- microbenchmark(
  RC$new(),
  R6$new(),
  R6NoClass$new(),
  R6NonPortable$new(),
  R6NonCloneable$new(),
  R6Bare$new(),
  R6Private$new(),
  R6PrivateBare$new(),
  FunctionEnvClass(),
  FunctionEnvNoClass()
)
speed <- mb_summary(speed)
speed
#>                    name   median
#> 1              RC$new() 220.1525
#> 2              R6$new()  39.1770
#> 3       R6NoClass$new()  36.3810
#> 4   R6NonPortable$new()  36.6365
#> 5  R6NonCloneable$new()  37.3490
#> 6          R6Bare$new()  33.4570
#> 7       R6Private$new()  52.5565
#> 8   R6PrivateBare$new()  45.6435
#> 9    FunctionEnvClass()   1.9740
#> 10 FunctionEnvNoClass()   1.2335

The plot below shows the median instantiation time.

Reference classes are much slower to instantiate than the other types of classes. Instantiating R6 objects is roughly 5 times faster. Creating an environment with a simple function call is another 20-30 times faster.

Field access speed

How much time does it take to access a field in an object? First we’ll make some objects:

rc           <- RC$new()
r6           <- R6$new()
r6noclass    <- R6NoClass$new()
r6noport     <- R6NonPortable$new()
r6noclone    <- R6NonCloneable$new()
r6bare       <- R6Bare$new()
r6priv       <- R6Private$new()
r6priv_bare  <- R6PrivateBare$new()
fun_env      <- FunctionEnvClass()
fun_env_nc   <- FunctionEnvNoClass()

And then get a value from these objects:

speed <- microbenchmark(
  rc$x,
  r6$x,
  r6noclass$x,
  r6noport$x,
  r6noclone$x,
  r6bare$x,
  r6priv$x,
  r6priv_bare$x,
  fun_env$x,
  fun_env_nc$x
)
speed <- mb_summary(speed)
speed
#>             name median
#> 1           rc$x 6.4705
#> 2           r6$x 1.0975
#> 3    r6noclass$x 0.2555
#> 4     r6noport$x 1.2270
#> 5    r6noclone$x 1.1915
#> 6       r6bare$x 0.2565
#> 7       r6priv$x 1.2145
#> 8  r6priv_bare$x 0.2650
#> 9      fun_env$x 0.9770
#> 10  fun_env_nc$x 0.2710

Accessing the field of a reference class is much slower than the other methods.

There’s also an obvious pattern where accessing the field of an environment (created by R6 or a function call) is slower when there is a class attribute. This is because, for the objects that have a class attribute, R attempts to look up an S3 method for $, and this lookup has a performance penalty. We’ll see more about this below.

Field setting speed

How much time does it take to set the value of a field in an object?

speed <- microbenchmark(
  rc$x <- 4,
  r6$x <- 4,
  r6noclass$x <- 4,
  r6noport$x <- 4,
  r6noclone$x <- 4,
  r6bare$x <- 4,
  # r6priv$x <- 4,         # Can't set private field directly,
  # r6priv_nc_np$x <- 4,   # so we'll skip these two
  fun_env$x <- 4,
  fun_env_nc$x <- 4
)
speed <- mb_summary(speed)
speed
#>                name  median
#> 1         rc$x <- 4 30.7685
#> 2         r6$x <- 4  1.7340
#> 3  r6noclass$x <- 4  0.7465
#> 4   r6noport$x <- 4  1.8975
#> 5  r6noclone$x <- 4  1.8760
#> 6     r6bare$x <- 4  0.7095
#> 7    fun_env$x <- 4  1.6460
#> 8 fun_env_nc$x <- 4  0.7305

Reference classes are significantly slower than the others, again. In this case, there’s additional overhead due to type-checking the value.

Once more, the no-class objects are significantly faster than the others, again probably due to attempted S3 dispatch on the `$<-` function.

Speed of method call that accesses a field

How much overhead is there when calling a method from one of these objects? All of these getx() methods simply return the value of x in the object. When necessary, this method uses self$x (for R6 classes, when portable=TRUE), and in others, it just uses x (when portable=FALSE, and in reference classes).

speed <- microbenchmark(
  rc$getx(),
  r6$getx(),
  r6noclass$getx(),
  r6noport$getx(),
  r6noclone$getx(),
  r6bare$getx(),
  r6priv$getx(),
  r6priv_bare$getx(),
  fun_env$getx(),
  fun_env_nc$getx()
)
speed <- mb_summary(speed)
speed
#>                  name median
#> 1           rc$getx() 6.7705
#> 2           r6$getx() 2.4550
#> 3    r6noclass$getx() 0.5940
#> 4     r6noport$getx() 1.4190
#> 5    r6noclone$getx() 2.5665
#> 6       r6bare$getx() 0.4000
#> 7       r6priv$getx() 1.6015
#> 8  r6priv_bare$getx() 0.4070
#> 9      fun_env$getx() 1.2165
#> 10  fun_env_nc$getx() 0.4015

The reference class is the slowest.

r6 is also somewhat slower than the others. There are two reasons for this: first, it uses self$x which adds some time, and second, it has a class attribute, which slows down the access of both r6$getx and self$x.

One might expect r6priv to be the same speed as r6, but it is faster. Although accessing r6priv$getx is slow because r6priv has a class attribute, accessing private$x is faster because it does not have a class attribute.

The objects which can access x directly (without self or private) and which lack a class attribute are the fastest.

Assignment using self$x <- vs. x <<-

With reference classes, you can modify fields using the <<- operator, or by using the .self object. For example, compare the setx() methods of these two classes:

RCself <- setRefClass("RCself",
  fields = list(x = "numeric"),
  methods = list(
    initialize = function() .self$x <- 1,
    setx = function(n = 2) .self$x <- n
  )
)

RCnoself <- setRefClass("RCnoself",
  fields = list(x = "numeric"),
  methods = list(
    initialize = function() x <<- 1,
    setx = function(n = 2) x <<- n
  )
)

Non-portable R6 classes are similar, except they use self instead of .self.

R6self <- R6Class("R6self",
  portable = FALSE,
  public = list(
    x = 1,
    setx = function(n = 2) self$x <- n
  )
)

R6noself <- R6Class("R6noself",
  portable = FALSE,
  public = list(
    x = 1,
    setx = function(n = 2) x <<- n
  )
)
rc_self   <- RCself$new()
rc_noself <- RCnoself$new()
r6_self   <- R6self$new()
r6_noself <- R6noself$new()

speed <- microbenchmark(
  rc_self$setx(),
  rc_noself$setx(),
  r6_self$setx(),
  r6_noself$setx()
)
speed <- mb_summary(speed)
speed
#>               name  median
#> 1   rc_self$setx() 36.4870
#> 2 rc_noself$setx() 22.4990
#> 3   r6_self$setx()  4.0360
#> 4 r6_noself$setx()  1.8445

For both reference and non-portable R6 classes, assignment using .self$x <- is somewhat slower than using x <<-.

Bear in mind that, by default, R6 classes are portable, and can’t use assignment with x <<-.

Overhead from using $ on objects with a class attribute

There is some overhead when using $ on an object that has a class attribute. In the test below, we’ll create three different kinds of objects:

  1. An environment with no class attribute.
  2. An environment with a class "e2", but without a $.e2 S3 method.
  3. An environment with a class "e3", which has a $.e3 S3 method that simply returns NULL.

Each one of these environments will contain an object x.

e1 <- new.env(hash = FALSE, parent = emptyenv())
e2 <- new.env(hash = FALSE, parent = emptyenv())
e3 <- new.env(hash = FALSE, parent = emptyenv())

e1$x <- 1
e2$x <- 1
e3$x <- 1

class(e2) <- "e2"
class(e3) <- "e3"

# Define an S3 method for class e3
`$.e3` <- function(x, name) {
  NULL
}

Now we can run timing tests for calling $ on each type of object. Note that for the e3 object, the $ function does nothing — it simply returns NULL.

speed <- microbenchmark(
  e1$x,
  e2$x,
  e3$x
)
speed <- mb_summary(speed)
speed
#>   name median
#> 1 e1$x 0.2230
#> 2 e2$x 0.8745
#> 3 e3$x 0.7585

Using $ on e2 and e3 is much slower than on e1. This is because e2 and e3 have a class attribute. Even though there’s no $ method defined for e2, doing e2$x still about 6 times slower than e1$x, simply because R looks for an appropriate S3 method.

e3$x is slightly faster than e2$x; this is probably because the $.e3 function doesn’t actually do anything other than return NULL.

If an object has a class attribute, R will attempt to look for a method every time $ is called. This can slow things down considerably, if $ is used often.

Lists vs. environments, and $ vs. [[

Lists could also be used for creating classes (albeit not with reference semantics). How much time does it take to access items using $ for lists vs. environments? We’ll also compare using obj$x to obj[['x']].

lst <- list(x = 10)
env <- new.env()
env$x <- 10

mb_summary(microbenchmark(
  lst = lst$x,
  env = env$x,
  lst[['x']],
  env[['x']]
))
#>         name median
#> 1        lst 0.2065
#> 2        env 0.2110
#> 3 lst[["x"]] 0.1575
#> 4 env[["x"]] 0.1550

Performance is comparable across environments and lists.

The [[ operator is slightly faster than $, probably because it doesn’t need to convert the unevaluated symbol to a string.

Wrap-up

R6 objects take less memory and are significantly faster than R’s reference class objects, and they also have some options that provide for even more speed.

In these tests, the biggest speedup for R6 classes comes from not using a class attribute; this speeds up the use of $. Non-portable R6 classes can also access fields without $ at all, which provides another modest speed boost. In most cases, these speed increases are negligible – they are on the order of microseconds and will be noticeable only when tens or even hundreds of thousands of class member accesses are performed.

Appendix

Functions for calculating object sizes

# Utility functions for calculating sizes
obj_size <- function(expr, .env = parent.frame()) {
  size_n <- function(n = 1) {
    objs <- lapply(1:n, function(x) eval(expr, .env))
    as.numeric(do.call(object_size, objs))
  }

  data.frame(one = size_n(1), incremental = size_n(2) - size_n(1))
}

obj_sizes <- function(..., .env = parent.frame()) {
  exprs <- as.list(match.call(expand.dots = FALSE)$...)
  names(exprs) <- lapply(1:length(exprs),
    FUN = function(n) {
      name <- names(exprs)[n]
      if (is.null(name) || name == "") paste(deparse(exprs[[n]]), collapse = " ")
      else name
    })

  sizes <- mapply(obj_size, exprs, MoreArgs = list(.env = .env), SIMPLIFY = FALSE)
  do.call(rbind, sizes)
}

System information

sessionInfo()
#> R version 3.4.0 (2017-04-21)
#> Platform: x86_64-apple-darwin15.6.0 (64-bit)
#> Running under: macOS Sierra 10.12.5
#> 
#> Matrix products: default
#> BLAS: /Library/Frameworks/R.framework/Versions/3.4/Resources/lib/libRblas.0.dylib
#> LAPACK: /Library/Frameworks/R.framework/Versions/3.4/Resources/lib/libRlapack.dylib
#> 
#> locale:
#> [1] C/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> other attached packages:
#> [1] scales_0.4.1           ggplot2_2.2.1.9000     microbenchmark_1.4-2.1
#> [4] R6_2.2.2               pryr_0.1.2            
#> 
#> loaded via a namespace (and not attached):
#>  [1] Rcpp_0.12.11       knitr_1.16         magrittr_1.5      
#>  [4] munsell_0.4.3      colorspace_1.3-2   rlang_0.1.1       
#>  [7] stringr_1.2.0      plyr_1.8.4         tools_3.4.0       
#> [10] grid_3.4.0         gtable_0.2.0       htmltools_0.3.6   
#> [13] yaml_2.1.14        lazyeval_0.2.0     rprojroot_1.2     
#> [16] digest_0.6.12      tibble_1.3.3       codetools_0.2-15  
#> [19] evaluate_0.10      rmarkdown_1.5.9000 labeling_0.3      
#> [22] stringi_1.1.5      compiler_3.4.0     backports_1.1.0
R6/tests/0000755000176200001440000000000013104125424011677 5ustar liggesusersR6/tests/manual/0000755000176200001440000000000013104125424013154 5ustar liggesusersR6/tests/manual/test-inheritance.R0000644000176200001440000001416213104125424016551 0ustar liggesuserslibrary(testthat) context("Inheritance across packages") ## Helper functions to create a new package, with some ## R code, and install it temporarily install_quietly <- TRUE with_wd <- function(dir, expr) { wd <- getwd() on.exit(setwd(wd)) setwd(dir) eval(substitute(expr), envir = parent.frame()) } build_pkg <- function(path, pkg_file = NULL) { if (!file.exists(path)) stop("path does not exist") pkg_name <- basename(path) if (is.null(pkg_file)) { pkg_file <- file.path(dirname(path), paste0(pkg_name, "_1.0.tar.gz")) } with_wd(dirname(path), tar(basename(pkg_file), pkg_name, compression = "gzip")) pkg_file } install_tmp_pkg <- function(..., pkg_name, lib_dir, imports = "R6") { if (!file.exists(lib_dir)) stop("lib_dir does not exist") if (!is.character(pkg_name) || length(pkg_name) != 1) { stop("pkg_name is not a string") } ## Create a directory that will contain the source package src_dir <- tempfile() on.exit(try(unlink(src_dir, recursive = TRUE), silent = TRUE), add = TRUE) dir.create(src_dir) ## Create source package, need a non-empty environment, ## otherwise package.skeleton fails tmp_env <- new.env() assign("f", function(x) x, envir = tmp_env) suppressMessages(package.skeleton(pkg_name, path = src_dir, envir = tmp_env)) pkg_dir <- file.path(src_dir, pkg_name) ## Make it installable: remove man, add R6 dependency unlink(file.path(pkg_dir, "man"), recursive = TRUE) cat("Imports: ", paste(imports, collapse = ", "), "\n", file = file.path(pkg_dir, "DESCRIPTION"), append = TRUE) cat(paste0("import(", imports, ")"), sep="\n", file = file.path(pkg_dir, "NAMESPACE"), append = TRUE) ## Put the code in it, dput is noisy, so we need to redirect it to ## temporary file exprs <- list(...) unlink(file.path(pkg_dir, "R"), recursive = TRUE) dir.create(file.path(pkg_dir, "R")) code_file <- file.path(pkg_dir, "R", "code.R") tmp_file <- tempfile() on.exit(try(unlink(tmp_file), silent = TRUE), add = TRUE) sapply(exprs, function(x) cat(deparse(dput(x, file = tmp_file)), file = code_file, append = TRUE, "\n", sep="\n")) ## Build it pkg_file <- build_pkg(pkg_dir) ## Install it into the supplied lib_dir install.packages(pkg_file, lib = lib_dir, repos = NULL, type = "source", quiet = install_quietly) } with_libpath <- function(lib_path, ...) { cur_lib_path <- .libPaths() on.exit(.libPaths(cur_lib_path), add = TRUE) .libPaths(c(lib_path, cur_lib_path)) exprs <- c(as.list(match.call(expand.dots = FALSE)$...)) sapply(exprs, eval, envir = parent.frame()) } ## Each expression in ... is put in a package, that ## is installed and loaded. The package name is given by ## argument name. The packages will be installed in lib_dir, load_tmp_pkgs <- function(..., lib_dir = tempfile(), imports = "R6") { if (!file.exists(lib_dir)) dir.create(lib_dir) exprs <- c(as.list(match.call(expand.dots = FALSE)$...)) for (i in seq_along(exprs)) { expr <- exprs[[i]] name <- names(exprs)[i] install_tmp_pkg(expr, pkg_name = name, lib_dir = lib_dir, imports = imports) ## Unload everything if an error happens on.exit(try(unloadNamespace(name), silent = TRUE), add = TRUE) with_libpath(lib_dir, suppressMessages(library(name, quietly = TRUE, character.only = TRUE))) on.exit() } invisible(NULL) } test_that("inheritance works across packages", { ## Temporary lib_dir lib_dir <- tempfile() on.exit(try(unlink(lib_dir, recursive = TRUE), silent = TRUE), add = TRUE) on.exit(unloadNamespace("R6testB"), add = TRUE) on.exit(unloadNamespace("R6testA"), add = TRUE) ## Make sure that we get the latest versions of them try(unloadNamespace("R6testB"), silent = TRUE) try(unloadNamespace("R6testA"), silent = TRUE) load_tmp_pkgs(lib_dir = lib_dir, ## Code to put in package 'R6testA' R6testA = { AC <- R6Class( public = list( x = 1 ) ) }, ## Code to put in package 'R6testB' R6testB = { BC <- R6Class( inherit = R6testA::AC, public = list( y = 2 ) ) } ) ## Now ready for the tests B <- BC$new() expect_equal(B$x, 1) expect_equal(B$y, 2) }) test_that("more inheritance", { ## Temporary lib_dir lib_dir <- tempfile() on.exit(try(unlink(lib_dir, recursive = TRUE), silent = TRUE), add = TRUE) on.exit(unloadNamespace("pkgB"), add = TRUE) on.exit(unloadNamespace("pkgA"), add = TRUE) ## Make sure that we get the latest versions of them try(unloadNamespace("pkgB"), silent = TRUE) try(unloadNamespace("pkgA"), silent = TRUE) load_tmp_pkgs(lib_dir = lib_dir, pkgA = { funA <- function() { message("Called funA in pkgA 1.0") } AC <- R6Class("AC", public = list( versionString = "pkgA 1.0", fun = function() { message("This object was created in pkgA 1.0") message(paste0("The object has versionString ", self$versionString)) funA() } ) ) } ) load_tmp_pkgs(lib_dir = lib_dir, imports = "pkgA", pkgB = { B <- pkgA::AC$new() } ) expect_message(B$fun(), "created in pkgA 1.0") expect_message(B$fun(), "versionString pkgA 1.0") expect_message(B$fun(), "Called funA in pkgA 1.0") unloadNamespace("pkgB") unloadNamespace("pkgA") load_tmp_pkgs(lib_dir = lib_dir, pkgA = { funA <- function() { message("Called funA in pkgA 2.0") } AC <- R6Class("AC", public = list( versionString = "pkgA 2.0", fun = function() { message("This object was created in pkgA 2.0") message(paste0("The object has versionString ", self$versionString)) funA() } ) ) } ) with_libpath(lib_dir, library(pkgB)) expect_message(B$fun(), "created in pkgA 1.0") expect_message(B$fun(), "versionString pkgA 1.0") expect_message(B$fun(), "Called funA in pkgA 2.0") }) R6/tests/manual/README0000644000176200001440000000021213104125424014027 0ustar liggesusersThe tests in this directory are somewhat invasive, so they must be run by hand, and therefore are kept separate from the automated tests. R6/tests/manual/encapsulation.R0000644000176200001440000001076613104125424016156 0ustar liggesuserslibrary(pryr) library(testthat) library(inline) unlockEnvironment <- cfunction(signature(env = "environment"), body = ' #define FRAME_LOCK_MASK (1<<14) #define FRAME_IS_LOCKED(e) (ENVFLAGS(e) & FRAME_LOCK_MASK) #define UNLOCK_FRAME(e) SET_ENVFLAGS(e, ENVFLAGS(e) & (~ FRAME_LOCK_MASK)) if (TYPEOF(env) == NILSXP) error("use of NULL environment is defunct"); if (TYPEOF(env) != ENVSXP) error("not an environment"); UNLOCK_FRAME(env); // Return TRUE if unlocked; FALSE otherwise SEXP result = PROTECT( Rf_allocVector(LGLSXP, 1) ); LOGICAL(result)[0] = FRAME_IS_LOCKED(env) == 0; UNPROTECT(1); return result; ') # To make sure these tests actually work: # * Un-encapsulate one or more of the encapsulated functions. # * load_all(), or install R6, restart R, then library(R6). # * Run these tests. With the function(s) commented out, there should be an # error. With the code restored to normal, there should be no errors. test_that("R6 objects can be instantiated even when R6 isn't loaded", { library(R6) AC <- R6Class("AC", portable = TRUE, public = list( x = 0, initialize = function() { self$inc_x() private$inc_y() self$incz }, inc_x = function() self$x <- self$x + 1, inc = function(val) val + 1, pinc = function(val) private$priv_inc(val), # Call private inc method gety = function() private$y, z = 0 ), private = list( y = 0, inc_y = function() private$y <- private$y + 1, priv_inc = function(val) val + 1 ), active = list( incz = function() { self$z <- self$z + 1 } ) ) BC <- R6Class("BC", portable = TRUE, inherit = AC, public = list( inc_x = function() self$x <- self$x + 2, inc = function(val) super$inc(val) + 20 ), private = list( inc_y = function() private$y <- private$y + 2, priv_inc = function(val) super$priv_inc(val) + 20 ), active = list( incz = function() { self$z <- self$z + 2 } ) ) # Remove everything from the R6 namespace r6ns <- .getNamespace('R6') unlockEnvironment(r6ns) rm(list = ls(r6ns), envir = r6ns) # Also try unloading R6 namespace. Even this set of commands may not be enough # to fully unload the R6 namespace environment, because AC and BC are children # of the R6 namespace. detach('package:R6', unload = TRUE) expect_null(.getNamespace('R6')) expect_error(as.environment('package:R6')) expect_error(get('R6Class', inherits = TRUE)) B <- BC$new() # Testing overrides expect_identical(B$x, 2) # Public expect_identical(B$gety(), 2) # Private expect_identical(B$z, 2) # Active # Calling superclass methods expect_identical(B$inc(0), 21) expect_identical(B$pinc(0), 21) library(R6) # Multi-level inheritance CC <- R6Class("CC", portable = TRUE, inherit = BC, public = list( inc_x = function() self$x <- self$x + 3, inc = function(val) super$inc(val) + 300 ), private = list( inc_y = function() private$y <- private$y + 3, priv_inc = function(val) super$priv_inc(val) + 300 ), active = list( incz = function() { self$z <- self$z + 3 } ) ) # Remove everything from the R6 namespace r6ns <- .getNamespace('R6') unlockEnvironment(r6ns) rm(list = ls(r6ns), envir = r6ns) # Detach and unload R6, then run the tests as usual detach('package:R6', unload = TRUE) expect_null(.getNamespace('R6')) expect_error(as.environment('package:R6')) expect_error(get('R6Class', inherits = TRUE)) C <- CC$new() # Testing overrides expect_identical(C$x, 3) # Public expect_identical(C$gety(), 3) # Private expect_identical(C$z, 3) # Active # Calling superclass methods (two levels) expect_identical(C$inc(0), 321) expect_identical(C$pinc(0), 321) # Classes expect_identical(class(C), c("CC", "BC", "AC", "R6")) }) # Encapsulate R6 in new() ======================= # This set of tests requires restarting R library(R6) AC <- R6Class("AC", portable = FALSE, public = list( x = 1, getx = function() self$x ) ) BC <- R6Class("BC", portable = FALSE, inherit = AC, public = list( x = 2, getx = function() self$x ) ) save(AC, BC, file = 'test.rda') #### Restart R #### library(testthat) load('test.rda') # R6 will be loaded expect_true("R6" %in% loadedNamespaces()) A <- AC$new() B <- BC$new() expect_identical(A$getx(), 1) expect_identical(B$getx(), 2) # Clean up unlink('test.rda') R6/tests/testthat.R0000644000176200001440000000006013104125424013656 0ustar liggesuserslibrary(testthat) library(R6) test_check("R6") R6/tests/testthat/0000755000176200001440000000000013121163343013540 5ustar liggesusersR6/tests/testthat/test-portable.R0000644000176200001440000001153613104125424016455 0ustar liggesuserscontext("portable") test_that("initialization", { AC <- R6Class("AC", portable = TRUE, public = list( x = 1, initialize = function(x, y) { self$x <- self$getx() + x # Assign to self; also access a method private$y <- y # Assign to private }, getx = function() self$x, gety = function() private$y ), private = list( y = 2 ) ) A <- AC$new(2, 3) expect_identical(A$x, 3) expect_identical(A$gety(), 3) # No initialize method: throw error if arguments are passed in AC <- R6Class("AC", portable = TRUE, public = list(x = 1)) expect_error(AC$new(3)) }) test_that("empty members and methods are allowed", { # No initialize method: throw error if arguments are passed in AC <- R6Class("AC", portable = TRUE) expect_no_error(AC$new()) }) test_that("Private members are private, and self/private environments", { AC <- R6Class("AC", portable = TRUE, public = list( x = 1, gety = function() private$y, getx = function() self$x, getx2 = function() private$getx_priv(), getself = function() self, getprivate = function() private ), private = list( y = 2, getx_priv = function() self$x ) ) A <- AC$new() # Environment structure expect_identical(A$getself(), A) expect_identical(parent.env(A), emptyenv()) # The private binding environment contains private fields private_bind_env <- A$getprivate() expect_identical(ls(private_bind_env), c("getx_priv", "y")) expect_identical(parent.env(private_bind_env), emptyenv()) # Eval environment for public methods eval_env <- environment(A$getx) expect_identical(parent.env(eval_env), environment()) expect_identical(eval_env$self, A) expect_identical(eval_env$private, A$getprivate()) # Eval environment for private methods should be the same expect_identical(eval_env, environment(A$getprivate()$getx_priv)) # Behavioral tests expect_identical(A$x, 1) expect_null(A$y) expect_null(A$getx_foo) expect_identical(A$gety(), 2) # Explicit access: private$y expect_identical(A$getx(), 1) # Explicit access: self$x expect_identical(A$getx2(), 1) # Indirect access: private$getx_priv() }) test_that("Private methods exist even when no private fields", { AC <- R6Class("AC", portable = TRUE, public = list( x = 1, getx = function() self$x, getx2 = function() private$getx_priv(), getself = function() self, getprivate = function() private ), private = list( getx_priv = function() self$x ) ) A <- AC$new() # The private binding environment contains private fields private_bind_env <- A$getprivate() expect_identical(ls(private_bind_env), "getx_priv") expect_identical(parent.env(private_bind_env), emptyenv()) }) test_that("Active bindings work", { AC <- R6Class("AC", portable = TRUE, public = list( x = 5 ), active = list( x2 = function(value) { if (missing(value)) return(self$x * 2) else self$x <- value/2 }, sqrt_of_x = function(value) { if (!missing(value)) # In "setter" role stop("Sorry this is a read-only variable.") else { # In "getter" role if (self$x < 0) stop("The requested value is not available.") else sqrt(self$x) } } ) ) A <- AC$new() expect_identical(A$x2, 10) A$x <- 20 expect_identical(A$x2, 40) A$x2 <- 60 expect_identical(A$x2, 60) expect_identical(A$x, 30) A$x <- -2 expect_error(A$sqrt_of_x) # print does not throw an error trying to read # the active binding variables muted_print <- function(x) capture.output(print(x)) expect_no_error(muted_print(A)) }) test_that("Locking works", { AC <- R6Class("AC", portable = FALSE, public = list(x = 1, getx = function() self$x), private = list(y = 2, gety = function() self$y), lock_objects = TRUE ) A <- AC$new() # Can modify fields expect_no_error(A$x <- 5) expect_identical(A$x, 5) expect_no_error(A$private$y <- 5) expect_identical(A$private$y, 5) # Can't modify methods expect_error(A$getx <- function() 1) expect_error(A$gety <- function() 2) # Can't add members expect_error(A$z <- 1) expect_error(A$private$z <- 1) # Not locked AC <- R6Class("AC", portable = FALSE, public = list(x = 1, getx = function() x), private = list(y = 2, gety = function() y), lock_objects = FALSE ) A <- AC$new() # Can modify fields expect_no_error(A$x <- 5) expect_identical(A$x, 5) expect_no_error(A$private$y <- 5) expect_identical(A$private$y, 5) # Can't modify methods expect_error(A$getx <- function() 1) expect_error(A$private$gety <- function() 2) # Can add members expect_no_error(A$z <- 1) expect_identical(A$z, 1) expect_no_error(A$private$z <- 1) expect_identical(A$private$z, 1) }) R6/tests/testthat/test-portable-inheritance.R0000644000176200001440000002477613104125424020756 0ustar liggesuserscontext("portable-inheritance") test_that("Inheritance", { AC <- R6Class("AC", portable = TRUE, public = list( x = 0, z = 0, initialize = function(x) self$x <- x, getx = function() self$x, getx2 = function() self$x*2, getprivateA = function() private ), private = list( getz = function() self$z, getz2 = function() self$z*2 ), active = list( x2 = function(value) { if (missing(value)) return(self$x * 2) else self$x <- value/2 }, x3 = function(value) { if (missing(value)) return(self$x * 3) else self$x <- value/3 } ) ) BC <- R6Class("BC", portable = TRUE, inherit = AC, public = list( y = 0, z = 3, initialize = function(x, y) { super$initialize(x) self$y <- y }, getx = function() self$x + 10, getprivateB = function() private ), private = list( getz = function() self$z + 10 ), active = list( x2 = function(value) { if (missing(value)) return(self$x + 2) else self$x <- value-2 } ) ) B <- BC$new(1, 2) # Environment checks eval_env <- environment(B$getx) super_bind_env <- eval_env$super super_eval_env <- environment(super_bind_env$getx) expect_identical(parent.env(super_bind_env), emptyenv()) expect_identical(parent.env(super_eval_env), environment()) expect_identical(super_eval_env$self, B) expect_identical(super_eval_env$private, B$getprivateA()) expect_identical(B$getprivateA(), B$getprivateB()) # Overridden public method expect_identical(eval_env, environment(B$getx)) # Inherited public method environment(B$getx2) expect_identical(B, environment(B$getx2)$self) # Overridden private method expect_identical(eval_env, environment(B$getprivateA()$getz)) # Inherited private method - should have same eval env as inherited public expect_identical(environment(B$getx2), environment(B$getprivateA()$getz2)) # Behavioral tests # Overriding literals expect_identical(B$x, 1) expect_identical(B$y, 2) expect_identical(B$z, 3) # Subclass value overrides superclass value # Methods expect_identical(B$getx(), 11) # Overridden public method expect_identical(B$getx2(), 2) # Inherited public method expect_identical(B$getprivateA()$getz(), 13) # Overriden private method expect_identical(B$getprivateA()$getz2(), 6) # Inherited private method # Active bindings expect_identical(B$x2, 3) # Overridden expect_identical(B$x3, 3) # Inherited # Classes expect_identical(class(B), c("BC", "AC", "R6")) }) test_that("Inheritance: superclass methods", { AC <- R6Class("AC", portable = TRUE, public = list( x = 0, initialize = function() { self$inc_x() private$inc_y() self$incz }, inc_x = function() self$x <- self$x + 1, inc = function(val) val + 1, pinc = function(val) private$priv_inc(val), # Call private inc method gety = function() private$y, z = 0 ), private = list( y = 0, inc_y = function() private$y <- private$y + 1, priv_inc = function(val) val + 1 ), active = list( incz = function(value) { self$z <- z + 1 } ) ) BC <- R6Class("BC", portable = TRUE, inherit = AC, public = list( inc_x = function() self$x <- self$x + 2, inc = function(val) super$inc(val) + 20 ), private = list( inc_y = function() private$y <- private$y + 2, priv_inc = function(val) super$priv_inc(val) + 20 ), active = list( incz = function(value) { self$z <- self$z + 2 } ) ) B <- BC$new() # Testing overrides expect_identical(B$x, 2) # Public expect_identical(B$gety(), 2) # Private expect_identical(B$z, 2) # Active # Calling superclass methods expect_identical(B$inc(0), 21) expect_identical(B$pinc(0), 21) # Multi-level inheritance CC <- R6Class("CC", portable = TRUE, inherit = BC, public = list( inc_x = function() self$x <- self$x + 3, inc = function(val) super$inc(val) + 300 ), private = list( inc_y = function() private$y <- private$y + 3, priv_inc = function(val) super$priv_inc(val) + 300 ), active = list( incz = function(value) { self$z <- self$z + 3 } ) ) C <- CC$new() # Testing overrides expect_identical(C$x, 3) # Public expect_identical(C$gety(), 3) # Private expect_identical(C$z, 3) # Active # Calling superclass methods (two levels) expect_identical(C$inc(0), 321) expect_identical(C$pinc(0), 321) # Classes expect_identical(class(C), c("CC", "BC", "AC", "R6")) }) test_that("Inheritance: enclosing environments for super$ methods", { encA <- new.env() encB <- new.env() encC <- new.env() encA$n <- 1 encB$n <- 20 encC$n <- 300 AC <- R6Class("AC", portable = TRUE, parent_env = encA, public = list( x = 0, initialize = function() { self$x <- self$get_n() }, get_n = function() n, priv_get_n = function(val) private$get_n_priv() ), private = list( get_n_priv = function() n ), active = list( active_get_n = function() n ) ) A <- AC$new() expect_identical(A$x, 1) expect_identical(A$get_n(), 1) expect_identical(A$priv_get_n(), 1) expect_identical(A$active_get_n, 1) BC <- R6Class("BC", portable = TRUE, parent_env = encB, inherit = AC, public = list( x = 0, initialize = function() { super$initialize() }, get_n = function() n + super$get_n(), priv_get_n = function(val) private$get_n_priv() ), private = list( get_n_priv = function() n + super$get_n_priv() ), active = list( active_get_n = function() n + super$active_get_n ) ) B <- BC$new() expect_identical(B$x, 21) expect_identical(B$get_n(), 21) expect_identical(B$priv_get_n(), 21) expect_identical(B$active_get_n, 21) CC <- R6Class("CC", portable = TRUE, parent_env = encC, inherit = BC, public = list( x = 0, initialize = function() { super$initialize() }, get_n = function() n + super$get_n(), priv_get_n = function(val) private$get_n_priv() ), private = list( get_n_priv = function() n + super$get_n_priv() ), active = list( active_get_n = function() n + super$active_get_n ) ) C <- CC$new() expect_identical(C$x, 321) expect_identical(C$get_n(), 321) expect_identical(C$priv_get_n(), 321) expect_identical(C$active_get_n, 321) }) test_that("Inheritance: enclosing environments for inherited methods", { encA <- new.env() encB <- new.env() encC <- new.env() encA$n <- 1 encB$n <- 20 encC$n <- 300 AC <- R6Class("AC", portable = TRUE, parent_env = encA, public = list( get_n = function() n ) ) A <- AC$new() expect_identical(A$get_n(), 1) BC <- R6Class("BC", portable = TRUE, parent_env = encB, inherit = AC ) B <- BC$new() # Since this inherits A's get_n() method, it should also inherit the # environment in which get_n() runs. This is necessary for inherited methods # to find methods from the correct namespace. expect_identical(B$get_n(), 1) CC <- R6Class("CC", portable = TRUE, parent_env = encC, inherit = BC, public = list( get_n = function() n + super$get_n() ) ) C <- CC$new() # When this calls super$get_n(), it should get B's version of get_n(), which # should in turn run in A's environment, returning 1. Add C's value of n, and # the total is 301. expect_identical(C$get_n(), 301) }) test_that("Inheritance hierarchy for super$ methods", { AC <- R6Class("AC", portable = TRUE, public = list(n = function() 0 + 1) ) expect_identical(AC$new()$n(), 1) BC <- R6Class("BC", portable = TRUE, public = list(n = function() super$n() + 10), inherit = AC ) expect_identical(BC$new()$n(), 11) CC <- R6Class("CC", portable = TRUE, inherit = BC ) # This should equal 11 because it inherits BC's n(), which adds 1 to AC's n() expect_identical(CC$new()$n(), 11) # Skipping one level of inheritance --------------------------------- AC <- R6Class("AC", portable = TRUE, public = list(n = function() 0 + 1) ) expect_identical(AC$new()$n(), 1) BC <- R6Class("BC", portable = TRUE, inherit = AC ) expect_identical(BC$new()$n(), 1) CC <- R6Class("CC", portable = TRUE, public = list(n = function() super$n() + 100), inherit = BC ) # This should equal 101 because BC inherits AC's n() expect_identical(CC$new()$n(), 101) DC <- R6Class("DC", portable = TRUE, inherit = CC ) # This should equal 101 because DC inherits CC's n(), and BC inherits AC's n() expect_identical(DC$new()$n(), 101) # Skipping two level of inheritance --------------------------------- AC <- R6Class("AC", portable = TRUE, public = list(n = function() 0 + 1) ) expect_identical(AC$new()$n(), 1) BC <- R6Class("BC", portable = TRUE, inherit = AC) expect_identical(BC$new()$n(), 1) CC <- R6Class("CC", portable = TRUE, inherit = BC) expect_identical(CC$new()$n(), 1) }) test_that("sub and superclass must both be portable or non-portable", { AC <- R6Class("AC", portable = FALSE, public = list(x=1)) BC <- R6Class("BC", portable = TRUE, inherit = AC) expect_error(BC$new()) AC <- R6Class("AC", portable = TRUE, public = list(x=1)) BC <- R6Class("BC", portable = FALSE, inherit = AC) expect_error(BC$new()) }) test_that("Inheritance is dynamic", { AC <- R6Class("AC", public = list(x = 1, initialize = function() self$x <<- self$x + 10) ) BC <- R6Class("BC", inherit = AC) expect_identical(BC$new()$x, 11) AC <- R6Class("AC", public = list(x = 2, initialize = function() self$x <<- self$x + 20) ) expect_identical(BC$new()$x, 22) # BC doesn't contain AC, and it has less stuff in it, so it should be smaller # than AC. expect_true(pryr::object_size(BC) < pryr::object_size(AC)) }) test_that("Private env is created when all private members are inherited", { # Private contains fields only AC <- R6Class("AC", public = list(getx = function() private$x), private = list(x = 1) ) BC <- R6Class("BC", inherit = AC) expect_identical(BC$new()$getx(), 1) # Private contains functions only AC <- R6Class("AC", public = list(getx = function() private$x()), private = list(x = function() 1) ) BC <- R6Class("BC", inherit = AC) expect_identical(BC$new()$getx(), 1) }) R6/tests/testthat/test-nonportable.R0000644000176200001440000001225713104125424017171 0ustar liggesuserscontext("nonportable") test_that("initialization", { AC <- R6Class("AC", portable = FALSE, public = list( x = 1, initialize = function(x, y) { self$x <- getx() + x # Assign to self; also access a method private$y <- y # Assign to private }, getx = function() x, gety = function() private$y ), private = list( y = 2 ) ) A <- AC$new(2, 3) expect_identical(A$x, 3) expect_identical(A$gety(), 3) # No initialize method: throw error if arguments are passed in AC <- R6Class("AC", portable = FALSE, public = list(x = 1)) expect_error(AC$new(3)) }) test_that("empty members and methods are allowed", { # No initialize method: throw error if arguments are passed in AC <- R6Class("AC", portable = FALSE) expect_no_error(AC$new()) }) test_that("Private members are private, and self/private environments", { AC <- R6Class("AC", portable = FALSE, public = list( x = 1, gety = function() private$y, gety2 = function() y, getx = function() self$x, getx2 = function() x, getx3 = function() getx_priv3(), getx4 = function() getx_priv4() ), private = list( y = 2, getx_priv3 = function() self$x, getx_priv4 = function() x ) ) A <- AC$new() # Environment structure expect_identical(A$self, A) expect_identical(A$private, parent.env(A)) # Enclosing env for fublic and private methods is the public env expect_identical(A, environment(A$getx)) expect_identical(A, environment(A$private$getx_priv3)) # Behavioral tests expect_identical(A$x, 1) expect_null(A$y) expect_error(A$getx_priv3()) expect_identical(A$gety(), 2) # Explicit access: private$y expect_identical(A$gety2(), 2) # Implicit access: y expect_identical(A$getx(), 1) # Explicit access: self$x expect_identical(A$getx2(), 1) # Implicit access: x expect_identical(A$getx3(), 1) # Call private method, which has explicit: self$x expect_identical(A$getx4(), 1) # Call private method, which has implicit: x }) test_that("Active bindings work", { AC <- R6Class("AC", portable = FALSE, public = list( x = 5 ), active = list( x2 = function(value) { if (missing(value)) return(x * 2) else x <<- value/2 } ) ) A <- AC$new() expect_identical(A$x2, 10) A$x <- 20 expect_identical(A$x2, 40) A$x2 <- 60 expect_identical(A$x2, 60) expect_identical(A$x, 30) }) test_that("Locking objects", { AC <- R6Class("AC", portable = FALSE, public = list(x = 1, getx = function() x), private = list(y = 2, gety = function() y), lock_objects = TRUE ) A <- AC$new() # Can modify fields expect_no_error(A$x <- 5) expect_identical(A$x, 5) expect_no_error(A$private$y <- 5) expect_identical(A$private$y, 5) # Can't modify methods expect_error(A$getx <- function() 1) expect_error(A$gety <- function() 2) # Can't add members expect_error(A$z <- 1) expect_error(A$private$z <- 1) # Not locked AC <- R6Class("AC", portable = FALSE, public = list(x = 1, getx = function() x), private = list(y = 2, gety = function() y), lock_objects = FALSE ) A <- AC$new() # Can modify fields expect_no_error(A$x <- 5) expect_identical(A$x, 5) expect_no_error(A$private$y <- 5) expect_identical(A$private$y, 5) # Can't modify methods expect_error(A$getx <- function() 1) expect_error(A$private$gety <- function() 2) # Can add members expect_no_error(A$z <- 1) expect_identical(A$z, 1) expect_no_error(A$private$z <- 1) expect_identical(A$private$z, 1) }) test_that("Validity checks on creation", { fun <- function() 1 # Dummy function for tests # All arguments must be named expect_error(R6Class("AC", public = list(1))) expect_error(R6Class("AC", private = list(1))) expect_error(R6Class("AC", active = list(fun))) # Names can't be duplicated expect_error(R6Class("AC", public = list(a=1, a=2))) expect_error(R6Class("AC", public = list(a=1), private = list(a=1))) expect_error(R6Class("AC", private = list(a=1), active = list(a=fun))) # Reserved names expect_error(R6Class("AC", public = list(self = 1))) expect_error(R6Class("AC", private = list(private = 1))) expect_error(R6Class("AC", active = list(super = 1))) # `initialize` only allowed in public expect_error(R6Class("AC", private = list(initialize = fun))) expect_error(R6Class("AC", active = list(initialize = fun))) }) test_that("default print method has a trailing newline", { ## This is kind of hackish, because both capture.output and ## expect_output drop the trailing newline. This function ## does not work in the general case, but it is good enough ## for this test. expect_output_n <- function(object) { tmp <- file() on.exit(close(tmp)) sink(tmp) print(object) sink(NULL) output <- readChar(tmp, nchar = 10000) last_char <- substr(output, nchar(output), nchar(output)) expect_that(last_char, equals("\n")) } AC <- R6Class("AC") expect_output_n(print(AC)) A <- AC$new() expect_output_n(print(A)) AC <- R6Class("AC", private = list( x = 2 )) expect_output_n(print(AC)) A <- AC$new() expect_output_n(print(A)) }) R6/tests/testthat/test-nonportable-inheritance.R0000644000176200001440000001551313104125424021456 0ustar liggesuserscontext("nonportable-inheritance") test_that("Inheritance", { AC <- R6Class("AC", portable = FALSE, public = list( x = 0, z = 0, initialize = function(x) self$x <- x, getx = function() x, getx2 = function() x*2 ), private = list( getz = function() z, getz2 = function() z*2 ), active = list( x2 = function(value) { if (missing(value)) return(x * 2) else x <<- value/2 }, x3 = function(value) { if (missing(value)) return(x * 3) else x <<- value/3 } ) ) BC <- R6Class("BC", portable = FALSE, inherit = AC, public = list( y = 0, z = 3, initialize = function(x, y) { super$initialize(x) self$y <- y }, getx = function() x + 10 ), private = list( getz = function() z + 10 ), active = list( x2 = function(value) { if (missing(value)) return(x + 2) else x <<- value-2 } ) ) B <- BC$new(1, 2) # Environment checks expect_identical(B, environment(B$getx)) # Overridden public method expect_identical(B, parent.env(environment(B$getx2))) # Inherited public method expect_identical(B, environment(B$private$getz)) # Overridden private method expect_identical(B, parent.env(environment(B$private$getz2))) # Inherited private method # Behavioral tests # Overriding literals expect_identical(B$x, 1) expect_identical(B$y, 2) expect_identical(B$z, 3) # Subclass value overrides superclass value # Methods expect_identical(B$getx(), 11) # Overridden public method expect_identical(B$getx2(), 2) # Inherited public method expect_identical(B$private$getz(), 13) # Overriden private method expect_identical(B$private$getz2(), 6) # Inherited private method # Active bindings expect_identical(B$x2, 3) # Overridden expect_identical(B$x3, 3) # Inherited # Classes expect_identical(class(B), c("BC", "AC", "R6")) }) test_that("Inheritance: superclass methods", { AC <- R6Class("AC", portable = FALSE, public = list( x = 0, initialize = function() { inc_x() inc_self_x() inc_y() inc_self_y() incz }, inc_x = function() x <<- x + 1, inc_self_x = function() self$x <- self$x + 10, inc = function(val) val + 1, pinc = function(val) priv_inc(val), # Call private inc method z = 0 ), private = list( y = 0, inc_y = function() y <<- y + 1, inc_self_y = function() private$y <- private$y + 10, priv_inc = function(val) val + 1 ), active = list( incz = function(value) { z <<- z + 1 } ) ) BC <- R6Class("BC", portable = FALSE, inherit = AC, public = list( inc_x = function() x <<- x + 2, inc_self_x = function() self$x <- self$x + 20, inc = function(val) super$inc(val) + 20 ), private = list( inc_y = function() y <<- y + 2, inc_self_y = function() private$y <- private$y + 20, priv_inc = function(val) super$priv_inc(val) + 20 ), active = list( incz = function(value) { z <<- z + 2 } ) ) B <- BC$new() # Environment checks expect_identical(parent.env(B$super), emptyenv()) # Enclosing env for functions in $super is a child of $self expect_identical(parent.env(environment(B$super$inc_x)), B) # Testing overrides expect_identical(B$x, 22) # Public expect_identical(B$private$y, 22) # Private expect_identical(B$z, 2) # Active # Calling superclass methods expect_identical(B$inc(0), 21) expect_identical(B$pinc(0), 21) # Multi-level inheritance CC <- R6Class("CC", portable = FALSE, inherit = BC, public = list( inc_x = function() x <<- x + 3, inc_self_x = function() self$x <- self$x + 30, inc = function(val) super$inc(val) + 300 ), private = list( inc_y = function() y <<- y + 3, inc_self_y = function() private$y <- private$y + 30, priv_inc = function(val) super$priv_inc(val) + 300 ), active = list( incz = function(value) { z <<- z + 3 } ) ) C <- CC$new() # Testing overrides expect_identical(C$x, 33) # Public expect_identical(C$private$y, 33) # Private expect_identical(C$z, 3) # Active # Calling superclass methods (two levels) expect_identical(C$inc(0), 321) expect_identical(C$pinc(0), 321) # Classes expect_identical(class(C), c("CC", "BC", "AC", "R6")) }) test_that("Inheritance hierarchy for super$ methods", { AC <- R6Class("AC", portable = FALSE, public = list(n = function() 0 + 1) ) expect_identical(AC$new()$n(), 1) BC <- R6Class("BC", portable = FALSE, public = list(n = function() super$n() + 10), inherit = AC ) expect_identical(BC$new()$n(), 11) CC <- R6Class("CC", portable = FALSE, inherit = BC ) # This should equal 11 because it inherits BC's n(), which adds 1 to AC's n() expect_identical(CC$new()$n(), 11) # Skipping one level of inheritance --------------------------------- AC <- R6Class("AC", portable = FALSE, public = list(n = function() 0 + 1) ) expect_identical(AC$new()$n(), 1) BC <- R6Class("BC", portable = FALSE, inherit = AC ) expect_identical(BC$new()$n(), 1) CC <- R6Class("CC", portable = FALSE, public = list(n = function() super$n() + 100), inherit = BC ) # This should equal 101 because BC inherits AC's n() expect_identical(CC$new()$n(), 101) DC <- R6Class("DC", portable = FALSE, inherit = CC ) # This should equal 101 because DC inherits CC's n(), and BC inherits AC's n() expect_identical(DC$new()$n(), 101) # Skipping two level of inheritance --------------------------------- AC <- R6Class("AC", portable = FALSE, public = list(n = function() 0 + 1) ) expect_identical(AC$new()$n(), 1) BC <- R6Class("BC", portable = FALSE, inherit = AC) expect_identical(BC$new()$n(), 1) CC <- R6Class("CC", portable = FALSE, inherit = BC) expect_identical(CC$new()$n(), 1) }) test_that("Private env is created when all private members are inherited", { # Private contains fields only AC <- R6Class("AC", portable = FALSE, public = list( getx = function() x, getx2 = function() private$x ), private = list(x = 1) ) BC <- R6Class("BC", portable = FALSE, inherit = AC) expect_identical(BC$new()$getx(), 1) expect_identical(BC$new()$getx2(), 1) # Private contains functions only AC <- R6Class("AC", portable = FALSE, public = list( getx = function() x(), getx2 = function() private$x() ), private = list(x = function() 1) ) BC <- R6Class("BC", portable = FALSE, inherit = AC) expect_identical(BC$new()$getx(), 1) expect_identical(BC$new()$getx2(), 1) }) R6/tests/testthat/test-set.R0000644000176200001440000000535713104125424015444 0ustar liggesuserscontext("set") test_that("Setting values set values on generator", { AC <- R6Class("AC", public = list( x = 1, getxyz = function() self$x + private$y + private$z() ), private = list( y = 2, z = function() 3 ), active = list( x2 = function(value) { if (missing(value)) return(self$x * 2) else self$x <<- value/2 } ) ) # Can set new names AC$set("public", "nx", 10) AC$set("public", "ngetxyz", function() self$nx + private$ny + private$nz()) AC$set("private", "ny", 20) AC$set("private", "nz", function() 30) AC$set("active", "nx2", function(value) { if (missing(value)) return(self$nx * 2) else self$nx <<- value/2 }) A <- AC$new() expect_identical(A$nx, 10) expect_identical(A$ngetxyz(), 60) expect_identical(A$nx2, 20) # Can't set existing names expect_error(AC$set("public", "x", 99)) expect_error(AC$set("public", "getxyz", function() 99)) expect_error(AC$set("private", "y", 99)) expect_error(AC$set("private", "z", function() 99)) expect_error(AC$set("active", "x2", function(value) 99)) # Can't set existing names in different group expect_error(AC$set("private", "x", 99)) expect_error(AC$set("private", "getxyz", function() 99)) expect_error(AC$set("active", "y", 99)) expect_error(AC$set("public", "z", function() 99)) expect_error(AC$set("private", "x2", function(value) 99)) # Can set existing names if overwrite = TRUE AC$set("public", "x", 99, overwrite = TRUE) AC$set("public", "getxyz", function() 99, overwrite = TRUE) AC$set("private", "y", 99, overwrite = TRUE) AC$set("private", "z", function() 99, overwrite = TRUE) AC$set("active", "x2", function(value) 99, overwrite = TRUE) # Can't set existing names in different group, even if overwrite = TRUE expect_error(AC$set("private", "x", 99, overwrite = TRUE)) expect_error(AC$set("private", "getxyz", function() 99, overwrite = TRUE)) expect_error(AC$set("active", "y", 99, overwrite = TRUE)) expect_error(AC$set("public", "z", function() 99, overwrite = TRUE)) expect_error(AC$set("private", "x2", function(value) 99, overwrite = TRUE)) }) test_that("Setting values with empty public or private", { AC <- R6Class("AC", public = list(), private = list() ) AC$set("public", "x", 1) AC$set("private", "y", 1) AC$set("public", "gety", function() private$y) a <- AC$new() expect_identical(a$x, 1) expect_identical(a$gety(), 1) }) test_that("Locked class", { AC <- R6Class("AC", lock_class = TRUE) expect_error(AC$set("public", "x", 1)) expect_error(AC$set("private", "x", 1)) expect_true(AC$is_locked()) AC$unlock() expect_false(AC$is_locked()) AC$set("public", "x", 1) AC$lock() expect_error(AC$set("public", "x", 2)) }) R6/tests/testthat/test-clone.R0000644000176200001440000003340213117560711015747 0ustar liggesuserscontext("clone") test_that("Can't use reserved name 'clone'", { expect_error(R6Class("AC", public = list(clone = function() NULL))) expect_error(R6Class("AC", private = list(clone = function() NULL))) expect_error(R6Class("AC", active = list(clone = function() NULL))) }) test_that("Can disable cloning", { AC <- R6Class("AC", public = list(x = 1), cloneable = FALSE) a <- AC$new() expect_null(a$clone) }) test_that("Cloning portable objects with public only", { parenv <- new.env() AC <- R6Class("AC", portable = TRUE, public = list( x = 1, getx = function() self$x ), parent_env = parenv ) # Behavioral tests a <- AC$new() b <- a$clone() b$x <- 2 expect_identical(a$getx(), 1) expect_identical(b$getx(), 2) # Enclosing environment for methods a_enclos_env <- environment(a$getx) b_enclos_env <- environment(b$getx) # self points to the object (public binding env) expect_identical(a_enclos_env$self, a) expect_identical(b_enclos_env$self, b) # Parent of enclosing env should be class's parent_env expect_identical(parent.env(a_enclos_env), parenv) expect_identical(parent.env(b_enclos_env), parenv) # Enclosing env only contains self expect_identical(ls(a_enclos_env), "self") expect_identical(ls(b_enclos_env), "self") # Parent of binding env is emptyenv(), for portable classes expect_identical(parent.env(a), emptyenv()) expect_identical(parent.env(b), emptyenv()) # Cloning a clone c <- b$clone() expect_identical(c$getx(), 2) c$x <- 3 expect_identical(c$getx(), 3) }) test_that("Cloning non-portable objects with public only", { parenv <- new.env() AC <- R6Class("AC", portable = FALSE, public = list( x = 1, getx = function() self$x ), parent_env = parenv ) # Behavioral tests a <- AC$new() b <- a$clone() b$x <- 2 expect_identical(a$getx(), 1) expect_identical(b$getx(), 2) # Enclosing environment for methods a_enclos_env <- environment(a$getx) b_enclos_env <- environment(b$getx) # Enclosing env is identical to public binding env expect_identical(a_enclos_env, a) expect_identical(b_enclos_env, b) # self points back to the object (public binding env) expect_identical(a$self, a) expect_identical(b$self, b) # Parent of enclosing env should be class's parent_env expect_identical(parent.env(a_enclos_env), parenv) expect_identical(parent.env(b_enclos_env), parenv) # Contains correct objects expect_identical(ls(a), c("clone", "getx", "self", "x")) expect_identical(ls(b), c("clone", "getx", "self", "x")) }) test_that("Cloning portable objects with public and private", { parenv <- new.env() AC <- R6Class("AC", portable = TRUE, public = list( x = 1, getx = function() self$x, getprivate = function() private, sety = function(value) private$y <- value ), private = list( y = 1, gety = function() private$y ), parent_env = parenv ) # Behavioral tests a <- AC$new() b <- a$clone() b$x <- 2 b$sety(2) expect_identical(a$getx(), 1) expect_identical(a$getprivate()$gety(), 1) expect_identical(b$getx(), 2) expect_identical(b$getprivate()$gety(), 2) # Enclosing environment for methods a_enclos_env <- environment(a$getx) b_enclos_env <- environment(b$getx) # Enclosing environment for private methods is same expect_identical(a_enclos_env, environment(a$getprivate()$gety)) expect_identical(b_enclos_env, environment(b$getprivate()$gety)) # self points to the object (public binding env) expect_identical(a_enclos_env$self, a) expect_identical(b_enclos_env$self, b) # Parent of enclosing env should be class's parent_env expect_identical(parent.env(a_enclos_env), parenv) expect_identical(parent.env(b_enclos_env), parenv) # Parent of public binding env is emptyenv(), for portable classes expect_identical(parent.env(a), emptyenv()) expect_identical(parent.env(b), emptyenv()) # Parent of private binding env is emptyenv(), for portable classes expect_identical(parent.env(a$getprivate()), emptyenv()) expect_identical(parent.env(b$getprivate()), emptyenv()) # Enclosing env only contains self and private expect_identical(ls(a_enclos_env), c("private", "self")) expect_identical(ls(b_enclos_env), c("private", "self")) # public binding env contains just the public members expect_identical(ls(a), c("clone", "getprivate", "getx", "sety", "x")) expect_identical(ls(b), c("clone", "getprivate", "getx", "sety", "x")) # private binding env contains just the private members expect_identical(ls(a$getprivate()), c("gety", "y")) expect_identical(ls(b$getprivate()), c("gety", "y")) }) test_that("Cloning non-portable objects with public and private", { parenv <- new.env() AC <- R6Class("AC", portable = FALSE, public = list( x = 1, getx = function() self$x, getprivate = function() private, sety = function(value) private$y <- value ), private = list( y = 1, gety = function() private$y ), parent_env = parenv ) # Behavioral tests a <- AC$new() b <- a$clone() b$x <- 2 b$sety(2) expect_identical(a$getx(), 1) expect_identical(a$getprivate()$gety(), 1) expect_identical(b$getx(), 2) expect_identical(b$getprivate()$gety(), 2) # Enclosing environment for methods a_enclos_env <- environment(a$getx) b_enclos_env <- environment(b$getx) # Enclosing env is identical to public binding env expect_identical(a_enclos_env, a) expect_identical(b_enclos_env, b) # Enclosing environment for private methods is same expect_identical(a_enclos_env, environment(a$getprivate()$gety)) expect_identical(b_enclos_env, environment(b$getprivate()$gety)) # self points to the object (public binding env) expect_identical(a_enclos_env$self, a) expect_identical(b_enclos_env$self, b) # Parent of enclosing env should be private env expect_identical(parent.env(a), a$getprivate()) expect_identical(parent.env(b), b$getprivate()) # Parent of private env should be class's parent_env expect_identical(parent.env(a$getprivate()), parenv) expect_identical(parent.env(b$getprivate()), parenv) # Public binding env (AKA enclosing env) contains self, private, and members expect_identical(ls(a), c("clone", "getprivate", "getx", "private", "self", "sety", "x")) expect_identical(ls(b), c("clone", "getprivate", "getx", "private", "self", "sety", "x")) # private binding env contains just the private members expect_identical(ls(a$getprivate()), c("gety", "y")) expect_identical(ls(b$getprivate()), c("gety", "y")) }) test_that("Cloning subclasses with inherited private fields", { # For issue #72 AC <- R6Class("AC", public = list( getx = function() private$x ), private = list( x = 1 ) ) BC <- R6Class("BC", inherit = AC, public = list( getx = function() super$getx() ) ) b1 <- BC$new() b2 <- b1$clone() expect_identical(b1$getx(), 1) expect_identical(b2$getx(), 1) }) test_that("Cloning active bindings", { AC <- R6Class("AC", public = list( x = 1 ), active = list( x2 = function(value) { if (missing(value)) self$x * 2 else self$x <- value / 2 } ) ) a <- AC$new() b <- a$clone() a$x <- 10 expect_identical(a$x2, 20) a$x2 <- 22 expect_identical(a$x, 11) expect_identical(b$x2, 2) b$x <- 2 expect_identical(b$x2, 4) b$x2 <- 10 expect_identical(b$x, 5) }) test_that("Cloning active binding in superclass", { AC <- R6Class("AC", public = list( x = 1 ), active = list( x2 = function(value){ if (missing(value)) self$x * 2 else self$x <- value / 2 } ) ) BC <- R6Class("BC", inherit = AC, active = list( x2 = function(value){ if (missing(value)) super$x2 * 2 else super$x2 <- value / 2 } ) ) a <- AC$new() a$x <- 10 expect_identical(a$x2, 20) a$x2 <- 22 expect_identical(a$x, 11) b <- BC$new() b$x <- 10 expect_identical(b$x2, 40) b$x <- 11 expect_identical(b$x2, 44) b1 <- b$clone() expect_identical(b1$x2, 44) b1$x <- 12 expect_identical(b1$x2, 48) }) test_that("Cloning active binding in two levels of inheritance", { # For issue #119 A <- R6Class("A", public = list( methodA = function() "A" ), active = list( x = function() "x" ) ) B <- R6Class("B", inherit = A, public = list( methodB = function() { super$methodA() } ) ) C <- R6Class("C", inherit = B, public = list( methodC = function() { super$methodB() } ) ) C1 <- C$new() C2 <- C1$clone() expect_identical(C2$methodC(), "A") expect_identical( C1$.__enclos_env__$super$.__enclos_env__, environment(C1$.__enclos_env__$super$methodB) ) }) test_that("Lock state", { AC <- R6Class("AC", public = list( x = 1, yval = function(y) { if (missing(y)) private$y else private$y <- y } ), private = list(w = 1), lock_objects = TRUE ) a <- AC$new() b <- a$clone() expect_error(a$z <- 1) expect_error(b$z <- 1) expect_identical(a$yval(), NULL) expect_identical(b$yval(), NULL) expect_error(a$yval(1)) expect_error(b$yval(1)) # With lock = FALSE AC <- R6Class("AC", public = list( x = 1, yval = function(y) { if (missing(y)) private$y else private$y <- y } ), private = list(w = 1), lock_objects = FALSE ) a <- AC$new() b <- a$clone() a$y <- 1 b$y <- 1 expect_identical(a$y, 1) expect_identical(b$y, 1) expect_identical(a$yval(), NULL) expect_identical(b$yval(), NULL) a$yval(1) b$yval(1) expect_identical(a$yval(), 1) expect_identical(b$yval(), 1) }) test_that("Cloning inherited methods", { C1 <- R6Class("C1", public = list( x = 1, getx = function() self$x, addx = function() self$x + 10 ), active = list( xa = function(val) { if (missing(val)) self$x * 2 else self$x <- val / 2 } ) ) C2 <- R6Class("C2", inherit = C1, public = list( x = 2, addx = function() super$addx() + 10 ), active = list( xa = function(val) { if (missing(val)) self$x * 3 else self$x <- val / 3 } ) ) a <- C2$new() b <- a$clone() expect_identical(b$getx(), 2) expect_identical(b$addx(), 22) b$x <- 3 expect_identical(b$getx(), 3) expect_identical(b$addx(), 23) expect_identical(b$xa, 9) b$xa <- 12 expect_identical(b$x, 4) # Make sure a was unaffected expect_identical(a$x, 2) # Same as previous, but with another copy and another level of inheritance C3 <- R6Class("C3", inherit = C2, public = list( x = 3, addx = function() super$addx() + 20 ), active = list( xa = function(val) { if (missing(val)) self$x * 4 else self$x <- val / 4 } ) ) a <- C3$new() b <- a$clone() c <- b$clone() b$x <- 4 c$x <- 5 expect_identical(a$getx(), 3) expect_identical(a$addx(), 43) expect_identical(b$getx(), 4) expect_identical(b$addx(), 44) expect_identical(c$getx(), 5) expect_identical(c$addx(), 45) expect_identical(c$xa, 20) c$xa <- 24 expect_identical(c$x, 6) # Make sure a and b were unaffected expect_identical(a$x, 3) expect_identical(b$x, 4) # Three levels; don't override active binding C3na <- R6Class("C3na", inherit = C2, public = list(x = 3) ) a <- C3na$new() b <- a$clone() b$x <- 4 expect_identical(b$xa, 12) b$xa <- 15 expect_identical(b$x, 5) }) test_that("Deep cloning", { AC <- R6Class("AC", public = list(x = 1)) BC <- R6Class("BC", public = list( x = NULL, y = function() private$y_, initialize = function() { self$x <- AC$new() private$y_ <- AC$new() } ), private = list( y_ = NULL ) ) b <- BC$new() b2 <- b$clone(deep = FALSE) expect_identical(b$x, b2$x) expect_identical(b$y(), b2$y()) b <- BC$new() b2 <- b$clone(deep = TRUE) expect_false(identical(b$x, b2$x)) expect_false(identical(b$y(), b2$y())) # Make sure b2$x and b2$y are properly cloned R6 objects expect_identical(class(b2$x), c("AC", "R6")) expect_identical(class(b2$y()), c("AC", "R6")) # Deep cloning with multiple levels CC <- R6Class("CC", public = list( x = NULL, initialize = function() { self$x <- BC$new() } ) ) c <- CC$new() c2 <- c$clone(deep = TRUE) expect_false(identical(c$x, c2$x)) expect_false(identical(c$x$x, c2$x$x)) # Make sure c2$x and c2$x$x are properly cloned R6 objects expect_identical(class(c2$x), c("BC", "R6")) expect_identical(class(c2$x$x), c("AC", "R6")) # Deep cloning with custom function AC <- R6Class("AC", public = list(x = 1)) BC <- R6Class("BC", public = list( x = "AC", y = "AC", z = "AC", initialize = function() { self$x <- AC$new() self$y <- AC$new() self$z <- AC$new() } ), private = list( deep_clone = function(name, val) { if (name %in% c("x", "y")) val$clone() else val } ) ) a <- BC$new() b <- a$clone() c <- a$clone(deep = TRUE) a$x$x <- 2 a$y$x <- 3 a$z$x <- 4 # b is shallow clone expect_identical(a$x$x, b$x$x) expect_identical(a$y$x, b$y$x) expect_identical(a$z$x, b$z$x) # c has deep clones of x and y, but not z expect_identical(c$x$x, 1) expect_identical(c$y$x, 1) expect_identical(a$z$x, c$z$x) }) test_that("Deep cloning non-portable classes", { # Make sure deep cloning doesn't lead to infinite loop because of `self` AC <- R6Class("AC", portable = FALSE, public = list(x = 1)) a <- AC$new() a$x <- 2 a2 <- a$clone(deep = TRUE) expect_identical(a2$x, 2) expect_identical(a2$self, a2) }) R6/tests/testthat/helper.R0000644000176200001440000000031113104125424015134 0ustar liggesusersexpect_no_error <- function(expr) { err <- FALSE tryCatch(force(expr), error = function(e) { err <<- TRUE } ) expect(!err, "Expected no error, but had error.") invisible(NULL) }R6/tests/testthat/test-finalizer.R0000644000176200001440000001501713104125424016626 0ustar liggesuserscontext("finalizer") test_that("Finalizers are called, portable", { parenv <- new.env() parenv$peekaboo <- FALSE AC <- R6Class("AC", public = list(finalize = function() peekaboo <<- TRUE), portable = TRUE, parent_env = parenv ) a <- AC$new() rm(a) gc() expect_true(parenv$peekaboo) }) test_that("Finalizers are called, non-portable", { parenv <- new.env() parenv$peekaboo <- FALSE AC <- R6Class("AC", public = list(finalize = function() peekaboo <<- TRUE), portable = FALSE, parent_env = parenv ) a <- AC$new() rm(a) gc() expect_true(parenv$peekaboo) }) test_that("Finalizers have the right environment, portable", { parenv <- new.env() parenv$pub <- parenv$priv <- FALSE AC <- R6Class( "AC", public = list( finalize = function() { pub <<- self$mypub; priv <<- private$mypriv }, mypub = TRUE ), private = list( mypriv = TRUE ), portable = TRUE, parent_env = parenv ) a <- AC$new() rm(a) gc() expect_true(parenv$pub) expect_true(parenv$priv) }) test_that("Finalizers have the right environment, non-portable #1", { parenv <- new.env() parenv$pub <- parenv$priv <- FALSE AC <- R6Class( "AC", public = list( finalize = function() { pub <<- self$mypub; priv <<- private$mypriv }, mypub = TRUE ), private = list( mypriv = TRUE ), portable = FALSE, parent_env = parenv ) a <- AC$new() rm(a) gc() expect_true(parenv$pub) expect_true(parenv$priv) }) test_that("Finalizers have the right environment, non-portable #2", { parenv <- new.env() parenv$pub <- parenv$priv <- FALSE AC <- R6Class( "AC", public = list( finalize = function() { pub <<- mypub; priv <<- mypriv }, mypub = TRUE ), private = list( mypriv = TRUE ), portable = FALSE, parent_env = parenv ) a <- AC$new() rm(a) gc() expect_true(parenv$pub) expect_true(parenv$priv) }) test_that("Finalizers are inherited, portable", { AC <- R6Class( "AC", public = list( finalize = function() print("An AC was just deleted") ) ) BC <- R6Class( "BC", inherit = AC ) B <- BC$new() expect_output({ rm(B); gc() }, "An AC was just deleted") }) test_that("Children can override finalizers, portable", { AC <- R6Class( "AC", public = list( finalize = function() cat("An AC was just deleted") ) ) BC <- R6Class( "BC", inherit = AC, public = list( finalize = function() cat("A BC was just deleted") ) ) B <- BC$new() ## The anchors make sure that there is no extra output here expect_output({ rm(B); gc() }, "^A BC was just deleted$") }) test_that("Children can call finalizers in the parent, portable", { AC <- R6Class( "AC", public = list( finalize = function() cat("An AC was just deleted\n") ) ) BC <- R6Class( "BC", inherit = AC, public = list( finalize = function() { super$finalize() cat("A BC was just deleted\n") } ) ) B <- BC$new() expect_output( { rm(B); gc() }, "An AC was just deleted.*A BC was just deleted" ) }) test_that("Finalizers and two levels of inheritance, portable", { AC <- R6Class( "AC", public = list( finalize = function() cat("An AC was just deleted\n") ) ) BC <- R6Class( "BC", inherit = AC, public = list( finalize = function() { super$finalize() cat("A BC was just deleted\n") } ) ) CC <- R6Class( "CC", inherit = BC, public = list( finalize = function() { super$finalize() cat("A CC was just deleted\n") } ) ) C <- CC$new() expect_output( { rm(C); gc() }, "An AC was just deleted.*A BC was just deleted.*A CC was just deleted" ) }) test_that("Finalizers are inherited, non-portable", { AC <- R6Class( "AC", public = list( finalize = function() print("An AC was just deleted") ), portable = FALSE ) BC <- R6Class( "BC", inherit = AC, portable = FALSE ) B <- BC$new() expect_output({ rm(B); gc() }, "An AC was just deleted") }) test_that("Children can override finalizers, non-portable", { AC <- R6Class( "AC", public = list( finalize = function() cat("An AC was just deleted") ), portable = FALSE ) BC <- R6Class( "BC", inherit = AC, public = list( finalize = function() cat("A BC was just deleted") ), portable = FALSE ) B <- BC$new() ## The anchors make sure that there is no extra output here expect_output({ rm(B); gc() }, "^A BC was just deleted$") }) test_that("Children can call finalizers in the parent, non-portable", { AC <- R6Class( "AC", public = list( finalize = function() cat("An AC was just deleted\n") ), portable = FALSE ) BC <- R6Class( "BC", inherit = AC, public = list( finalize = function() { super$finalize() cat("A BC was just deleted\n") } ), portable = FALSE ) B <- BC$new() expect_output( { rm(B); gc() }, "An AC was just deleted.*A BC was just deleted" ) }) test_that("Finalizers and two levels of inheritance, portable", { AC <- R6Class( "AC", public = list( finalize = function() cat("An AC was just deleted\n") ) ) BC <- R6Class( "BC", inherit = AC, public = list( finalize = function() { super$finalize() cat("A BC was just deleted\n") } ) ) CC <- R6Class( "CC", inherit = BC, public = list( finalize = function() { super$finalize() cat("A CC was just deleted\n") } ) ) C <- CC$new() expect_output( { rm(C); gc() }, "An AC was just deleted.*A BC was just deleted.*A CC was just deleted" ) }) test_that("Finalizers and two levels of inheritance, non-portable", { AC <- R6Class( "AC", public = list( finalize = function() cat("An AC was just deleted\n") ), portable = FALSE ) BC <- R6Class( "BC", inherit = AC, public = list( finalize = function() { super$finalize() cat("A BC was just deleted\n") } ), portable = FALSE ) CC <- R6Class( "CC", inherit = BC, public = list( finalize = function() { super$finalize() cat("A CC was just deleted\n") } ), portable = FALSE ) C <- CC$new() expect_output( { rm(C); gc() }, "An AC was just deleted.*A BC was just deleted.*A CC was just deleted" ) }) R6/tests/testthat/test-s3-methods.R0000644000176200001440000000135613104125424016632 0ustar liggesuserscontext("S3 methods") test_that("`$` and `[[` methods don't interfere with R6 operations", { # Make sure that these method aren't used anywhere in internal R6 code `$.AC` <- function(x, name) stop("Attempted to use `$.AC`") `[[.AC` <- function(x, name) stop("Attempted to use `[[.AC`") `$<-.AC` <- function(x, name, value) stop("Attempted to use `$<-.AC`") `[[<-.AC` <- function(x, name, value) stop("Attempted to use `[[<-.AC`") AC <- R6Class("AC", public = list( x = 1, gety = function() private$y ), private = list( y = 2, y2 = function() y * 2 ), active = list( z = function(value) 3 ) ) expect_no_error(a <- AC$new()) expect_no_error(b <- .subset2(a, "clone")()) }) R6/NAMESPACE0000644000176200001440000000036013104125424011753 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(as.list,R6) S3method(format,R6) S3method(format,R6ClassGenerator) S3method(plot,R6) S3method(print,R6) S3method(print,R6ClassGenerator) export(R6Class) export(is.R6) export(is.R6Class) R6/NEWS.md0000644000176200001440000001017513117560710011644 0ustar liggesusersR6 2.2.2 ======== * Fixed [#108](https://github.com/wch/R6/issues/108): When an object with a `super` object and an active binding in the `super` object was cloned, the new object's `super` object did not get the active binding -- it was a normal function. * Fixed [#119](https://github.com/wch/R6/issues/119): When a class had two levels of inheritance, an instance of that class's `super` object could contain methods that had an incorrect enclosing environment. R6 2.2.1 ======== * Vignettes now only try use the microbenchmark package if it is present. This is so that the package builds properly on platforms where microbenchmark is not present, like Solaris. * Fixed ending position for `trim()`. R6 2.2.0 ======== * Classes can define finalizers explicitly, by defining a public `finalize` method. ([#92](https://github.com/wch/R6/issues/92), [#93](https://github.com/wch/R6/pull/93)) * Added function `is.R6()` and `is.R6Class()`. ([#95](https://github.com/wch/R6/pull/95)) * Fixed [#96](https://github.com/wch/R6/issues/96): R6 now avoids using `$` and `[[` after the class has been assigned to the object. This allows the user to provide their own methods for `$` and `[[` without causing problems to R6's operation. R6 2.1.3 ======== * The `plot` S3 method for R6 objects will call `$plot` on the object if present. (#77) * Fixed printing of members that are R6 objects. (#88) * Fixed deep cloning for non-portable classes. (#85) * Added `as.list.R6` method. (#91) R6 2.1.2 ======== * Implemented `format.R6()` and `format.R6ClassGenerator`, the former calls a public `format` method if defined. This might change the functionality of existing classes that define a public `format` method intended for other purposes (#73. Thanks to Kirill Müller) * Functions are shown with their interface in `print` and `format`, limited to one line (#76. Thanks to Kirill Müller) * R6 objects and generators print out which class they inherit from. (#67) R6 2.1.1 ======== * Fixed a bug with printing R6 objects when a `[[` method is defined for the class. (#70) * Fixed cloning of objects that call a `super` method which accesses `private`. (#72) R6 2.1.0 ======== * Added support for making clones of R6 objects with a `clone()` method on R6 objects. The `deep=TRUE` option allows for making clones that have copies of fields with reference semantics (like other R6 objects). (#27) * Allow adding public or private members when there were no public or private members to begin with. (#51) * Previously, when an R6 object was printed, it accessed (and called) active bindings. Now it simply reports that a field is an active binding. (#37, #38. Thanks to Oscar de Lama) * Printing private members now works correctly for portable R6 objects. (#26) * The 'lock' argument has been renamed to 'lock_objects'. Also, there is a new argument, 'lock_class', which can prevent changes to the class. (#52) * Fixed printing of NULL fields. R6 2.0.1 ======== * A superclass is validated on object instantation, not on class creation. * Added `debug` and `undebug` methods to generator object. R6 2.0 ======== * [BREAKING CHANGE] Added `portable` option, which allows inheritance across different package namespaces, and made it the default. * Added `set()` method on class generator object, so new fields and methods can be added after the generator has been created. * All of the functions involved in instantiating objects are encapsulated in an environment separate from the R6 namespace. This means that if a generator is created with one version of R6, saved, then restored in a new R session that has a different version of R6, there shouldn't be any problems with compatibility. * Methods are locked so that they can't be changed. (Fixes #19) * Inheritance of superclasses is dynamic; instead of reading in the superclass when a class is created, this happens each time an object is instantiated. (Fixes #12) * Added trailing newline when printing R6 objects. (Thanks to Gabor Csardi) * The `print` method of R6 objects can be redefined. (Thanks to Gabor Csardi) R6 1.0.1 ======== * First release on CRAN. * Removed pryr from suggested packages. R6 1.0 ======== * First release R6/R/0000755000176200001440000000000013117560710010743 5ustar liggesusersR6/R/utils.R0000644000176200001440000000233113104125424012220 0ustar liggesusersencapsulate({ # Given two named vectors, join them together, and keep only the last element # with a given name in the resulting vector. If b has any elements with the # same name as elements in a, the element in a is dropped. Also, if there are # any duplicated names in a or b, only the last one with that name is kept. merge_vectors <- function(a, b) { if ((!is.null(a) && length(a) > 1 && is.null(names(a))) || (!is.null(b) && length(b) > 1 && is.null(names(b)))) { stop("merge_vectors: vectors must be either NULL or named vectors") } x <- c(a, b) drop_idx <- duplicated(names(x), fromLast = TRUE) x[!drop_idx] } # Check that all elements of a list are named. # NULL and empty lists return TRUE. all_named <- function(x) { if (length(names(x)) != length(x) || any(names(x) == "")) { return(FALSE) } TRUE } # Return all the functions in a list. get_functions <- function(x) { funcs <- vapply(x, is.function, logical(1)) if (all(!funcs)) return(NULL) x[funcs] } # Return all the non-functions in a list. get_nonfunctions <- function(x) { funcs <- vapply(x, is.function, logical(1)) if (all(funcs)) return(NULL) x[!funcs] } }) R6/R/aaa.R0000644000176200001440000000236613104125424011612 0ustar liggesusers# This is the enclosing environment for all of the functions involved in # instantiating objects. It is also the binding environment for all these # functions, except for R6Class(). This is because a generator object can be # saved (in a built package, for example) and then restored in a different R # session which has a different version of the R6 package. With the capsule # environment, the generator object doesn't need to use any functions or objects # from the potentially different R6 namespace, and because the saved/restored # object also saves and restores the capsule environment (but not the R6 # namespace). capsule <- new.env(hash = FALSE) attr(capsule, "name") <- "R6_capsule" # This function takes an expression and evaluates it in the capsule environment. encapsulate <- function(expr) { expr <- substitute(expr) eval(expr, capsule) } # This list contains functions that are copied to the generator environment and # are assigned as the generator env as their enclosing environment. # This is simpler than encapsulate, because these functions don't need to be # enclosed in a special environment now; when a class is created, they will be # copied into the generator environment and assigned it as their enclosing env. generator_funs <- list() R6/R/clone.R0000644000176200001440000001745413117560710012201 0ustar liggesusers# 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(deep = FALSE) { # 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, has_private, private_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) super_copies <- super_copies[setdiff(names(super_copies), ".__enclos_env__")] # Degenerate case: super env is empty if (length(super_copies) == 0) { new_enclos_env$super <- new.env(parent = emptyenv(), hash = FALSE) return() } # Get the enclosing env for the super object. Note that this is the # enclosing env only for methods declared for this level of super object -- # if this super object has inherited methods from its super object, then # those methods will have a different environment. (#119) old_super_enclos_env <- old_super_bind_env$.__enclos_env__ # 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 (has_private) new_super_enclos_env$private <- private_bind_env new_super_bind_env <- new.env(parent = emptyenv(), hash = FALSE) new_super_bind_env$.__enclos_env__ <- new_super_enclos_env # Fix up environments for methods super_copies <- assign_func_envs(super_copies, new_super_enclos_env) # Separate active from non-active items active_idx <- vapply(names(super_copies), bindingIsActive, env = old_super_bind_env, TRUE) active_copies <- super_copies[active_idx] non_active_copies <- super_copies[!active_idx] # Copy over items list2env2(non_active_copies, new_super_bind_env) if (length(active_copies) > 0) { for (name in names(active_copies)) { makeActiveBinding(name, active_copies[[name]], 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, has_private, private_bind_env) } # ------------------------------------------------------------------ old_enclos_env <- .subset2(self, ".__enclos_env__") if (!is.environment(old_enclos_env)) { stop("clone() must be called from an R6 object.") } old_public_bind_env <- self old_private_bind_env <- old_enclos_env$private has_private <- !is.null(old_private_bind_env) # Figure out if we're in a portable class object portable <- !identical(old_public_bind_env, old_enclos_env) # Set up stuff for deep clones if (deep) { if (has_private && is.function(old_private_bind_env$deep_clone)) { # Get private$deep_clone, if available. deep_clone <- old_private_bind_env$deep_clone } else { # If there's no private$deep_clone, then this default function will copy # fields that are R6 objects. deep_clone <- function(name, value) { # Check if it's an R6 object. if (is.environment(value) && !is.null(value$`.__enclos_env__`)) { return(value$clone(deep = TRUE)) } value } } } # Create the new binding and enclosing environments if (portable) { if (has_private) { private_bind_env <- new.env(emptyenv(), hash = FALSE) } public_bind_env <- new.env(emptyenv(), hash = FALSE) new_enclos_env <- new.env(parent.env(old_enclos_env), hash = FALSE) } else { if (has_private) { private_bind_env <- new.env(parent.env(old_private_bind_env), hash = FALSE) public_bind_env <- new.env(private_bind_env, hash = FALSE) } else { public_bind_env <- new.env(parent.env(old_public_bind_env), hash = FALSE) } new_enclos_env <- public_bind_env } # Copy members ---------------------------------------------------- # Copy the old objects, fix up method environments, and put them into the # new binding environment. public_copies <- as.list.environment(old_public_bind_env, all.names = TRUE) # If non-portable, `self` will be there; make sure not to copy it. if (!portable) { public_copies$self <- NULL } # Don't copy .__enclos_env__ public_copies <- public_copies[setdiff(names(public_copies), ".__enclos_env__")] public_copies <- assign_func_envs(public_copies, new_enclos_env) # Separate active and non-active bindings active_idx <- vapply(names(public_copies), bindingIsActive, env = old_public_bind_env, logical(1)) active_copies <- public_copies[active_idx] public_copies <- public_copies[!active_idx] if (deep) { public_copies <- mapply(deep_clone, names(public_copies), public_copies, SIMPLIFY = FALSE) } # Copy in public and active bindings list2env2(public_copies, public_bind_env) if (length(active_copies) > 0) { for (name in names(active_copies)) { makeActiveBinding(name, active_copies[[name]], public_bind_env) } } # Copy private members if (has_private) { private_copies <- as.list.environment(old_private_bind_env, all.names = TRUE) if (deep) { private_copies <- mapply(deep_clone, names(private_copies), private_copies, SIMPLIFY = FALSE) } private_copies <- assign_func_envs(private_copies, new_enclos_env) list2env2(private_copies, private_bind_env) } # Clone super object ------------------------------------------- clone_super(old_enclos_env, new_enclos_env, public_bind_env, has_private, private_bind_env) # Add refs to other environments in the object -------------------- public_bind_env$`.__enclos_env__` <- new_enclos_env # Add self and (optional) private pointer --------------------------- new_enclos_env$self <- public_bind_env if (has_private) new_enclos_env$private <- private_bind_env class(public_bind_env) <- class(old_public_bind_env) # Lock -------------------------------------------------------------- # Copy locked state of environment if (environmentIsLocked(old_public_bind_env)) { lockEnvironment(public_bind_env) } if (has_private && environmentIsLocked(old_private_bind_env)) { lockEnvironment(private_bind_env) } # Always lock methods # We inspect the names in public_copies instead public_bind_env, because # ls() is so slow for environments. R 3.2.0 introduced the sorted=FALSE # option, which makes ls() much faster, so at some point we'll be able to # switch to that. for (name in names(public_copies)) { if (is.function(.subset2(public_bind_env, name))) lockBinding(name, public_bind_env) } if (has_private) { for (name in names(private_copies)) { if (is.function(private_bind_env[[name]])) lockBinding(name, private_bind_env) } } public_bind_env } R6/R/new.R0000644000176200001440000002210413117560710011656 0ustar liggesusers# This is the $new function for a R6ClassGenerator. This copy of it won't run # properly; it needs to be copied, and its parent environment set to the # generator object environment. generator_funs$new <- function(...) { # Get superclass object ------------------------------------------- inherit <- get_inherit() # Some checks on superclass --------------------------------------- if (!is.null(inherit)) { if (!inherits(inherit, "R6ClassGenerator")) stop("`inherit` must be a R6ClassGenerator.") if (!identical(portable, inherit$portable)) stop("Sub and superclass must both be portable or non-portable.") # Merge fields over superclass fields, recursively -------------- recursive_merge <- function(obj, which) { if (is.null(obj)) return(NULL) merge_vectors(recursive_merge(obj$get_inherit(), which), obj[[which]]) } public_fields <- merge_vectors(recursive_merge(inherit, "public_fields"), public_fields) private_fields <- merge_vectors(recursive_merge(inherit, "private_fields"), private_fields) } if (class) { classes <- c(classname, get_superclassnames(inherit), "R6") } else { classes <- NULL } # Precompute some things ------------------------------------------ has_priv <- has_private() # Create binding and enclosing environments ----------------------- if (portable) { # When portable==TRUE, the public binding environment is separate from the # enclosing environment. # Binding environment for private objects (where private objects are found) if (has_priv) private_bind_env <- new.env(parent = emptyenv(), hash = FALSE) else private_bind_env <- NULL # Binding environment for public objects (where public objects are found) public_bind_env <- new.env(parent = emptyenv(), hash = FALSE) # The enclosing environment for methods enclos_env <- new.env(parent = parent_env, hash = FALSE) } else { # When portable==FALSE, the public binding environment is the same as the # enclosing environment. # If present, the private binding env is the parent of the public binding # env. if (has_priv) { private_bind_env <- new.env(parent = parent_env, hash = FALSE) public_bind_env <- new.env(parent = private_bind_env, hash = FALSE) } else { private_bind_env <- NULL public_bind_env <- new.env(parent = parent_env, hash = FALSE) } enclos_env <- public_bind_env } # Add self and private pointer ------------------------------------ enclos_env$self <- public_bind_env if (has_priv) enclos_env$private <- private_bind_env # Fix environment for methods ------------------------------------- public_methods <- assign_func_envs(public_methods, enclos_env) if (has_priv) private_methods <- assign_func_envs(private_methods, enclos_env) if (!is.null(active)) active <- assign_func_envs(active, enclos_env) # Enable debugging ------------------------------------------------ if (length(debug_names) > 0) { lapply(public_methods[names(public_methods) %in% debug_names], base::debug) lapply(private_methods[names(private_methods) %in% debug_names], base::debug) lapply(active[names(active) %in% debug_names], base::debug) } # Set up superclass objects --------------------------------------- if (!is.null(inherit)) { if (portable) { # Set up the superclass objects super_struct <- create_super_env(inherit, public_bind_env, private_bind_env, portable = TRUE) } else { # Set up the superclass objects super_struct <- create_super_env(inherit, public_bind_env, portable = FALSE) } enclos_env$super <- super_struct$bind_env # Merge this level's methods over the superclass methods public_methods <- merge_vectors(super_struct$public_methods, public_methods) private_methods <- merge_vectors(super_struct$private_methods, private_methods) active <- merge_vectors(super_struct$active, active) } # Copy objects to public bind environment ------------------------- list2env2(public_methods, envir = public_bind_env) list2env2(public_fields, envir = public_bind_env) # Copy objects to private bind environment ------------------------ if (has_priv) { list2env2(private_methods, envir = private_bind_env) list2env2(private_fields, envir = private_bind_env) } # Set up active bindings ------------------------------------------ if (!is.null(active)) { for (name in names(active)) { makeActiveBinding(name, active[[name]], public_bind_env) } } # Add refs to other environments in the object -------------------- public_bind_env$`.__enclos_env__` <- enclos_env # Lock ------------------------------------------------------------ if (lock_objects) { if (has_priv) lockEnvironment(private_bind_env) lockEnvironment(public_bind_env) } # Always lock methods if (has_priv) { for (name in names(private_methods)) lockBinding(name, private_bind_env) } for (name in names(public_methods)) lockBinding(name, public_bind_env) class(public_bind_env) <- classes # Initialize ------------------------------------------------------ if (is.function(.subset2(public_bind_env, "initialize"))) { .subset2(public_bind_env, "initialize")(...) } else if (length(list(...)) != 0 ) { stop("Called new() with arguments, but there is no initialize method.") } # Finalize -------------------------------------------------------- if (is.function(.subset2(public_bind_env, "finalize"))) { reg.finalizer( public_bind_env, function(...) .subset2(public_bind_env, "finalize")(), onexit = TRUE ) } public_bind_env } encapsulate({ # Create and populate the self$super environment, for non-portable case. # In this function, we "climb to the top" of the superclass hierarchy by # recursing early on in the function, and then fill the methods downward by # doing the work for each level and passing the needed information down. create_super_env <- function(inherit, public_bind_env, private_bind_env = NULL, portable = TRUE) { public_methods <- inherit$public_methods private_methods <- inherit$private_methods active <- inherit$active # Set up super enclosing and binding environments ------------------- # The environment in which functions run is a child of the public bind env # (AKA self). # For portable classes, this is a child of the superclass's parent env. # For non-portable classes, this is a child of self; however, self has no # bindings that point to it. The only reason this environment is needed is so # that if a function super$foo in turn calls super$bar, it will be able to # find bar from the next superclass up. if (portable) enclos_parent <- inherit$parent_env else enclos_parent <- public_bind_env super_enclos_env <- new.env(parent = enclos_parent, hash = FALSE) # The binding environment is a new environment. Its parent doesn't matter # because it's not the enclosing environment for any functions. super_bind_env <- new.env(parent = emptyenv(), hash = FALSE) # Need to store the enclosing environment for cloning. super_bind_env$.__enclos_env__ <- super_enclos_env # Add self/private pointers ----------------------------------------- if (portable) { super_enclos_env$self <- public_bind_env if (!is.null(private_bind_env)) super_enclos_env$private <- private_bind_env } # Set up method environments ---------------------------------------- # All the methods can be found in self$super (the binding env). # Their enclosing env is a different environment. public_methods <- assign_func_envs(public_methods, super_enclos_env) private_methods <- assign_func_envs(private_methods, super_enclos_env) active <- assign_func_envs(active, super_enclos_env) # Recurse if there are more superclasses ---------------------------- inherit_inherit <- inherit$get_inherit() if (!is.null(inherit_inherit)) { super_struct <- create_super_env(inherit_inherit, public_bind_env, private_bind_env, portable) super_enclos_env$super <- super_struct$bind_env # Merge this level's methods over the superclass methods public_methods <- merge_vectors(super_struct$public_methods, public_methods) private_methods <- merge_vectors(super_struct$private_methods, private_methods) active <- merge_vectors(super_struct$active, active) } # Copy the methods into the binding environment --------------------- list2env2(public_methods, envir = super_bind_env) list2env2(private_methods, envir = super_bind_env) for (name in names(active)) { makeActiveBinding(name, active[[name]], super_bind_env) } # Return an object with all the information needed to merge down list( bind_env = super_bind_env, public_methods = public_methods, private_methods = private_methods, active = active ) } }) R6/R/generator_funs.R0000644000176200001440000000553013104125424014105 0ustar liggesusers# This function returns the superclass object generator_funs$get_inherit <- function() { # The NULL arg speeds up eval a tiny bit eval(inherit, parent_env, NULL) } # This is the $has_private function for a R6ClassGenerator. This copy of it # won't run properly; it needs to be copied, and its parent environment set to # the generator object environment. # Returns TRUE if this class or one of its ancestor superclasses has private # members; FALSE otherwise. generator_funs$has_private <- function() { inherit <- get_inherit() if (!is.null(private_fields) || !is.null(private_methods)) TRUE else if (is.null(inherit)) FALSE else inherit$has_private() } # This is the $set function for a R6ClassGenerator. This copy of it won't run # properly; it needs to be copied, and its parent environment set to the # generator object environment. generator_funs$set <- function(which = NULL, name = NULL, value, overwrite = FALSE) { if (lock_class) stop("Can't modify a locked R6 class.") if (is.null(which) || !(which %in% c("public", "private", "active"))) stop("`which` must be 'public', 'private', or 'active'.") if (is.null(name) || !is.character(name)) stop("`name` must be a string.") if (missing(value)) stop("`value` must be provided.") # Find which group this object should go in. if (which == "public") { group <- if (is.function(value)) "public_methods" else "public_fields" } else if (which == "private") { group <- if (is.function(value)) "private_methods" else "private_fields" } else if (which == "active") { if (is.function(value)) group <- "active" else stop("Can't add non-function to active") } # Check that it's not already present all_groups <- c("public_methods", "public_fields", "private_methods", "private_fields", "active") # If we're allowed to overwrite, don't check the group that this object # would go in. if (overwrite) all_groups <- setdiff(all_groups, group) all_names <- unlist(lapply(all_groups, function(g) names(get(g)))) if (name %in% all_names) { stop("Can't add ", name, " because it already present in ", classname, " generator.") } # Assign in correct group. Create group if it doesn't exist. if (is.null(self[[group]])) self[[group]] <- list() self[[group]][[name]] <- value invisible() } # Enable debugging for one or more methods. This will apply to all objects # instantiated after this is called. generator_funs$debug <- function(name) { debug_names <<- union(debug_names, name) } # Disable debugging for one or more methods. generator_funs$undebug <- function(name) { debug_names <<- setdiff(debug_names, name) } generator_funs$lock <- function() { lock_class <<- TRUE } generator_funs$unlock <- function() { lock_class <<- FALSE } generator_funs$is_locked <- function() { lock_class } R6/R/env_utils.R0000644000176200001440000000250113104125424013067 0ustar liggesusersencapsulate({ # Search a list for all function objects, change the environment for those # functions to a target environment, and return the modified list. 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 }) } # Get names of all superclasses get_superclassnames <- function(inherit) { if (is.null(inherit)) return(NULL) c(inherit$classname, get_superclassnames(inherit$get_inherit())) } # Wrapper around list2env with a NULL check. In R <3.2.0, if an empty unnamed # list is passed to list2env(), it errors. But an empty named list is OK. For # R >=3.2.0, this wrapper is not necessary. # @param empty_to_null Controls what to do when x is NULL or empty list. # If TRUE, return NULL. If FALSE, return an empty list. 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) } }) R6/R/is.R0000644000176200001440000000132613104125424011476 0ustar liggesusers#' Is an object an R6 Class Generator or Object? #' #' Checks for R6 class generators and R6 objects. #' @param x An object. #' @return A logical value. #' \itemize{ #' \item{\code{is.R6Class} returns \code{TRUE} when the input is an R6 class #' generator and \code{FALSE} otherwise.} #' \item{\code{is.R6} returns \code{TRUE} when the input is an R6 object and #' \code{FALSE} otherwise.} #' } #' @examples #' class_generator <- R6Class() #' object <- class_generator$new() #' #' is.R6Class(class_generator) #' is.R6(class_generator) #' #' is.R6Class(object) #' is.R6(object) #' @export is.R6 <- function(x) { inherits(x, "R6") } #' @rdname is.R6 #' @export is.R6Class <- function(x) { inherits(x, "R6ClassGenerator") } R6/R/print.R0000644000176200001440000000775313104125424012231 0ustar liggesusers#' @export format.R6 <- function(x, ...) { if (is.function(.subset2(x, "format"))) { .subset2(x, "format")(...) } else { ret <- paste0("<", class(x)[1], ">") # If there's another class besides first class and R6 classes <- setdiff(class(x), "R6") if (length(classes) >= 2) { ret <- c(ret, paste0(" Inherits from: <", classes[2], ">")) } ret <- c(ret, " Public:", indent(object_summaries(x, exclude = ".__enclos_env__"), 4) ) private <- .subset2(.subset2(x, ".__enclos_env__"), "private") if (!is.null(private)) { ret <- c(ret, " Private:", indent(object_summaries(private), 4) ) } paste(ret, collapse = "\n") } } #' @export print.R6 <- function(x, ...) { if (is.function(.subset2(x, "print"))) { .subset2(x, "print")(...) } else { cat(format(x, ...), sep = "\n") } } #' @export format.R6ClassGenerator <- function(x, ...) { classname <- x$classname if (is.null(classname)) classname <- "unnamed" ret <- paste0("<", classname, "> object generator") if (!is.null(x$inherit)) { ret <- c(ret, paste0(" Inherits from: <", deparse(x$inherit), ">")) } ret <- c(ret, " Public:", indent(object_summaries(x$public_fields), 4), indent(object_summaries(x$public_methods), 4) ) if (!is.null(x$active)) { ret <- c(ret, " Active bindings:", indent(object_summaries(x$active), 4) ) } if (!(is.null(x$private_fields) && is.null(x$private_methods))) { ret <- c(ret, " Private:", indent(object_summaries(x$private_fields), 4), indent(object_summaries(x$private_methods), 4) ) } ret <- c(ret, paste(" Parent env:", format(x$parent_env))) # R6 generators created by versions <2.1 could be used with this version of # print. They had x$lock instead of x$lock_objects, and they didn't have # x$lock_class at all. Make sure we don't error in that case. Eventually we'll # be able to remove this check. if (!is.null(x$lock) && is.logical(x$lock)) ret <- c(ret, paste(" Locked objects:", x$lock)) if (!is.null(x$lock_objects)) ret <- c(ret, paste(" Locked objects:", x$lock_objects)) if (!is.null(x$lock_class)) ret <- c(ret, paste(" Locked class:", x$lock_class)) ret <- c(ret, paste(" Portable:", x$portable)) paste(ret, collapse = "\n") } #' @export print.R6ClassGenerator <- function(x, ...) { cat(format(x, ...), sep = "\n") } # Return a summary string of the items of a list or environment # x must be a list or environment object_summaries <- function(x, exclude = NULL) { if (length(x) == 0) return(NULL) if (is.list(x)) obj_names <- names(x) else if (is.environment(x)) obj_names <- ls(x, all.names = TRUE) obj_names <- setdiff(obj_names, exclude) values <- vapply(obj_names, function(name) { if (is.environment(x) && bindingIsActive(name, x)) { "active binding" } else { obj <- .subset2(x, name) if (is.function(obj)) deparse(args(obj))[[1L]] # Plain environments (not envs with classes, like R6 or RefClass objects) else if (is.environment(obj) && identical(class(obj), "environment")) "environment" else if (is.null(obj)) "NULL" else if (is.atomic(obj)) trim(paste(as.character(obj), collapse = " ")) else paste(class(obj), collapse = ", ") } }, FUN.VALUE = character(1)) paste0(obj_names, ": ", values, sep = "") } # Given a string, indent every line by some number of spaces. # The exception is to not add spaces after a trailing \n. indent <- function(str, indent = 0) { gsub("(^|\\n)(?!$)", paste0("\\1", paste(rep(" ", indent), collapse = "")), str, perl = TRUE ) } # Trim a string to n characters; if it's longer than n, add " ..." to the end trim <- function(str, n = 60) { if (nchar(str) > n) paste(substr(str, 1, n-4), "...") else str } #' @export plot.R6 <- function(x, ...) { if (is.function(x$plot)) { x$plot(...) } else { stop(paste0("No plot method defined for R6 class ", class(x)[1])) } } R6/R/r6_class.R0000644000176200001440000004266013104125424012605 0ustar liggesusers#' Create an R6 reference object generator #' #' R6 objects are essentially environments, structured in a way that makes them #' look like an object in a more typical object-oriented language than R. They #' support public and private members, as well as inheritance across different #' packages. #' #' An R6 object consists of a public environment, and may also contain a private #' environment, as well as environments for superclasses. In one sense, the #' object and the public environment are the same; a reference to the object is #' identical to a reference to the public environment. But in another sense, the #' object also consists of the fields, methods, private environment and so on. #' #' The \code{active} argument is a list of active binding functions. These #' functions take one argument. They look like regular variables, but when #' accessed, a function is called with an optional argument. For example, if #' \code{obj$x2} is an active binding, then when accessed as \code{obj$x2}, it #' calls the \code{x2()} function that was in the \code{active} list, with no #' arguments. However, if a value is assigned to it, as in \code{obj$x2 <- 50}, #' then the function is called with the right-side value as its argument, as in #' \code{x2(50)}. See \code{\link{makeActiveBinding}} for more information. #' #' If the public or private lists contain any items that have reference #' semantics (for example, an environment), those items will be shared across #' all instances of the class. To avoid this, add an entry for that item with a #' \code{NULL} initial value, and then in the \code{initialize} method, #' instantiate the object and assign it. #' #' @section The \code{print} method: #' #' R6 object generators and R6 objects have a default \code{print} method to #' show them on the screen: they simply list the members and parameters (e.g. #' lock_objects, portable, etc., see above) of the object. #' #' The default \code{print} method of R6 objects can be redefined, by #' supplying a public \code{print} method. (\code{print} members that are not #' functions are ignored.) This method is automatically called whenever the #' object is printed, e.g. when the object's name is typed at the command #' prompt, or when \code{print(obj)} is called. It can also be called directly #' via \code{obj$print()}. All extra arguments from a \code{print(obj, ...)} #' call are passed on to the \code{obj$print(...)} method. #' #' @section Portable and non-portable classes: #' #' When R6 classes are portable (the default), they can be inherited across #' packages without complication. However, when in portable mode, members must #' be accessed with \code{self} and \code{private}, as in \code{self$x} and #' \code{private$y}. #' #' When used in non-portable mode, R6 classes behave more like reference #' 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. #' #' By default, calling \code{x$clone()} on an R6 object will result in a #' shallow clone. That is, if any fields have reference semantics #' (environments, R6, or reference class objects), they will not be copied; #' instead, the clone object will have a field that simply refers to the same #' object. #' #' To make a deep copy, you can use \code{x$clone(deep=TRUE)}. With this #' option, any fields that are R6 objects will also be cloned; however, #' environments and reference class objects will not be. #' #' If you want different deep copying behavior, you can supply your own #' private method called \code{deep_clone}. This method will be called for #' each field in the object, with two arguments: \code{name}, which is the #' name of the field, and \code{value}, which is the value. Whatever the #' method returns will be used as the value for the field in the new clone #' object. You can write a \code{deep_clone} method that makes copies of #' specific fields, whether they are environments, R6 objects, or reference #' class objects. #' #' @section S3 details: #' #' Normally the public environment will have two classes: the one supplied in #' the \code{classname} argument, and \code{"R6"}. It is possible to get the #' public environment with no classes, by using \code{class=FALSE}. This will #' result in faster access speeds by avoiding class-based dispatch of #' \code{$}. The benefit is is negligible in most cases. #' #' If a class is a subclass of another, the object will have as its classes #' the \code{classname}, the superclass's \code{classname}, and \code{"R6"} #' #' The primary difference in behavior when \code{class=FALSE} is that, without #' a class attribute, it won't be possible to use S3 methods with the objects. #' So, for example, pretty printing (with \code{print.R6Class}) won't be used. #' #' @aliases R6 #' @export #' @param classname Name of the class. The class name is useful primarily for S3 #' method dispatch. #' @param public A list of public members, which can be functions (methods) and #' non-functions (fields). #' @param private An optional list of private members, which can be functions #' and non-functions. #' @param active An optional list of active binding functions. #' @param inherit A R6ClassGenerator object to inherit from; in other words, a #' superclass. This is captured as an unevaluated expression which is #' evaluated in \code{parent_env} each time an object is instantiated. #' @param portable If \code{TRUE} (the default), this class will work with #' inheritance across different packages. Note that when this is enabled, #' fields and members must be accessed with \code{self$x} or #' \code{private$x}; they can't be accessed with just \code{x}. #' @param parent_env An environment to use as the parent of newly-created #' objects. #' @param class Should a class attribute be added to the object? Default is #' \code{TRUE}. If \code{FALSE}, the objects will simply look like #' environments, which is what they are. #' @param lock_objects Should the environments of the generated objects be #' locked? If locked, new members can't be added to the objects. #' @param lock_class If \code{TRUE}, it won't be possible to add more members to #' the generator object with \code{$set}. If \code{FALSE} (the default), then #' 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 --------------------------------------------------------- #' Queue <- R6Class("Queue", #' public = list( #' initialize = function(...) { #' for (item in list(...)) { #' self$add(item) #' } #' }, #' add = function(x) { #' private$queue <- c(private$queue, list(x)) #' invisible(self) #' }, #' remove = function() { #' if (private$length() == 0) return(NULL) #' # Can use private$queue for explicit access #' head <- private$queue[[1]] #' private$queue <- private$queue[-1] #' head #' } #' ), #' private = list( #' queue = list(), #' length = function() base::length(private$queue) #' ) #' ) #' #' q <- Queue$new(5, 6, "foo") #' #' # Add and remove items #' q$add("something") #' q$add("another thing") #' q$add(17) #' q$remove() #' #> [1] 5 #' q$remove() #' #> [1] 6 #' #' # Private members can't be accessed directly #' q$queue #' #> NULL #' # q$length() #' #> Error: attempt to apply non-function #' #' # add() returns self, so it can be chained #' q$add(10)$add(11)$add(12) #' #' # remove() returns the value removed, so it's not chainable #' q$remove() #' #> [1] "foo" #' q$remove() #' #> [1] "something" #' q$remove() #' #> [1] "another thing" #' q$remove() #' #> [1] 17 #' #' #' # Active bindings ------------------------------------------------- #' Numbers <- R6Class("Numbers", #' public = list( #' x = 100 #' ), #' active = list( #' x2 = function(value) { #' if (missing(value)) return(self$x * 2) #' else self$x <- value/2 #' }, #' rand = function() rnorm(1) #' ) #' ) #' #' n <- Numbers$new() #' n$x #' #> [1] 100 #' n$x2 #' #> [1] 200 #' n$x2 <- 1000 #' n$x #' #> [1] 500 #' #' # If the function takes no arguments, it's not possible to use it with <-: #' n$rand #' #> [1] 0.2648 #' n$rand #' #> [1] 2.171 #' # n$rand <- 3 #' #> Error: unused argument (quote(3)) #' #' #' # Inheritance ----------------------------------------------------- #' # Note that this isn't very efficient - it's just for illustrating inheritance. #' HistoryQueue <- R6Class("HistoryQueue", #' inherit = Queue, #' public = list( #' show = function() { #' cat("Next item is at index", private$head_idx + 1, "\n") #' for (i in seq_along(private$queue)) { #' cat(i, ": ", private$queue[[i]], "\n", sep = "") #' } #' }, #' remove = function() { #' if (private$length() - private$head_idx == 0) return(NULL) #' private$head_idx <<- private$head_idx + 1 #' private$queue[[private$head_idx]] #' } #' ), #' private = list( #' head_idx = 0 #' ) #' ) #' #' hq <- HistoryQueue$new(5, 6, "foo") #' hq$show() #' #> Next item is at index 1 #' #> 1: 5 #' #> 2: 6 #' #> 3: foo #' hq$remove() #' #> [1] 5 #' hq$show() #' #> Next item is at index 2 #' #> 1: 5 #' #> 2: 6 #' #> 3: foo #' hq$remove() #' #> [1] 6 #' #' #' #' # Calling superclass methods with super$ -------------------------- #' CountingQueue <- R6Class("CountingQueue", #' inherit = Queue, #' public = list( #' add = function(x) { #' private$total <<- private$total + 1 #' super$add(x) #' }, #' get_total = function() private$total #' ), #' private = list( #' total = 0 #' ) #' ) #' #' cq <- CountingQueue$new("x", "y") #' cq$get_total() #' #> [1] 2 #' cq$add("z") #' cq$remove() #' #> [1] "x" #' cq$remove() #' #> [1] "y" #' cq$get_total() #' #> [1] 3 #' #' #' # Non-portable classes -------------------------------------------- #' # By default, R6 classes are portable, which means they can be inherited #' # across different packages. Portable classes require using self$ and #' # private$ to access members. #' # When used in non-portable mode, members can be accessed without self$, #' # and assignments can be made with <<-. #' #' NP <- R6Class("NP", #' portable = FALSE, #' public = list( #' x = NA, #' getx = function() x, #' setx = function(value) x <<- value #' ) #' ) #' #' np <- NP$new() #' np$setx(10) #' np$getx() #' #> [1] 10 #' #' # Setting new values ---------------------------------------------- #' # It is possible to add new members to the class after it has been created, #' # by using the $set() method on the generator. #' #' Simple <- R6Class("Simple", #' public = list( #' x = 1, #' getx = function() self$x #' ) #' ) #' #' Simple$set("public", "getx2", function() self$x*2) #' #' # Use overwrite = TRUE to overwrite existing values #' Simple$set("public", "x", 10, overwrite = TRUE) #' #' 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 #' #' #' # Deep clones ----------------------------------------------------- #' #'Simple <- R6Class("Simple", #' public = list( #' x = NULL, #' initialize = function(val) self$x <- val #' ) #') #' #' Cloner <- R6Class("Cloner", #' public = list( #' s = NULL, #' y = 1, #' initialize = function() self$s <- Simple$new(1) #' ) #' ) #' #' a <- Cloner$new() #' b <- a$clone() #' c <- a$clone(deep = TRUE) #' #' # Modify a #' a$s$x <- 2 #' a$y <- 2 #' #' # b is a shallow clone. b$s is the same as a$s because they are R6 objects. #' b$s$x #' #> [1] 2 #' # But a$y and b$y are different, because y is just a value. #' b$y #' #> [1] 1 #' #' # c is a deep clone, so c$s is not the same as a$s. #' c$s$x #' #> [1] 1 #' c$y #' #> [1] 1 #' #' #' # Deep clones with custom deep_clone method ----------------------- #' #' CustomCloner <- R6Class("CustomCloner", #' public = list( #' e = NULL, #' s1 = NULL, #' s2 = NULL, #' s3 = NULL, #' initialize = function() { #' self$e <- new.env(parent = emptyenv()) #' self$e$x <- 1 #' self$s1 <- Simple$new(1) #' self$s2 <- Simple$new(1) #' self$s3 <- Simple$new(1) #' } #' ), #' private = list( #' # When x$clone(deep=TRUE) is called, the deep_clone gets invoked once for #' # each field, with the name and value. #' deep_clone = function(name, value) { #' if (name == "e") { #' # e1 is an environment, so use this quick way of copying #' list2env(as.list.environment(value, all.names = TRUE), #' parent = emptyenv()) #' #' } else if (name %in% c("s1", "s2")) { #' # s1 and s2 are R6 objects which we can clone #' value$clone() #' #' } else { #' # For everything else, just return it. This results in a shallow #' # copy of s3. #' value #' } #' } #' ) #' ) #' #' a <- CustomCloner$new() #' b <- a$clone(deep = TRUE) #' #' # Change some values in a's fields #' a$e$x <- 2 #' a$s1$x <- 3 #' a$s2$x <- 4 #' a$s3$x <- 5 #' #' # b has copies of e, s1, and s2, but shares the same s3 #' b$e$x #' #> [1] 1 #' b$s1$x #' #> [1] 1 #' b$s2$x #' #> [1] 1 #' b$s3$x #' #> [1] 5 #' #' #' # Debugging ------------------------------------------------------- #' \dontrun{ #' # This will enable debugging the getx() method for objects of the 'Simple' #' # class that are instantiated in the future. #' Simple$debug("getx") #' s <- Simple$new() #' s$getx() #' #' # Disable debugging for future instances: #' Simple$undebug("getx") #' s <- Simple$new() #' s$getx() #' #' # To enable and disable debugging for a method in a single instance of an #' # R6 object (this will not affect other objects): #' s <- Simple$new() #' debug(s$getx) #' s$getx() #' undebug(s$getx) #' } # This function is encapsulated so that it is bound in the R6 namespace, but # enclosed in the capsule environment R6Class <- encapsulate(function(classname = NULL, public = list(), private = NULL, active = NULL, inherit = NULL, lock_objects = TRUE, class = TRUE, portable = TRUE, 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.") 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'.") if ("initialize" %in% c(names(private), names(active))) stop("'initialize' is not allowed in private or active.") if (length(get_nonfunctions(active)) != 0) stop("All items in active must be functions.") if (!missing(lock)) { message(paste0( "R6Class ", classname, ": 'lock' argument has been renamed to 'lock_objects' as of version 2.1.", "This code will continue to work, but the 'lock' option will be removed in a later version of R6" )) lock_objects <- lock } # Create the generator object, which is an environment generator <- new.env(parent = capsule) 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 generator$parent_env <- parent_env generator$lock_objects <- lock_objects generator$class <- class generator$lock_class <- lock_class # Separate fields from methods generator$public_fields <- get_nonfunctions(public) generator$private_fields <- get_nonfunctions(private) 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) attr(generator, "name") <- paste0(classname, "_generator") class(generator) <- "R6ClassGenerator" generator }) R6/R/aslist.R0000644000176200001440000000047613104125424012367 0ustar liggesusers#' Create a list from an R6 object #' #' This returns a list of public members from the object. It simply calls #' \code{as.list.environment}. #' #' @param x An R6 object. #' @param ... Other arguments, which will be ignored. #' #' @export as.list.R6 <- function(x, ...) { as.list.environment(x, all.names = TRUE) } R6/vignettes/0000755000176200001440000000000013117561013012547 5ustar liggesusersR6/vignettes/Introduction.Rmd0000644000176200001440000004273113104125424015701 0ustar liggesusers--- title: "Introduction to R6 classes" output: html_document: theme: null css: mystyle.css toc: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Introduction to R6 classes} %\usepackage[utf8]{inputenc} --- ```{r echo = FALSE} library(pryr) knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ``` The R6 package provides a type of class which is similar to R's standard reference classes, but it is more efficient and doesn't depend on S4 classes and the methods package. ## R6 classes R6 classes are similar to R's standard reference classes, but are lighter weight, and avoid some issues that come along with using S4 classes (R's reference classes are based on S4). For more information about speed and memory footprint, see the Performance vignette. Unlike many objects in R, instances (objects) of R6 classes have reference semantics. R6 classes also support: * public and private methods * active bindings * inheritance (superclasses) which works across packages Why the name R6? When R's reference classes were introduced, some users, following the names of R's existing class systems S3 and S4, called the new class system R5 in jest. Although reference classes are not actually called R5, the name of this package and its classes takes inspiration from that name. The name R5 was also a code-name used for a different object system started by Simon Urbanek, meant to solve some issues with S4 relating to syntax and performance. However, the R5 branch was shelved after a little development, and it was never released. ### Basics Here's how to create a simple R6 class. The `public` argument is a list of items, which can be functions and fields (non-functions). Functions will be used as methods. ```{r} library(R6) Person <- R6Class("Person", public = list( name = NULL, hair = NULL, initialize = function(name = NA, hair = NA) { self$name <- name self$hair <- hair self$greet() }, set_hair = function(val) { self$hair <- val }, greet = function() { cat(paste0("Hello, my name is ", self$name, ".\n")) } ) ) ``` To instantiate an object of this class, use `$new()`: ```{r} ann <- Person$new("Ann", "black") ann ``` The `$new()` method creates the object and calls the `initialize()` method, if it exists. Inside methods of the class, `self` refers to the object. Public members of the object (all you've seen so far) are accessed with `self$x`, and assignment is done with `self$x <- y`. Note that by default, `self` is required to access members, although for non-portable classes which we'll see later, it is optional. Once the object is instantiated, you can access values and methods with `$`: ```{r} ann$hair ann$greet() ann$set_hair("red") ann$hair ``` Implementation note: The external face of an R6 object is basically an environment with the public members in it. This is also known as the *public environment*. An R6 object's methods have a separate *enclosing environment* which, roughly speaking, is the environment they "run in". This is where `self` binding is found, and it is simply a reference back to public environment. ### Private members In the previous example, all the members were public. It's also possible to add private members: ```{r} Queue <- R6Class("Queue", public = list( initialize = function(...) { for (item in list(...)) { self$add(item) } }, add = function(x) { private$queue <- c(private$queue, list(x)) invisible(self) }, remove = function() { if (private$length() == 0) return(NULL) # Can use private$queue for explicit access head <- private$queue[[1]] private$queue <- private$queue[-1] head } ), private = list( queue = list(), length = function() base::length(private$queue) ) ) q <- Queue$new(5, 6, "foo") ``` Whereas public members are accessed with `self`, like `self$add()`, private members are accessed with `private`, like `private$queue`. The public members can be accessed as usual: ```{r} # Add and remove items q$add("something") q$add("another thing") q$add(17) q$remove() q$remove() ``` However, private members can't be accessed directly: ```{r eval = FALSE} q$queue #> NULL q$length() #> Error: attempt to apply non-function ``` A useful design pattern is for methods to return `self` (invisibly) when possible, because it makes them chainable. For example, the `add()` method returns `self` so you can chain them together: ```{r} q$add(10)$add(11)$add(12) ``` On the other hand, `remove()` returns the value removed, so it's not chainable: ```{r} q$remove() q$remove() q$remove() q$remove() ``` ### Active bindings Active bindings look like fields, but each time they are accessed, they call a function. They are always publicly visible. ```{r} Numbers <- R6Class("Numbers", public = list( x = 100 ), active = list( x2 = function(value) { if (missing(value)) return(self$x * 2) else self$x <- value/2 }, rand = function() rnorm(1) ) ) n <- Numbers$new() n$x ``` When an active binding is accessed as if reading a value, it calls the function with `value` as a missing argument: ```{r} n$x2 ``` When it's accessed as if assigning a value, it uses the assignment value as the `value` argument: ```{r} n$x2 <- 1000 n$x ``` If the function takes no arguments, it's not possible to use it with `<-`: ```{r eval=FALSE} n$rand #> [1] 0.2648 n$rand #> [1] 2.171 n$rand <- 3 #> Error: unused argument (quote(3)) ``` Implementation note: Active bindings are bound in the public environment. The enclosing environment for these functions is also the public environment. ### Inheritance One R6 class can inherit from another. In other words, you can have super- and sub-classes. Subclasses can have additional methods, and they can also have methods that override the superclass methods. In this example of a queue that retains its history, we'll add a `show()` method and override the `remove()` method: ```{r} # Note that this isn't very efficient - it's just for illustrating inheritance. HistoryQueue <- R6Class("HistoryQueue", inherit = Queue, public = list( show = function() { cat("Next item is at index", private$head_idx + 1, "\n") for (i in seq_along(private$queue)) { cat(i, ": ", private$queue[[i]], "\n", sep = "") } }, remove = function() { if (private$length() - private$head_idx == 0) return(NULL) private$head_idx <<- private$head_idx + 1 private$queue[[private$head_idx]] } ), private = list( head_idx = 0 ) ) hq <- HistoryQueue$new(5, 6, "foo") hq$show() hq$remove() hq$show() hq$remove() ``` Superclass methods can be called with `super$xx()`. The `CountingQueue` (example below) keeps a count of the total number of objects that have ever been added to the queue. It does this by overriding the `add()` method -- it increments a counter and then calls the superclass's `add()` method, with `super$add(x)`: ```{r} CountingQueue <- R6Class("CountingQueue", inherit = Queue, public = list( add = function(x) { private$total <<- private$total + 1 super$add(x) }, get_total = function() private$total ), private = list( total = 0 ) ) cq <- CountingQueue$new("x", "y") cq$get_total() cq$add("z") cq$remove() cq$remove() cq$get_total() ``` ### Fields containing reference objects If your R6 class contains any fields that also have reference semantics (e.g., other R6 objects, and environments), those fields should be populated in the `initialize` method. If the field set to the reference object directly in the class definition, that object will be shared across all instances of the R6 objects. Here's an example: ```{r} SimpleClass <- R6Class("SimpleClass", public = list(x = NULL) ) SharedField <- R6Class("SharedField", public = list( e = SimpleClass$new() ) ) s1 <- SharedField$new() s1$e$x <- 1 s2 <- SharedField$new() s2$e$x <- 2 # Changing s2$e$x has changed the value of s1$e$x s1$e$x ``` To avoid this, populate the field in the `initialize` method: ```{r} NonSharedField <- R6Class("NonSharedField", public = list( e = NULL, initialize = function() self$e <- SimpleClass$new() ) ) n1 <- NonSharedField$new() n1$e$x <- 1 n2 <- NonSharedField$new() n2$e$x <- 2 # n2$e$x does not affect n1$e$x n1$e$x ``` ## Portable and non-portable classes In R6 version 1.0.1, the default was to create **non-portable** classes. In subsequent versions, the default is to create **portable** classes. The two most noticeable differences are that portable classes: * Support inheritance across different packages. Non-portable classes do not do this very well. * Always require the use of `self` and `private` to access members, as in `self$x` and `private$y`. Non-portable classes can access these members with just `x` and `y`, and do assignment to these members with the `<<-` operator. The implementation of the first point is such that it makes the second point necessary. ### Using `self` and `<<-` With reference classes, you can access the field without `self`, and assign to fields using `<<-`. For example: ```{r} RC <- setRefClass("RC", fields = list(x = 'ANY'), methods = list( getx = function() x, setx = function(value) x <<- value ) ) rc <- RC$new() rc$setx(10) rc$getx() ``` The same is true for non-portable R6 classes: ```{r} NP <- R6Class("NP", portable = FALSE, public = list( x = NA, getx = function() x, setx = function(value) x <<- value ) ) np <- NP$new() np$setx(10) np$getx() ``` But for portable R6 classes (this is the default), you must use `self` and/or `private`, and `<<-` assignment doesn't work -- unless you use `self`, of course: ```{r} P <- R6Class("P", portable = TRUE, # This is default public = list( x = NA, getx = function() self$x, setx = function(value) self$x <- value ) ) p <- P$new() p$setx(10) p$getx() ``` For more information, see the Portable vignette. ## Other topics ### Adding members to an existing class It is sometimes useful to add members to a class after the class has already been created. This can be done using the `$set()` method on the generator object. ```{r} Simple <- R6Class("Simple", public = list( x = 1, getx = function() self$x ) ) Simple$set("public", "getx2", function() self$x*2) # To replace an existing member, use overwrite=TRUE Simple$set("public", "x", 10, overwrite = TRUE) s <- Simple$new() s$x s$getx2() ``` The new members will be present only in instances that are created after `$set()` has been called. To prevent modification of a class, you can use `lock_class=TRUE` when creating the class. You can also lock and unlock a class as follows: ```{r} # Create a locked class Simple <- R6Class("Simple", public = list( x = 1, getx = function() self$x ), lock_class = TRUE ) # This would result in an error # Simple$set("public", "y", 2) # Unlock the class Simple$unlock() # Now it works Simple$set("public", "y", 2) # Lock the class again Simple$lock() ``` ### Cloning objects By default, R6 objects have method named `clone` for making a copy of the object. ```{r} Simple <- R6Class("Simple", public = list( x = 1, getx = function() self$x ) ) s <- Simple$new() # Create a clone s1 <- s$clone() # Modify it s1$x <- 2 s1$getx() # Original is unaffected by changes to the clone s$getx() ``` ```{r clone-size, echo=FALSE} # Calculate size of clone method in this block. Cloneable <- R6Class("Cloneable", cloneable = TRUE) NonCloneable <- R6Class("NonCloneable", cloneable = FALSE) c1 <- Cloneable$new() c2 <- Cloneable$new() # Bytes for each new cloneable object cloneable_delta <- object_size(c1, c2) - object_size(c2) nc1 <- NonCloneable$new() nc2 <- NonCloneable$new() # Bytes for each new noncloneable object noncloneable_delta <- object_size(nc1, nc2) - object_size(nc2) # Number of bytes used by each copy of clone method additional_clone_method_bytes <- cloneable_delta - noncloneable_delta additional_clone_method_bytes_str <- capture.output(print(additional_clone_method_bytes)) # Number of bytes used by first copy of a clone method first_clone_method_bytes <- object_size(c1) - object_size(nc1) # Need some trickery to get the nice output from pryr::print.bytes first_clone_method_bytes_str <- capture.output(print(first_clone_method_bytes)) ``` If you don't want a `clone` method to be added, you can use `cloneable=FALSE` when creating the class. If any loaded R6 object has a `clone` method, that function uses `r first_clone_method_bytes_str`, but for each additional object, the `clone` method costs a trivial amount of space (`r additional_clone_method_bytes` bytes). #### Deep cloning If there are any fields which are objects with reference sematics (environments, R6 objects, reference class objects), the copy will get a reference to the same object. This is sometimes desirable, but often it is not. For example, we'll create an object `c1` which contains another R6 object, `s`, and then clone it. Because the original's and the clone's `s` fields both refer to the same object, modifying it from one results in a change that is reflect in the other. ```{r} Simple <- R6Class("Simple", public = list(x = 1)) Cloneable <- R6Class("Cloneable", public = list( s = NULL, initialize = function() self$s <- Simple$new() ) ) c1 <- Cloneable$new() c2 <- c1$clone() # Change c1's `s` field c1$s$x <- 2 # c2's `s` is the same object, so it reflects the change c2$s$x ``` To make it so the clone receives a *copy* of `s`, we can use the `deep=TRUE` option: ```{r} c3 <- c1$clone(deep = TRUE) # Change c1's `s` field c1$s$x <- 3 # c2's `s` is different c3$s$x ``` The default behavior of `clone(deep=TRUE)` is to copy fields which are R6 objects, but not copy fields which are environments, reference class objects, or other data structures which contain other reference-type objects (for example, a list with an R6 object). If your R6 object contains these types of objects and you want to make a deep clone of them, you must provide your own function for deep cloning, in a private method named `deep_clone`. Below is an example of an R6 object with two fields, `a` and `b`, both of which which are environments, and both of which contain a value `x`. It also has a field `v` which is a regular (non-reference) value, and a private `deep_clone` method. The `deep_clone` method is be called once for each field. It is passed the name and value of the field, and the value it returns is be used in the clone. ```{r} CloneEnv <- R6Class("CloneEnv", public = list( a = NULL, b = NULL, v = 1, initialize = function() { self$a <- new.env(parent = emptyenv()) self$b <- new.env(parent = emptyenv()) self$a$x <- 1 self$b$x <- 1 } ), private = list( deep_clone = function(name, value) { # With x$clone(deep=TRUE) is called, the deep_clone gets invoked once for # each field, with the name and value. if (name == "a") { # `a` is an environment, so use this quick way of copying list2env(as.list.environment(value, all.names = TRUE), parent = emptyenv()) } else { # For all other fields, just return the value value } } ) ) c1 <- CloneEnv$new() c2 <- c1$clone(deep = TRUE) ``` When `c1$clone(deep=TRUE)` is called, the `deep_clone` method is called for each field in `c1`, and is passed the name of the field and value. In our version, the `a` environment gets copied, but `b` does not, nor does `v` (but that doesn't matter since `v` is not a reference object). We can test out the clone: ```{r} # Modifying c1$a doesn't affect c2$a, because they're separate objects c1$a$x <- 2 c2$a$x # Modifying c1$b does affect c2$b, because they're the same object c1$b$x <- 3 c2$b$x # Modifying c1$v doesn't affect c2$v, because they're not reference objects c1$v <- 4 c2$v ``` In the example `deep_clone` method above, we checked the name of each field to determine what to do with it, but we could also check the value, by using `inherits(value, "R6")`, or `is.environment()`, and so on. ### Printing R6 objects to the screen R6 objects have a default `print` method that lists all members of the object. If a class defines a `print` method, then it overrides the default one. ```{r} PrettyCountingQueue <- R6Class("PrettyCountingQueue", inherit = CountingQueue, public = list( print = function(...) { cat(" of ", self$get_total(), " elements\n", sep = "") invisible(self) } ) ) ``` ```{r} pq <- PrettyCountingQueue$new(1, 2, "foobar") pq ``` ### Finalizers Sometimes it's useful to run a function when the object is garbage collected. For example, you may want to make sure a file or database connection gets closed. To do this, you can define a `finalize()` method, which will be called with no arguments when the object is garbage collected. ```{r} A <- R6Class("A", public = list( finalize = function() { print("Finalizer has been called!") } )) # Instantiate an object: obj <- A$new() # Remove the single existing reference to it, and force garbage collection # (normally garbage collection will happen automatically from time # to time) rm(obj); gc() ``` Finalizers are implemented using the `reg.finalizer()` function, and they set `onexit=TRUE`, so that the finalizer will also be called when R exits. This is useful in some cases, like database connections. ## Summary R6 classes provide capabilities that are common in other object-oriented programming languages. They're similar to R's built-in reference classes, but are simpler, smaller, and faster, and they allow inheritance across packages. R6/vignettes/Debugging.Rmd0000644000176200001440000000377113104125424015114 0ustar liggesusers--- title: "Debugging methods in R6 objects" output: html_document: theme: null css: mystyle.css toc: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Debugging methods in R6 objects} %\usepackage[utf8]{inputenc} --- ```{r echo = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ``` Debugging methods in R6 classes is somewhat different from debugging normal R functions. RStudio breakpoints don't work in R6 class methods. The simplest way to debug code is to insert a `browser()` line where you want to open a debugging console, reload the classes, and then step through your code. But this involves modifying your code, reloading it, and re-instantiating any objects you want to test. ## Enabling debugging for all future instances of a class R6 generator objects have a method called `debug()` which will enable debugging for a method. This will affect all instances of the class that are created after the `debug()` is called. ```{r eval=FALSE} # An example class Simple <- R6Class("Simple", public = list( x = 10, getx = function() self$x ) ) # This will enable debugging the getx() method for objects of the 'Simple' # class that are instantiated in the future. Simple$debug("getx") s <- Simple$new() s$getx() # [Debugging prompt] ``` To disable debugging for future instances, use the generator's `undebug()` method: ```{r eval=FALSE} # Disable debugging for future instances: Simple$undebug("getx") s <- Simple$new() s$getx() #> [1] 10 ``` ## Debugging methods in individual objects To enable debugging for a method in a single instance of an object, use the `debug()` function (not the `debug()` method in the generator object). ```{r eval=FALSE} s <- Simple$new() debug(s$getx) s$getx() # [Debugging prompt] ``` Use `undebug()` to disable debugging on an object's method. ```{r eval=FALSE} undebug(s$getx) s$getx() #> [1] 10 ``` You can also use the `trace()` function to specify where in a method you want to drop into the debugging console. R6/vignettes/Performance.Rmd0000644000176200001440000005606113104125424015462 0ustar liggesusers--- title: "R6 and Reference class performance tests" output: html_document: theme: null css: mystyle.css toc: yes fig_retina: false vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{R6 and Reference class performance tests} %\usepackage[utf8]{inputenc} --- ```{r echo = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>", fig.width = 3.9, fig.height = 3.5) # Make sure vignette doesn't error on platforms where microbenchmark is not present. if (requireNamespace("microbenchmark", quietly = TRUE)) { library(microbenchmark) # Only print 3 significant digits print_microbenchmark <- function (x, unit, order = NULL, ...) { s <- summary(x, unit = unit) cat("Unit: ", attr(s, "unit"), "\n", sep = "") timing_cols <- c("min", "lq", "median", "uq", "max") s[timing_cols] <- lapply(s[timing_cols], signif, digits = 3) s[timing_cols] <- lapply(s[timing_cols], format, big.mark = ",") print(s, ..., row.names = FALSE) } assignInNamespace("print.microbenchmark", print_microbenchmark, "microbenchmark") } else { # Some dummy functions so that the vignette doesn't throw an error. microbenchmark <- function(...) { structure(list(), class = "microbenchmark_dummy") } summary.microbenchmark_dummy <- function(object, ...) { data.frame(expr = "", median = 0) } } ``` This document compares the memory costs and speed of R's reference classes against R6 classes and simple environments. For must uses, R6 and reference classes have comparable features, but as we'll see, R6 classes are faster and lighter weight. This document tests reference classes against R6 classes (in many variations), as well as against very simple reference objects: environments created by functino calls. ***** First we'll load some packages which will be used below: ```{r eval = FALSE} library(microbenchmark) options(microbenchmark.unit = "us") library(pryr) # For object_size function library(R6) ``` ```{r echo = FALSE} # The previous code block is just for appearances. This code block is the one # that gets run. The loading of microbenchmark must be conditional because it is # not available on all platforms. if (requireNamespace("microbenchmark", quietly = TRUE)) { library(microbenchmark) } options(microbenchmark.unit = "us") library(pryr) # For object_size function library(R6) ``` ```{r echo=FALSE} library(ggplot2) library(scales) # Set up ggplot2 theme my_theme <- theme_bw(base_size = 10) + theme(axis.title.x = element_blank(), axis.title.y = element_blank(), panel.grid.major.y = element_blank(), panel.grid.minor.y = element_blank() ) ``` ***** Class definitions ================= We'll start by defining a number of classes or class-like entities, using reference classes, R6 classes, and simple environments that are created directly by functions. There are a number of options for R6 that can affect the size of the resulting objects, so we will use a number of variants. These classes will be used for the speed and memory tests that follow. This is a lot of boring code, so you may want to skip ahead to the results. All of these classes have the same basic characteristics: * A field named `x` that contains a number. * An way of initializing the value of `x`. * A method named `getx` for retrieving the value of `x`. * A method named `inc` for incrementing the value of `x`. The fields and methods are accessed with the `$` operator, so if we have an object named `obj`, we could use `obj$x` or `obj$getx()`. ## R reference class ```{r} RC <- setRefClass("RC", fields = list(x = "numeric"), methods = list( initialize = function(x = 1) .self$x <- x, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ``` In reference classes, the binding that points back to the object is named `.self`. Within a method, assignment can be done by using `.self`, as in `.self$x <- 10`, or by using `<<-`, as in `x <<- 10`. To create an object, simply call `$new()` on the class: ```{r} RC$new() ``` ## R6 class Creating an R6 class is similar to the reference class, except that there's no need to separate the fields and methods, and you can't specify the types of the fields. ```{r} R6 <- R6Class("R6", public = list( x = NULL, initialize = function(x = 1) self$x <- x, getx = function() self$x, inc = function(n = 1) self$x <- x + n ) ) ``` Whereas reference classes use `.self`, R6 classes use `self` (without the leading period). As with reference classes, objects are instantiated by calling `$new()`: ```{r} R6$new() ``` An R6 object essentially just a set of environments structured in a particular way. The fields and methods for an R6 object have bindings (that is, they have names) in the *public environment*. There is also have a separate environment which is the *enclosing environment* for methods (they "run in" an environment that contains a binding named `self`, which is simply a reference to the public environment). ## R6 class, without class attribute By default, a class attribute is added to R6 objects. This attribute adds a slight performance penalty because R will attempt to use S3 dispatch when using `$` on the object. It's possible generate objects without the class attribute, by using `class=FALSE`: ```{r} R6NoClass <- R6Class("R6NoClass", class = FALSE, public = list( x = NULL, initialize = function(x = 1) self$x <- x, getx = function() self$x, inc = function(n = 1) self$x <- self$x + n ) ) ``` Note that without the class attribute, S3 method dispatch on the objects is not possible. ## R6 class, non-portable By default, R6 objects are *portable*. This means that inheritance can be in classes that are in different packages. However, it also requires the use of `self$` and `private$` to access members, and this incurs a small performance penalty. If `portable=FALSE` is used, members can be accessed without using `self$`, and assignment can be done with `<<-`: ```{r} R6NonPortable <- R6Class("R6NonPortable", portable = FALSE, public = list( x = NULL, initialize = function(value = 1) x <<- value, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ``` ## R6 class, with `cloneable=FALSE` By default, R6 objects have a `clone()` method, which is a fairly large function. If you do not need this feature, you can save some memory by using `cloneable=FALSE`. ```{r} R6NonCloneable <- R6Class("R6NonCloneable", cloneable = FALSE, public = list( x = NULL, initialize = function(x = 1) self$x <- x, getx = function() self$x, inc = function(n = 1) self$x <- self$x + n ) ) ``` ## R6 class, without class attribute, non-portable, and non-cloneable For comparison, we'll use a an R6 class that is without a class attribute, non-portable, and non-cloneable. This is the most stripped-down we can make an R6 object. ```{r} R6Bare <- R6Class("R6Bare", portable = FALSE, class = FALSE, cloneable = FALSE, public = list( x = NULL, initialize = function(value = 1) x <<- value, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ``` ## R6 class, with public and private members This variant has public and private members. ```{r} R6Private <- R6Class("R6Private", private = list(x = NULL), public = list( initialize = function(x = 1) private$x <- x, getx = function() private$x, inc = function(n = 1) private$x <- private$x + n ) ) ``` Instead of a single `self` object which refers to all items in an object, these objects have `self` (which refers to the public items) and `private`. ```{r} R6Private$new() ``` ## R6 class, with public and private, no class attribute, non-portable, and non-cloneable For comparison, we'll add a version that is without a class attribute, non-portable, and non-cloneable. ```{r} R6PrivateBare <- R6Class("R6PrivateBare", portable = FALSE, class = FALSE, cloneable = FALSE, private = list(x = NULL), public = list( initialize = function(x = 1) private$x <- x, getx = function() x, inc = function(n = 1) x <<- x + n ) ) ``` ## Environment created by a function call, with class attribute In R, environments are passed by reference. A simple way to create an object that's passed by reference is to use the environment created by the invocation of a function. The function below captures that environment, attaches a class to it, and returns it: ```{r} FunctionEnvClass <- function(x = 1) { inc <- function(n = 1) x <<- x + n getx <- function() x self <- environment() class(self) <- "FunctionEnvClass" self } ``` Even though `x` isn't declared in the function body, it gets captured because it's an argument to the function. ```{r} ls(FunctionEnvClass()) ``` Objects created this way are very similar to those created by `R6` generator we created above. ## Environment created by a function call, without class attribute We can make an even simpler type of reference object to the previous one, by not having a a class attribute, and not having `self` object: ```{r} FunctionEnvNoClass <- function(x = 1) { inc <- function(n = 1) x <<- x + n getx <- function() x environment() } ``` This is simply an environment with some objects in it. ```{r} ls(FunctionEnvNoClass()) ``` ***** Tests ===== For all the timings using `microbenchmark()`, the results are reported in microseconds, and the most useful value is probably the median column. ## Memory footprint ```{r echo = FALSE} # Utility functions for calculating sizes obj_size <- function(expr, .env = parent.frame()) { size_n <- function(n = 1) { objs <- lapply(1:n, function(x) eval(expr, .env)) as.numeric(do.call(object_size, objs)) } data.frame(one = size_n(1), incremental = size_n(2) - size_n(1)) } obj_sizes <- function(..., .env = parent.frame()) { exprs <- as.list(match.call(expand.dots = FALSE)$...) names(exprs) <- lapply(1:length(exprs), FUN = function(n) { name <- names(exprs)[n] if (is.null(name) || name == "") paste(deparse(exprs[[n]]), collapse = " ") else name }) sizes <- mapply(obj_size, exprs, MoreArgs = list(.env = .env), SIMPLIFY = FALSE) do.call(rbind, sizes) } ``` How much memory does a single instance of each object take, and how much memory does each additional object take? We'll use the functions `obj_size` and `obj_sizes` (shown at the bottom of this document) to calculate the sizes. Sizes of each type of object, in bytes: ```{r} sizes <- obj_sizes( RC$new(), R6$new(), R6NoClass$new(), R6NonPortable$new(), R6NonCloneable$new(), R6Bare$new(), R6Private$new(), R6PrivateBare$new(), FunctionEnvClass(), FunctionEnvNoClass() ) sizes ``` The results are plotted below. Note that the plots have very different x scales. ```{r echo = FALSE, results = 'hold'} objnames <- c( "RC", "R6", "R6NoClass", "R6NonPortable", "R6NonCloneable", "R6Bare", "R6Private", "R6PrivateBare", "FunctionEnvClass", "FunctionEnvNoClass" ) obj_labels <- objnames obj_labels[1] <- "RC (off chart)" sizes$name <- factor(objnames, levels = rev(objnames)) ggplot(sizes, aes(y = name, x = one)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(sizes$one[-1]) * 1.5), expand = c(0, 0), oob = rescale_none) + scale_y_discrete( breaks = sizes$name, labels = obj_labels) + my_theme + ggtitle("First object") ggplot(sizes, aes(y = name, x = incremental)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + scale_x_continuous(limits = c(0, max(sizes$incremental) * 1.05), expand = c(0, 0)) + geom_point(size = 2) + my_theme + ggtitle("Additional objects") ``` Some preliminary observations about the first instance of various classes: Using a reference class consumes a large amount of memory. For R6 objects, the option with the largest impact is `cloneable`: not having the `clone()` method saves around 40 kB of memory. For subsequent instances of these classes, there isn't nearly as much difference between the different kinds. It appeared that using a reference class takes up a huge amount of memory, but much of that is shared between reference classes. Adding an object from a different reference class doesn't require much more memory --- around 38KB: ```{r} RC2 <- setRefClass("RC2", fields = list(x = "numeric"), methods = list( initialize = function(x = 2) .self$x <<- x, inc = function(n = 2) x <<- x * n ) ) # Calcualte the size of a new RC2 object, over and above an RC object as.numeric(object_size(RC$new(), RC2$new()) - object_size(RC$new())) ``` ## Object instantiation speed How much time does it take to create one of these objects? This shows the median time, in microseconds: ```{r} # Function to extract the medians from microbenchmark results mb_summary <- function(x) { res <- summary(x, unit="us") data.frame(name = res$expr, median = res$median) } speed <- microbenchmark( RC$new(), R6$new(), R6NoClass$new(), R6NonPortable$new(), R6NonCloneable$new(), R6Bare$new(), R6Private$new(), R6PrivateBare$new(), FunctionEnvClass(), FunctionEnvNoClass() ) speed <- mb_summary(speed) speed ``` The plot below shows the median instantiation time. ```{r echo = FALSE, results = 'hold', fig.width = 8} speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(speed$median) * 1.05), expand = c(0, 0)) + my_theme + ggtitle("Median time to instantiate object (\u0b5s)") p ``` Reference classes are much slower to instantiate than the other types of classes. Instantiating R6 objects is roughly 5 times faster. Creating an environment with a simple function call is another 20-30 times faster. ## Field access speed How much time does it take to access a field in an object? First we'll make some objects: ```{r} rc <- RC$new() r6 <- R6$new() r6noclass <- R6NoClass$new() r6noport <- R6NonPortable$new() r6noclone <- R6NonCloneable$new() r6bare <- R6Bare$new() r6priv <- R6Private$new() r6priv_bare <- R6PrivateBare$new() fun_env <- FunctionEnvClass() fun_env_nc <- FunctionEnvNoClass() ``` And then get a value from these objects: ```{r} speed <- microbenchmark( rc$x, r6$x, r6noclass$x, r6noport$x, r6noclone$x, r6bare$x, r6priv$x, r6priv_bare$x, fun_env$x, fun_env_nc$x ) speed <- mb_summary(speed) speed ``` ```{r echo = FALSE, results = 'hold', fig.width = 8} speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(speed$median) * 1.05), expand = c(0, 0)) + my_theme + ggtitle("Median time to access field (\u0b5s)") p ``` Accessing the field of a reference class is much slower than the other methods. There's also an obvious pattern where accessing the field of an environment (created by R6 or a function call) is slower when there is a class attribute. This is because, for the objects that have a class attribute, R attempts to look up an S3 method for `$`, and this lookup has a performance penalty. We'll see more about this below. ## Field setting speed How much time does it take to set the value of a field in an object? ```{r} speed <- microbenchmark( rc$x <- 4, r6$x <- 4, r6noclass$x <- 4, r6noport$x <- 4, r6noclone$x <- 4, r6bare$x <- 4, # r6priv$x <- 4, # Can't set private field directly, # r6priv_nc_np$x <- 4, # so we'll skip these two fun_env$x <- 4, fun_env_nc$x <- 4 ) speed <- mb_summary(speed) speed ``` ```{r echo = FALSE, results = 'hold', fig.width = 8} speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + scale_x_continuous(limits = c(0, max(speed$median) * 1.05), expand = c(0, 0)) + my_theme + ggtitle("Median time to set field (\u0b5s)") p ``` Reference classes are significantly slower than the others, again. In this case, there's additional overhead due to type-checking the value. Once more, the no-class objects are significantly faster than the others, again probably due to attempted S3 dispatch on the `` `$<-` `` function. ## Speed of method call that accesses a field How much overhead is there when calling a method from one of these objects? All of these `getx()` methods simply return the value of `x` in the object. When necessary, this method uses `self$x` (for R6 classes, when `portable=TRUE`), and in others, it just uses `x` (when `portable=FALSE`, and in reference classes). ```{r} speed <- microbenchmark( rc$getx(), r6$getx(), r6noclass$getx(), r6noport$getx(), r6noclone$getx(), r6bare$getx(), r6priv$getx(), r6priv_bare$getx(), fun_env$getx(), fun_env_nc$getx() ) speed <- mb_summary(speed) speed ``` ```{r echo = FALSE, results = 'hold', fig.width = 8} speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + my_theme + ggtitle("Median time to call method that accesses field (\u0b5s)") p ``` The reference class is the slowest. `r6` is also somewhat slower than the others. There are two reasons for this: first, it uses `self$x` which adds some time, and second, it has a class attribute, which slows down the access of both `r6$getx` and `self$x`. One might expect `r6priv` to be the same speed as `r6`, but it is faster. Although accessing `r6priv$getx` is slow because `r6priv` has a class attribute, accessing `private$x` is faster because it does not have a class attribute. The objects which can access `x` directly (without `self` or `private`) and which lack a class attribute are the fastest. ## Assignment using `self$x <-` vs. `x <<-` With reference classes, you can modify fields using the `<<-` operator, or by using the `.self` object. For example, compare the `setx()` methods of these two classes: ```{r} RCself <- setRefClass("RCself", fields = list(x = "numeric"), methods = list( initialize = function() .self$x <- 1, setx = function(n = 2) .self$x <- n ) ) RCnoself <- setRefClass("RCnoself", fields = list(x = "numeric"), methods = list( initialize = function() x <<- 1, setx = function(n = 2) x <<- n ) ) ``` Non-portable R6 classes are similar, except they use `self` instead of `.self`. ```{r} R6self <- R6Class("R6self", portable = FALSE, public = list( x = 1, setx = function(n = 2) self$x <- n ) ) R6noself <- R6Class("R6noself", portable = FALSE, public = list( x = 1, setx = function(n = 2) x <<- n ) ) ``` ```{r} rc_self <- RCself$new() rc_noself <- RCnoself$new() r6_self <- R6self$new() r6_noself <- R6noself$new() speed <- microbenchmark( rc_self$setx(), rc_noself$setx(), r6_self$setx(), r6_noself$setx() ) speed <- mb_summary(speed) speed ``` ```{r echo = FALSE, results = 'hold', fig.width = 8} speed$name <- factor(speed$name, rev(levels(speed$name))) p <- ggplot(speed, aes(y = name, x = median)) + geom_segment(aes(yend = name), xend = 0, colour = "gray80") + geom_point(size = 2) + my_theme + ggtitle("Assignment to a field using self vs <<- (\u0b5s)") p ``` For both reference and non-portable R6 classes, assignment using `.self$x <-` is somewhat slower than using `x <<-`. Bear in mind that, by default, R6 classes are portable, and can't use assignment with `x <<-`. ## Overhead from using `$` on objects with a class attribute There is some overhead when using `$` on an object that has a class attribute. In the test below, we'll create three different kinds of objects: 1. An environment with no class attribute. 1. An environment with a class `"e2"`, but without a `$.e2` S3 method. 1. An environment with a class `"e3"`, which has a `$.e3` S3 method that simply returns `NULL`. Each one of these environments will contain an object `x`. ```{r} e1 <- new.env(hash = FALSE, parent = emptyenv()) e2 <- new.env(hash = FALSE, parent = emptyenv()) e3 <- new.env(hash = FALSE, parent = emptyenv()) e1$x <- 1 e2$x <- 1 e3$x <- 1 class(e2) <- "e2" class(e3) <- "e3" # Define an S3 method for class e3 `$.e3` <- function(x, name) { NULL } ``` Now we can run timing tests for calling `$` on each type of object. Note that for the `e3` object, the `$` function does nothing --- it simply returns `NULL`. ```{r} speed <- microbenchmark( e1$x, e2$x, e3$x ) speed <- mb_summary(speed) speed ``` Using `$` on `e2` and `e3` is much slower than on `e1`. This is because `e2` and `e3` have a class attribute. Even though there's no `$` method defined for `e2`, doing `e2$x` still about 6 times slower than `e1$x`, simply because R looks for an appropriate S3 method. `e3$x` is slightly faster than `e2$x`; this is probably because the `$.e3` function doesn't actually do anything other than return NULL. If an object has a class attribute, R will attempt to look for a method every time `$` is called. This can slow things down considerably, if `$` is used often. ## Lists vs. environments, and `$` vs. `[[` Lists could also be used for creating classes (albeit not with reference semantics). How much time does it take to access items using `$` for lists vs. environments? We'll also compare using `obj$x` to `obj[['x']]`. ```{r} lst <- list(x = 10) env <- new.env() env$x <- 10 mb_summary(microbenchmark( lst = lst$x, env = env$x, lst[['x']], env[['x']] )) ``` Performance is comparable across environments and lists. The `[[` operator is slightly faster than `$`, probably because it doesn't need to convert the unevaluated symbol to a string. ***** Wrap-up ======= R6 objects take less memory and are significantly faster than R's reference class objects, and they also have some options that provide for even more speed. In these tests, the biggest speedup for R6 classes comes from not using a class attribute; this speeds up the use of `$`. Non-portable R6 classes can also access fields without `$` at all, which provides another modest speed boost. In most cases, these speed increases are negligible -- they are on the order of microseconds and will be noticeable only when tens or even hundreds of thousands of class member accesses are performed. ***** Appendix ======== ## Functions for calculating object sizes ```{r eval=FALSE} # Utility functions for calculating sizes obj_size <- function(expr, .env = parent.frame()) { size_n <- function(n = 1) { objs <- lapply(1:n, function(x) eval(expr, .env)) as.numeric(do.call(object_size, objs)) } data.frame(one = size_n(1), incremental = size_n(2) - size_n(1)) } obj_sizes <- function(..., .env = parent.frame()) { exprs <- as.list(match.call(expand.dots = FALSE)$...) names(exprs) <- lapply(1:length(exprs), FUN = function(n) { name <- names(exprs)[n] if (is.null(name) || name == "") paste(deparse(exprs[[n]]), collapse = " ") else name }) sizes <- mapply(obj_size, exprs, MoreArgs = list(.env = .env), SIMPLIFY = FALSE) do.call(rbind, sizes) } ``` ## System information ```{r} sessionInfo() ``` R6/vignettes/mystyle.css0000644000176200001440000001000113104125424014755 0ustar liggesusersbody { background-color: #fff; margin: 0 auto; max-width: 800px; float: center; margin-left: auto; margin-right: auto; overflow: visible; } body #header { clear: both; margin-bottom: 8px; border-bottom: 2px solid #999; font-size: 20px; padding: 2px 10px 2px 25px; } body #content { background-color: white; clear: both; float: left; overflow: visible; padding: 10px; border: 1px solid #BBBBBB; border-radius: 5px; width: 780px; } body #footer { background-color: #99BBDD; clear: both; float: left; margin: 8px 0; border: 1px solid #6688AA; border-radius: 5px; padding: 0 10px; width: 780px; } body .clear { clear: both; border-width: 0; margin: 0; visibility: hidden; } #TOC { clear: both; margin: 0 0 10px 10px; padding: 4px; width: 400px; border: 1px solid #CCCCCC; border-radius: 5px; background-color: #f6f6f6; font-size: 13px; line-height: 16px; } #TOC .toctitle { font-weight: bold; font-size: 15px; margin-left: 5px; } #TOC ul { padding-left: 40px; margin-left: -1.5em; margin-top: 5px; margin-bottom: 5px; } #TOC ul ul { margin-left: -2em; } #TOC li { line-height: 16px; } table { margin-left: 25px; border-width: 1px; border-spacing: 0px; border-style: outset; border-color: gray; border-collapse: collapse; } table th { border-width: 1px; padding: 5px; border-style: inset; border-color: #DDDDDD; background-color: white; } table td { border-width: 1px; border-style: inset; border-color: #DDDDDD; background-color: white; line-height: 18px; padding: 2px 5px; } p { margin-left: 15px; margin-bottom: 5px; } blockquote { background-color: #f6f6f6; padding: 13px; padding-bottom: 1px; } hr { border-style: solid; border: none; border-top: 1px solid #777; margin: 28px 0; } dl { margin-left: 0; } dl dd { margin-bottom: 13px; margin-left: 13px; } ul { margin-top: 0; } ul li { list-style: circle outside; } ul ul { margin-bottom: 0; } code { font-family: Consolas, Monaco, 'Courier New', monospace; color: #000; padding: 0px; } p > code, li > code { color: #333; border: 1px solid #ddd; border-radius: 3px; background-color: #f8f8f8; font-size: 80%; padding: 0px 2px; } /*pre > code { font-size: 12px; line-height: 16px; }*/ pre { font-size: 12px; line-height: 16px; white-space: pre-wrap; /* Wrap long lines */ } pre.r { background-color: #F3F5F7; padding: 4px 10px; border: 1px solid #AEBDCC; border-radius: 5px; margin: 5px 5px 10px 20px; } img { background-color: #FFFFFF; padding: 2px; border: 1px solid #DDDDDD; border-radius: 3px; border: 1px solid #CCCCCC; box-shadow: 2px 2px 12px -5px #999999; margin: 0 5px; } body { font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: 15px; line-height: 22px; } body #header { } h1 { margin-top: 0; font-size: 35px; line-height: 40px; } h2 { border-bottom: 2px solid #ccc; width: 85%; padding-top: 10px; font-size: 22px; } h3 { border-bottom: 2px solid #ccc; width: 75%; padding-top: 10px; font-size: 18px; } h4 { border-bottom: 1px solid #ccc; width: 60%; margin-left: 8px; font-size: 16px; } h5, h6 { border-bottom: 1px solid #ccc; width: 60%; margin-left: 15px; font-size: 16px; } h4.author { border-bottom: none; } a { color: #0033dd; text-decoration: none; } a:hover { color: #6666ff; } a:visited { color: #800080; } a:visited:hover { color: #BB00BB; } a[href^="http:"] { text-decoration: underline; } a[href^="https:"] { text-decoration: underline; } dl dt { font-weight: bold; } pre .operator, pre .paren { color: #888; } pre .literal { color: #990073; } pre .number { color: #0080C0; } pre .comment { color: #008000; font-style: italic } pre .keyword { color: #900; font-weight: bold } pre .identifier { color: #000; } pre .string { color: #b44; } R6/vignettes/Portable.Rmd0000644000176200001440000002050013104125424014756 0ustar liggesusers--- title: "Portable and non-portable R6 classes" output: html_document: theme: null css: mystyle.css toc: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Portable and non-portable R6 classes} %\usepackage[utf8]{inputenc} --- ```{r echo = FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") ``` One limitation to R's reference classes is that class inheritance across package namespaces is limited. R6 avoids this problem when the `portable` option is enabled. ## The problem Here is an example of the cross-package inheritance problem with reference classes: Suppose you have ClassA in pkgA, and ClassB in pkgB, which inherits from ClassA. ClassA has a method `foo` which calls a non-exported function `fun` in pkgA. If ClassB inherits `foo`, it will try to call `fun` -- but since ClassB objects are created in pkgB namespace (which is an environment) instead of the pkgA namespace, it won't be able to find `fun`. Something similar happens with R6 when the `portable=FALSE` option is used. For example: ```{r} library(R6) # Simulate packages by creating environments pkgA <- new.env() pkgB <- new.env() # Create a function in pkgA but not pkgB pkgA$fun <- function() 10 ClassA <- R6Class("ClassA", portable = FALSE, public = list( foo = function() fun() ), parent_env = pkgA ) # ClassB inherits from ClassA ClassB <- R6Class("ClassB", portable = FALSE, inherit = ClassA, parent_env = pkgB ) ``` When we create an instance of ClassA, it works as expected: ```{r} a <- ClassA$new() a$foo() ``` But with ClassB, it can't find the `foo` function: ```{r eval=FALSE} b <- ClassB$new() b$foo() #> Error in b$foo() : could not find function "fun" ``` ## Portable R6 R6 supports inheritance across different packages, with the default `portable=TRUE` option. In this example, we'll again simulate different packages by creating separate parent environments for the classes. ```{r} pkgA <- new.env() pkgB <- new.env() pkgA$fun <- function() { "This function `fun` in pkgA" } ClassA <- R6Class("ClassA", portable = TRUE, # The default public = list( foo = function() fun() ), parent_env = pkgA ) ClassB <- R6Class("ClassB", portable = TRUE, inherit = ClassA, parent_env = pkgB ) a <- ClassA$new() a$foo() b <- ClassB$new() b$foo() ``` When a method is inherited from a superclass, that method also gets that class's environment. In other words, method "runs in" the superclass's environment. This makes it possible for inheritance to work across packages. When a method is defined in the subclass, that method gets the subclass's environment. For example, here ClassC is a subclass of ClassA, and defines its own `foo` method which overrides the `foo` method from ClassA. It happens that the method looks the same as ClassA's -- it just calls `fun`. But this time it finds `pkgC$fun` instead of `pkgA$fun`. This is in contrast to ClassB, which inherited the `foo` method and environment from ClassA. ```{r} pkgC <- new.env() pkgC$fun <- function() { "This function `fun` in pkgC" } ClassC <- R6Class("ClassC", portable = TRUE, inherit = ClassA, public = list( foo = function() fun() ), parent_env = pkgC ) cc <- ClassC$new() # This method is defined in ClassC, so finds pkgC$fun cc$foo() ``` ## Using `self` One important difference between non-portable and portable classes is that with non-portable classes, it's possible to access members with just the name of the member, and with portable classes, member access always requires using `self$` or `private$`. This is a consequence of the inheritance implementation. Here's an example of a non-portable class with two methods: `sety`, which sets the private field `y` using the `<<-` operator, and `getxy`, which returns a vector with the values of fields `x` and `y`: ```{r} NP <- R6Class("NP", portable = FALSE, public = list( x = 1, getxy = function() c(x, y), sety = function(value) y <<- value ), private = list( y = NA ) ) np <- NP$new() np$sety(20) np$getxy() ``` If we attempt the same with a portable class, it results in an error: ```{r eval=FALSE} P <- R6Class("P", portable = TRUE, public = list( x = 1, getxy = function() c(x, y), sety = function(value) y <<- value ), private = list( y = NA ) ) p <- P$new() # No error, but instead of setting private$y, this sets y in the global # environment! This is because of the sematics of <<-. p$sety(20) y #> [1] 20 p$getxy() #> Error in p$getxy() : object 'y' not found ``` To make this work with a portable class, we need to use `self$x` and `private$y`: ```{r} P2 <- R6Class("P2", portable = TRUE, public = list( x = 1, getxy = function() c(self$x, private$y), sety = function(value) private$y <- value ), private = list( y = NA ) ) p2 <- P2$new() p2$sety(20) p2$getxy() ``` There is a small performance penalty for using `self$x` as opposed to `x`. In most cases, this is negligible, but it can be noticeable in some situations where there are tens of thousands or more accesses per second. For more information, see the Performance vignette. ## Potential pitfalls with cross-package inheritance Inheritance happens when an object is instantiated with `MyClass$new()`. At that time, members from the superclass get copied to the new object. This means that when you instantiate R6 object, it will essentially save some pieces of the superclass in the object. Because of the way that packages are built in R, R6's inheritance behavior could potentially lead to surprising, hard-to-diagnose problems when packages change versions. Suppose you have two packages, pkgA, containing `ClassA`, and pkgB, containing `ClassB`, and there is code in pkgB that instantiates `ClassB` in an object, `objB`, at build time. This is in contrast to instantiating `ClassB` at run-time, by calling a function. All of the code in the package is run when a *binary* package is built, and the resulting objects are saved in the package. (Generally, if the object can be accessed with `pkgB:::objB`, this means it was created at build time.) When `objB` is created at package build time, pieces from the superclass, `pkgA::ClassA`, are saved inside of it. This is fine in and of itself. But imagine that pkgB was built and installed against pkgA 1.0, and then you upgrade to pkgA 2.0 without subsequently building and installing pkgB. Then `pkgB::objB` will contain some code from `pkgA::ClassA` 1.0, but the version of `pkgA::ClassA` that's installed will be 2.0. This can cause problems if `objB` inherited code which uses parts of `pkgA` that have changed -- but the problems may not be entirely obvious. This scenario is entirely possible when installing packages from CRAN. It is very common for a package to be upgraded without upgrading all of its downstream dependencies. As far as I know, R does not have any mechanism to force downstream dependencies to be rebuilt when a package is upgraded on a user's computer. If this problem happens, the remedy is to rebuild pkgB against pkgA 2.0. I don't know if CRAN rebuilds all downstream dependencies when a package is updated. If it doesn't, then it's possible for CRAN to have incompatible binary builds of pkgA and pkgB, and users would then have to install pkgB from source, with `install.packages("pkgB", type = "source")`. To avoid this problem entirely, objects of `ClassB` must not be instantiated at build time. You can either instantiate them only in functions, or at package load time, by adding an `.onLoad` function to your package. For example: ```{r eval=FALSE} ClassB <- R6Class("ClassB", inherit = pkgA::ClassA, public = list(x = 1) ) # We'll fill this at load time objB <- NULL .onLoad <- function(libname, pkgname) { # The namespace is locked after loading; we can still modify objB at this time. objB <<- ClassB$new() } ``` You might be wondering why `ClassB` (the class, not the instance of the class `objB`) doesn't save a copy of `pkgA::ClassA` inside of it when the package is built. This is because, for the `inherit` argument, `R6Class` saves the unevaluated expression, (`pkgA::ClassA`), and evaluates it when `$new()` is called. ## Wrap-up In summary: * Portable classes allow inheritance across different packages. * Portable classes always require the use of `self` or `private` to access members. This can incur a small performance penalty, since using `self$x` is slower than just `x`. R6/README.md0000644000176200001440000000374013104125424012020 0ustar liggesusersR6 classes =========== [![Build Status](https://travis-ci.org/wch/R6.svg?branch=master)](https://travis-ci.org/wch/R6) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/wch/R6?branch=master&svg=true)](https://ci.appveyor.com/project/wch/R6) This package contains an implemention of classes with reference semantics, and it is a simpler, faster, lighter-weight alternative to R's built-in reference classes. Additionally, these classes are not built on S4 classes, so they do not require the methods package. They allow public and private members, and they support inheritance. Unlike reference classes, R6 classes can be cleanly inherited across different packages, when used in portable mode (enabled by default). Why the name R6? When R's reference classes were introduced, some users, following the names of R's existing class systems S3 and S4, called the new class system R5 in jest. Although reference classes are not actually called R5, the name of this package and its classes takes inspiration from that name. The name R5 was also a code-name used for a different object system started by Simon Urbanek, meant to solve some issues with S4 relating to syntax and performance. However, the R5 branch was shelved after a little development, and it was never released. ## Installation To install R6 from CRAN: ```R install.packages('R6') ``` To install the development version (requires the devtools package): ```R devtools::install_github('wch/R6', build_vignettes = FALSE) ``` ## Documentation * [Introduction to R6](https://cran.r-project.org/package=R6/vignettes/Introduction.html) * [Portable R6 classes](https://cran.r-project.org/package=R6/vignettes/Portable.html) - Inheritance across different packages. * [Performance tests](https://cran.r-project.org/package=R6/vignettes/Performance.html) - Speed and memory comparisons of R6 classes and reference classes. * [Debugging methods in R6 objects](https://cran.r-project.org/package=R6/vignettes/Debugging.html) R6/MD50000644000176200001440000000520213121163343011045 0ustar liggesusers6a5e9c3f464edefb255d4cbc57d50a27 *DESCRIPTION 2491c4039e00be047cce99c452d3fd00 *LICENSE 2290c691ec0011ac745e45d5874fa193 *NAMESPACE 3d2909fe67126a810ca47074ddb24d9b *NEWS.md 890797fed39cbc35799c315d9c322108 *R/aaa.R 8fc2b68dd2ba714c478255c42d60fdb5 *R/aslist.R 188fa603ac979a45f72960511ea940d4 *R/clone.R 969da6f631df9a1f7fbdf9531f60b4dc *R/env_utils.R 2a86561da7babbb64df97905bb58d43c *R/generator_funs.R da8d32330b60debc59dc9ce8a31e877c *R/is.R 130ff95a05f3625003e43bb2b81d97e5 *R/new.R 50c3ecec7dbae8eb9a51571a6120dba7 *R/print.R a2b3e845a08ba77dd1c35e47a5b51705 *R/r6_class.R b88a321a00815f8fbf23a3eac1790f5d *R/utils.R d8074cd312c50a432b1632838b86e005 *README.md 59c6e9808263295d357d5ecb5039539c *build/vignette.rds b5cae09ea49d219b8f76b7c877a2acc3 *inst/doc/Debugging.R 19292e64765adb13605c5c08a1b0fbeb *inst/doc/Debugging.Rmd 3b045777c5b7e3a1363cb33e2acffd21 *inst/doc/Debugging.html 458c5c4ffc9d2e3edbd3fe53bab698db *inst/doc/Introduction.R 53a296d3faa1f359f85722423237fcb9 *inst/doc/Introduction.Rmd 38f76fc5d85eb07062aa72b717e81bee *inst/doc/Introduction.html a1a6084d866ec4e63fd1fca514a19b06 *inst/doc/Performance.R 1b808007d78f30136622d198ebbd65f4 *inst/doc/Performance.Rmd f589fc216a0d57825f15b981aa674f0d *inst/doc/Performance.html 7c74c2ced879ad6b28eed3a986ecf561 *inst/doc/Portable.R 2cc84e9c04c954138914110a29cc5625 *inst/doc/Portable.Rmd e70fb3278d0b77efbcdd6475904654fc *inst/doc/Portable.html 1c72c34021aff0749a7d1119277acc17 *man/R6Class.Rd 1ab85a3b47a7e9757b9e11fe9ab73441 *man/as.list.R6.Rd ba0b7a8329fd8be2251946b54e1119f5 *man/is.R6.Rd 792c2b5c02379e27e3eccbee832b2b28 *tests/manual/README a6eb9df5a1cef6cf0b94c958ec25a7a3 *tests/manual/encapsulation.R cbaba26cf0c3e5a9004f9a03123028fa *tests/manual/test-inheritance.R 08d4cdb1a57dc1e4307c6f4c8d83e65e *tests/testthat.R 45a99007ec8c0255886a2100904c2cae *tests/testthat/helper.R e372420967eb6f34ea98aa72d2013d76 *tests/testthat/test-clone.R 1f3112069189a7541b2286556a65ce5b *tests/testthat/test-finalizer.R 890765388a44c68277dcb82c4dbb2141 *tests/testthat/test-nonportable-inheritance.R 3d9cfcb12b51886fbb0ccb2e81399d8b *tests/testthat/test-nonportable.R fdaf01455a512a34e11acd1e4f939708 *tests/testthat/test-portable-inheritance.R 44f73a7b77858cc4dc7e2f9f13ad041f *tests/testthat/test-portable.R 02410e6c12799186c1c1d05a1055fcbc *tests/testthat/test-s3-methods.R 1ff34f14a8bff32c201e41174c535ed9 *tests/testthat/test-set.R 19292e64765adb13605c5c08a1b0fbeb *vignettes/Debugging.Rmd 53a296d3faa1f359f85722423237fcb9 *vignettes/Introduction.Rmd 1b808007d78f30136622d198ebbd65f4 *vignettes/Performance.Rmd 2cc84e9c04c954138914110a29cc5625 *vignettes/Portable.Rmd c252987682010c83d511941ea3e447fb *vignettes/mystyle.css R6/build/0000755000176200001440000000000013117561013011636 5ustar liggesusersR6/build/vignette.rds0000644000176200001440000000050713117561013014177 0ustar liggesusersRN0e\]7/B-)lFcN;7/}s-ZZƭŰtpqBHEQ"L3gT&sQS_E\HT6I rϳO'Vݚ䧊m 2CPpNIЎZTqh˺R 70po=. u۹#ij̶=oYbXNg֣A+:]Z1p <X>\`>of~b뷢є" 4G@xR6/DESCRIPTION0000644000176200001440000000175213121163343012251 0ustar liggesusersPackage: R6 Title: Classes with Reference Semantics Version: 2.2.2 Authors@R: person("Winston", "Chang", role = c("aut", "cre"), email = "winston@stdout.org") Description: The R6 package allows the creation of classes with reference semantics, similar to R's built-in reference classes. Compared to reference classes, R6 classes are simpler and lighter-weight, and they are not built on S4 classes so they do not require the methods package. These classes allow public and private members, and they support inheritance, even when the classes are defined in different packages. Depends: R (>= 3.0) Suggests: knitr, microbenchmark, pryr, testthat, ggplot2, scales License: MIT + file LICENSE URL: https://github.com/wch/R6/ LazyData: true VignetteBuilder: knitr RoxygenNote: 6.0.1 NeedsCompilation: no Packaged: 2017-06-12 18:48:43 UTC; winston Author: Winston Chang [aut, cre] Maintainer: Winston Chang Repository: CRAN Date/Publication: 2017-06-17 08:22:59 UTC R6/man/0000755000176200001440000000000013104125424011310 5ustar liggesusersR6/man/as.list.R6.Rd0000644000176200001440000000063113104125424013442 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/aslist.R \name{as.list.R6} \alias{as.list.R6} \title{Create a list from an R6 object} \usage{ \method{as.list}{R6}(x, ...) } \arguments{ \item{x}{An R6 object.} \item{...}{Other arguments, which will be ignored.} } \description{ This returns a list of public members from the object. It simply calls \code{as.list.environment}. } R6/man/is.R6.Rd0000644000176200001440000000132613104125424012502 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/is.R \name{is.R6} \alias{is.R6} \alias{is.R6Class} \title{Is an object an R6 Class Generator or Object?} \usage{ is.R6(x) is.R6Class(x) } \arguments{ \item{x}{An object.} } \value{ A logical value. \itemize{ \item{\code{is.R6Class} returns \code{TRUE} when the input is an R6 class generator and \code{FALSE} otherwise.} \item{\code{is.R6} returns \code{TRUE} when the input is an R6 object and \code{FALSE} otherwise.} } } \description{ Checks for R6 class generators and R6 objects. } \examples{ class_generator <- R6Class() object <- class_generator$new() is.R6Class(class_generator) is.R6(class_generator) is.R6Class(object) is.R6(object) } R6/man/R6Class.Rd0000644000176200001440000003322613104125424013062 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/r6_class.R \name{R6Class} \alias{R6Class} \alias{R6} \title{Create an R6 reference object generator} \usage{ R6Class(classname = NULL, public = list(), private = NULL, active = NULL, inherit = NULL, lock_objects = TRUE, class = TRUE, 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 method dispatch.} \item{public}{A list of public members, which can be functions (methods) and non-functions (fields).} \item{private}{An optional list of private members, which can be functions and non-functions.} \item{active}{An optional list of active binding functions.} \item{inherit}{A R6ClassGenerator object to inherit from; in other words, a superclass. This is captured as an unevaluated expression which is evaluated in \code{parent_env} each time an object is instantiated.} \item{lock_objects}{Should the environments of the generated objects be locked? If locked, new members can't be added to the objects.} \item{class}{Should a class attribute be added to the object? Default is \code{TRUE}. If \code{FALSE}, the objects will simply look like environments, which is what they are.} \item{portable}{If \code{TRUE} (the default), this class will work with inheritance across different packages. Note that when this is enabled, fields and members must be accessed with \code{self$x} or \code{private$x}; they can't be accessed with just \code{x}.} \item{lock_class}{If \code{TRUE}, it won't be possible to add more members to the generator object with \code{$set}. If \code{FALSE} (the default), then 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.} \item{lock}{Deprecated as of version 2.1; use \code{lock_class} instead.} } \description{ R6 objects are essentially environments, structured in a way that makes them look like an object in a more typical object-oriented language than R. They support public and private members, as well as inheritance across different packages. } \details{ An R6 object consists of a public environment, and may also contain a private environment, as well as environments for superclasses. In one sense, the object and the public environment are the same; a reference to the object is identical to a reference to the public environment. But in another sense, the object also consists of the fields, methods, private environment and so on. The \code{active} argument is a list of active binding functions. These functions take one argument. They look like regular variables, but when accessed, a function is called with an optional argument. For example, if \code{obj$x2} is an active binding, then when accessed as \code{obj$x2}, it calls the \code{x2()} function that was in the \code{active} list, with no arguments. However, if a value is assigned to it, as in \code{obj$x2 <- 50}, then the function is called with the right-side value as its argument, as in \code{x2(50)}. See \code{\link{makeActiveBinding}} for more information. If the public or private lists contain any items that have reference semantics (for example, an environment), those items will be shared across all instances of the class. To avoid this, add an entry for that item with a \code{NULL} initial value, and then in the \code{initialize} method, instantiate the object and assign it. } \section{The \code{print} method}{ R6 object generators and R6 objects have a default \code{print} method to show them on the screen: they simply list the members and parameters (e.g. lock_objects, portable, etc., see above) of the object. The default \code{print} method of R6 objects can be redefined, by supplying a public \code{print} method. (\code{print} members that are not functions are ignored.) This method is automatically called whenever the object is printed, e.g. when the object's name is typed at the command prompt, or when \code{print(obj)} is called. It can also be called directly via \code{obj$print()}. All extra arguments from a \code{print(obj, ...)} call are passed on to the \code{obj$print(...)} method. } \section{Portable and non-portable classes}{ When R6 classes are portable (the default), they can be inherited across packages without complication. However, when in portable mode, members must be accessed with \code{self} and \code{private}, as in \code{self$x} and \code{private$y}. When used in non-portable mode, R6 classes behave more like reference 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. By default, calling \code{x$clone()} on an R6 object will result in a shallow clone. That is, if any fields have reference semantics (environments, R6, or reference class objects), they will not be copied; instead, the clone object will have a field that simply refers to the same object. To make a deep copy, you can use \code{x$clone(deep=TRUE)}. With this option, any fields that are R6 objects will also be cloned; however, environments and reference class objects will not be. If you want different deep copying behavior, you can supply your own private method called \code{deep_clone}. This method will be called for each field in the object, with two arguments: \code{name}, which is the name of the field, and \code{value}, which is the value. Whatever the method returns will be used as the value for the field in the new clone object. You can write a \code{deep_clone} method that makes copies of specific fields, whether they are environments, R6 objects, or reference class objects. } \section{S3 details}{ Normally the public environment will have two classes: the one supplied in the \code{classname} argument, and \code{"R6"}. It is possible to get the public environment with no classes, by using \code{class=FALSE}. This will result in faster access speeds by avoiding class-based dispatch of \code{$}. The benefit is is negligible in most cases. If a class is a subclass of another, the object will have as its classes the \code{classname}, the superclass's \code{classname}, and \code{"R6"} The primary difference in behavior when \code{class=FALSE} is that, without a class attribute, it won't be possible to use S3 methods with the objects. So, for example, pretty printing (with \code{print.R6Class}) won't be used. } \examples{ # A queue --------------------------------------------------------- Queue <- R6Class("Queue", public = list( initialize = function(...) { for (item in list(...)) { self$add(item) } }, add = function(x) { private$queue <- c(private$queue, list(x)) invisible(self) }, remove = function() { if (private$length() == 0) return(NULL) # Can use private$queue for explicit access head <- private$queue[[1]] private$queue <- private$queue[-1] head } ), private = list( queue = list(), length = function() base::length(private$queue) ) ) q <- Queue$new(5, 6, "foo") # Add and remove items q$add("something") q$add("another thing") q$add(17) q$remove() #> [1] 5 q$remove() #> [1] 6 # Private members can't be accessed directly q$queue #> NULL # q$length() #> Error: attempt to apply non-function # add() returns self, so it can be chained q$add(10)$add(11)$add(12) # remove() returns the value removed, so it's not chainable q$remove() #> [1] "foo" q$remove() #> [1] "something" q$remove() #> [1] "another thing" q$remove() #> [1] 17 # Active bindings ------------------------------------------------- Numbers <- R6Class("Numbers", public = list( x = 100 ), active = list( x2 = function(value) { if (missing(value)) return(self$x * 2) else self$x <- value/2 }, rand = function() rnorm(1) ) ) n <- Numbers$new() n$x #> [1] 100 n$x2 #> [1] 200 n$x2 <- 1000 n$x #> [1] 500 # If the function takes no arguments, it's not possible to use it with <-: n$rand #> [1] 0.2648 n$rand #> [1] 2.171 # n$rand <- 3 #> Error: unused argument (quote(3)) # Inheritance ----------------------------------------------------- # Note that this isn't very efficient - it's just for illustrating inheritance. HistoryQueue <- R6Class("HistoryQueue", inherit = Queue, public = list( show = function() { cat("Next item is at index", private$head_idx + 1, "\\n") for (i in seq_along(private$queue)) { cat(i, ": ", private$queue[[i]], "\\n", sep = "") } }, remove = function() { if (private$length() - private$head_idx == 0) return(NULL) private$head_idx <<- private$head_idx + 1 private$queue[[private$head_idx]] } ), private = list( head_idx = 0 ) ) hq <- HistoryQueue$new(5, 6, "foo") hq$show() #> Next item is at index 1 #> 1: 5 #> 2: 6 #> 3: foo hq$remove() #> [1] 5 hq$show() #> Next item is at index 2 #> 1: 5 #> 2: 6 #> 3: foo hq$remove() #> [1] 6 # Calling superclass methods with super$ -------------------------- CountingQueue <- R6Class("CountingQueue", inherit = Queue, public = list( add = function(x) { private$total <<- private$total + 1 super$add(x) }, get_total = function() private$total ), private = list( total = 0 ) ) cq <- CountingQueue$new("x", "y") cq$get_total() #> [1] 2 cq$add("z") cq$remove() #> [1] "x" cq$remove() #> [1] "y" cq$get_total() #> [1] 3 # Non-portable classes -------------------------------------------- # By default, R6 classes are portable, which means they can be inherited # across different packages. Portable classes require using self$ and # private$ to access members. # When used in non-portable mode, members can be accessed without self$, # and assignments can be made with <<-. NP <- R6Class("NP", portable = FALSE, public = list( x = NA, getx = function() x, setx = function(value) x <<- value ) ) np <- NP$new() np$setx(10) np$getx() #> [1] 10 # Setting new values ---------------------------------------------- # It is possible to add new members to the class after it has been created, # by using the $set() method on the generator. Simple <- R6Class("Simple", public = list( x = 1, getx = function() self$x ) ) Simple$set("public", "getx2", function() self$x*2) # Use overwrite = TRUE to overwrite existing values Simple$set("public", "x", 10, overwrite = TRUE) 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 # Deep clones ----------------------------------------------------- Simple <- R6Class("Simple", public = list( x = NULL, initialize = function(val) self$x <- val ) ) Cloner <- R6Class("Cloner", public = list( s = NULL, y = 1, initialize = function() self$s <- Simple$new(1) ) ) a <- Cloner$new() b <- a$clone() c <- a$clone(deep = TRUE) # Modify a a$s$x <- 2 a$y <- 2 # b is a shallow clone. b$s is the same as a$s because they are R6 objects. b$s$x #> [1] 2 # But a$y and b$y are different, because y is just a value. b$y #> [1] 1 # c is a deep clone, so c$s is not the same as a$s. c$s$x #> [1] 1 c$y #> [1] 1 # Deep clones with custom deep_clone method ----------------------- CustomCloner <- R6Class("CustomCloner", public = list( e = NULL, s1 = NULL, s2 = NULL, s3 = NULL, initialize = function() { self$e <- new.env(parent = emptyenv()) self$e$x <- 1 self$s1 <- Simple$new(1) self$s2 <- Simple$new(1) self$s3 <- Simple$new(1) } ), private = list( # When x$clone(deep=TRUE) is called, the deep_clone gets invoked once for # each field, with the name and value. deep_clone = function(name, value) { if (name == "e") { # e1 is an environment, so use this quick way of copying list2env(as.list.environment(value, all.names = TRUE), parent = emptyenv()) } else if (name \%in\% c("s1", "s2")) { # s1 and s2 are R6 objects which we can clone value$clone() } else { # For everything else, just return it. This results in a shallow # copy of s3. value } } ) ) a <- CustomCloner$new() b <- a$clone(deep = TRUE) # Change some values in a's fields a$e$x <- 2 a$s1$x <- 3 a$s2$x <- 4 a$s3$x <- 5 # b has copies of e, s1, and s2, but shares the same s3 b$e$x #> [1] 1 b$s1$x #> [1] 1 b$s2$x #> [1] 1 b$s3$x #> [1] 5 # Debugging ------------------------------------------------------- \dontrun{ # This will enable debugging the getx() method for objects of the 'Simple' # class that are instantiated in the future. Simple$debug("getx") s <- Simple$new() s$getx() # Disable debugging for future instances: Simple$undebug("getx") s <- Simple$new() s$getx() # To enable and disable debugging for a method in a single instance of an # R6 object (this will not affect other objects): s <- Simple$new() debug(s$getx) s$getx() undebug(s$getx) } } R6/LICENSE0000644000176200001440000000004513104125424011541 0ustar liggesusersYEAR: 2015 COPYRIGHT HOLDER: RStudio