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.63µs 6.96µs 134584. 0B 67.3
#> 2 foo_S3(x) 1.9µs 2.23µs 388102. 0B 77.6
#> 3 foo_S4(x) 2.02µs 2.37µs 396161. 0B 39.6
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) 10.01µs 11.45µs 82343. 0B 74.2
#> 2 bar_S4(x, y) 5.47µs 6.02µs 159292. 0B 47.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 5.64µs 6.57µs 143690. 0B 86.3
#> 2 worst 3 15 5.86µs 6.63µs 144327. 0B 86.6
#> 3 best 5 15 5.66µs 6.49µs 147013. 0B 88.3
#> 4 worst 5 15 5.94µs 6.96µs 135849. 0B 81.6
#> 5 best 10 15 5.7µs 6.36µs 149526. 0B 89.8
#> 6 worst 10 15 6.16µs 6.98µs 136889. 0B 82.2
#> 7 best 50 15 6.05µs 6.95µs 137435. 0B 82.5
#> 8 worst 50 15 7.81µs 9.22µs 103319. 0B 62.0
#> 9 best 100 15 6.33µs 8.16µs 112380. 0B 22.5
#> 10 worst 100 15 10.02µs 11.63µs 83830. 0B 8.38
#> 11 best 3 100 5.62µs 6.98µs 137761. 0B 27.6
#> 12 worst 3 100 6.02µs 7.58µs 128132. 0B 12.8
#> 13 best 5 100 5.61µs 6.97µs 137137. 0B 27.4
#> 14 worst 5 100 6.24µs 7.64µs 126643. 0B 25.3
#> 15 best 10 100 5.8µs 7.12µs 135839. 0B 13.6
#> 16 worst 10 100 6.98µs 8.32µs 115902. 0B 23.2
#> 17 best 50 100 6.15µs 7.65µs 126283. 0B 25.3
#> 18 worst 50 100 12.35µs 13.88µs 70564. 0B 7.06
#> 19 best 100 100 6.53µs 8.07µs 120361. 0B 12.0
#> 20 worst 100 100 19.07µs 20.76µs 47372. 0B 9.48And 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 7.03µs 8.79µs 109830. 0B 22.0
#> 2 worst 3 15 7.42µs 9.12µs 106245. 0B 21.3
#> 3 best 5 15 7.18µs 8.8µs 110337. 0B 22.1
#> 4 worst 5 15 7.67µs 9.32µs 103054. 0B 20.6
#> 5 best 10 15 7.2µs 8.93µs 107666. 0B 21.5
#> 6 worst 10 15 8.08µs 9.69µs 99461. 0B 19.9
#> 7 best 50 15 7.87µs 9.6µs 100429. 0B 20.1
#> 8 worst 50 15 11.25µs 13.21µs 71549. 0B 14.3
#> 9 best 100 15 8.7µs 10.41µs 92521. 0B 18.5
#> 10 worst 100 15 15.54µs 17.38µs 56148. 0B 11.2
#> 11 best 3 100 7.32µs 9.06µs 105736. 0B 21.2
#> 12 worst 3 100 7.97µs 9.64µs 99923. 0B 20.0
#> 13 best 5 100 7.2µs 9.05µs 105423. 0B 21.1
#> 14 worst 5 100 8.49µs 10.29µs 93793. 0B 18.8
#> 15 best 10 100 7.2µs 8.92µs 107378. 0B 21.5
#> 16 worst 10 100 10µs 11.88µs 81354. 0B 16.3
#> 17 best 50 100 8.09µs 9.83µs 97915. 0B 19.6
#> 18 worst 50 100 18.7µs 20.6µs 47457. 0B 9.49
#> 19 best 100 100 8.69µs 10.45µs 91721. 0B 18.3
#> 20 worst 100 100 32.7µs 34.98µs 28100. 0B 5.62