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.48µs 8.61µs 104107. 0B 52.1
#> 2 foo_S3(x) 2.4µs 2.97µs 281202. 0B 28.1
#> 3 foo_S4(x) 2.55µs 3.36µs 279402. 0B 55.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) 11.85µs 14.54µs 63884. 0B 57.5
#> 2 bar_S4(x, y) 6.63µs 8.44µs 109659. 0B 43.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.71µs 9.12µs 98660. 0B 59.2
#> 2 worst 3 15 6.75µs 9.2µs 97222. 0B 68.1
#> 3 best 5 15 6.72µs 8.76µs 103018. 0B 72.2
#> 4 worst 5 15 6.91µs 8.99µs 101049. 0B 60.7
#> 5 best 10 15 6.71µs 8.7µs 104504. 0B 62.7
#> 6 worst 10 15 7.09µs 9.16µs 100701. 0B 60.5
#> 7 best 50 15 7.22µs 9.07µs 100342. 0B 70.3
#> 8 worst 50 15 8.93µs 11.01µs 82985. 0B 58.1
#> 9 best 100 15 7.69µs 9.21µs 93620. 0B 18.7
#> 10 worst 100 15 11µs 12.58µs 77188. 0B 7.72
#> 11 best 3 100 6.66µs 8.04µs 117855. 0B 23.6
#> 12 worst 3 100 6.93µs 8.39µs 113614. 0B 22.7
#> 13 best 5 100 6.67µs 8.27µs 113409. 0B 11.3
#> 14 worst 5 100 7.12µs 8.63µs 111449. 0B 22.3
#> 15 best 10 100 6.76µs 8.38µs 113092. 0B 11.3
#> 16 worst 10 100 7.79µs 9.35µs 101706. 0B 20.3
#> 17 best 50 100 7.26µs 8.71µs 109331. 0B 21.9
#> 18 worst 50 100 12.13µs 13.59µs 71385. 0B 7.14
#> 19 best 100 100 7.83µs 9.58µs 92328. 0B 9.23
#> 20 worst 100 100 17.83µs 19.43µs 49985. 0B 10.00And 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.35µs 9.96µs 95124. 0B 19.0
#> 2 worst 3 15 8.5µs 10.23µs 93496. 0B 18.7
#> 3 best 5 15 8.37µs 10.04µs 92994. 0B 18.6
#> 4 worst 5 15 8.73µs 10.5µs 89264. 0B 17.9
#> 5 best 10 15 8.43µs 10.12µs 93033. 0B 18.6
#> 6 worst 10 15 9.13µs 10.77µs 87987. 0B 17.6
#> 7 best 50 15 9.38µs 11.13µs 84795. 0B 17.0
#> 8 worst 50 15 12.61µs 14.48µs 65170. 0B 13.0
#> 9 best 100 15 10.5µs 12.32µs 75613. 0B 22.7
#> 10 worst 100 15 17.01µs 18.89µs 50625. 0B 10.1
#> 11 best 3 100 8.34µs 10.09µs 90540. 0B 18.1
#> 12 worst 3 100 8.91µs 10.64µs 87101. 0B 17.4
#> 13 best 5 100 8.33µs 10.06µs 92619. 0B 18.5
#> 14 worst 5 100 8.94µs 10.65µs 88211. 0B 17.6
#> 15 best 10 100 8.45µs 10.13µs 93065. 0B 18.6
#> 16 worst 10 100 9.77µs 11.51µs 81760. 0B 16.4
#> 17 best 50 100 9.65µs 11.5µs 81572. 0B 16.3
#> 18 worst 50 100 18.53µs 20.4µs 46444. 0B 4.64
#> 19 best 100 100 10.6µs 12.33µs 76383. 0B 15.3
#> 20 worst 100 100 31.26µs 33.12µs 29281. 0B 5.86