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) 5.32µs 6.85µs 138664. NA 41.6
#> 2 foo_S3(x) 1.96µs 2.34µs 390170. NA 39.0
#> 3 foo_S4(x) 2.03µs 2.56µs 360192. NA 36.0
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) 9.86µs 11.97µs 79973. NA 32.0
#> 2 bar_S4(x, y) 5.61µs 6.64µs 145654. NA 29.1A 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 5.49µs 7.06µs 135321. NA 40.6
#> 2 worst 3 15 5.59µs 7.21µs 132660. NA 39.8
#> 3 best 5 15 5.53µs 7.07µs 135403. NA 40.6
#> 4 worst 5 15 5.68µs 7.29µs 132684. NA 26.5
#> 5 best 10 15 5.56µs 7.07µs 135782. NA 40.7
#> 6 worst 10 15 5.8µs 7.36µs 130767. NA 39.2
#> 7 best 50 15 5.91µs 7.58µs 127624. NA 25.5
#> 8 worst 50 15 7.27µs 8.88µs 109113. NA 32.7
#> 9 best 100 15 6.46µs 8.07µs 119807. NA 36.0
#> 10 worst 100 15 9.02µs 11.09µs 66568. NA 20.0
#> 11 best 3 100 5.48µs 6.98µs 138382. NA 41.5
#> 12 worst 3 100 5.85µs 7.41µs 129768. NA 26.0
#> 13 best 5 100 5.57µs 7.03µs 135405. NA 40.6
#> 14 worst 5 100 5.82µs 7.55µs 126144. NA 37.9
#> 15 best 10 100 5.41µs 7.12µs 133687. NA 40.1
#> 16 worst 10 100 6.39µs 8.01µs 119899. NA 24.0
#> 17 best 50 100 5.98µs 7.74µs 120853. NA 36.3
#> 18 worst 50 100 10.35µs 12.04µs 80231. NA 24.1
#> 19 best 100 100 6.41µs 8.05µs 119016. NA 35.7
#> 20 worst 100 100 16.2µs 17.83µs 54722. NA 16.4And 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 6.85µs 8.7µs 108975. NA 43.6
#> 2 worst 3 15 7.09µs 8.88µs 107308. NA 42.9
#> 3 best 5 15 6.93µs 8.74µs 110082. NA 33.0
#> 4 worst 5 15 7.17µs 8.92µs 107756. NA 43.1
#> 5 best 10 15 6.86µs 7.62µs 128613. NA 38.6
#> 6 worst 10 15 7.38µs 8.2µs 119579. NA 47.9
#> 7 best 50 15 7.61µs 8.37µs 117221. NA 35.2
#> 8 worst 50 15 10.38µs 11.11µs 88766. NA 35.5
#> 9 best 100 15 8.71µs 9.98µs 94797. NA 28.4
#> 10 worst 100 15 13.95µs 15.56µs 61944. NA 24.8
#> 11 best 3 100 6.97µs 8.28µs 114274. NA 34.3
#> 12 worst 3 100 7.47µs 8.92µs 106276. NA 31.9
#> 13 best 5 100 7.07µs 8.53µs 110212. NA 33.1
#> 14 worst 5 100 8µs 9.5µs 99769. NA 29.9
#> 15 best 10 100 7.02µs 8.49µs 110581. NA 33.2
#> 16 worst 10 100 8.8µs 10.26µs 92425. NA 27.7
#> 17 best 50 100 7.85µs 9.39µs 100004. NA 30.0
#> 18 worst 50 100 17.69µs 19.23µs 50438. NA 15.1
#> 19 best 100 100 8.75µs 10.06µs 94977. NA 38.0
#> 20 worst 100 100 28.86µs 30.64µs 31882. NA 9.57