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.99µs 8.12µs 117278. 0B 46.9
#> 2 foo_S3(x) 2.4µs 2.67µs 345301. 0B 34.5
#> 3 foo_S4(x) 2.65µs 2.96µs 328505. 0B 32.9
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.68µs 13.83µs 70005. 0B 56.0
#> 2 bar_S4(x, y) 7.17µs 8.02µs 122225. 0B 48.9A 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 7.75µs 124537. 0B 74.8
#> 2 worst 3 15 7.21µs 7.82µs 124351. 0B 74.7
#> 3 best 5 15 6.95µs 7.63µs 126120. 0B 75.7
#> 4 worst 5 15 7.31µs 7.92µs 123237. 0B 74.0
#> 5 best 10 15 7.19µs 8.16µs 118127. 0B 70.9
#> 6 worst 10 15 7.48µs 8.47µs 114129. 0B 68.5
#> 7 best 50 15 7.56µs 8.46µs 115235. 0B 69.2
#> 8 worst 50 15 9.34µs 10.06µs 97397. 0B 58.5
#> 9 best 100 15 8.01µs 8.96µs 100029. 0B 20.0
#> 10 worst 100 15 11.55µs 12.69µs 77665. 0B 15.5
#> 11 best 3 100 7.08µs 8.09µs 121095. 0B 12.1
#> 12 worst 3 100 7.44µs 8.35µs 117217. 0B 23.4
#> 13 best 5 100 7.13µs 8.07µs 121572. 0B 24.3
#> 14 worst 5 100 7.53µs 8.58µs 113638. 0B 11.4
#> 15 best 10 100 7.07µs 8.07µs 121643. 0B 24.3
#> 16 worst 10 100 8.34µs 9.28µs 105980. 0B 21.2
#> 17 best 50 100 7.6µs 8.57µs 114450. 0B 22.9
#> 18 worst 50 100 12.32µs 13.29µs 73760. 0B 7.38
#> 19 best 100 100 8.33µs 9.42µs 104594. 0B 10.5
#> 20 worst 100 100 17.9µs 19.05µs 51862. 0B 10.4And 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.69µs 9.85µs 99292. 0B 29.8
#> 2 worst 3 15 9.1µs 10.22µs 96230. 0B 19.2
#> 3 best 5 15 8.81µs 10.01µs 97934. 0B 19.6
#> 4 worst 5 15 9.19µs 10.21µs 96191. 0B 19.2
#> 5 best 10 15 8.91µs 9.91µs 98703. 0B 19.7
#> 6 worst 10 15 9.7µs 10.74µs 91137. 0B 18.2
#> 7 best 50 15 9.56µs 10.66µs 91248. 0B 18.3
#> 8 worst 50 15 12.76µs 13.95µs 70394. 0B 14.1
#> 9 best 100 15 10.94µs 12.1µs 80708. 0B 16.1
#> 10 worst 100 15 17.67µs 18.98µs 51995. 0B 10.4
#> 11 best 3 100 8.78µs 9.89µs 98203. 0B 29.5
#> 12 worst 3 100 9.29µs 10.4µs 94002. 0B 18.8
#> 13 best 5 100 8.97µs 10.05µs 96987. 0B 19.4
#> 14 worst 5 100 10.18µs 11.24µs 86916. 0B 17.4
#> 15 best 10 100 9.05µs 10.12µs 96566. 0B 29.0
#> 16 worst 10 100 11.3µs 12.34µs 79708. 0B 15.9
#> 17 best 50 100 9.8µs 10.97µs 89085. 0B 17.8
#> 18 worst 50 100 18.09µs 19.2µs 51290. 0B 10.3
#> 19 best 100 100 11.05µs 12.27µs 79786. 0B 16.0
#> 20 worst 100 100 32.23µs 33.39µs 29651. 0B 5.93