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) 6.95µs 7.7µs 123609. 0B 61.8
#> 2 foo_S3(x) 2.44µs 2.63µs 344067. 0B 34.4
#> 3 foo_S4(x) 2.65µs 2.9µs 332847. 0B 66.6
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) 12.73µs 13.8µs 69996. 0B 63.1
#> 2 bar_S4(x, y) 6.94µs 7.5µs 129073. 0B 38.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 6.97µs 8.1µs 119241. 0B 71.6
#> 2 worst 3 15 7.2µs 7.96µs 122025. 0B 73.3
#> 3 best 5 15 7.02µs 7.97µs 119715. 0B 71.9
#> 4 worst 5 15 7.27µs 7.88µs 121966. 0B 73.2
#> 5 best 10 15 6.99µs 7.71µs 124047. 0B 74.5
#> 6 worst 10 15 7.47µs 7.92µs 121736. 0B 73.1
#> 7 best 50 15 7.49µs 8.03µs 120476. 0B 72.3
#> 8 worst 50 15 9.1µs 9.73µs 98961. 0B 69.3
#> 9 best 100 15 7.91µs 8.9µs 98522. 0B 19.7
#> 10 worst 100 15 11.32µs 12.38µs 78904. 0B 7.89
#> 11 best 3 100 7.03µs 8.09µs 120056. 0B 24.0
#> 12 worst 3 100 7.42µs 8.47µs 115046. 0B 23.0
#> 13 best 5 100 6.92µs 7.99µs 121956. 0B 12.2
#> 14 worst 5 100 7.39µs 8.32µs 117001. 0B 23.4
#> 15 best 10 100 7.05µs 7.97µs 122453. 0B 12.2
#> 16 worst 10 100 8.31µs 9.26µs 105340. 0B 21.1
#> 17 best 50 100 7.53µs 8.57µs 113621. 0B 22.7
#> 18 worst 50 100 12.69µs 13.71µs 70865. 0B 14.2
#> 19 best 100 100 8.35µs 9.3µs 105142. 0B 21.0
#> 20 worst 100 100 17.47µs 18.59µs 52707. 0B 5.27And 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 8.54µs 9.64µs 100448. 0B 20.1
#> 2 worst 3 15 8.94µs 9.95µs 97498. 0B 19.5
#> 3 best 5 15 8.69µs 9.79µs 99001. 0B 19.8
#> 4 worst 5 15 9.17µs 10.32µs 94315. 0B 18.9
#> 5 best 10 15 8.76µs 9.92µs 98062. 0B 19.6
#> 6 worst 10 15 9.47µs 10.67µs 91359. 0B 18.3
#> 7 best 50 15 9.67µs 10.75µs 90232. 0B 18.0
#> 8 worst 50 15 12.68µs 13.81µs 70757. 0B 14.2
#> 9 best 100 15 10.78µs 11.95µs 81362. 0B 16.3
#> 10 worst 100 15 17.13µs 18.48µs 52830. 0B 10.6
#> 11 best 3 100 8.7µs 9.79µs 98896. 0B 19.8
#> 12 worst 3 100 9.09µs 10.13µs 95667. 0B 19.1
#> 13 best 5 100 8.93µs 9.95µs 97224. 0B 19.4
#> 14 worst 5 100 9.92µs 11µs 88267. 0B 17.7
#> 15 best 10 100 9.13µs 10.28µs 94231. 0B 18.9
#> 16 worst 10 100 11.11µs 12.31µs 78711. 0B 15.7
#> 17 best 50 100 9.92µs 11.19µs 86724. 0B 17.3
#> 18 worst 50 100 19.07µs 20.3µs 48145. 0B 9.63
#> 19 best 100 100 11.03µs 12.34µs 78297. 0B 23.5
#> 20 worst 100 100 28.03µs 29.43µs 33169. 0B 3.32