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.92µs 7.97µs 119594. 0B 47.9
#> 2 foo_S3(x) 2.46µs 2.69µs 337423. 0B 33.7
#> 3 foo_S4(x) 2.62µs 2.95µs 326771. 0B 32.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) 12.54µs 13.62µs 70336. 0B 56.3
#> 2 bar_S4(x, y) 6.97µs 7.62µs 127265. 0B 50.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.92µs 7.86µs 122047. 0B 61.1
#> 2 worst 3 15 7.17µs 8.04µs 118542. 0B 71.2
#> 3 best 5 15 6.97µs 7.91µs 121435. 0B 60.7
#> 4 worst 5 15 7.18µs 8.06µs 119019. 0B 71.5
#> 5 best 10 15 6.96µs 7.75µs 124118. 0B 74.5
#> 6 worst 10 15 7.38µs 8.13µs 118206. 0B 71.0
#> 7 best 50 15 7.52µs 8.38µs 114620. 0B 68.8
#> 8 worst 50 15 9.21µs 10.14µs 95107. 0B 57.1
#> 9 best 100 15 8.05µs 9.02µs 97861. 0B 19.6
#> 10 worst 100 15 11.36µs 12.61µs 73932. 0B 14.8
#> 11 best 3 100 7.04µs 8.04µs 121092. 0B 12.1
#> 12 worst 3 100 7.29µs 8.31µs 117208. 0B 23.4
#> 13 best 5 100 7µs 8.04µs 121265. 0B 12.1
#> 14 worst 5 100 7.4µs 8.39µs 115465. 0B 23.1
#> 15 best 10 100 6.99µs 7.97µs 121750. 0B 24.4
#> 16 worst 10 100 7.99µs 8.97µs 108310. 0B 10.8
#> 17 best 50 100 7.59µs 8.6µs 113306. 0B 11.3
#> 18 worst 50 100 12.35µs 13.37µs 72975. 0B 7.30
#> 19 best 100 100 8.1µs 9.14µs 106202. 0B 10.6
#> 20 worst 100 100 17.72µs 18.8µs 51905. 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.64µs 9.68µs 100264. 0B 20.1
#> 2 worst 3 15 8.91µs 9.98µs 97072. 0B 19.4
#> 3 best 5 15 8.76µs 9.77µs 99605. 0B 19.9
#> 4 worst 5 15 9.09µs 10.15µs 95755. 0B 19.2
#> 5 best 10 15 8.75µs 9.86µs 98270. 0B 29.5
#> 6 worst 10 15 9.56µs 10.66µs 90229. 0B 18.0
#> 7 best 50 15 9.73µs 10.8µs 89355. 0B 17.9
#> 8 worst 50 15 12.73µs 13.9µs 69740. 0B 14.0
#> 9 best 100 15 10.86µs 11.98µs 80708. 0B 16.1
#> 10 worst 100 15 17.07µs 18.39µs 52582. 0B 10.5
#> 11 best 3 100 8.85µs 9.95µs 96916. 0B 19.4
#> 12 worst 3 100 9.29µs 10.43µs 92591. 0B 18.5
#> 13 best 5 100 8.89µs 9.99µs 96253. 0B 19.3
#> 14 worst 5 100 10.14µs 11.23µs 85825. 0B 17.2
#> 15 best 10 100 9.13µs 10.37µs 92566. 0B 18.5
#> 16 worst 10 100 10.94µs 12.07µs 79870. 0B 16.0
#> 17 best 50 100 10.01µs 11.2µs 85922. 0B 17.2
#> 18 worst 50 100 20.23µs 21.41µs 45476. 0B 9.10
#> 19 best 100 100 11.05µs 12.22µs 78642. 0B 23.6
#> 20 worst 100 100 30.27µs 31.56µs 30918. 0B 6.18