Here’s a potential definition of proto2. It only takes ... args for setting values, but it could just as well take an expr to evaluate.
proto2 <- function(..., inherit = NULL) {
e <- new.env(parent = emptyenv())
e$self <- e
list2env(list(...), envir = e)
if (is.proto2(inherit))
e$super <- inherit
class(e) <- "proto2"
e
}
is.proto2 <- function(x) inherits(x, "proto2")
fetch_proto2 <- function(x, name, depth = 0) {
res <- NULL
val <- .subset2(x, name)
# The NULL check is an optimization for a common case
if (!is.null(val) || exists(name, envir = x, inherits = FALSE)) {
res <- val
} else {
# If not found here, recurse into super environments
super <- .subset2(x, "super")
if (is.proto2(super))
res <- fetch_proto2(super, name, depth + 1)
}
# Wrap the function to pass the current proto2 object-- but only at the lowest
# level call
if (is.function(res) && depth == 0)
return(function(...) res(x, ...))
res
}
`$.proto2` <- function(x, name) fetch_proto2(x, name)
`[[.proto2` <- `$.proto2` Here’s a demonstration of proto2 in action:
A <- proto2(
x = 1,
y = 1,
x2 = function(self) self$x * 2,
y2 = function(self) self$y * 2
)
A$x
#> [1] 1
A$x2()
#> [1] 2
A$y
#> [1] 1
A$y2()
#> [1] 2
B <- proto2(inherit = A,
x = 2
)
B$x
#> [1] 2
B$x2()
#> [1] 4
B$y
#> [1] 1
B$y2()
#> [1] 2Some benchmarks comparing proto2 to proto and bare environments:
library(microbenchmark)
library(proto)
# Bare environments
e <- new.env()
e$x <- 1
e$x2 <- function() x * 2
environment(e$x2) <- e
# proto2
A <- proto2(
x = 1,
x2 = function(self) self$x * 2
)
# proto
P <- proto(expr = {
x <- 1
x2 <- function(self) self$x * 2
})
microbenchmark(
e$x, # bare environment
A$x, # proto2
P$x, # proto
e$x2(),
A$x2(),
P$x2()
)
#> Unit: nanoseconds
#> expr min lq mean median uq max neval cld
#> e$x 182 260.0 363.53 325.5 389.0 4233 100 a
#> A$x 1939 2387.5 3133.03 2694.5 3080.0 15575 100 b
#> P$x 3360 4029.5 4846.73 4400.0 4741.5 14021 100 b
#> e$x2() 388 517.5 821.07 622.0 746.0 9807 100 a
#> A$x2() 4762 5721.5 7393.29 6535.0 7065.0 35368 100 c
#> P$x2() 30106 31642.0 35633.92 32625.5 34325.5 147567 100 dBare environments are about 10x faster than proto2 for accessing fields and methods. proto2 is in turn about 2c the speed as proto for accessing fields, and 6x faster for invoking methods.
We can also compare proto and proto2 with one level of inheritance:
B <- proto2(inherit = A)
Q <- proto(P)
microbenchmark(
B$x, # proto2
Q$x, # proto
B$x2(),
Q$x2()
)
#> Unit: microseconds
#> expr min lq mean median uq max neval cld
#> B$x 5.564 6.2660 7.77921 6.9425 7.771 28.296 100 b
#> Q$x 3.572 4.0940 4.85985 4.5325 4.890 14.721 100 a
#> B$x2() 11.980 13.8095 16.59275 15.1505 16.639 28.838 100 c
#> Q$x2() 29.821 31.9600 36.01391 33.0590 35.270 105.080 100 dThis time, proto2 is about 50% slower for accessing an inherited field, and 2x faster for invoking an inherited method.
Cross-package inheritance works fine. We’ll simulate it by evaluating the proto2 code in different environments.
pkgA <- new.env()
evalq(envir = pkgA, {
val <- 100
A <- proto2(
x = 1,
y = 1,
x2 = function(self) val + self$x,
y2 = function(self) val + self$y
)
# The methods in A will get val from the parent environment, pkgA
print(A$x)
print(A$x2())
print(A$y)
print(A$y2())
})
#> [1] 1
#> [1] 101
#> [1] 1
#> [1] 101
pkgB <- new.env()
evalq(envir = pkgB, {
val <- 200
B <- proto2(inherit = pkgA$A,
x = 2,
y2 = function(self) val + self$y
)
# The inherited method, x2, will get:
# * self$x from B
# * val from pkgA
# The overridden method, y2, will get:
# * self$y from A
# * val from pkgB
print(B$x)
print(B$x2())
print(B$y)
print(B$y2())
})
#> [1] 2
#> [1] 102
#> [1] 1
#> [1] 201devtools::session_info()
#> Session info --------------------------------------------------------------
#> setting value
#> version R version 3.2.1 (2015-06-18)
#> system x86_64, linux-gnu
#> ui X11
#> language en_US
#> collate en_US.UTF-8
#> tz <NA>
#> Packages ------------------------------------------------------------------
#> package * version date source
#> codetools 0.2-11 2015-03-10 CRAN (R 3.1.3)
#> colorspace 1.2-6 2015-03-11 CRAN (R 3.2.0)
#> curl 0.9 2015-06-19 CRAN (R 3.2.1)
#> devtools 1.8.0 2015-05-09 CRAN (R 3.2.0)
#> digest 0.6.8 2014-12-31 CRAN (R 3.2.0)
#> evaluate 0.7 2015-04-21 CRAN (R 3.2.0)
#> formatR 1.2 2015-04-21 CRAN (R 3.2.0)
#> ggplot2 1.0.1.9001 2015-06-25 local
#> git2r 0.10.1 2015-05-07 CRAN (R 3.2.0)
#> gtable 0.1.2.9000 2015-06-25 local
#> htmltools 0.2.6 2014-09-08 CRAN (R 3.2.0)
#> knitr 1.10.5 2015-05-06 CRAN (R 3.2.0)
#> lattice 0.20-31 2015-03-30 CRAN (R 3.1.3)
#> magrittr 1.5 2014-11-22 CRAN (R 3.2.0)
#> MASS 7.3-41 2015-06-18 CRAN (R 3.2.1)
#> memoise 0.2.1 2014-04-22 CRAN (R 3.2.0)
#> microbenchmark * 1.4-2 2014-09-28 CRAN (R 3.2.0)
#> multcomp 1.4-0 2015-03-05 CRAN (R 3.2.1)
#> munsell 0.4.2 2013-07-11 CRAN (R 3.2.0)
#> mvtnorm 1.0-2 2014-12-18 CRAN (R 3.2.1)
#> plyr 1.8.3.9000 2015-06-25 local
#> proto * 1.0.0 2015-06-26 Github (hadley/proto@0d74053)
#> Rcpp 0.11.6 2015-05-01 CRAN (R 3.2.0)
#> reshape2 1.4.1 2014-12-06 CRAN (R 3.2.0)
#> rmarkdown 0.7 2015-06-13 CRAN (R 3.2.1)
#> rversions 1.0.1 2015-06-06 CRAN (R 3.2.1)
#> sandwich 2.3-3 2015-03-26 CRAN (R 3.2.1)
#> scales 0.2.5.9000 2015-06-25 local
#> stringi 0.5-2 2015-06-22 CRAN (R 3.2.1)
#> stringr 1.0.0 2015-04-30 CRAN (R 3.2.0)
#> survival 2.38-2 2015-06-12 CRAN (R 3.2.0)
#> TH.data 1.0-6 2015-01-05 CRAN (R 3.2.1)
#> xml2 0.1.1 2015-06-02 CRAN (R 3.2.1)
#> yaml 2.1.13 2014-06-12 CRAN (R 3.2.0)
#> zoo 1.7-12 2015-03-16 CRAN (R 3.2.1)