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.29µs 8.43µs 110766. 18.2KB 22.2
#> 2 foo_S3(x) 2.59µs 2.83µs 322645. 0B 0
#> 3 foo_S4(x) 2.77µs 3.09µs 310841. 0B 31.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.25µs 14.94µs 64761. 0B 25.9
#> 2 bar_S4(x, y) 7.44µs 8.29µs 117097. 0B 23.4A 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.16µs 8.42µs 115287. 0B 34.6
#> 2 worst 3 15 7.42µs 8.53µs 114141. 0B 22.8
#> 3 best 5 15 7.21µs 8.46µs 114809. 0B 23.0
#> 4 worst 5 15 7.52µs 8.73µs 111477. 0B 33.5
#> 5 best 10 15 7.43µs 8.56µs 113088. 0B 33.9
#> 6 worst 10 15 7.67µs 9µs 107615. 0B 21.5
#> 7 best 50 15 7.88µs 9.14µs 106167. 0B 31.9
#> 8 worst 50 15 9.68µs 11.03µs 88414. 0B 17.7
#> 9 best 100 15 8.61µs 9.86µs 98512. 0B 29.6
#> 10 worst 100 15 12.18µs 13.6µs 71586. 0B 14.3
#> 11 best 3 100 7.38µs 8.55µs 113547. 0B 34.1
#> 12 worst 3 100 7.67µs 8.79µs 109677. 0B 32.9
#> 13 best 5 100 7.35µs 8.6µs 112867. 0B 33.9
#> 14 worst 5 100 7.82µs 8.97µs 107973. 0B 32.4
#> 15 best 10 100 7.42µs 8.58µs 112383. 0B 33.7
#> 16 worst 10 100 8.14µs 9.25µs 103716. 0B 31.1
#> 17 best 50 100 7.79µs 8.94µs 107503. 0B 32.3
#> 18 worst 50 100 12.84µs 14.28µs 67315. 0B 20.2
#> 19 best 100 100 8.62µs 9.89µs 97485. 0B 29.3
#> 20 worst 100 100 19.36µs 20.92µs 46449. 0B 13.9And 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.91µs 10.42µs 92289. 0B 27.7
#> 2 worst 3 15 9.4µs 10.83µs 87986. 0B 35.2
#> 3 best 5 15 9.02µs 10.46µs 91916. 0B 27.6
#> 4 worst 5 15 9.56µs 10.75µs 89443. 0B 26.8
#> 5 best 10 15 9.21µs 10.74µs 87830. 0B 26.4
#> 6 worst 10 15 10.08µs 11.69µs 82037. 0B 24.6
#> 7 best 50 15 9.79µs 10.69µs 89367. 0B 35.8
#> 8 worst 50 15 13.54µs 14.24µs 68681. 0B 20.6
#> 9 best 100 15 11.22µs 11.98µs 81213. 0B 32.5
#> 10 worst 100 15 18.33µs 19.23µs 50684. 0B 20.3
#> 11 best 3 100 9.16µs 9.98µs 97043. 0B 29.1
#> 12 worst 3 100 10.04µs 11.11µs 86291. 0B 34.5
#> 13 best 5 100 9.05µs 10.06µs 95445. 0B 28.6
#> 14 worst 5 100 10.19µs 11.39µs 84105. 0B 25.2
#> 15 best 10 100 9.19µs 10.35µs 92399. 0B 27.7
#> 16 worst 10 100 11.44µs 12.62µs 76222. 0B 22.9
#> 17 best 50 100 10.37µs 11.59µs 81907. 0B 32.8
#> 18 worst 50 100 19.68µs 20.87µs 46553. 0B 14.0
#> 19 best 100 100 11.63µs 12.79µs 75226. 0B 30.1
#> 20 worst 100 100 30.66µs 32.18µs 29587. 0B 11.8