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.23µs 8.2µs 116066. 0B 58.1
#> 2 foo_S3(x) 2.46µs 2.69µs 336443. 0B 33.6
#> 3 foo_S4(x) 2.6µs 2.94µs 324187. 0B 64.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) 13.02µs 14.67µs 64450. 0B 64.5
#> 2 bar_S4(x, y) 6.97µs 7.61µs 127055. 0B 50.8A 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.31µs 8.07µs 117672. 0B 82.4
#> 2 worst 3 15 7.46µs 8.11µs 118167. 0B 82.8
#> 3 best 5 15 7.22µs 8.01µs 118954. 0B 83.3
#> 4 worst 5 15 7.56µs 8.63µs 110436. 0B 77.4
#> 5 best 10 15 7.31µs 8.11µs 118431. 0B 83.0
#> 6 worst 10 15 7.72µs 9.07µs 94989. 0B 19.0
#> 7 best 50 15 7.76µs 8.95µs 106854. 0B 21.4
#> 8 worst 50 15 10.01µs 11.09µs 87516. 0B 17.5
#> 9 best 100 15 8.44µs 9.55µs 101982. 0B 20.4
#> 10 worst 100 15 12.62µs 13.77µs 70541. 0B 14.1
#> 11 best 3 100 7.28µs 8.44µs 114877. 0B 11.5
#> 12 worst 3 100 7.75µs 8.86µs 109228. 0B 21.9
#> 13 best 5 100 7.27µs 8.41µs 115360. 0B 23.1
#> 14 worst 5 100 7.72µs 8.87µs 109235. 0B 21.9
#> 15 best 10 100 7.41µs 8.65µs 111992. 0B 11.2
#> 16 worst 10 100 8.45µs 9.61µs 101319. 0B 20.3
#> 17 best 50 100 7.89µs 8.97µs 107753. 0B 10.8
#> 18 worst 50 100 12.51µs 13.76µs 70638. 0B 14.1
#> 19 best 100 100 8.37µs 9.54µs 101182. 0B 20.2
#> 20 worst 100 100 18.93µs 20.24µs 48005. 0B 9.60And 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.92µs 10.2µs 94571. 0B 28.4
#> 2 worst 3 15 9.43µs 10.7µs 91017. 0B 18.2
#> 3 best 5 15 9.15µs 10.4µs 93424. 0B 18.7
#> 4 worst 5 15 9.61µs 10.9µs 89331. 0B 17.9
#> 5 best 10 15 9.14µs 10.4µs 93450. 0B 18.7
#> 6 worst 10 15 9.97µs 11.3µs 83518. 0B 16.7
#> 7 best 50 15 10.23µs 11.4µs 84218. 0B 16.8
#> 8 worst 50 15 14.08µs 15.5µs 62675. 0B 12.5
#> 9 best 100 15 11.41µs 12.7µs 76038. 0B 15.2
#> 10 worst 100 15 19.34µs 20.9µs 45992. 0B 13.8
#> 11 best 3 100 9.19µs 10.5µs 91805. 0B 18.4
#> 12 worst 3 100 9.64µs 11.1µs 87365. 0B 17.5
#> 13 best 5 100 9.15µs 10.5µs 91444. 0B 27.4
#> 14 worst 5 100 10.43µs 11.6µs 83126. 0B 16.6
#> 15 best 10 100 9.42µs 10.7µs 90264. 0B 18.1
#> 16 worst 10 100 11.52µs 12.9µs 75471. 0B 15.1
#> 17 best 50 100 10.35µs 11.7µs 82719. 0B 16.5
#> 18 worst 50 100 19.72µs 21.1µs 46198. 0B 9.24
#> 19 best 100 100 11.42µs 12.7µs 76344. 0B 15.3
#> 20 worst 100 100 33.95µs 35.5µs 27537. 0B 5.51