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) 2.34µs 2.91µs 321523. 0B 64.3
#> 2 foo_S3(x) 820.03ns 1.02µs 890660. 0B 0
#> 3 foo_S4(x) 901.99ns 1.11µs 854665. 0B 85.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) 4.51µs 5.33µs 185525. 0B 55.7
#> 2 bar_S4(x, y) 2.42µs 2.87µs 346314. 0B 69.3A 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 2.3µs 2.91µs 327845. 0B 65.6
#> 2 worst 3 15 2.42µs 2.91µs 326477. 0B 98.0
#> 3 best 5 15 2.42µs 2.91µs 335745. 0B 101.
#> 4 worst 5 15 2.54µs 3.12µs 312902. 0B 93.9
#> 5 best 10 15 2.38µs 2.91µs 332566. 0B 66.5
#> 6 worst 10 15 2.62µs 3.16µs 308933. 0B 92.7
#> 7 best 50 15 2.58µs 3.12µs 308225. 0B 92.5
#> 8 worst 50 15 3.53µs 4.18µs 238042. 0B 47.6
#> 9 best 100 15 2.91µs 3.53µs 275800. 0B 82.8
#> 10 worst 100 15 4.51µs 5.58µs 171812. 0B 51.6
#> 11 best 3 100 2.5µs 3.16µs 295462. 0B 88.7
#> 12 worst 3 100 2.54µs 3.12µs 308540. 0B 92.6
#> 13 best 5 100 2.42µs 2.95µs 337441. 0B 101.
#> 14 worst 5 100 2.79µs 3.32µs 299633. 0B 59.9
#> 15 best 10 100 2.46µs 2.99µs 324368. 0B 64.9
#> 16 worst 10 100 3.12µs 3.85µs 242909. 0B 72.9
#> 17 best 50 100 2.62µs 3.24µs 294293. 0B 88.3
#> 18 worst 50 100 5.86µs 6.72µs 149265. 0B 29.9
#> 19 best 100 100 2.87µs 3.48µs 280761. 0B 56.2
#> 20 worst 100 100 8.98µs 9.88µs 94950. 0B 28.5And 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 3.03µs 3.69µs 260087. 0B 78.0
#> 2 worst 3 15 3.08µs 3.73µs 256996. 0B 103.
#> 3 best 5 15 2.91µs 3.57µs 276035. 0B 82.8
#> 4 worst 5 15 3.12µs 3.81µs 246617. 0B 98.7
#> 5 best 10 15 3.03µs 3.69µs 250444. 0B 75.2
#> 6 worst 10 15 3.28µs 3.98µs 240903. 0B 96.4
#> 7 best 50 15 3.48µs 4.1µs 240246. 0B 72.1
#> 8 worst 50 15 5.04µs 5.86µs 170030. 0B 68.0
#> 9 best 100 15 3.98µs 4.67µs 212001. 0B 84.8
#> 10 worst 100 15 7.26µs 8.36µs 119896. 0B 48.0
#> 11 best 3 100 2.99µs 3.57µs 276679. 0B 83.0
#> 12 worst 3 100 3.53µs 4.14µs 241812. 0B 96.8
#> 13 best 5 100 2.99µs 3.57µs 279756. 0B 84.0
#> 14 worst 5 100 3.77µs 4.43µs 225702. 0B 67.7
#> 15 best 10 100 2.99µs 3.61µs 267764. 0B 80.4
#> 16 worst 10 100 4.76µs 5.45µs 181277. 0B 54.4
#> 17 best 50 100 3.48µs 4.35µs 217679. 0B 65.3
#> 18 worst 50 100 10.13µs 10.91µs 86121. 0B 25.8
#> 19 best 100 100 4.1µs 4.92µs 198078. 0B 79.3
#> 20 worst 100 100 18.29µs 19.43µs 48216. 0B 14.5