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) 9.28µs 10.66µs 89403. 21.3KB 26.8
#> 2 foo_S3(x) 2.65µs 2.98µs 308473. 0B 30.9
#> 3 foo_S4(x) 2.86µs 3.23µs 292760. 0B 29.3
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) 16.36µs 18.2µs 52996. 0B 26.5
#> 2 bar_S4(x, y) 7.97µs 8.84µs 110038. 0B 11.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("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 9.42µs 10.7µs 91769. 0B 27.5
#> 2 worst 3 15 9.63µs 10.9µs 89520. 0B 26.9
#> 3 best 5 15 9.45µs 10.8µs 90388. 0B 36.2
#> 4 worst 5 15 9.68µs 11µs 89181. 0B 26.8
#> 5 best 10 15 9.54µs 10.9µs 90062. 0B 27.0
#> 6 worst 10 15 9.96µs 11.2µs 86829. 0B 34.7
#> 7 best 50 15 10.09µs 11.4µs 86064. 0B 34.4
#> 8 worst 50 15 11.81µs 13.1µs 75051. 0B 22.5
#> 9 best 100 15 10.73µs 12.1µs 79128. 0B 31.7
#> 10 worst 100 15 14.35µs 15.9µs 61591. 0B 24.6
#> 11 best 3 100 9.27µs 10.7µs 91272. 0B 36.5
#> 12 worst 3 100 9.66µs 10.9µs 89197. 0B 26.8
#> 13 best 5 100 9.47µs 10.7µs 90779. 0B 27.2
#> 14 worst 5 100 9.76µs 11.1µs 87613. 0B 35.1
#> 15 best 10 100 9.59µs 10.9µs 87915. 0B 26.4
#> 16 worst 10 100 10.16µs 11.6µs 81614. 0B 24.5
#> 17 best 50 100 9.91µs 11.2µs 86860. 0B 26.1
#> 18 worst 50 100 14.89µs 16.3µs 60138. 0B 24.1
#> 19 best 100 100 10.8µs 12.1µs 80680. 0B 32.3
#> 20 worst 100 100 21.6µs 23.3µs 41700. 0B 16.7And 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 11.1µs 12.6µs 76933. 0B 38.5
#> 2 worst 3 15 11.6µs 13.2µs 73738. 0B 29.5
#> 3 best 5 15 11µs 11.7µs 84378. 0B 33.8
#> 4 worst 5 15 11.4µs 12.1µs 81509. 0B 32.6
#> 5 best 10 15 11.1µs 11.9µs 83022. 0B 33.2
#> 6 worst 10 15 11.9µs 12.6µs 78432. 0B 31.4
#> 7 best 50 15 12.1µs 12.9µs 76366. 0B 30.6
#> 8 worst 50 15 15.5µs 16.7µs 58936. 0B 23.6
#> 9 best 100 15 13.6µs 14.7µs 64310. 0B 32.2
#> 10 worst 100 15 20.4µs 21.5µs 45628. 0B 22.8
#> 11 best 3 100 11.2µs 12.4µs 78347. 0B 31.4
#> 12 worst 3 100 12.1µs 13.4µs 72037. 0B 28.8
#> 13 best 5 100 11.2µs 12.5µs 77468. 0B 31.0
#> 14 worst 5 100 12.4µs 13.8µs 69157. 0B 27.7
#> 15 best 10 100 11.3µs 12.7µs 75125. 0B 30.1
#> 16 worst 10 100 13.4µs 14.8µs 65397. 0B 26.2
#> 17 best 50 100 12.8µs 14µs 69414. 0B 27.8
#> 18 worst 50 100 22µs 23.3µs 42206. 0B 16.9
#> 19 best 100 100 13.8µs 15.2µs 64052. 0B 32.0
#> 20 worst 100 100 33.3µs 35.1µs 27933. 0B 11.2