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) 4.86µs 7.33µs 122142. 18.2KB 36.7
#> 2 foo_S3(x) 1.65µs 2.3µs 354916. 0B 35.5
#> 3 foo_S4(x) 1.85µs 2.57µs 349595. 0B 35.0
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) 8.77µs 12.28µs 74556. 0B 29.8
#> 2 bar_S4(x, y) 4.8µs 6.73µs 133497. 0B 26.7A 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 4.92µs 7.76µs 117758. 0B 35.3
#> 2 worst 3 15 5.23µs 8.1µs 110934. 0B 22.2
#> 3 best 5 15 4.94µs 8.3µs 107493. 0B 32.3
#> 4 worst 5 15 5.12µs 7.68µs 121526. 0B 24.3
#> 5 best 10 15 5.01µs 7.87µs 116563. 0B 23.3
#> 6 worst 10 15 5.24µs 8.24µs 112441. 0B 33.7
#> 7 best 50 15 5.29µs 7.81µs 118642. 0B 35.6
#> 8 worst 50 15 6.52µs 10.46µs 88389. 0B 26.5
#> 9 best 100 15 5.69µs 8.49µs 106706. 0B 32.0
#> 10 worst 100 15 8.24µs 12.32µs 72534. 0B 21.8
#> 11 best 3 100 5.04µs 8.04µs 110935. 0B 33.3
#> 12 worst 3 100 5.29µs 7.97µs 116361. 0B 34.9
#> 13 best 5 100 5.07µs 7.75µs 120873. 0B 36.3
#> 14 worst 5 100 5.33µs 7.94µs 116564. 0B 35.0
#> 15 best 10 100 5.04µs 7.71µs 118494. 0B 35.6
#> 16 worst 10 100 5.64µs 8.23µs 112820. 0B 33.9
#> 17 best 50 100 5.31µs 8.01µs 116122. 0B 34.8
#> 18 worst 50 100 9.27µs 12.4µs 75807. 0B 22.7
#> 19 best 100 100 5.8µs 8.54µs 108859. 0B 32.7
#> 20 worst 100 100 13.91µs 18.53µs 50484. 0B 15.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 6.41µs 9.65µs 93025. 0B 37.2
#> 2 worst 3 15 6.57µs 9.71µs 95187. 0B 38.1
#> 3 best 5 15 6.41µs 9.59µs 92278. 0B 27.7
#> 4 worst 5 15 6.85µs 9.97µs 92086. 0B 36.8
#> 5 best 10 15 6.52µs 7.95µs 109265. 0B 43.7
#> 6 worst 10 15 7.15µs 8.37µs 111539. 0B 33.5
#> 7 best 50 15 7.01µs 8.34µs 105124. 0B 31.5
#> 8 worst 50 15 9.61µs 11.08µs 83339. 0B 33.3
#> 9 best 100 15 7.85µs 10.03µs 88129. 0B 35.3
#> 10 worst 100 15 12.96µs 17.24µs 50924. 0B 15.3
#> 11 best 3 100 6.52µs 8.36µs 108753. 0B 43.5
#> 12 worst 3 100 7.16µs 14.52µs 68147. 0B 27.3
#> 13 best 5 100 6.4µs 8.45µs 106642. 0B 32.0
#> 14 worst 5 100 7.23µs 9.74µs 87323. 0B 34.9
#> 15 best 10 100 6.28µs 8.81µs 98919. 0B 39.6
#> 16 worst 10 100 8.15µs 10.55µs 84331. 0B 25.3
#> 17 best 50 100 7.26µs 10.29µs 85178. 0B 25.6
#> 18 worst 50 100 14.2µs 17.82µs 50656. 0B 20.3
#> 19 best 100 100 8.09µs 10.38µs 88075. 0B 35.2
#> 20 worst 100 100 22.51µs 26.82µs 35255. 0B 10.6