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(parent = class_character)
Number := new_class(parent = class_double)
x <- Text("hi")
y <- Number(1)
foo_S7 := new_generic("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) 6.49µs 7.59µs 123660. 0B 61.9
#> 2 foo_S3(x) 2.44µs 2.92µs 298568. 0B 59.7
#> 3 foo_S4(x) 2.65µs 3.28µs 284172. 0B 56.8
bar_S7 := new_generic(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) 13.25µs 15.54µs 57718. 0B 17.3
#> 2 bar_S4(x, y) 7.15µs 8.06µs 119055. 0B 11.9A 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(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("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("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 6.41µs 7.07µs 136068. 0B 13.6
#> 2 worst 3 15 6.63µs 7.33µs 131700. 0B 13.2
#> 3 best 5 15 6.34µs 7.07µs 137087. 0B 13.7
#> 4 worst 5 15 6.72µs 7.42µs 130613. 0B 13.1
#> 5 best 10 15 6.5µs 7.23µs 127749. 0B 12.8
#> 6 worst 10 15 6.88µs 7.7µs 126223. 0B 12.6
#> 7 best 50 15 6.51µs 7.19µs 134329. 0B 13.4
#> 8 worst 50 15 8.83µs 9.6µs 101112. 0B 10.1
#> 9 best 100 15 6.77µs 7.63µs 127106. 0B 12.7
#> 10 worst 100 15 11.53µs 12.44µs 78650. 0B 7.87
#> 11 best 3 100 6.27µs 6.86µs 140277. 0B 14.0
#> 12 worst 3 100 6.76µs 7.34µs 132319. 0B 13.2
#> 13 best 5 100 6.38µs 6.95µs 139278. 0B 13.9
#> 14 worst 5 100 6.99µs 7.56µs 128195. 0B 12.8
#> 15 best 10 100 6.48µs 7.05µs 137629. 0B 13.8
#> 16 worst 10 100 7.78µs 8.45µs 114881. 0B 11.5
#> 17 best 50 100 6.56µs 7.16µs 135182. 0B 13.5
#> 18 worst 50 100 12.67µs 13.34µs 73102. 0B 7.31
#> 19 best 100 100 6.97µs 7.62µs 126934. 0B 12.7
#> 20 worst 100 100 19.1µs 19.82µs 49297. 0B 4.93And 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(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(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(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 8.95µs 9.71µs 99727. 0B 19.9
#> 2 worst 3 15 9.34µs 10.1µs 96041. 0B 9.61
#> 3 best 5 15 9µs 9.76µs 99367. 0B 19.9
#> 4 worst 5 15 9.63µs 10.51µs 92310. 0B 9.23
#> 5 best 10 15 9.07µs 9.81µs 98909. 0B 19.8
#> 6 worst 10 15 10µs 10.77µs 89883. 0B 8.99
#> 7 best 50 15 9.49µs 10.23µs 94103. 0B 9.41
#> 8 worst 50 15 13.61µs 14.57µs 66435. 0B 13.3
#> 9 best 100 15 9.8µs 10.64µs 90088. 0B 18.0
#> 10 worst 100 15 18.48µs 19.42µs 50108. 0B 5.01
#> 11 best 3 100 9µs 9.77µs 97989. 0B 19.6
#> 12 worst 3 100 9.91µs 10.73µs 90181. 0B 9.02
#> 13 best 5 100 9.29µs 10.03µs 96192. 0B 9.62
#> 14 worst 5 100 10.67µs 11.42µs 84687. 0B 8.47
#> 15 best 10 100 9.36µs 10.13µs 94791. 0B 9.48
#> 16 worst 10 100 11.99µs 12.94µs 68000. 0B 13.6
#> 17 best 50 100 9.5µs 10.42µs 92200. 0B 9.22
#> 18 worst 50 100 21.53µs 22.47µs 43287. 0B 8.66
#> 19 best 100 100 10.15µs 11.15µs 86911. 0B 8.69
#> 20 worst 100 100 33.02µs 34.01µs 28531. 0B 5.71