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.05µs 8.29µs 113476. 0B 56.8
#> 2 foo_S3(x) 2.5µs 2.89µs 305667. 0B 61.1
#> 3 foo_S4(x) 2.65µs 3.19µs 298213. 0B 29.8
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.04µs 15.45µs 60358. 0B 54.4
#> 2 bar_S4(x, y) 7.31µs 8.41µs 114047. 0B 34.2A 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.28µs 8.95µs 105172. 0B 63.1
#> 2 worst 3 15 7.43µs 8.51µs 111459. 0B 66.9
#> 3 best 5 15 7.16µs 8.37µs 114046. 0B 79.9
#> 4 worst 5 15 7.38µs 8.48µs 112791. 0B 67.7
#> 5 best 10 15 7.22µs 8.2µs 116633. 0B 70.0
#> 6 worst 10 15 7.75µs 8.72µs 110088. 0B 66.1
#> 7 best 50 15 7.73µs 9.07µs 105552. 0B 63.4
#> 8 worst 50 15 10.08µs 11.3µs 84399. 0B 50.7
#> 9 best 100 15 8.23µs 9.59µs 89726. 0B 17.9
#> 10 worst 100 15 12.98µs 14.35µs 67962. 0B 6.80
#> 11 best 3 100 7.23µs 8.44µs 113691. 0B 22.7
#> 12 worst 3 100 7.67µs 9.14µs 106720. 0B 10.7
#> 13 best 5 100 7.19µs 8.43µs 114706. 0B 22.9
#> 14 worst 5 100 7.83µs 9.14µs 105947. 0B 21.2
#> 15 best 10 100 7.4µs 8.74µs 111336. 0B 11.1
#> 16 worst 10 100 8.73µs 10.02µs 96809. 0B 19.4
#> 17 best 50 100 7.78µs 9.05µs 107733. 0B 21.6
#> 18 worst 50 100 13.87µs 15.17µs 64354. 0B 6.44
#> 19 best 100 100 8.4µs 9.64µs 100948. 0B 10.1
#> 20 worst 100 100 21µs 22.36µs 43601. 0B 8.72And 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.81µs 10.1µs 96085. 0B 19.2
#> 2 worst 3 15 9.2µs 10.6µs 92175. 0B 18.4
#> 3 best 5 15 8.93µs 10.2µs 94690. 0B 18.9
#> 4 worst 5 15 9.36µs 10.8µs 90053. 0B 18.0
#> 5 best 10 15 9.01µs 10.4µs 92060. 0B 18.4
#> 6 worst 10 15 10.06µs 11.4µs 84981. 0B 8.50
#> 7 best 50 15 9.86µs 11.3µs 85350. 0B 17.1
#> 8 worst 50 15 14.45µs 15.8µs 61193. 0B 12.2
#> 9 best 100 15 11.14µs 12.4µs 78245. 0B 15.7
#> 10 worst 100 15 19.87µs 21.3µs 45521. 0B 9.11
#> 11 best 3 100 9.09µs 10.4µs 93019. 0B 18.6
#> 12 worst 3 100 10µs 11.2µs 86678. 0B 17.3
#> 13 best 5 100 8.96µs 10.1µs 95047. 0B 19.0
#> 14 worst 5 100 10.55µs 11.8µs 81791. 0B 16.4
#> 15 best 10 100 9.11µs 10.5µs 91693. 0B 18.3
#> 16 worst 10 100 11.46µs 12.8µs 75319. 0B 15.1
#> 17 best 50 100 10.12µs 11.5µs 84203. 0B 16.8
#> 18 worst 50 100 21.96µs 23.4µs 41485. 0B 8.30
#> 19 best 100 100 11.25µs 12.6µs 76370. 0B 15.3
#> 20 worst 100 100 37µs 38.5µs 25337. 0B 5.07