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.15µs 8.55µs 108971. 0B 54.5
#> 2 foo_S3(x) 2.42µs 2.79µs 318141. 0B 63.6
#> 3 foo_S4(x) 2.62µs 3.13µs 306609. 0B 30.7
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) 12.63µs 14.25µs 66660. 0B 60.0
#> 2 bar_S4(x, y) 7.01µs 8.12µs 118688. 0B 47.5A 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.01µs 8.6µs 109342. 0B 65.6
#> 2 worst 3 15 7.23µs 8.62µs 109187. 0B 65.6
#> 3 best 5 15 7.08µs 8.15µs 117526. 0B 70.6
#> 4 worst 5 15 7.07µs 8.17µs 116366. 0B 69.9
#> 5 best 10 15 7.12µs 8.75µs 107521. 0B 64.6
#> 6 worst 10 15 7.57µs 9.05µs 104493. 0B 62.7
#> 7 best 50 15 7.46µs 9.24µs 99535. 0B 69.7
#> 8 worst 50 15 9.25µs 10.88µs 86510. 0B 51.9
#> 9 best 100 15 7.93µs 9.17µs 95650. 0B 19.1
#> 10 worst 100 15 11.38µs 12.54µs 77511. 0B 7.75
#> 11 best 3 100 6.97µs 8.22µs 118408. 0B 23.7
#> 12 worst 3 100 7.34µs 8.5µs 114989. 0B 23.0
#> 13 best 5 100 7.22µs 8.38µs 116580. 0B 11.7
#> 14 worst 5 100 7.6µs 8.82µs 109709. 0B 21.9
#> 15 best 10 100 7.05µs 8.29µs 118050. 0B 23.6
#> 16 worst 10 100 8.24µs 9.45µs 103118. 0B 10.3
#> 17 best 50 100 7.67µs 8.9µs 109051. 0B 10.9
#> 18 worst 50 100 13.06µs 14.32µs 68286. 0B 13.7
#> 19 best 100 100 8.22µs 9.45µs 103012. 0B 20.6
#> 20 worst 100 100 17.98µs 19.35µs 50617. 0B 10.1And 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.7µs 9.97µs 97280. 0B 19.5
#> 2 worst 3 15 9.08µs 10.42µs 92797. 0B 18.6
#> 3 best 5 15 8.84µs 10.05µs 95980. 0B 19.2
#> 4 worst 5 15 9.17µs 10.4µs 92429. 0B 18.5
#> 5 best 10 15 8.91µs 10.2µs 94579. 0B 18.9
#> 6 worst 10 15 9.67µs 10.94µs 88302. 0B 17.7
#> 7 best 50 15 9.69µs 11.16µs 86772. 0B 17.4
#> 8 worst 50 15 12.97µs 14.33µs 67758. 0B 13.6
#> 9 best 100 15 10.85µs 12.14µs 79200. 0B 23.8
#> 10 worst 100 15 17.26µs 18.52µs 52562. 0B 10.5
#> 11 best 3 100 9.04µs 10.35µs 93498. 0B 18.7
#> 12 worst 3 100 9.41µs 10.73µs 90364. 0B 18.1
#> 13 best 5 100 8.85µs 10.12µs 95803. 0B 19.2
#> 14 worst 5 100 9.74µs 11.09µs 86898. 0B 17.4
#> 15 best 10 100 8.94µs 10.23µs 94449. 0B 18.9
#> 16 worst 10 100 11.12µs 12.4µs 78315. 0B 15.7
#> 17 best 50 100 9.76µs 11.16µs 86861. 0B 17.4
#> 18 worst 50 100 18.33µs 19.63µs 49755. 0B 9.95
#> 19 best 100 100 10.83µs 12.25µs 78393. 0B 15.7
#> 20 worst 100 100 29.72µs 31.26µs 31209. 0B 6.24