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) 3.76µs 4.43µs 210830. 0B 105.
#> 2 foo_S3(x) 1.46µs 1.62µs 555474. 0B 111.
#> 3 foo_S4(x) 1.48µs 1.63µs 583117. 0B 58.3
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) 6.73µs 7.19µs 133441. 0B 120.
#> 2 bar_S4(x, y) 3.91µs 4.1µs 237187. 0B 71.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 3.84µs 4.36µs 184358. 0B 111.
#> 2 worst 3 15 4.02µs 4.37µs 176328. 0B 106.
#> 3 best 5 15 3.85µs 4.15µs 227956. 0B 160.
#> 4 worst 5 15 3.98µs 4.25µs 226013. 0B 136.
#> 5 best 10 15 3.87µs 4.23µs 222796. 0B 134.
#> 6 worst 10 15 4.1µs 4.38µs 218983. 0B 131.
#> 7 best 50 15 4.03µs 4.35µs 221103. 0B 133.
#> 8 worst 50 15 5.2µs 5.5µs 173960. 0B 104.
#> 9 best 100 15 4.36µs 5.57µs 160065. 0B 32.0
#> 10 worst 100 15 6.93µs 7.83µs 125305. 0B 12.5
#> 11 best 3 100 3.8µs 4.77µs 204309. 0B 40.9
#> 12 worst 3 100 4.14µs 4.94µs 197759. 0B 19.8
#> 13 best 5 100 4.06µs 4.95µs 195506. 0B 39.1
#> 14 worst 5 100 4.44µs 5.29µs 183045. 0B 36.6
#> 15 best 10 100 4.12µs 4.91µs 197005. 0B 19.7
#> 16 worst 10 100 4.8µs 5.6µs 172501. 0B 34.5
#> 17 best 50 100 4.25µs 5.1µs 190164. 0B 38.0
#> 18 worst 50 100 8.35µs 9µs 108967. 0B 10.9
#> 19 best 100 100 4.49µs 5.41µs 180096. 0B 18.0
#> 20 worst 100 100 11.78µs 12.74µs 77158. 0B 15.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 4.83µs 5.87µs 161968. 0B 32.4
#> 2 worst 3 15 5.13µs 6.03µs 158262. 0B 31.7
#> 3 best 5 15 4.84µs 5.89µs 162886. 0B 32.6
#> 4 worst 5 15 5.16µs 6.05µs 160265. 0B 32.1
#> 5 best 10 15 4.82µs 5.72µs 155925. 0B 31.2
#> 6 worst 10 15 5.27µs 6.23µs 156311. 0B 31.3
#> 7 best 50 15 5.5µs 6.4µs 148695. 0B 29.7
#> 8 worst 50 15 7.76µs 8.6µs 113130. 0B 22.6
#> 9 best 100 15 6.23µs 7.34µs 132368. 0B 26.5
#> 10 worst 100 15 10.68µs 11.92µs 80354. 0B 16.1
#> 11 best 3 100 4.9µs 5.86µs 165193. 0B 33.0
#> 12 worst 3 100 5.49µs 6.36µs 152708. 0B 30.5
#> 13 best 5 100 4.99µs 6.05µs 156299. 0B 31.3
#> 14 worst 5 100 5.6µs 6.6µs 145618. 0B 29.1
#> 15 best 10 100 4.79µs 5.83µs 164679. 0B 32.9
#> 16 worst 10 100 6.68µs 7.69µs 126351. 0B 25.3
#> 17 best 50 100 5.58µs 6.75µs 143127. 0B 28.6
#> 18 worst 50 100 13.47µs 14.77µs 66761. 0B 13.4
#> 19 best 100 100 5.9µs 6.88µs 140614. 0B 42.2
#> 20 worst 100 100 19.91µs 21.25µs 46220. 0B 9.25