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.21µs 6.83µs 137394. 0B 68.7
#> 2 foo_S3(x) 1.92µs 2.27µs 397726. 0B 39.8
#> 3 foo_S4(x) 2.05µs 2.59µs 364416. 0B 72.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) 9.29µs 11.38µs 83869. 0B 75.5
#> 2 bar_S4(x, y) 5.19µs 6.18µs 155468. 0B 62.2A 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.39µs 6.67µs 140115. 0B 98.1
#> 2 worst 3 15 5.49µs 6.6µs 143952. 0B 86.4
#> 3 best 5 15 5.38µs 6.95µs 135023. 0B 81.1
#> 4 worst 5 15 5.6µs 6.85µs 137914. 0B 82.8
#> 5 best 10 15 5.44µs 6.59µs 143771. 0B 86.3
#> 6 worst 10 15 5.73µs 6.92µs 136850. 0B 82.2
#> 7 best 50 15 5.85µs 6.9µs 137013. 0B 96.0
#> 8 worst 50 15 7.19µs 8.5µs 112005. 0B 67.2
#> 9 best 100 15 6.23µs 7.49µs 118681. 0B 23.7
#> 10 worst 100 15 8.75µs 10.15µs 96257. 0B 9.63
#> 11 best 3 100 5.33µs 6.65µs 146273. 0B 29.3
#> 12 worst 3 100 5.59µs 6.85µs 140108. 0B 14.0
#> 13 best 5 100 5.45µs 6.81µs 141694. 0B 14.2
#> 14 worst 5 100 5.89µs 7.16µs 134941. 0B 27.0
#> 15 best 10 100 5.43µs 6.77µs 142899. 0B 14.3
#> 16 worst 10 100 6.19µs 7.6µs 126836. 0B 25.4
#> 17 best 50 100 5.88µs 7.2µs 133569. 0B 26.7
#> 18 worst 50 100 9.86µs 11.22µs 86935. 0B 8.69
#> 19 best 100 100 6.33µs 7.64µs 126728. 0B 12.7
#> 20 worst 100 100 14.2µs 15.66µs 62377. 0B 12.5And 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.67µs 8.08µs 119237. 0B 23.9
#> 2 worst 3 15 6.97µs 8.38µs 115284. 0B 23.1
#> 3 best 5 15 6.65µs 8.26µs 116316. 0B 23.3
#> 4 worst 5 15 7.12µs 8.71µs 109613. 0B 21.9
#> 5 best 10 15 6.89µs 8.48µs 112795. 0B 22.6
#> 6 worst 10 15 7.47µs 9µs 106076. 0B 21.2
#> 7 best 50 15 7.68µs 9.19µs 103961. 0B 20.8
#> 8 worst 50 15 10.27µs 11.87µs 81260. 0B 16.3
#> 9 best 100 15 8.69µs 10.19µs 94341. 0B 18.9
#> 10 worst 100 15 13.77µs 15.38µs 62894. 0B 12.6
#> 11 best 3 100 6.75µs 8.21µs 115992. 0B 23.2
#> 12 worst 3 100 7.37µs 8.83µs 107534. 0B 21.5
#> 13 best 5 100 6.86µs 8.35µs 114115. 0B 22.8
#> 14 worst 5 100 7.56µs 9.08µs 105586. 0B 21.1
#> 15 best 10 100 6.95µs 8.32µs 114819. 0B 23.0
#> 16 worst 10 100 7.86µs 9.43µs 101602. 0B 20.3
#> 17 best 50 100 7.66µs 9.17µs 103994. 0B 20.8
#> 18 worst 50 100 15.08µs 16.66µs 58332. 0B 11.7
#> 19 best 100 100 8.72µs 10.31µs 92855. 0B 18.6
#> 20 worst 100 100 24.2µs 26.06µs 37574. 0B 7.52