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.06µs 117463. 0B 58.8
#> 2 foo_S3(x) 2.5µs 2.78µs 328027. 0B 32.8
#> 3 foo_S4(x) 2.66µs 3.08µs 312215. 0B 31.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.81µs 14.5µs 65439. 0B 52.4
#> 2 bar_S4(x, y) 6.99µs 7.83µs 124160. 0B 49.7A 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 6.97µs 8.19µs 116546. 0B 70.0
#> 2 worst 3 15 7.19µs 8.24µs 115772. 0B 57.9
#> 3 best 5 15 7.04µs 7.99µs 120650. 0B 60.4
#> 4 worst 5 15 7.25µs 8.22µs 116349. 0B 69.9
#> 5 best 10 15 7µs 8.21µs 115998. 0B 69.6
#> 6 worst 10 15 7.37µs 8.47µs 112953. 0B 67.8
#> 7 best 50 15 7.48µs 8.67µs 110385. 0B 66.3
#> 8 worst 50 15 9.27µs 10.56µs 91035. 0B 45.5
#> 9 best 100 15 8µs 9.06µs 96023. 0B 19.2
#> 10 worst 100 15 11.36µs 12.44µs 78703. 0B 7.87
#> 11 best 3 100 7µs 7.97µs 121704. 0B 24.3
#> 12 worst 3 100 7.29µs 8.2µs 118691. 0B 23.7
#> 13 best 5 100 6.98µs 8.01µs 121344. 0B 24.3
#> 14 worst 5 100 7.38µs 8.37µs 116439. 0B 11.6
#> 15 best 10 100 7.04µs 8.04µs 120666. 0B 24.1
#> 16 worst 10 100 7.83µs 8.89µs 107336. 0B 21.5
#> 17 best 50 100 7.68µs 8.8µs 110771. 0B 22.2
#> 18 worst 50 100 12.35µs 13.39µs 73017. 0B 7.30
#> 19 best 100 100 8.19µs 9.28µs 104995. 0B 10.5
#> 20 worst 100 100 16.73µs 17.87µs 54757. 0B 11.0And 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.57µs 9.66µs 100585. 0B 20.1
#> 2 worst 3 15 8.83µs 9.92µs 97921. 0B 19.6
#> 3 best 5 15 8.56µs 9.72µs 100320. 0B 20.1
#> 4 worst 5 15 9.18µs 10.18µs 95743. 0B 19.2
#> 5 best 10 15 8.84µs 9.97µs 97247. 0B 19.5
#> 6 worst 10 15 9.55µs 10.6µs 91305. 0B 18.3
#> 7 best 50 15 9.74µs 10.97µs 88582. 0B 17.7
#> 8 worst 50 15 12.86µs 14µs 69517. 0B 13.9
#> 9 best 100 15 10.93µs 12.18µs 79879. 0B 16.0
#> 10 worst 100 15 17.03µs 18.34µs 53101. 0B 10.6
#> 11 best 3 100 8.96µs 10.07µs 96095. 0B 28.8
#> 12 worst 3 100 9.33µs 10.5µs 92039. 0B 18.4
#> 13 best 5 100 8.98µs 10.17µs 94861. 0B 19.0
#> 14 worst 5 100 10µs 11.09µs 86904. 0B 17.4
#> 15 best 10 100 8.97µs 10.14µs 95219. 0B 19.0
#> 16 worst 10 100 10.51µs 11.67µs 83111. 0B 16.6
#> 17 best 50 100 9.73µs 10.95µs 88534. 0B 17.7
#> 18 worst 50 100 19.15µs 20.49µs 47676. 0B 9.54
#> 19 best 100 100 11.02µs 12.36µs 78359. 0B 15.7
#> 20 worst 100 100 28.7µs 30.02µs 32566. 0B 6.51