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.25µs 8.72µs 106372. 0B 53.2
#> 2 foo_S3(x) 2.43µs 2.85µs 312369. 0B 62.5
#> 3 foo_S4(x) 2.67µs 3.16µs 302507. 0B 30.3
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.31µs 15.07µs 63262. 0B 57.0
#> 2 bar_S4(x, y) 7.32µs 8.47µs 113348. 0B 34.0A 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.29µs 8.65µs 110037. 0B 66.1
#> 2 worst 3 15 7.47µs 8.84µs 108250. 0B 65.0
#> 3 best 5 15 7.37µs 8.79µs 107601. 0B 75.4
#> 4 worst 5 15 7.67µs 9.21µs 101877. 0B 61.2
#> 5 best 10 15 7.37µs 9.04µs 103651. 0B 62.2
#> 6 worst 10 15 7.99µs 9.57µs 98763. 0B 59.3
#> 7 best 50 15 7.79µs 9.44µs 100202. 0B 60.2
#> 8 worst 50 15 10.17µs 11.51µs 82989. 0B 49.8
#> 9 best 100 15 8.24µs 9.55µs 90902. 0B 18.2
#> 10 worst 100 15 12.91µs 14.26µs 68313. 0B 6.83
#> 11 best 3 100 7.17µs 8.34µs 116794. 0B 23.4
#> 12 worst 3 100 7.49µs 8.71µs 111816. 0B 11.2
#> 13 best 5 100 7.31µs 8.46µs 114976. 0B 23.0
#> 14 worst 5 100 7.79µs 8.95µs 108522. 0B 21.7
#> 15 best 10 100 7.47µs 8.68µs 112064. 0B 11.2
#> 16 worst 10 100 8.48µs 9.74µs 99958. 0B 20.0
#> 17 best 50 100 7.8µs 9.1µs 106819. 0B 21.4
#> 18 worst 50 100 14.32µs 15.49µs 63093. 0B 6.31
#> 19 best 100 100 8.56µs 9.74µs 100180. 0B 10.0
#> 20 worst 100 100 21.09µs 22.47µs 42241. 0B 8.45And 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 8.96µs 10.2µs 95450. 0B 19.1
#> 2 worst 3 15 9.25µs 10.6µs 92151. 0B 18.4
#> 3 best 5 15 8.99µs 10.1µs 96056. 0B 19.2
#> 4 worst 5 15 9.65µs 10.9µs 89099. 0B 17.8
#> 5 best 10 15 9.03µs 10.4µs 92832. 0B 18.6
#> 6 worst 10 15 10.12µs 11.4µs 85117. 0B 17.0
#> 7 best 50 15 9.89µs 11.2µs 86097. 0B 17.2
#> 8 worst 50 15 14.48µs 15.9µs 61094. 0B 12.2
#> 9 best 100 15 10.96µs 12.3µs 78987. 0B 15.8
#> 10 worst 100 15 19.63µs 21.2µs 45730. 0B 9.15
#> 11 best 3 100 9.12µs 10.6µs 91477. 0B 18.3
#> 12 worst 3 100 9.91µs 11.3µs 85663. 0B 17.1
#> 13 best 5 100 9.21µs 10.5µs 91552. 0B 18.3
#> 14 worst 5 100 10.49µs 11.9µs 81081. 0B 16.2
#> 15 best 10 100 9.44µs 10.7µs 89763. 0B 18.0
#> 16 worst 10 100 12.15µs 13.4µs 72228. 0B 14.4
#> 17 best 50 100 10.02µs 11.3µs 85686. 0B 17.1
#> 18 worst 50 100 21.44µs 22.9µs 42538. 0B 8.51
#> 19 best 100 100 11.21µs 12.6µs 76223. 0B 22.9
#> 20 worst 100 100 36.27µs 37.8µs 25872. 0B 5.18