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.03µs 8.35µs 111781. 0B 55.9
#> 2 foo_S3(x) 2.46µs 2.83µs 317784. 0B 31.8
#> 3 foo_S4(x) 2.62µs 3.15µs 302384. 0B 30.2
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.8µs 14.42µs 65875. 0B 52.7
#> 2 bar_S4(x, y) 6.98µs 8.11µs 118892. 0B 47.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.17µs 8.56µs 110750. 0B 66.5
#> 2 worst 3 15 7.37µs 8.78µs 107724. 0B 53.9
#> 3 best 5 15 7.35µs 8.72µs 109812. 0B 54.9
#> 4 worst 5 15 7.47µs 8.76µs 108995. 0B 65.4
#> 5 best 10 15 7.14µs 8.51µs 111680. 0B 67.0
#> 6 worst 10 15 7.56µs 8.82µs 108158. 0B 64.9
#> 7 best 50 15 7.7µs 9.17µs 104087. 0B 62.5
#> 8 worst 50 15 9.39µs 11.02µs 87007. 0B 43.5
#> 9 best 100 15 7.93µs 9.08µs 96145. 0B 19.2
#> 10 worst 100 15 11.28µs 12.46µs 78195. 0B 7.82
#> 11 best 3 100 7.05µs 8.1µs 119686. 0B 23.9
#> 12 worst 3 100 7.36µs 8.47µs 114526. 0B 22.9
#> 13 best 5 100 7.12µs 8.29µs 117406. 0B 23.5
#> 14 worst 5 100 7.59µs 8.73µs 111414. 0B 11.1
#> 15 best 10 100 7.04µs 8.16µs 118937. 0B 23.8
#> 16 worst 10 100 8.1µs 9.19µs 105885. 0B 21.2
#> 17 best 50 100 7.43µs 8.76µs 105528. 0B 21.1
#> 18 worst 50 100 12.44µs 13.64µs 71655. 0B 7.17
#> 19 best 100 100 8.18µs 9.34µs 104461. 0B 10.4
#> 20 worst 100 100 17.5µs 18.7µs 52111. 0B 10.4And 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.88µs 10µs 97100. 0B 19.4
#> 2 worst 3 15 9.16µs 10.3µs 94056. 0B 18.8
#> 3 best 5 15 8.92µs 10.1µs 96336. 0B 19.3
#> 4 worst 5 15 9.31µs 10.4µs 93586. 0B 18.7
#> 5 best 10 15 8.96µs 10.1µs 96494. 0B 19.3
#> 6 worst 10 15 9.66µs 10.9µs 88503. 0B 17.7
#> 7 best 50 15 9.74µs 11µs 87717. 0B 17.5
#> 8 worst 50 15 12.93µs 14.1µs 68528. 0B 13.7
#> 9 best 100 15 10.91µs 12.1µs 79446. 0B 15.9
#> 10 worst 100 15 16.97µs 18.4µs 52826. 0B 10.6
#> 11 best 3 100 8.71µs 10.1µs 94902. 0B 28.5
#> 12 worst 3 100 9.23µs 10.5µs 91865. 0B 18.4
#> 13 best 5 100 9.1µs 10.4µs 92637. 0B 18.5
#> 14 worst 5 100 10.19µs 11.5µs 83583. 0B 16.7
#> 15 best 10 100 9.3µs 10.5µs 91167. 0B 18.2
#> 16 worst 10 100 11.05µs 12.3µs 78400. 0B 15.7
#> 17 best 50 100 9.82µs 11.1µs 86318. 0B 17.3
#> 18 worst 50 100 17.44µs 18.9µs 51432. 0B 10.3
#> 19 best 100 100 11.03µs 12.4µs 77945. 0B 15.6
#> 20 worst 100 100 32.21µs 33.5µs 29181. 0B 5.84