The dispatch performance should be roughly on par with S3 and S4,
though as this is implemented in a package there is some overhead due to
.Call vs .Primitive.
Text <- new_class("Text", parent = class_character)
Number <- new_class("Number", parent = class_double)
x <- Text("hi")
y <- Number(1)
foo_S7 <- new_generic("foo_S7", "x")
method(foo_S7, Text) <- function(x, ...) paste0(x, "-foo")
foo_S3 <- function(x, ...) {
UseMethod("foo_S3")
}
foo_S3.Text <- function(x, ...) {
paste0(x, "-foo")
}
library(methods)
setOldClass(c("Number", "numeric", "S7_object"))
setOldClass(c("Text", "character", "S7_object"))
setGeneric("foo_S4", function(x, ...) standardGeneric("foo_S4"))
#> [1] "foo_S4"
setMethod("foo_S4", c("Text"), function(x, ...) paste0(x, "-foo"))
# Measure performance of single dispatch
bench::mark(foo_S7(x), foo_S3(x), foo_S4(x))
#> # A tibble: 3 × 6
#> expression min median `itr/sec` mem_alloc `gc/sec`
#> <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl>
#> 1 foo_S7(x) 7.12µs 8.76µs 105611. 0B 52.8
#> 2 foo_S3(x) 2.46µs 2.88µs 306337. 0B 61.3
#> 3 foo_S4(x) 2.67µs 3.21µs 295747. 0B 29.6
bar_S7 <- new_generic("bar_S7", c("x", "y"))
method(bar_S7, list(Text, Number)) <- function(x, y, ...) paste0(x, "-", y, "-bar")
setGeneric("bar_S4", function(x, y, ...) standardGeneric("bar_S4"))
#> [1] "bar_S4"
setMethod("bar_S4", c("Text", "Number"), function(x, y, ...) paste0(x, "-", y, "-bar"))
# Measure performance of double dispatch
bench::mark(bar_S7(x, y), bar_S4(x, y))
#> # A tibble: 2 × 6
#> expression min median `itr/sec` mem_alloc `gc/sec`
#> <bch:expr> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl>
#> 1 bar_S7(x, y) 13.65µs 15.73µs 59431. 0B 53.5
#> 2 bar_S4(x, y) 7.53µs 8.66µs 110866. 0B 33.3A potential optimization is caching based on the class names, but lookup should be fast without this.
The following benchmark generates a class hierarchy of different levels and lengths of class names and compares the time to dispatch on the first class in the hierarchy vs the time to dispatch on the last class.
We find that even in very extreme cases (e.g. 100 deep hierarchy 100 of character class names) the overhead is reasonable, and for more reasonable cases (e.g. 10 deep hierarchy of 15 character class names) the overhead is basically negligible.
library(S7)
gen_character <- function (n, min = 5, max = 25, values = c(letters, LETTERS, 0:9)) {
lengths <- sample(min:max, replace = TRUE, size = n)
values <- sample(values, sum(lengths), replace = TRUE)
starts <- c(1, cumsum(lengths)[-n] + 1)
ends <- cumsum(lengths)
mapply(function(start, end) paste0(values[start:end], collapse=""), starts, ends)
}
bench::press(
num_classes = c(3, 5, 10, 50, 100),
class_nchar = c(15, 100),
{
# Construct a class hierarchy with that number of classes
Text <- new_class("Text", parent = class_character)
parent <- Text
classes <- gen_character(num_classes, min = class_nchar, max = class_nchar)
env <- new.env()
for (x in classes) {
assign(x, new_class(x, parent = parent), env)
parent <- get(x, env)
}
# Get the last defined class
cls <- parent
# Construct an object of that class
x <- do.call(cls, list("hi"))
# Define a generic and a method for the last class (best case scenario)
foo_S7 <- new_generic("foo_S7", "x")
method(foo_S7, cls) <- function(x, ...) paste0(x, "-foo")
# Define a generic and a method for the first class (worst case scenario)
foo2_S7 <- new_generic("foo2_S7", "x")
method(foo2_S7, S7_object) <- function(x, ...) paste0(x, "-foo")
bench::mark(
best = foo_S7(x),
worst = foo2_S7(x)
)
}
)
#> # A tibble: 20 × 8
#> expression num_classes class_nchar min median `itr/sec` mem_alloc `gc/sec`
#> <bch:expr> <dbl> <dbl> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl>
#> 1 best 3 15 7.3µs 9.11µs 102259. 0B 61.4
#> 2 worst 3 15 7.64µs 9.46µs 96289. 0B 57.8
#> 3 best 5 15 7.39µs 9.09µs 102389. 0B 71.7
#> 4 worst 5 15 7.63µs 9.35µs 99295. 0B 59.6
#> 5 best 10 15 7.36µs 9.11µs 101671. 0B 61.0
#> 6 worst 10 15 7.87µs 9.61µs 96910. 0B 58.2
#> 7 best 50 15 7.96µs 9.75µs 95345. 0B 57.2
#> 8 worst 50 15 10.34µs 12.02µs 77908. 0B 46.8
#> 9 best 100 15 8.26µs 9.56µs 90932. 0B 18.2
#> 10 worst 100 15 13.05µs 14.47µs 67264. 0B 6.73
#> 11 best 3 100 7.38µs 8.62µs 112945. 0B 22.6
#> 12 worst 3 100 7.78µs 9.13µs 106766. 0B 10.7
#> 13 best 5 100 7.4µs 8.6µs 112600. 0B 22.5
#> 14 worst 5 100 7.96µs 9.09µs 106508. 0B 21.3
#> 15 best 10 100 7.35µs 8.65µs 112498. 0B 11.3
#> 16 worst 10 100 9.02µs 10.23µs 95090. 0B 19.0
#> 17 best 50 100 7.88µs 9.19µs 105839. 0B 21.2
#> 18 worst 50 100 13.92µs 15.14µs 64383. 0B 6.44
#> 19 best 100 100 8.44µs 9.7µs 100332. 0B 10.0
#> 20 worst 100 100 19.43µs 20.84µs 46743. 0B 9.35And the same benchmark using double-dispatch
bench::press(
num_classes = c(3, 5, 10, 50, 100),
class_nchar = c(15, 100),
{
# Construct a class hierarchy with that number of classes
Text <- new_class("Text", parent = class_character)
parent <- Text
classes <- gen_character(num_classes, min = class_nchar, max = class_nchar)
env <- new.env()
for (x in classes) {
assign(x, new_class(x, parent = parent), env)
parent <- get(x, env)
}
# Get the last defined class
cls <- parent
# Construct an object of that class
x <- do.call(cls, list("hi"))
y <- do.call(cls, list("ho"))
# Define a generic and a method for the last class (best case scenario)
foo_S7 <- new_generic("foo_S7", c("x", "y"))
method(foo_S7, list(cls, cls)) <- function(x, y, ...) paste0(x, y, "-foo")
# Define a generic and a method for the first class (worst case scenario)
foo2_S7 <- new_generic("foo2_S7", c("x", "y"))
method(foo2_S7, list(S7_object, S7_object)) <- function(x, y, ...) paste0(x, y, "-foo")
bench::mark(
best = foo_S7(x, y),
worst = foo2_S7(x, y)
)
}
)
#> # A tibble: 20 × 8
#> expression num_classes class_nchar min median `itr/sec` mem_alloc `gc/sec`
#> <bch:expr> <dbl> <dbl> <bch:tm> <bch:tm> <dbl> <bch:byt> <dbl>
#> 1 best 3 15 8.97µs 10.3µs 94048. 0B 18.8
#> 2 worst 3 15 9.36µs 10.8µs 90070. 0B 18.0
#> 3 best 5 15 8.95µs 10.4µs 92177. 0B 18.4
#> 4 worst 5 15 9.63µs 11.1µs 87514. 0B 17.5
#> 5 best 10 15 9.04µs 10.5µs 91424. 0B 18.3
#> 6 worst 10 15 10.05µs 11.4µs 84126. 0B 16.8
#> 7 best 50 15 10.04µs 11.5µs 83866. 0B 16.8
#> 8 worst 50 15 14.31µs 15.7µs 61734. 0B 12.3
#> 9 best 100 15 11.04µs 12.5µs 77287. 0B 15.5
#> 10 worst 100 15 19.73µs 21.3µs 45440. 0B 9.09
#> 11 best 3 100 9.27µs 10.7µs 90005. 0B 18.0
#> 12 worst 3 100 9.94µs 11.3µs 85314. 0B 17.1
#> 13 best 5 100 8.96µs 10.4µs 92068. 0B 18.4
#> 14 worst 5 100 10.14µs 11.5µs 83437. 0B 16.7
#> 15 best 10 100 9.45µs 10.9µs 88777. 0B 17.8
#> 16 worst 10 100 11.58µs 13.1µs 72747. 0B 14.6
#> 17 best 50 100 10.3µs 11.7µs 82220. 0B 16.4
#> 18 worst 50 100 22.99µs 24.4µs 39823. 0B 7.97
#> 19 best 100 100 11.33µs 12.7µs 75395. 0B 22.6
#> 20 worst 100 100 35.61µs 37.2µs 26183. 0B 5.24