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) 4.55µs 5µs 192830. 0B 57.9
#> 2 foo_S3(x) 1.23µs 1.35µs 661710. 0B 66.2
#> 3 foo_S4(x) 1.35µs 1.52µs 620031. 0B 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) 7.95µs 8.61µs 111847. 0B 56.0
#> 2 bar_S4(x, y) 3.77µs 4.1µs 235555. 0B 23.6A 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.55µs 5µs 195762. 0B 58.7
#> 2 worst 3 15 4.67µs 5.12µs 191035. 0B 76.4
#> 3 best 5 15 4.55µs 5µs 194971. 0B 58.5
#> 4 worst 5 15 4.71µs 5.21µs 187491. 0B 75.0
#> 5 best 10 15 4.63µs 5.12µs 188134. 0B 75.3
#> 6 worst 10 15 4.96µs 5.41µs 180300. 0B 54.1
#> 7 best 50 15 4.88µs 5.37µs 181461. 0B 72.6
#> 8 worst 50 15 6.36µs 6.85µs 142644. 0B 42.8
#> 9 best 100 15 5.25µs 5.74µs 170367. 0B 68.2
#> 10 worst 100 15 8.12µs 8.69µs 112610. 0B 33.8
#> 11 best 3 100 4.51µs 5.04µs 192639. 0B 77.1
#> 12 worst 3 100 4.8µs 5.29µs 182849. 0B 73.2
#> 13 best 5 100 4.63µs 5.12µs 188750. 0B 75.5
#> 14 worst 5 100 4.92µs 5.54µs 176693. 0B 53.0
#> 15 best 10 100 4.76µs 5.25µs 184134. 0B 55.3
#> 16 worst 10 100 5.95µs 6.44µs 151700. 0B 60.7
#> 17 best 50 100 4.84µs 5.37µs 180968. 0B 72.4
#> 18 worst 50 100 10.95µs 11.44µs 86264. 0B 34.5
#> 19 best 100 100 5.25µs 5.54µs 178132. 0B 71.3
#> 20 worst 100 100 16.65µs 17.14µs 57669. 0B 23.1And 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.41µs 5.82µs 165292. 0B 82.7
#> 2 worst 3 15 5.7µs 6.15µs 157902. 0B 63.2
#> 3 best 5 15 5.41µs 5.9µs 165632. 0B 66.3
#> 4 worst 5 15 5.78µs 6.27µs 155876. 0B 62.4
#> 5 best 10 15 5.54µs 5.99µs 162462. 0B 65.0
#> 6 worst 10 15 6.03µs 6.52µs 150108. 0B 60.1
#> 7 best 50 15 6.07µs 6.56µs 148440. 0B 59.4
#> 8 worst 50 15 8.57µs 9.14µs 106982. 0B 53.5
#> 9 best 100 15 6.81µs 7.3µs 133233. 0B 66.6
#> 10 worst 100 15 12.14µs 12.75µs 76864. 0B 38.5
#> 11 best 3 100 5.82µs 6.4µs 150848. 0B 75.5
#> 12 worst 3 100 6.52µs 7.09µs 137028. 0B 54.8
#> 13 best 5 100 5.82µs 6.36µs 152363. 0B 61.0
#> 14 worst 5 100 7.22µs 7.75µs 125326. 0B 50.2
#> 15 best 10 100 5.78µs 6.31µs 152658. 0B 61.1
#> 16 worst 10 100 8.65µs 9.31µs 104963. 0B 42.0
#> 17 best 50 100 6.07µs 6.6µs 146713. 0B 73.4
#> 18 worst 50 100 17.34µs 18.12µs 54393. 0B 27.2
#> 19 best 100 100 6.89µs 7.22µs 136725. 0B 68.4
#> 20 worst 100 100 30.01µs 30.59µs 32264. 0B 16.1