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.12µs 7.8µs 121843. 0B 61.0
#> 2 foo_S3(x) 2.56µs 2.74µs 331464. 0B 66.3
#> 3 foo_S4(x) 2.75µs 2.96µs 327768. 0B 32.8
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) 12.78µs 13.49µs 70882. 0B 63.9
#> 2 bar_S4(x, y) 7.27µs 7.71µs 125980. 0B 50.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µs 7.55µs 126393. 0B 75.9
#> 2 worst 3 15 7.07µs 7.64µs 125201. 0B 75.2
#> 3 best 5 15 7.05µs 7.58µs 126648. 0B 76.0
#> 4 worst 5 15 7.26µs 7.68µs 125562. 0B 88.0
#> 5 best 10 15 7.14µs 7.59µs 126824. 0B 76.1
#> 6 worst 10 15 7.44µs 7.86µs 122696. 0B 73.7
#> 7 best 50 15 7.53µs 8.05µs 119734. 0B 83.9
#> 8 worst 50 15 9.22µs 9.66µs 100223. 0B 70.2
#> 9 best 100 15 8.01µs 9.06µs 95079. 0B 19.0
#> 10 worst 100 15 11.45µs 12.55µs 77239. 0B 7.72
#> 11 best 3 100 7.16µs 8.15µs 119605. 0B 23.9
#> 12 worst 3 100 7.45µs 8.32µs 117224. 0B 23.4
#> 13 best 5 100 7.1µs 8.05µs 120671. 0B 12.1
#> 14 worst 5 100 7.5µs 8.5µs 114533. 0B 22.9
#> 15 best 10 100 7.25µs 8.16µs 119741. 0B 12.0
#> 16 worst 10 100 8.26µs 9.14µs 106449. 0B 21.3
#> 17 best 50 100 7.63µs 8.56µs 113471. 0B 22.7
#> 18 worst 50 100 12.26µs 13.22µs 74101. 0B 14.8
#> 19 best 100 100 8.21µs 9.17µs 106659. 0B 21.3
#> 20 worst 100 100 17.93µs 18.99µs 51494. 0B 5.15And 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.74µs 10µs 97419. 0B 19.5
#> 2 worst 3 15 9.12µs 10.13µs 95831. 0B 19.2
#> 3 best 5 15 8.92µs 9.91µs 97688. 0B 19.5
#> 4 worst 5 15 9.35µs 10.35µs 94073. 0B 18.8
#> 5 best 10 15 9.01µs 10.01µs 97234. 0B 19.5
#> 6 worst 10 15 9.66µs 10.62µs 91421. 0B 18.3
#> 7 best 50 15 9.92µs 11.01µs 88481. 0B 17.7
#> 8 worst 50 15 13.01µs 14.12µs 69066. 0B 13.8
#> 9 best 100 15 10.93µs 12.14µs 80337. 0B 16.1
#> 10 worst 100 15 17.37µs 18.57µs 52364. 0B 10.5
#> 11 best 3 100 8.97µs 10.03µs 96455. 0B 19.3
#> 12 worst 3 100 9.6µs 10.65µs 91099. 0B 18.2
#> 13 best 5 100 9.17µs 10.2µs 95001. 0B 19.0
#> 14 worst 5 100 10.06µs 11.05µs 87676. 0B 17.5
#> 15 best 10 100 9.23µs 10.35µs 92130. 0B 18.4
#> 16 worst 10 100 10.62µs 11.71µs 82914. 0B 16.6
#> 17 best 50 100 10.18µs 11.26µs 86195. 0B 17.2
#> 18 worst 50 100 20.14µs 21.25µs 46050. 0B 9.21
#> 19 best 100 100 11.13µs 12.31µs 79002. 0B 15.8
#> 20 worst 100 100 31.21µs 32.56µs 30052. 0B 6.01