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.16µs 8.36µs 111786. 18.2KB 22.4
#> 2 foo_S3(x) 2.56µs 2.81µs 326128. 0B 0
#> 3 foo_S4(x) 2.75µs 3.07µs 313221. 0B 31.3
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.22µs 14.87µs 65004. 0B 26.0
#> 2 bar_S4(x, y) 7.34µs 8.21µs 118936. 0B 23.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.28µs 8.6µs 113078. 0B 33.9
#> 2 worst 3 15 7.3µs 8.67µs 112178. 0B 22.4
#> 3 best 5 15 7.3µs 8.59µs 113051. 0B 22.6
#> 4 worst 5 15 7.55µs 8.8µs 110219. 0B 33.1
#> 5 best 10 15 7.39µs 8.68µs 111528. 0B 33.5
#> 6 worst 10 15 7.74µs 8.97µs 108372. 0B 21.7
#> 7 best 50 15 7.86µs 9.26µs 104850. 0B 31.5
#> 8 worst 50 15 9.52µs 10.75µs 90291. 0B 18.1
#> 9 best 100 15 8.46µs 9.89µs 97772. 0B 29.3
#> 10 worst 100 15 11.79µs 13.13µs 74026. 0B 22.2
#> 11 best 3 100 7.5µs 8.7µs 111082. 0B 33.3
#> 12 worst 3 100 7.79µs 9.06µs 107042. 0B 21.4
#> 13 best 5 100 7.49µs 8.84µs 109555. 0B 21.9
#> 14 worst 5 100 7.88µs 9.2µs 105226. 0B 31.6
#> 15 best 10 100 7.32µs 8.65µs 110543. 0B 22.1
#> 16 worst 10 100 8.11µs 9.46µs 101087. 0B 30.3
#> 17 best 50 100 7.84µs 9.29µs 103482. 0B 20.7
#> 18 worst 50 100 12.99µs 14.33µs 67270. 0B 20.2
#> 19 best 100 100 8.7µs 10.09µs 94856. 0B 28.5
#> 20 worst 100 100 19.21µs 20.72µs 46758. 0B 14.0And 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 9µs 10.5µs 90693. 0B 27.2
#> 2 worst 3 15 9.47µs 10.9µs 86751. 0B 34.7
#> 3 best 5 15 9.21µs 10.7µs 89539. 0B 26.9
#> 4 worst 5 15 9.56µs 11µs 86642. 0B 26.0
#> 5 best 10 15 9.33µs 10.9µs 87037. 0B 26.1
#> 6 worst 10 15 9.92µs 11.5µs 83524. 0B 25.1
#> 7 best 50 15 10.01µs 10.9µs 87592. 0B 35.1
#> 8 worst 50 15 13.08µs 13.8µs 70695. 0B 21.2
#> 9 best 100 15 11.29µs 12.1µs 81105. 0B 32.5
#> 10 worst 100 15 17.6µs 18.5µs 52903. 0B 21.2
#> 11 best 3 100 9.28µs 10µs 96206. 0B 38.5
#> 12 worst 3 100 10.05µs 11.2µs 85608. 0B 25.7
#> 13 best 5 100 9.14µs 10.4µs 92004. 0B 27.6
#> 14 worst 5 100 10.13µs 11.4µs 84609. 0B 25.4
#> 15 best 10 100 9.12µs 10.4µs 92420. 0B 37.0
#> 16 worst 10 100 11.39µs 12.7µs 76307. 0B 22.9
#> 17 best 50 100 10.43µs 11.8µs 80797. 0B 32.3
#> 18 worst 50 100 19.44µs 20.7µs 46645. 0B 14.0
#> 19 best 100 100 11.7µs 13µs 73585. 0B 29.4
#> 20 worst 100 100 30.06µs 31.5µs 30793. 0B 12.3