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.28µs 8.94µs 104007. 0B 52.0
#> 2 foo_S3(x) 2.52µs 2.91µs 303446. 0B 60.7
#> 3 foo_S4(x) 2.69µs 3.21µs 296910. 0B 29.7
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.71µs 15.75µs 59594. 0B 53.7
#> 2 bar_S4(x, y) 7.48µs 8.61µs 110971. 0B 33.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("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.37µs 8.96µs 104797. 0B 62.9
#> 2 worst 3 15 7.75µs 9.38µs 100357. 0B 60.3
#> 3 best 5 15 7.25µs 8.99µs 102314. 0B 71.7
#> 4 worst 5 15 7.82µs 9.34µs 99874. 0B 60.0
#> 5 best 10 15 7.46µs 9.11µs 102660. 0B 61.6
#> 6 worst 10 15 7.93µs 9.57µs 97648. 0B 58.6
#> 7 best 50 15 7.92µs 9.53µs 98273. 0B 59.0
#> 8 worst 50 15 10.25µs 11.95µs 78675. 0B 47.2
#> 9 best 100 15 8.28µs 9.6µs 90646. 0B 18.1
#> 10 worst 100 15 13.11µs 14.39µs 67568. 0B 6.76
#> 11 best 3 100 7.22µs 8.41µs 115325. 0B 23.1
#> 12 worst 3 100 7.66µs 8.94µs 108468. 0B 10.8
#> 13 best 5 100 7.29µs 8.5µs 114059. 0B 22.8
#> 14 worst 5 100 8.16µs 9.38µs 102208. 0B 20.4
#> 15 best 10 100 7.48µs 8.68µs 111568. 0B 11.2
#> 16 worst 10 100 9.04µs 10.25µs 94675. 0B 18.9
#> 17 best 50 100 8.01µs 9.23µs 105187. 0B 21.0
#> 18 worst 50 100 13.94µs 15.23µs 63137. 0B 6.31
#> 19 best 100 100 8.38µs 9.72µs 99408. 0B 9.94
#> 20 worst 100 100 20.68µs 22.02µs 44221. 0B 8.85And 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.16µs 10.4µs 93106. 0B 18.6
#> 2 worst 3 15 9.53µs 10.8µs 89820. 0B 18.0
#> 3 best 5 15 9.07µs 10.4µs 92875. 0B 18.6
#> 4 worst 5 15 9.67µs 11µs 87497. 0B 17.5
#> 5 best 10 15 9.31µs 10.8µs 89903. 0B 8.99
#> 6 worst 10 15 10.12µs 11.6µs 83129. 0B 16.6
#> 7 best 50 15 10.18µs 11.6µs 83229. 0B 16.6
#> 8 worst 50 15 14.56µs 16µs 60485. 0B 12.1
#> 9 best 100 15 11.3µs 12.7µs 76016. 0B 15.2
#> 10 worst 100 15 19.87µs 21.3µs 45684. 0B 9.14
#> 11 best 3 100 9.22µs 10.6µs 90507. 0B 18.1
#> 12 worst 3 100 10.2µs 11.6µs 82567. 0B 24.8
#> 13 best 5 100 9.41µs 10.8µs 89340. 0B 17.9
#> 14 worst 5 100 10.35µs 11.8µs 81633. 0B 16.3
#> 15 best 10 100 9.32µs 10.8µs 84394. 0B 16.9
#> 16 worst 10 100 11.93µs 13.5µs 69888. 0B 14.0
#> 17 best 50 100 10.26µs 11.7µs 82517. 0B 16.5
#> 18 worst 50 100 23.22µs 24.7µs 39400. 0B 7.88
#> 19 best 100 100 11.35µs 12.8µs 75759. 0B 15.2
#> 20 worst 100 100 36.73µs 38.2µs 25477. 0B 5.10