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.33µs 9µs 102401. 0B 51.2
#> 2 foo_S3(x) 2.47µs 2.88µs 300983. 0B 60.2
#> 3 foo_S4(x) 2.71µs 3.28µs 287522. 0B 28.8
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.94µs 16.12µs 58054. 0B 52.3
#> 2 bar_S4(x, y) 7.57µs 8.78µs 104746. 0B 31.4A 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.68µs 9.56µs 97211. 0B 58.4
#> 2 worst 3 15 7.7µs 9.83µs 94538. 0B 56.8
#> 3 best 5 15 7.6µs 9.24µs 100340. 0B 70.3
#> 4 worst 5 15 7.94µs 9.7µs 93406. 0B 56.1
#> 5 best 10 15 7.62µs 9.38µs 99236. 0B 59.6
#> 6 worst 10 15 8.29µs 9.91µs 93848. 0B 56.3
#> 7 best 50 15 8.35µs 10.2µs 91550. 0B 55.0
#> 8 worst 50 15 10.85µs 12.7µs 74115. 0B 44.5
#> 9 best 100 15 8.35µs 9.87µs 87081. 0B 17.4
#> 10 worst 100 15 13.36µs 14.77µs 65728. 0B 6.57
#> 11 best 3 100 7.35µs 8.7µs 111215. 0B 22.2
#> 12 worst 3 100 7.82µs 9.19µs 105666. 0B 10.6
#> 13 best 5 100 7.62µs 8.82µs 109867. 0B 22.0
#> 14 worst 5 100 8.04µs 9.34µs 103651. 0B 20.7
#> 15 best 10 100 7.72µs 9.04µs 107261. 0B 10.7
#> 16 worst 10 100 9.18µs 10.5µs 92448. 0B 18.5
#> 17 best 50 100 8.15µs 9.44µs 102820. 0B 20.6
#> 18 worst 50 100 14.22µs 15.61µs 61125. 0B 6.11
#> 19 best 100 100 8.86µs 10.19µs 95414. 0B 9.54
#> 20 worst 100 100 21.62µs 22.94µs 41740. 0B 8.35And 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 9.28µs 10.7µs 90676. 0B 18.1
#> 2 worst 3 15 9.84µs 11.2µs 86513. 0B 17.3
#> 3 best 5 15 9.33µs 10.8µs 90224. 0B 18.0
#> 4 worst 5 15 9.77µs 11.3µs 86375. 0B 17.3
#> 5 best 10 15 9.45µs 10.9µs 88777. 0B 17.8
#> 6 worst 10 15 10.29µs 11.8µs 82134. 0B 8.21
#> 7 best 50 15 10.38µs 11.7µs 82129. 0B 16.4
#> 8 worst 50 15 14.79µs 16.3µs 59569. 0B 11.9
#> 9 best 100 15 11.41µs 12.9µs 75433. 0B 15.1
#> 10 worst 100 15 20.72µs 22.3µs 43544. 0B 8.71
#> 11 best 3 100 9.39µs 10.8µs 89355. 0B 17.9
#> 12 worst 3 100 10.19µs 11.6µs 83179. 0B 16.6
#> 13 best 5 100 9.66µs 11µs 86895. 0B 17.4
#> 14 worst 5 100 11.3µs 12.8µs 75576. 0B 15.1
#> 15 best 10 100 9.4µs 10.9µs 88243. 0B 17.7
#> 16 worst 10 100 11.84µs 13.4µs 72032. 0B 14.4
#> 17 best 50 100 10.45µs 12µs 80242. 0B 16.1
#> 18 worst 50 100 23.49µs 25µs 38770. 0B 7.76
#> 19 best 100 100 11.68µs 13.2µs 73081. 0B 14.6
#> 20 worst 100 100 37.59µs 39.4µs 24707. 0B 4.94