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) 5.03µs 7.65µs 114745. 18.2KB 23.0
#> 2 foo_S3(x) 1.71µs 2.14µs 385175. 0B 38.5
#> 3 foo_S4(x) 1.86µs 2.6µs 339719. 0B 34.0
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) 9.16µs 12.77µs 69803. 0B 20.9
#> 2 bar_S4(x, y) 4.92µs 6.79µs 131192. 0B 26.2A 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 5.16µs 7.8µs 118225. 0B 35.5
#> 2 worst 3 15 5.21µs 7.74µs 120623. 0B 24.1
#> 3 best 5 15 5.18µs 8.03µs 111953. 0B 33.6
#> 4 worst 5 15 5.36µs 8.23µs 109607. 0B 21.9
#> 5 best 10 15 5.12µs 7.54µs 122754. 0B 36.8
#> 6 worst 10 15 5.4µs 8.22µs 111765. 0B 22.4
#> 7 best 50 15 5.47µs 8.27µs 110502. 0B 22.1
#> 8 worst 50 15 6.89µs 9.57µs 96276. 0B 28.9
#> 9 best 100 15 5.97µs 8.55µs 107459. 0B 32.2
#> 10 worst 100 15 8.45µs 11.36µs 82076. 0B 16.4
#> 11 best 3 100 5.13µs 7.63µs 121723. 0B 36.5
#> 12 worst 3 100 5.38µs 9.02µs 104358. 0B 20.9
#> 13 best 5 100 5.13µs 7.77µs 116401. 0B 34.9
#> 14 worst 5 100 5.55µs 7.99µs 115810. 0B 23.2
#> 15 best 10 100 5.25µs 7.74µs 120037. 0B 36.0
#> 16 worst 10 100 5.82µs 8.35µs 110990. 0B 22.2
#> 17 best 50 100 5.39µs 9.93µs 97606. 0B 19.5
#> 18 worst 50 100 9.46µs 13.03µs 69261. 0B 20.8
#> 19 best 100 100 6µs 9.65µs 94584. 0B 18.9
#> 20 worst 100 100 14.3µs 17.59µs 53784. 0B 16.1And 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 6.51µs 9.39µs 98043. 0B 29.4
#> 2 worst 3 15 6.68µs 11.3µs 82745. 0B 24.8
#> 3 best 5 15 6.48µs 10.98µs 84348. 0B 33.8
#> 4 worst 5 15 7.01µs 10.82µs 82288. 0B 24.7
#> 5 best 10 15 6.65µs 9.72µs 92941. 0B 27.9
#> 6 worst 10 15 7.33µs 10.68µs 85683. 0B 25.7
#> 7 best 50 15 7.25µs 12.11µs 75588. 0B 22.7
#> 8 worst 50 15 9.72µs 13.78µs 64822. 0B 19.5
#> 9 best 100 15 8.07µs 14.85µs 69307. 0B 20.8
#> 10 worst 100 15 13.29µs 22.45µs 46965. 0B 18.8
#> 11 best 3 100 6.52µs 12.29µs 79192. 0B 23.8
#> 12 worst 3 100 7.29µs 12.45µs 82959. 0B 24.9
#> 13 best 5 100 6.63µs 11.96µs 83187. 0B 25.0
#> 14 worst 5 100 7.36µs 13.24µs 74806. 0B 29.9
#> 15 best 10 100 6.78µs 13.09µs 76587. 0B 23.0
#> 16 worst 10 100 8.27µs 11.85µs 76740. 0B 23.0
#> 17 best 50 100 7.55µs 11.99µs 77811. 0B 23.4
#> 18 worst 50 100 14.71µs 18.38µs 48121. 0B 14.4
#> 19 best 100 100 8.42µs 10.78µs 81941. 0B 32.8
#> 20 worst 100 100 23.4µs 27.49µs 34278. 0B 10.3