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) 6.93µs 8.48µs 110465. 0B 55.3
#> 2 foo_S3(x) 2.37µs 2.79µs 325772. 0B 32.6
#> 3 foo_S4(x) 2.62µs 3.15µs 302269. 0B 60.5
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.39µs 15.39µs 61639. 0B 55.5
#> 2 bar_S4(x, y) 7.28µs 8.48µs 114432. 0B 34.3A 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.68µs 109065. 0B 65.5
#> 2 worst 3 15 7.36µs 8.79µs 108046. 0B 64.9
#> 3 best 5 15 7.11µs 8.69µs 108661. 0B 65.2
#> 4 worst 5 15 7.59µs 9.41µs 100786. 0B 50.4
#> 5 best 10 15 7.25µs 8.84µs 106579. 0B 64.0
#> 6 worst 10 15 7.66µs 9.35µs 100681. 0B 60.4
#> 7 best 50 15 7.62µs 9.37µs 100828. 0B 60.5
#> 8 worst 50 15 9.41µs 11.2µs 84702. 0B 50.9
#> 9 best 100 15 8.12µs 9.34µs 96692. 0B 19.3
#> 10 worst 100 15 11.78µs 13.03µs 75457. 0B 15.1
#> 11 best 3 100 7.11µs 8.3µs 117650. 0B 11.8
#> 12 worst 3 100 7.2µs 8.58µs 101478. 0B 20.3
#> 13 best 5 100 7.08µs 8.72µs 95204. 0B 19.0
#> 14 worst 5 100 7.78µs 9.35µs 104029. 0B 10.4
#> 15 best 10 100 7.02µs 8.34µs 116174. 0B 23.2
#> 16 worst 10 100 7.99µs 9.37µs 102608. 0B 20.5
#> 17 best 50 100 7.68µs 8.89µs 110305. 0B 22.1
#> 18 worst 50 100 12.44µs 13.72µs 66985. 0B 6.70
#> 19 best 100 100 8.28µs 9.99µs 89666. 0B 8.97
#> 20 worst 100 100 18.3µs 19.72µs 49780. 0B 9.96And 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.7µs 10.2µs 96132. 0B 19.2
#> 2 worst 3 15 9.03µs 10.4µs 94207. 0B 28.3
#> 3 best 5 15 8.77µs 10.2µs 96305. 0B 19.3
#> 4 worst 5 15 9.13µs 10.5µs 93088. 0B 18.6
#> 5 best 10 15 8.87µs 10.3µs 94628. 0B 18.9
#> 6 worst 10 15 9.5µs 10.9µs 88944. 0B 17.8
#> 7 best 50 15 9.88µs 11.4µs 85059. 0B 17.0
#> 8 worst 50 15 13.28µs 14.8µs 65849. 0B 13.2
#> 9 best 100 15 11.13µs 12.5µs 77268. 0B 23.2
#> 10 worst 100 15 17.64µs 19.1µs 51224. 0B 10.2
#> 11 best 3 100 8.75µs 10.2µs 95369. 0B 19.1
#> 12 worst 3 100 9.4µs 10.8µs 89732. 0B 26.9
#> 13 best 5 100 8.88µs 10.3µs 94049. 0B 18.8
#> 14 worst 5 100 9.61µs 10.9µs 88500. 0B 17.7
#> 15 best 10 100 9.07µs 10.4µs 92670. 0B 18.5
#> 16 worst 10 100 11.01µs 12.4µs 78287. 0B 15.7
#> 17 best 50 100 10.05µs 11.5µs 83664. 0B 16.7
#> 18 worst 50 100 20.22µs 21.6µs 45445. 0B 9.09
#> 19 best 100 100 11.28µs 12.7µs 75634. 0B 15.1
#> 20 worst 100 100 29.97µs 31.5µs 31299. 0B 6.26