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) 2.42µs 2.91µs 330701. 0B 99.2
#> 2 foo_S3(x) 861.01ns 1.07µs 862274. 0B 86.2
#> 3 foo_S4(x) 860.98ns 1.15µs 843830. 0B 84.4
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) 4.55µs 5.66µs 168263. 0B 67.3
#> 2 bar_S4(x, y) 2.46µs 2.99µs 330169. 0B 66.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 2.46µs 3.03µs 320538. 0B 96.2
#> 2 worst 3 15 2.54µs 3.03µs 326714. 0B 98.0
#> 3 best 5 15 2.38µs 2.95µs 336761. 0B 67.4
#> 4 worst 5 15 2.58µs 3.08µs 319673. 0B 95.9
#> 5 best 10 15 2.46µs 2.95µs 333903. 0B 100.
#> 6 worst 10 15 2.67µs 3.2µs 305966. 0B 91.8
#> 7 best 50 15 2.71µs 3.2µs 310232. 0B 93.1
#> 8 worst 50 15 3.57µs 4.22µs 236754. 0B 71.0
#> 9 best 100 15 2.99µs 3.57µs 277814. 0B 83.4
#> 10 worst 100 15 4.92µs 5.78µs 171688. 0B 68.7
#> 11 best 3 100 2.54µs 3.08µs 317960. 0B 95.4
#> 12 worst 3 100 2.79µs 3.4µs 286052. 0B 85.8
#> 13 best 5 100 2.54µs 3.08µs 313021. 0B 62.6
#> 14 worst 5 100 2.79µs 3.32µs 289301. 0B 86.8
#> 15 best 10 100 2.62µs 3.2µs 305120. 0B 91.6
#> 16 worst 10 100 3.28µs 3.9µs 254938. 0B 76.5
#> 17 best 50 100 2.71µs 3.32µs 294308. 0B 88.3
#> 18 worst 50 100 5.58µs 6.48µs 154093. 0B 46.2
#> 19 best 100 100 2.99µs 3.57µs 274455. 0B 82.4
#> 20 worst 100 100 10.09µs 10.62µs 91679. 0B 27.5And 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 3.08µs 3.69µs 263334. 0B 79.0
#> 2 worst 3 15 3.32µs 3.94µs 249928. 0B 100.
#> 3 best 5 15 3.08µs 3.77µs 263260. 0B 105.
#> 4 worst 5 15 3.28µs 3.9µs 256256. 0B 76.9
#> 5 best 10 15 3.08µs 3.65µs 269725. 0B 108.
#> 6 worst 10 15 3.48µs 4.1µs 243635. 0B 73.1
#> 7 best 50 15 3.53µs 4.1µs 246041. 0B 98.5
#> 8 worst 50 15 5.29µs 6.11µs 165180. 0B 49.6
#> 9 best 100 15 4.1µs 4.76µs 208298. 0B 62.5
#> 10 worst 100 15 7.46µs 8.61µs 117170. 0B 46.9
#> 11 best 3 100 3.08µs 3.65µs 273386. 0B 82.0
#> 12 worst 3 100 3.65µs 4.26µs 235268. 0B 70.6
#> 13 best 5 100 3.32µs 3.98µs 251051. 0B 75.3
#> 14 worst 5 100 4.06µs 4.67µs 214362. 0B 64.3
#> 15 best 10 100 3.08µs 3.65µs 272562. 0B 109.
#> 16 worst 10 100 4.43µs 5.08µs 196608. 0B 59.0
#> 17 best 50 100 3.77µs 4.47µs 223699. 0B 67.1
#> 18 worst 50 100 10.58µs 11.23µs 85277. 0B 25.6
#> 19 best 100 100 4.26µs 5µs 197339. 0B 79.0
#> 20 worst 100 100 17.02µs 17.63µs 55098. 0B 16.5