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.1µs 8.55µs 108528. 0B 54.3
#> 2 foo_S3(x) 2.52µs 2.88µs 310809. 0B 31.1
#> 3 foo_S4(x) 2.67µs 3.2µs 294192. 0B 58.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) 13.2µs 15.23µs 61293. 0B 55.2
#> 2 bar_S4(x, y) 7.1µs 8.26µs 116331. 0B 46.6A 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.14µs 8.53µs 110307. 0B 77.3
#> 2 worst 3 15 7.29µs 8.7µs 108502. 0B 65.1
#> 3 best 5 15 7.24µs 8.73µs 106998. 0B 75.0
#> 4 worst 5 15 7.47µs 8.96µs 104522. 0B 62.8
#> 5 best 10 15 7.11µs 8.65µs 108662. 0B 65.2
#> 6 worst 10 15 7.67µs 9.18µs 102716. 0B 72.0
#> 7 best 50 15 7.75µs 9.2µs 101965. 0B 71.4
#> 8 worst 50 15 9.58µs 11.06µs 84899. 0B 59.5
#> 9 best 100 15 8.06µs 9.13µs 96305. 0B 19.3
#> 10 worst 100 15 11.85µs 13.09µs 74269. 0B 7.43
#> 11 best 3 100 7.13µs 8.21µs 115277. 0B 23.1
#> 12 worst 3 100 7.5µs 8.56µs 112839. 0B 11.3
#> 13 best 5 100 7.07µs 8.2µs 116372. 0B 23.3
#> 14 worst 5 100 7.48µs 8.59µs 111792. 0B 11.2
#> 15 best 10 100 7.22µs 8.45µs 112981. 0B 22.6
#> 16 worst 10 100 8.41µs 9.5µs 101758. 0B 10.2
#> 17 best 50 100 7.68µs 8.85µs 108333. 0B 10.8
#> 18 worst 50 100 12.64µs 13.83µs 69560. 0B 13.9
#> 19 best 100 100 8.12µs 9.31µs 99359. 0B 9.94
#> 20 worst 100 100 18.75µs 20.28µs 46126. 0B 9.23And 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.78µs 9.95µs 95893. 0B 19.2
#> 2 worst 3 15 9.09µs 10.32µs 90835. 0B 18.2
#> 3 best 5 15 8.71µs 10.06µs 94670. 0B 18.9
#> 4 worst 5 15 9.35µs 10.64µs 89248. 0B 17.9
#> 5 best 10 15 8.94µs 10.18µs 93496. 0B 18.7
#> 6 worst 10 15 9.76µs 11.03µs 86657. 0B 17.3
#> 7 best 50 15 9.93µs 11.21µs 85015. 0B 17.0
#> 8 worst 50 15 13.36µs 14.68µs 65253. 0B 13.1
#> 9 best 100 15 11.01µs 12.44µs 76525. 0B 15.3
#> 10 worst 100 15 18µs 19.62µs 48866. 0B 14.7
#> 11 best 3 100 8.82µs 10.44µs 90237. 0B 18.1
#> 12 worst 3 100 9.39µs 10.66µs 89225. 0B 17.8
#> 13 best 5 100 9.05µs 10.47µs 91581. 0B 9.16
#> 14 worst 5 100 10.22µs 11.54µs 82340. 0B 16.5
#> 15 best 10 100 9.08µs 10.39µs 91321. 0B 18.3
#> 16 worst 10 100 10.82µs 12.19µs 76710. 0B 15.3
#> 17 best 50 100 9.93µs 11.4µs 84331. 0B 8.43
#> 18 worst 50 100 20.34µs 21.89µs 44063. 0B 8.81
#> 19 best 100 100 11.14µs 12.54µs 76638. 0B 7.66
#> 20 worst 100 100 32.42µs 34.16µs 28294. 0B 5.66