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) 7.45µs 9.08µs 102195. 0B 51.1
#> 2 foo_S3(x) 2.52µs 2.88µs 307891. 0B 61.6
#> 3 foo_S4(x) 2.67µs 3.16µs 301198. 0B 30.1
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) 13.9µs 15.85µs 59387. 0B 53.5
#> 2 bar_S4(x, y) 7.37µs 8.43µs 114235. 0B 34.3A 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 7.36µs 8.77µs 108430. 0B 65.1
#> 2 worst 3 15 7.7µs 8.79µs 108442. 0B 65.1
#> 3 best 5 15 7.37µs 8.61µs 110652. 0B 66.4
#> 4 worst 5 15 7.78µs 8.67µs 110380. 0B 77.3
#> 5 best 10 15 7.46µs 8.8µs 108030. 0B 64.9
#> 6 worst 10 15 8.04µs 8.97µs 106901. 0B 64.2
#> 7 best 50 15 7.87µs 8.72µs 109686. 0B 65.9
#> 8 worst 50 15 10.4µs 11.56µs 83243. 0B 50.0
#> 9 best 100 15 8.53µs 9.75µs 88808. 0B 17.8
#> 10 worst 100 15 13.23µs 14.38µs 67926. 0B 6.79
#> 11 best 3 100 7.45µs 8.54µs 114052. 0B 22.8
#> 12 worst 3 100 7.77µs 8.98µs 108322. 0B 10.8
#> 13 best 5 100 7.38µs 8.48µs 114632. 0B 22.9
#> 14 worst 5 100 8.04µs 9.15µs 106520. 0B 21.3
#> 15 best 10 100 7.6µs 8.7µs 110522. 0B 11.1
#> 16 worst 10 100 8.81µs 9.94µs 98063. 0B 19.6
#> 17 best 50 100 8.07µs 9.33µs 104759. 0B 21.0
#> 18 worst 50 100 14.21µs 15.35µs 63635. 0B 6.36
#> 19 best 100 100 8.9µs 10.03µs 97231. 0B 9.72
#> 20 worst 100 100 22.76µs 23.91µs 40874. 0B 8.18And 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 9.11µs 10.4µs 93569. 0B 18.7
#> 2 worst 3 15 9.53µs 10.7µs 90933. 0B 18.2
#> 3 best 5 15 9.19µs 10.4µs 93637. 0B 18.7
#> 4 worst 5 15 9.79µs 10.9µs 88596. 0B 17.7
#> 5 best 10 15 9.26µs 10.6µs 91692. 0B 18.3
#> 6 worst 10 15 10.27µs 11.6µs 82084. 0B 16.4
#> 7 best 50 15 10.16µs 11.4µs 85202. 0B 17.0
#> 8 worst 50 15 14.29µs 15.7µs 61799. 0B 12.4
#> 9 best 100 15 11.37µs 12.7µs 76458. 0B 15.3
#> 10 worst 100 15 20.3µs 21.7µs 44739. 0B 8.95
#> 11 best 3 100 9.26µs 10.5µs 91379. 0B 18.3
#> 12 worst 3 100 9.87µs 11.3µs 85949. 0B 17.2
#> 13 best 5 100 9.51µs 10.7µs 90149. 0B 18.0
#> 14 worst 5 100 10.83µs 12.2µs 79725. 0B 15.9
#> 15 best 10 100 9.56µs 10.8µs 90083. 0B 18.0
#> 16 worst 10 100 11.77µs 13µs 74662. 0B 14.9
#> 17 best 50 100 10.66µs 12µs 80556. 0B 16.1
#> 18 worst 50 100 22.4µs 23.7µs 41241. 0B 8.25
#> 19 best 100 100 11.77µs 13.2µs 73493. 0B 22.1
#> 20 worst 100 100 37.55µs 39.1µs 24971. 0B 5.00