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) 7.43µs 8.83µs 105992. 0B 63.6
#> 2 foo_S3(x) 2.48µs 2.85µs 315345. 0B 63.1
#> 3 foo_S4(x) 2.63µs 3.14µs 302963. 0B 30.3
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) 13.79µs 16.21µs 57756. 0B 57.8
#> 2 bar_S4(x, y) 7.21µs 8.54µs 111190. 0B 44.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(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 7.5µs 9.36µs 98745. 0B 69.2
#> 2 worst 3 15 7.61µs 9.56µs 98068. 0B 68.7
#> 3 best 5 15 7.57µs 9.27µs 101085. 0B 70.8
#> 4 worst 5 15 7.82µs 9.4µs 99929. 0B 70.0
#> 5 best 10 15 7.55µs 9.12µs 101594. 0B 71.2
#> 6 worst 10 15 8.01µs 9.52µs 91117. 0B 18.2
#> 7 best 50 15 7.82µs 9.05µs 107275. 0B 10.7
#> 8 worst 50 15 10.16µs 11.33µs 85876. 0B 17.2
#> 9 best 100 15 8.5µs 9.69µs 100172. 0B 10.0
#> 10 worst 100 15 12.82µs 14.19µs 68525. 0B 13.7
#> 11 best 3 100 7.53µs 8.77µs 110585. 0B 22.1
#> 12 worst 3 100 7.79µs 9.11µs 106179. 0B 21.2
#> 13 best 5 100 7.41µs 8.66µs 111905. 0B 22.4
#> 14 worst 5 100 7.82µs 9.02µs 107701. 0B 10.8
#> 15 best 10 100 7.67µs 8.87µs 109393. 0B 21.9
#> 16 worst 10 100 8.77µs 9.91µs 97928. 0B 19.6
#> 17 best 50 100 8.14µs 9.23µs 104762. 0B 10.5
#> 18 worst 50 100 14.79µs 16.13µs 60374. 0B 12.1
#> 19 best 100 100 8.73µs 9.89µs 97946. 0B 19.6
#> 20 worst 100 100 21.82µs 23.05µs 42345. 0B 8.47And 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 9.15µs 10.5µs 92574. 0B 27.8
#> 2 worst 3 15 9.58µs 11µs 88220. 0B 17.6
#> 3 best 5 15 9.13µs 10.6µs 89908. 0B 18.0
#> 4 worst 5 15 9.7µs 11.2µs 86671. 0B 17.3
#> 5 best 10 15 9.25µs 10.7µs 90142. 0B 27.1
#> 6 worst 10 15 10.28µs 11.7µs 82416. 0B 16.5
#> 7 best 50 15 10.26µs 11.7µs 82459. 0B 16.5
#> 8 worst 50 15 14.56µs 16µs 60619. 0B 12.1
#> 9 best 100 15 11.48µs 13µs 74063. 0B 14.8
#> 10 worst 100 15 20.36µs 21.9µs 44263. 0B 8.85
#> 11 best 3 100 9.51µs 11µs 87731. 0B 26.3
#> 12 worst 3 100 10.39µs 11.6µs 82990. 0B 16.6
#> 13 best 5 100 9.31µs 10.7µs 90149. 0B 18.0
#> 14 worst 5 100 10.07µs 11.6µs 81495. 0B 16.3
#> 15 best 10 100 9.57µs 11µs 87314. 0B 17.5
#> 16 worst 10 100 11.83µs 13.3µs 72853. 0B 21.9
#> 17 best 50 100 10.29µs 11.7µs 82700. 0B 16.5
#> 18 worst 50 100 22.89µs 24.3µs 39946. 0B 12.0
#> 19 best 100 100 11.61µs 13.2µs 72650. 0B 21.8
#> 20 worst 100 100 36.26µs 37.7µs 25883. 0B 5.18