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.09µs 8.63µs 108070. 0B 54.1
#> 2 foo_S3(x) 2.52µs 2.85µs 317090. 0B 63.4
#> 3 foo_S4(x) 2.67µs 3.13µs 308596. 0B 30.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.36µs 15.19µs 62084. 0B 55.9
#> 2 bar_S4(x, y) 7.24µs 8.28µs 115772. 0B 46.3A 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.14µs 8.52µs 110696. 0B 66.5
#> 2 worst 3 15 7.3µs 8.75µs 107534. 0B 64.6
#> 3 best 5 15 7.2µs 8.64µs 108758. 0B 65.3
#> 4 worst 5 15 7.46µs 8.95µs 104869. 0B 73.5
#> 5 best 10 15 7.21µs 8.85µs 105711. 0B 63.5
#> 6 worst 10 15 7.62µs 8.8µs 107141. 0B 64.3
#> 7 best 50 15 7.63µs 9.03µs 104730. 0B 73.4
#> 8 worst 50 15 9.28µs 10.63µs 86017. 0B 60.3
#> 9 best 100 15 8.19µs 9.41µs 93475. 0B 18.7
#> 10 worst 100 15 11.61µs 12.74µs 76466. 0B 7.65
#> 11 best 3 100 7.22µs 8.42µs 115412. 0B 23.1
#> 12 worst 3 100 7.49µs 8.74µs 111721. 0B 22.3
#> 13 best 5 100 7.16µs 8.36µs 116710. 0B 11.7
#> 14 worst 5 100 7.71µs 8.92µs 108992. 0B 21.8
#> 15 best 10 100 7.32µs 8.54µs 114187. 0B 11.4
#> 16 worst 10 100 8.35µs 9.53µs 102223. 0B 20.4
#> 17 best 50 100 7.77µs 8.98µs 108392. 0B 21.7
#> 18 worst 50 100 12.17µs 13.35µs 73252. 0B 14.7
#> 19 best 100 100 8.39µs 9.57µs 102006. 0B 20.4
#> 20 worst 100 100 18.1µs 19.39µs 50442. 0B 5.04And 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.7µs 10.1µs 95770. 0B 19.2
#> 2 worst 3 15 9.12µs 10.4µs 93085. 0B 18.6
#> 3 best 5 15 8.84µs 10.2µs 94527. 0B 18.9
#> 4 worst 5 15 9.32µs 10.6µs 90900. 0B 18.2
#> 5 best 10 15 9.04µs 10.3µs 93659. 0B 18.7
#> 6 worst 10 15 9.87µs 11.2µs 86194. 0B 17.2
#> 7 best 50 15 9.93µs 11.3µs 85867. 0B 17.2
#> 8 worst 50 15 12.94µs 14.3µs 67618. 0B 13.5
#> 9 best 100 15 10.99µs 12.3µs 78344. 0B 15.7
#> 10 worst 100 15 17.22µs 18.5µs 52382. 0B 10.5
#> 11 best 3 100 8.78µs 10.1µs 95379. 0B 19.1
#> 12 worst 3 100 9.21µs 10.5µs 92008. 0B 18.4
#> 13 best 5 100 8.96µs 10.2µs 93873. 0B 18.8
#> 14 worst 5 100 9.88µs 11.2µs 85907. 0B 17.2
#> 15 best 10 100 9.15µs 10.5µs 91942. 0B 18.4
#> 16 worst 10 100 10.87µs 12.3µs 78800. 0B 15.8
#> 17 best 50 100 9.89µs 11.2µs 86436. 0B 17.3
#> 18 worst 50 100 19.15µs 20.5µs 47641. 0B 9.53
#> 19 best 100 100 11.23µs 12.6µs 76125. 0B 15.2
#> 20 worst 100 100 31.77µs 33.3µs 29358. 0B 5.87