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) 7.23µs 8.32µs 113741. 18.2KB 22.8
#> 2 foo_S3(x) 2.65µs 2.88µs 322292. 0B 32.2
#> 3 foo_S4(x) 2.77µs 3.14µs 308258. 0B 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) 13.88µs 15.32µs 63599. 0B 25.4
#> 2 bar_S4(x, y) 7.78µs 8.72µs 112693. 0B 22.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("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 7.2µs 8.53µs 114435. 0B 34.3
#> 2 worst 3 15 7.46µs 8.63µs 113854. 0B 34.2
#> 3 best 5 15 7.29µs 8.59µs 113478. 0B 34.1
#> 4 worst 5 15 7.53µs 8.81µs 110937. 0B 33.3
#> 5 best 10 15 7.4µs 8.67µs 112915. 0B 33.9
#> 6 worst 10 15 7.69µs 8.94µs 109449. 0B 21.9
#> 7 best 50 15 7.84µs 9.03µs 108384. 0B 32.5
#> 8 worst 50 15 9.33µs 10.72µs 88701. 0B 26.6
#> 9 best 100 15 8.49µs 9.77µs 100076. 0B 40.0
#> 10 worst 100 15 12.06µs 13.46µs 72663. 0B 21.8
#> 11 best 3 100 7.46µs 8.81µs 110850. 0B 33.3
#> 12 worst 3 100 7.65µs 8.88µs 109957. 0B 44.0
#> 13 best 5 100 7.34µs 8.57µs 114203. 0B 34.3
#> 14 worst 5 100 7.74µs 9µs 107714. 0B 32.3
#> 15 best 10 100 7.34µs 8.64µs 111942. 0B 33.6
#> 16 worst 10 100 8.19µs 9.49µs 102356. 0B 30.7
#> 17 best 50 100 7.74µs 9.15µs 106079. 0B 31.8
#> 18 worst 50 100 12.95µs 14.26µs 68657. 0B 20.6
#> 19 best 100 100 8.56µs 9.82µs 99585. 0B 29.9
#> 20 worst 100 100 19.1µs 20.56µs 47127. 0B 14.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 9.04µs 10.5µs 91160. 0B 27.4
#> 2 worst 3 15 9.28µs 10.7µs 89999. 0B 36.0
#> 3 best 5 15 8.96µs 10.5µs 92021. 0B 27.6
#> 4 worst 5 15 9.38µs 11µs 88199. 0B 35.3
#> 5 best 10 15 8.88µs 10.4µs 93770. 0B 37.5
#> 6 worst 10 15 9.73µs 10.5µs 94077. 0B 28.2
#> 7 best 50 15 9.99µs 10.8µs 91551. 0B 27.5
#> 8 worst 50 15 13.07µs 13.9µs 70360. 0B 28.2
#> 9 best 100 15 10.81µs 11.8µs 83405. 0B 33.4
#> 10 worst 100 15 17.78µs 19.1µs 49673. 0B 19.9
#> 11 best 3 100 9.23µs 10.4µs 93274. 0B 28.0
#> 12 worst 3 100 9.98µs 11.1µs 86856. 0B 34.8
#> 13 best 5 100 9.1µs 10.4µs 93018. 0B 37.2
#> 14 worst 5 100 10.06µs 11.2µs 86770. 0B 26.0
#> 15 best 10 100 9.11µs 10.4µs 92886. 0B 37.2
#> 16 worst 10 100 11.35µs 12.6µs 76555. 0B 30.6
#> 17 best 50 100 10.39µs 11.5µs 84333. 0B 33.7
#> 18 worst 50 100 19.22µs 20.5µs 47556. 0B 14.3
#> 19 best 100 100 11.3µs 12.6µs 76652. 0B 30.7
#> 20 worst 100 100 30.77µs 32.5µs 29919. 0B 12.0