library(adorn)
These examples use the timed, logged and memoize decorators from
vignette("writing-decorators"), repeated here so this vignette stands alone. The
memoize here is a minimal version that keys on the raw arguments and needs no
other packages; vignette("writing-decorators") has a fuller one.
timed <- decorator(
function(f, ..., digits = 3) {
name <- decorator_context()$name
start <- proc.time()[["elapsed"]]
on.exit(message(sprintf(
"%s took %s s",
name,
round(proc.time()[["elapsed"]] - start, digits)
)))
f(...)
},
name = "timed"
)
logged <- decorator(
function(f, ...) {
name <- decorator_context()$name
message("-> ", name)
result <- withVisible(f(...))
message("<- ", name)
if (result$visible) result$value else invisible(result$value)
},
name = "logged"
)
memoize <- decorator(
function(f) {
cache <- new.env(parent = emptyenv())
function(...) {
key <- paste(deparse(list(...)), collapse = "")
if (!exists(key, envir = cache, inherits = FALSE)) {
assign(key, f(...), envir = cache)
}
get(key, envir = cache, inherits = FALSE)
}
},
name = "memoize"
)
%@% works wherever you define a function, so it can decorate a method as you
write it.
money <- function(x) structure(list(amount = x), class = "money")
print.money <- logged %@% function(x, ...) {
cat("$", format(x$amount, nsmall = 2), "\n")
invisible(x)
}
print(money(12.5))
#> $ 12.50
setClass("Circle", representation(r = "numeric"))
setGeneric("area", function(shape, ...) standardGeneric("area"))
#> [1] "area"
setMethod("area", "Circle", logged %@% function(shape, ...) pi * shape@r^2)
area(new("Circle", r = 2))
#> [1] 12.56637
library(S7)
Dog <- new_class("Dog", properties = list(name = class_character))
speak <- new_generic("speak", "x")
method(speak, Dog) <- logged %@% function(x) paste(x@name, "says woof")
speak(Dog(name = "Rex"))
#> [1] "Rex says woof"
Decorated methods keep access to self and private, and invisible(self)
still chains.
library(R6)
Counter <- R6Class("Counter",
public = list(
n = 0,
add = logged %@% function(k = 1) {
self$n <- self$n + k
invisible(self)
}
)
)
counter <- Counter$new()
counter$add(2)$add(3)
counter$n
#> [1] 5
A stateful decorator works too. R6 methods belong to the class, so the cache
below is shared by every Model object (the key is the argument, not self).
Model <- R6Class("Model", public = list(
scale = 10,
predict = memoize %@% function(x) {
message("computing")
x * self$scale
}
))
m <- Model$new()
m$predict(2)
#> [1] 20
m$predict(2)
#> [1] 20
%@% is for methods you are defining. When the class is already built, perhaps
by another package, use decorate() to wrap one of its methods afterwards.
Each call adds a layer on the outside, and decorators() lists the stack,
outermost first.
Give decorate() the generic’s name as a string and the class. This works for
any generic.
format.money <- function(x, ...) paste0("$", x$amount)
decorate("format", timed, class = "money")
format(money(3))
#> [1] "$3"
You can also pass the generic function itself with the replacement form, as for
the other systems. The generic must call UseMethod() directly, so internal
generics such as length() need the string form above.
perimeter <- function(x, ...) UseMethod("perimeter")
perimeter.square <- function(x, ...) 4 * x$side
decorate(perimeter, "square") <- logged
perimeter(structure(list(side = 3), class = "square"))
#> [1] 12
Give decorate() the generic and the signature.
setClass("Square", representation(side = "numeric"))
setMethod("area", "Square", function(shape, ...) shape@side^2)
decorate(area, logged, signature = "Square")
decorate(area, timed, signature = "Square")
area(new("Square", side = 3))
#> [1] 9
decorators(getMethod("area", "Square"))
#> [1] "timed" "logged"
The replacement form works here too, and mirrors S7’s method(generic, class) <- fn:
decorate(area, "Square") <- logged
area(new("Square", side = 3))
#> [1] 9
Give decorate() the generic and the class. The method is wrapped in place.
decorate(speak, timed, class = Dog)
speak(Dog(name = "Rex"))
#> [1] "Rex says woof"
The stack can be inspected, and the replacement form mirrors
method(generic, class) <- fn:
decorate(speak, Dog) <- memoize
decorators(method(speak, Dog))
#> [1] "memoize" "timed" "logged"
undecorate() returns the original function. Register it again to remove all
the decorators.
method(speak, Dog) <- undecorate(method(speak, Dog))
speak(Dog(name = "Rex"))
#> [1] "Rex says woof"
Give decorate() the name of the method and the class generator as class,
the same shape as for S3. Objects
created afterwards use the decorated method; objects that already exist keep
the old one, because R6 copies methods into each object when it is created.
Resetter <- R6Class("Resetter", public = list(
n = 0,
add = function(k = 1) {
self$n <- self$n + k
invisible(self)
},
reset = function() {
self$n <- 0
invisible(self)
}
))
decorate("add", logged, class = Resetter)
r <- Resetter$new()
r$add(2)$add(3)
r$n
#> [1] 5
Pass several names to decorate several methods at once. Use where for methods that are not public
("public" is the default, the others are "private" and "active").
Safe <- R6Class("Safe",
public = list(go = function() private$step()),
private = list(step = function() "ok")
)
decorate("step", logged, class = Safe, where = "private")
Safe$new()$go()
#> [1] "ok"
A method the class only inherits is copied into the class you pass and decorated there. The parent is not changed, as with S7. The copy is a snapshot: decorating the parent again later does not affect it.
Doubler <- R6Class("Doubler", inherit = Resetter)
decorate("reset", timed, class = Doubler)
invisible(Doubler$new()$reset()) # timed
invisible(Resetter$new()$reset()) # not timed
For public methods the replacement form also works, and takes the same shape as
S7’s method(generic, class) <- fn.
decorate(Resetter, "reset") <- logged
invisible(Resetter$new()$reset())