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.73µs 7.6µs 128049. 0B 64.1
#> 2 foo_S3(x) 2.39µs 2.6µs 376101. 0B 75.2
#> 3 foo_S4(x) 2.6µs 2.9µs 330472. 0B 33.1
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.6µs 13.76µs 70476. 0B 56.4
#> 2 bar_S4(x, y) 6.9µs 7.96µs 122265. 0B 48.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.64µs 7.54µs 128562. 0B 77.2
#> 2 worst 3 15 6.85µs 7.51µs 129764. 0B 77.9
#> 3 best 5 15 6.68µs 7.49µs 129044. 0B 77.5
#> 4 worst 5 15 7.01µs 8.02µs 118090. 0B 70.9
#> 5 best 10 15 6.78µs 7.71µs 124781. 0B 74.9
#> 6 worst 10 15 7.05µs 7.68µs 126366. 0B 75.9
#> 7 best 50 15 7.18µs 8.02µs 121537. 0B 73.0
#> 8 worst 50 15 9.04µs 9.83µs 99267. 0B 59.6
#> 9 best 100 15 7.76µs 8.74µs 99793. 0B 20.0
#> 10 worst 100 15 11.54µs 12.59µs 78212. 0B 7.82
#> 11 best 3 100 6.76µs 7.77µs 126499. 0B 25.3
#> 12 worst 3 100 7.07µs 8.12µs 120882. 0B 24.2
#> 13 best 5 100 6.89µs 7.96µs 123739. 0B 24.8
#> 14 worst 5 100 7.22µs 8.22µs 119686. 0B 12.0
#> 15 best 10 100 6.78µs 7.7µs 127298. 0B 25.5
#> 16 worst 10 100 7.91µs 8.8µs 112005. 0B 22.4
#> 17 best 50 100 7.23µs 8.28µs 118939. 0B 23.8
#> 18 worst 50 100 12.24µs 13.18µs 74903. 0B 7.49
#> 19 best 100 100 7.88µs 8.85µs 111326. 0B 22.3
#> 20 worst 100 100 16.71µs 17.64µs 56046. 0B 5.61And 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.3µs 9.32µs 105195. 0B 21.0
#> 2 worst 3 15 8.49µs 9.58µs 102884. 0B 20.6
#> 3 best 5 15 8.37µs 9.39µs 104642. 0B 20.9
#> 4 worst 5 15 8.82µs 9.87µs 99797. 0B 20.0
#> 5 best 10 15 8.62µs 9.61µs 101945. 0B 20.4
#> 6 worst 10 15 9.22µs 10.31µs 94481. 0B 28.4
#> 7 best 50 15 9.37µs 10.37µs 94463. 0B 18.9
#> 8 worst 50 15 12.77µs 13.78µs 71454. 0B 14.3
#> 9 best 100 15 10.51µs 11.6µs 84784. 0B 17.0
#> 10 worst 100 15 17.2µs 18.36µs 53494. 0B 16.1
#> 11 best 3 100 8.38µs 9.47µs 103605. 0B 20.7
#> 12 worst 3 100 8.74µs 9.82µs 99707. 0B 19.9
#> 13 best 5 100 8.45µs 9.63µs 100951. 0B 20.2
#> 14 worst 5 100 9.22µs 10.29µs 94604. 0B 18.9
#> 15 best 10 100 8.75µs 9.89µs 98615. 0B 19.7
#> 16 worst 10 100 10.76µs 11.87µs 82389. 0B 24.7
#> 17 best 50 100 9.64µs 10.72µs 91306. 0B 18.3
#> 18 worst 50 100 18.94µs 20.24µs 48722. 0B 9.75
#> 19 best 100 100 10.55µs 11.69µs 83550. 0B 16.7
#> 20 worst 100 100 30.92µs 32.17µs 30586. 0B 9.18