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(parent = class_character)
Number := new_class(parent = class_double)
x <- Text("hi")
y <- Number(1)
foo_S7 := new_generic("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) 6.17µs 8.69µs 104061. 0B 72.9
#> 2 foo_S3(x) 1.95µs 2.44µs 367324. 0B 36.7
#> 3 foo_S4(x) 2.05µs 2.78µs 338656. 0B 67.7
bar_S7 := new_generic(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) 11.01µs 13.54µs 67654. 0B 27.1
#> 2 bar_S4(x, y) 5.44µs 6.35µs 149769. 0B 15.0A 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(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("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("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 6.04µs 7.54µs 126167. 0B 25.2
#> 2 worst 3 15 6.35µs 7.85µs 124484. 0B 24.9
#> 3 best 5 15 6.23µs 7.69µs 126823. 0B 25.4
#> 4 worst 5 15 6.36µs 7.9µs 121492. 0B 24.3
#> 5 best 10 15 6.21µs 7.74µs 125854. 0B 25.2
#> 6 worst 10 15 6.5µs 8.1µs 120620. 0B 24.1
#> 7 best 50 15 6.64µs 8.17µs 119232. 0B 23.9
#> 8 worst 50 15 7.97µs 9.58µs 101790. 0B 20.4
#> 9 best 100 15 6.95µs 8.53µs 114195. 0B 22.8
#> 10 worst 100 15 10.11µs 11.68µs 83474. 0B 16.7
#> 11 best 3 100 6.21µs 7.81µs 123476. 0B 24.7
#> 12 worst 3 100 6.53µs 8.19µs 118597. 0B 11.9
#> 13 best 5 100 6.17µs 7.74µs 124656. 0B 24.9
#> 14 worst 5 100 6.65µs 8.28µs 116735. 0B 23.4
#> 15 best 10 100 6.36µs 7.97µs 121059. 0B 24.2
#> 16 worst 10 100 7.07µs 8.65µs 109808. 0B 22.0
#> 17 best 50 100 6.74µs 8.27µs 117377. 0B 11.7
#> 18 worst 50 100 11.77µs 13.36µs 72993. 0B 14.6
#> 19 best 100 100 7.19µs 8.82µs 109424. 0B 21.9
#> 20 worst 100 100 16.17µs 17.56µs 55756. 0B 11.2And 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(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(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(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.27µs 9.8µs 99038. 0B 19.8
#> 2 worst 3 15 8.48µs 10.05µs 96847. 0B 19.4
#> 3 best 5 15 8.3µs 9.9µs 98218. 0B 19.6
#> 4 worst 5 15 8.65µs 10.24µs 95068. 0B 19.0
#> 5 best 10 15 8.43µs 9.96µs 97490. 0B 19.5
#> 6 worst 10 15 8.96µs 10.7µs 91198. 0B 18.2
#> 7 best 50 15 9.21µs 10.78µs 90149. 0B 18.0
#> 8 worst 50 15 12.21µs 13.77µs 70697. 0B 14.1
#> 9 best 100 15 10.22µs 11.93µs 81454. 0B 24.4
#> 10 worst 100 15 16.14µs 17.95µs 54495. 0B 16.4
#> 11 best 3 100 8.63µs 10.31µs 93849. 0B 28.2
#> 12 worst 3 100 9.04µs 10.75µs 90094. 0B 18.0
#> 13 best 5 100 8.25µs 9.99µs 96569. 0B 29.0
#> 14 worst 5 100 9.37µs 11.09µs 86956. 0B 26.1
#> 15 best 10 100 8.52µs 10.34µs 93288. 0B 28.0
#> 16 worst 10 100 10.41µs 12.15µs 79623. 0B 15.9
#> 17 best 50 100 9.32µs 11.16µs 86728. 0B 17.3
#> 18 worst 50 100 19.34µs 21.34µs 45722. 0B 13.7
#> 19 best 100 100 10.34µs 11.99µs 80762. 0B 24.2
#> 20 worst 100 100 31.83µs 33.74µs 29110. 0B 8.74