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) 3.9µs 5.13µs 176641. 0B 88.4
#> 2 foo_S3(x) 1.46µs 1.78µs 489729. 0B 98.0
#> 3 foo_S4(x) 1.5µs 1.93µs 484623. 0B 48.5
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) 7.15µs 8.45µs 109645. 0B 98.8
#> 2 bar_S4(x, y) 4.02µs 4.6µs 208832. 0B 62.7A 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 4.07µs 5.03µs 185447. 0B 111.
#> 2 worst 3 15 4.12µs 4.96µs 190010. 0B 114.
#> 3 best 5 15 3.99µs 5.52µs 163246. 0B 98.0
#> 4 worst 5 15 4.18µs 5.57µs 162459. 0B 114.
#> 5 best 10 15 4.09µs 5.48µs 165173. 0B 99.2
#> 6 worst 10 15 4.35µs 5.45µs 170410. 0B 102.
#> 7 best 50 15 4.31µs 5.71µs 158560. 0B 95.2
#> 8 worst 50 15 5.46µs 6.84µs 135228. 0B 81.2
#> 9 best 100 15 4.64µs 5.85µs 152585. 0B 30.5
#> 10 worst 100 15 7.19µs 8.3µs 117729. 0B 11.8
#> 11 best 3 100 4.01µs 5.09µs 189722. 0B 38.0
#> 12 worst 3 100 4.33µs 5.37µs 181398. 0B 18.1
#> 13 best 5 100 4.1µs 5.13µs 188762. 0B 18.9
#> 14 worst 5 100 4.55µs 5.6µs 164516. 0B 32.9
#> 15 best 10 100 4.08µs 5.07µs 185288. 0B 18.5
#> 16 worst 10 100 4.89µs 5.87µs 158925. 0B 31.8
#> 17 best 50 100 4.42µs 5.4µs 174809. 0B 35.0
#> 18 worst 50 100 8.85µs 9.88µs 96522. 0B 9.65
#> 19 best 100 100 4.76µs 5.87µs 158279. 0B 31.7
#> 20 worst 100 100 13.17µs 14.25µs 66732. 0B 6.67And 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 5.16µs 6.28µs 146570. 0B 29.3
#> 2 worst 3 15 5.29µs 6.45µs 141299. 0B 28.3
#> 3 best 5 15 5.05µs 6.23µs 147793. 0B 29.6
#> 4 worst 5 15 5.34µs 6.53µs 142313. 0B 28.5
#> 5 best 10 15 5.23µs 6.45µs 136312. 0B 27.3
#> 6 worst 10 15 5.71µs 6.91µs 130478. 0B 26.1
#> 7 best 50 15 5.84µs 7.07µs 127339. 0B 25.5
#> 8 worst 50 15 7.92µs 9.23µs 99640. 0B 19.9
#> 9 best 100 15 6.25µs 7.62µs 117092. 0B 23.4
#> 10 worst 100 15 11.25µs 12.48µs 75561. 0B 15.1
#> 11 best 3 100 5.26µs 6.49µs 137802. 0B 27.6
#> 12 worst 3 100 5.51µs 6.71µs 133338. 0B 26.7
#> 13 best 5 100 5.05µs 6.31µs 141711. 0B 28.3
#> 14 worst 5 100 5.71µs 6.98µs 129987. 0B 26.0
#> 15 best 10 100 5.15µs 6.37µs 141692. 0B 28.3
#> 16 worst 10 100 6.9µs 8.18µs 112057. 0B 22.4
#> 17 best 50 100 5.78µs 6.96µs 131409. 0B 26.3
#> 18 worst 50 100 13.94µs 15.14µs 63783. 0B 6.38
#> 19 best 100 100 6.58µs 7.79µs 117730. 0B 23.6
#> 20 worst 100 100 22.23µs 23.45µs 41257. 0B 8.25