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.52µs 109527. 0B 54.8
#> 2 foo_S3(x) 2.52µs 2.9µs 310871. 0B 62.2
#> 3 foo_S4(x) 2.76µs 3.29µs 292648. 0B 29.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) 13.31µs 15.15µs 62430. 0B 56.2
#> 2 bar_S4(x, y) 7.09µs 8.27µs 115548. 0B 46.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 7.08µs 8.59µs 109001. 0B 65.4
#> 2 worst 3 15 7.34µs 8.87µs 105698. 0B 63.5
#> 3 best 5 15 7.28µs 8.69µs 107241. 0B 64.4
#> 4 worst 5 15 7.52µs 8.82µs 107506. 0B 75.3
#> 5 best 10 15 7.23µs 8.54µs 111049. 0B 66.7
#> 6 worst 10 15 7.68µs 9.15µs 102697. 0B 71.9
#> 7 best 50 15 7.68µs 9.27µs 101617. 0B 71.2
#> 8 worst 50 15 9.48µs 10.97µs 86441. 0B 60.6
#> 9 best 100 15 8.19µs 9.33µs 92471. 0B 18.5
#> 10 worst 100 15 11.58µs 12.67µs 76712. 0B 7.67
#> 11 best 3 100 7.21µs 8.24µs 117816. 0B 23.6
#> 12 worst 3 100 7.6µs 8.66µs 112259. 0B 22.5
#> 13 best 5 100 7.14µs 8.29µs 117151. 0B 11.7
#> 14 worst 5 100 7.66µs 8.77µs 110792. 0B 22.2
#> 15 best 10 100 7.23µs 8.36µs 116517. 0B 11.7
#> 16 worst 10 100 8.2µs 9.32µs 104225. 0B 20.8
#> 17 best 50 100 7.67µs 8.78µs 110652. 0B 22.1
#> 18 worst 50 100 12.44µs 13.6µs 71995. 0B 14.4
#> 19 best 100 100 8.21µs 9.37µs 103412. 0B 20.7
#> 20 worst 100 100 17.24µs 18.54µs 52751. 0B 5.28And 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.81µs 10.2µs 95041. 0B 19.0
#> 2 worst 3 15 9.29µs 10.4µs 92347. 0B 18.5
#> 3 best 5 15 8.91µs 10.2µs 94695. 0B 18.9
#> 4 worst 5 15 9.32µs 10.7µs 89592. 0B 17.9
#> 5 best 10 15 8.96µs 10.3µs 92464. 0B 18.5
#> 6 worst 10 15 9.91µs 11.1µs 87029. 0B 17.4
#> 7 best 50 15 10µs 11.4µs 83975. 0B 16.8
#> 8 worst 50 15 13.13µs 14.6µs 64045. 0B 12.8
#> 9 best 100 15 11.06µs 12.4µs 77726. 0B 15.5
#> 10 worst 100 15 17.2µs 18.5µs 52172. 0B 10.4
#> 11 best 3 100 8.93µs 10.1µs 94566. 0B 18.9
#> 12 worst 3 100 9.45µs 10.7µs 89138. 0B 17.8
#> 13 best 5 100 9.02µs 10.3µs 93092. 0B 18.6
#> 14 worst 5 100 9.85µs 11.1µs 87192. 0B 17.4
#> 15 best 10 100 9.27µs 10.5µs 91682. 0B 18.3
#> 16 worst 10 100 10.87µs 12.2µs 79363. 0B 15.9
#> 17 best 50 100 10.35µs 11.6µs 82745. 0B 16.6
#> 18 worst 50 100 19.92µs 21.3µs 45672. 0B 9.14
#> 19 best 100 100 11.22µs 12.6µs 76434. 0B 15.3
#> 20 worst 100 100 29.05µs 30.5µs 31872. 0B 6.38