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.31µs 7.7µs 123345. 10.8KB 37.0
#> 2 foo_S3(x) 1.94µs 2.27µs 403660. 0B 0
#> 3 foo_S4(x) 2.06µs 2.54µs 377255. 0B 37.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.3µs 13.38µs 72841. 0B 36.4
#> 2 bar_S4(x, y) 5.4µs 6.37µs 152964. 0B 15.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(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.25µs 7.7µs 126069. 0B 37.8
#> 2 worst 3 15 6.39µs 7.87µs 123401. 0B 49.4
#> 3 best 5 15 6.35µs 7.57µs 128493. 0B 38.6
#> 4 worst 5 15 6.58µs 7.78µs 124712. 0B 49.9
#> 5 best 10 15 6.52µs 7.97µs 121973. 0B 36.6
#> 6 worst 10 15 6.83µs 8.32µs 116080. 0B 46.5
#> 7 best 50 15 6.85µs 8.46µs 114623. 0B 34.4
#> 8 worst 50 15 8.14µs 9.68µs 100380. 0B 30.1
#> 9 best 100 15 7.19µs 8.73µs 111443. 0B 33.4
#> 10 worst 100 15 9.74µs 11.14µs 87629. 0B 35.1
#> 11 best 3 100 6.33µs 7.61µs 127720. 0B 38.3
#> 12 worst 3 100 6.68µs 7.95µs 121209. 0B 48.5
#> 13 best 5 100 6.43µs 7.66µs 126136. 0B 37.9
#> 14 worst 5 100 6.76µs 7.96µs 120953. 0B 48.4
#> 15 best 10 100 6.58µs 7.8µs 123769. 0B 37.1
#> 16 worst 10 100 7.07µs 8.41µs 114233. 0B 45.7
#> 17 best 50 100 6.86µs 8.53µs 112165. 0B 33.7
#> 18 worst 50 100 10.72µs 12.5µs 77794. 0B 23.3
#> 19 best 100 100 7.5µs 9.21µs 104605. 0B 31.4
#> 20 worst 100 100 15.84µs 17.64µs 55036. 0B 22.0And 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.46µs 10.27µs 94347. 0B 37.8
#> 2 worst 3 15 8.26µs 10.34µs 93560. 0B 46.8
#> 3 best 5 15 8.23µs 9.01µs 107861. 0B 54.0
#> 4 worst 5 15 8.55µs 9.43µs 103455. 0B 41.4
#> 5 best 10 15 8.27µs 9.05µs 106963. 0B 53.5
#> 6 worst 10 15 8.85µs 9.63µs 101541. 0B 40.6
#> 7 best 50 15 9.22µs 10.29µs 93909. 0B 37.6
#> 8 worst 50 15 11.57µs 12.96µs 75114. 0B 30.1
#> 9 best 100 15 10.26µs 11.6µs 83833. 0B 33.5
#> 10 worst 100 15 15.39µs 16.68µs 58707. 0B 23.5
#> 11 best 3 100 8.55µs 9.73µs 99242. 0B 49.6
#> 12 worst 3 100 9.31µs 10.3µs 93518. 0B 37.4
#> 13 best 5 100 8.59µs 9.66µs 99179. 0B 49.6
#> 14 worst 5 100 9.08µs 10.21µs 94570. 0B 37.8
#> 15 best 10 100 8.53µs 9.57µs 100735. 0B 40.3
#> 16 worst 10 100 10.13µs 11.11µs 87239. 0B 43.6
#> 17 best 50 100 9.51µs 10.57µs 91730. 0B 36.7
#> 18 worst 50 100 16.75µs 17.96µs 54089. 0B 27.1
#> 19 best 100 100 10.42µs 11.45µs 84509. 0B 42.3
#> 20 worst 100 100 25.54µs 26.88µs 36114. 0B 14.5