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.11µs 8.62µs 109543. 0B 54.8
#> 2 foo_S3(x) 2.44µs 2.73µs 330966. 0B 33.1
#> 3 foo_S4(x) 2.63µs 3.1µs 307475. 0B 61.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) 12.9µs 14.66µs 64371. 0B 58.0
#> 2 bar_S4(x, y) 6.91µs 7.79µs 122050. 0B 48.8A 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.12µs 8.58µs 110447. 0B 77.4
#> 2 worst 3 15 7.29µs 8.57µs 111192. 0B 66.8
#> 3 best 5 15 7.22µs 8.51µs 111431. 0B 78.1
#> 4 worst 5 15 7.47µs 8.69µs 109215. 0B 65.6
#> 5 best 10 15 7.21µs 8.56µs 110755. 0B 77.6
#> 6 worst 10 15 7.56µs 9.02µs 103643. 0B 62.2
#> 7 best 50 15 7.82µs 9.17µs 104731. 0B 62.9
#> 8 worst 50 15 9.87µs 11.41µs 83630. 0B 58.6
#> 9 best 100 15 8.2µs 9.34µs 92779. 0B 18.6
#> 10 worst 100 15 12.39µs 13.83µs 70230. 0B 7.02
#> 11 best 3 100 7.18µs 8.42µs 114728. 0B 23.0
#> 12 worst 3 100 7.46µs 8.67µs 111550. 0B 11.2
#> 13 best 5 100 7.37µs 8.61µs 112660. 0B 11.3
#> 14 worst 5 100 7.91µs 9.2µs 105683. 0B 21.1
#> 15 best 10 100 7.39µs 8.66µs 111812. 0B 11.2
#> 16 worst 10 100 8.38µs 9.71µs 99991. 0B 20.0
#> 17 best 50 100 7.7µs 9.04µs 106670. 0B 21.3
#> 18 worst 50 100 12.78µs 14.04µs 69483. 0B 6.95
#> 19 best 100 100 8.56µs 9.92µs 97879. 0B 9.79
#> 20 worst 100 100 18.13µs 19.54µs 49744. 0B 9.95And 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.85µs 10.3µs 94208. 0B 18.8
#> 2 worst 3 15 9.23µs 10.7µs 90994. 0B 27.3
#> 3 best 5 15 9.03µs 10.4µs 92541. 0B 18.5
#> 4 worst 5 15 9.34µs 10.9µs 88865. 0B 17.8
#> 5 best 10 15 8.97µs 10.5µs 91476. 0B 18.3
#> 6 worst 10 15 9.87µs 11.3µs 85426. 0B 17.1
#> 7 best 50 15 10.05µs 11.5µs 83747. 0B 16.8
#> 8 worst 50 15 13.79µs 15.3µs 63409. 0B 12.7
#> 9 best 100 15 11.04µs 12.5µs 77418. 0B 15.5
#> 10 worst 100 15 19.13µs 20.5µs 47392. 0B 9.48
#> 11 best 3 100 8.93µs 10.3µs 93711. 0B 18.7
#> 12 worst 3 100 9.49µs 10.8µs 88526. 0B 17.7
#> 13 best 5 100 9.27µs 10.7µs 89621. 0B 17.9
#> 14 worst 5 100 10.18µs 11.6µs 83090. 0B 16.6
#> 15 best 10 100 9.23µs 10.6µs 90730. 0B 18.1
#> 16 worst 10 100 11.29µs 12.6µs 76369. 0B 15.3
#> 17 best 50 100 10.06µs 11.5µs 83925. 0B 16.8
#> 18 worst 50 100 19.5µs 21µs 46302. 0B 9.26
#> 19 best 100 100 11.4µs 12.9µs 73372. 0B 22.0
#> 20 worst 100 100 31.41µs 33µs 29515. 0B 5.90