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(parent = class_character)
Number := new_class(parent = class_double)
x <- Text("hi")
y <- Number(1)
foo_S7 := new_generic("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.42µs 4.05µs 231296. 0B 116.
#> 2 foo_S3(x) 1.48µs 1.62µs 552642. 0B 111.
#> 3 foo_S4(x) 1.52µs 1.73µs 543577. 0B 109.
bar_S7 := new_generic(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) 7.07µs 8.74µs 105572. 0B 31.7
#> 2 bar_S4(x, y) 4.04µs 4.62µs 210323. 0B 21.0A 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(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("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("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.46µs 4.02µs 239711. 0B 24.0
#> 2 worst 3 15 3.54µs 4.11µs 236663. 0B 23.7
#> 3 best 5 15 3.42µs 4µs 243423. 0B 24.3
#> 4 worst 5 15 3.56µs 4.14µs 235225. 0B 23.5
#> 5 best 10 15 3.42µs 3.95µs 246547. 0B 24.7
#> 6 worst 10 15 3.73µs 4.29µs 226929. 0B 22.7
#> 7 best 50 15 3.6µs 4.15µs 234984. 0B 23.5
#> 8 worst 50 15 4.81µs 5.36µs 182592. 0B 18.3
#> 9 best 100 15 3.77µs 4.3µs 226093. 0B 45.2
#> 10 worst 100 15 6.09µs 6.82µs 146006. 0B 14.6
#> 11 best 3 100 3.5µs 4.01µs 243298. 0B 24.3
#> 12 worst 3 100 3.7µs 4.23µs 230623. 0B 23.1
#> 13 best 5 100 3.5µs 5.5µs 169745. 0B 17.0
#> 14 worst 5 100 3.93µs 5.32µs 155508. 0B 15.6
#> 15 best 10 100 3.52µs 4.11µs 236288. 0B 23.6
#> 16 worst 10 100 4.29µs 4.85µs 201849. 0B 20.2
#> 17 best 50 100 3.65µs 4.17µs 233490. 0B 23.4
#> 18 worst 50 100 7.25µs 7.79µs 126242. 0B 12.6
#> 19 best 100 100 3.74µs 4.35µs 223179. 0B 22.3
#> 20 worst 100 100 11.38µs 12.24µs 80644. 0B 8.07And 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(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(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(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.78µs 5.56µs 174889. 0B 35.0
#> 2 worst 3 15 5.09µs 5.84µs 166457. 0B 16.6
#> 3 best 5 15 4.84µs 5.55µs 175153. 0B 35.0
#> 4 worst 5 15 5.12µs 5.85µs 166138. 0B 16.6
#> 5 best 10 15 4.87µs 5.56µs 174896. 0B 35.0
#> 6 worst 10 15 5.45µs 6.14µs 157884. 0B 15.8
#> 7 best 50 15 5.17µs 5.95µs 161935. 0B 16.2
#> 8 worst 50 15 7.47µs 8.2µs 118102. 0B 23.6
#> 9 best 100 15 5.56µs 6.28µs 153404. 0B 30.7
#> 10 worst 100 15 9.82µs 10.71µs 91576. 0B 9.16
#> 11 best 3 100 4.92µs 5.65µs 170908. 0B 17.1
#> 12 worst 3 100 5.52µs 6.24µs 156144. 0B 15.6
#> 13 best 5 100 4.93µs 5.68µs 170767. 0B 17.1
#> 14 worst 5 100 6µs 6.87µs 139872. 0B 28.0
#> 15 best 10 100 5.08µs 5.9µs 162788. 0B 16.3
#> 16 worst 10 100 6.8µs 7.57µs 127815. 0B 25.6
#> 17 best 50 100 5.39µs 6.24µs 153912. 0B 15.4
#> 18 worst 50 100 12.8µs 13.71µs 70622. 0B 14.1
#> 19 best 100 100 5.37µs 6.25µs 154011. 0B 15.4
#> 20 worst 100 100 23.32µs 24.27µs 40206. 0B 8.04