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.08µs 183376. 0B 55.0
#> 2 foo_S3(x) 1.23µs 1.39µs 639826. 0B 64.0
#> 3 foo_S4(x) 1.31µs 1.52µs 601461. 0B 60.2
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) 8.04µs 8.86µs 106807. 0B 42.7
#> 2 bar_S4(x, y) 3.77µs 4.18µs 223641. 0B 22.4
A 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.59µs 5.08µs 185038. 0B 55.5
#> 2 worst 3 15 4.71µs 5.33µs 174154. 0B 52.3
#> 3 best 5 15 4.59µs 5.12µs 182587. 0B 73.1
#> 4 worst 5 15 4.76µs 5.29µs 180074. 0B 54.0
#> 5 best 10 15 4.59µs 5.17µs 181353. 0B 72.6
#> 6 worst 10 15 4.88µs 5.49µs 170799. 0B 51.3
#> 7 best 50 15 4.92µs 5.49µs 166707. 0B 66.7
#> 8 worst 50 15 6.23µs 6.89µs 136191. 0B 40.9
#> 9 best 100 15 5.33µs 5.9µs 158973. 0B 63.6
#> 10 worst 100 15 8.08µs 8.81µs 107820. 0B 32.4
#> 11 best 3 100 4.59µs 5.21µs 180945. 0B 72.4
#> 12 worst 3 100 5µs 5.58µs 166365. 0B 49.9
#> 13 best 5 100 4.71µs 5.37µs 170532. 0B 51.2
#> 14 worst 5 100 5.33µs 5.95µs 156466. 0B 62.6
#> 15 best 10 100 4.76µs 5.37µs 174363. 0B 52.3
#> 16 worst 10 100 6.11µs 6.64µs 140211. 0B 42.1
#> 17 best 50 100 5.08µs 5.66µs 163972. 0B 49.2
#> 18 worst 50 100 11.15µs 12.1µs 79485. 0B 31.8
#> 19 best 100 100 5.21µs 5.66µs 167653. 0B 67.1
#> 20 worst 100 100 16.4µs 17.06µs 56685. 0B 17.0
And 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.78µs 165060. 0B 66.1
#> 2 worst 3 15 5.66µs 6.03µs 158615. 0B 63.5
#> 3 best 5 15 5.45µs 5.82µs 163255. 0B 65.3
#> 4 worst 5 15 5.82µs 6.36µs 151006. 0B 60.4
#> 5 best 10 15 5.54µs 6.15µs 154460. 0B 61.8
#> 6 worst 10 15 6.23µs 6.81µs 140228. 0B 56.1
#> 7 best 50 15 6.03µs 6.68µs 142722. 0B 57.1
#> 8 worst 50 15 8.73µs 9.35µs 102677. 0B 51.4
#> 9 best 100 15 6.76µs 7.42µs 126032. 0B 63.0
#> 10 worst 100 15 12.05µs 12.91µs 73986. 0B 37.0
#> 11 best 3 100 5.45µs 6.11µs 153112. 0B 61.3
#> 12 worst 3 100 6.36µs 7.01µs 134501. 0B 53.8
#> 13 best 5 100 5.45µs 6.11µs 154559. 0B 61.8
#> 14 worst 5 100 6.48µs 7.13µs 133415. 0B 53.4
#> 15 best 10 100 5.9µs 6.64µs 142185. 0B 56.9
#> 16 worst 10 100 7.58µs 8.36µs 112881. 0B 45.2
#> 17 best 50 100 6.36µs 7.09µs 133867. 0B 53.6
#> 18 worst 50 100 17.34µs 18.37µs 52561. 0B 26.3
#> 19 best 100 100 6.89µs 7.58µs 122626. 0B 61.3
#> 20 worst 100 100 31.73µs 33.13µs 29327. 0B 14.7