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.38µs 8.5µs 111163. 18.2KB 22.2
#> 2 foo_S3(x) 2.67µs 2.98µs 313137. 0B 31.3
#> 3 foo_S4(x) 2.81µs 3.23µs 301735. 0B 0
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.99µs 15.56µs 62932. 0B 25.2
#> 2 bar_S4(x, y) 8.06µs 8.89µs 110908. 0B 22.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.22µs 8.49µs 115068. 0B 34.5
#> 2 worst 3 15 7.52µs 8.73µs 111757. 0B 33.5
#> 3 best 5 15 7.28µs 8.55µs 111295. 0B 33.4
#> 4 worst 5 15 7.61µs 8.85µs 110377. 0B 33.1
#> 5 best 10 15 7.4µs 8.66µs 112584. 0B 33.8
#> 6 worst 10 15 7.76µs 9.04µs 108244. 0B 21.7
#> 7 best 50 15 7.88µs 9.15µs 106749. 0B 32.0
#> 8 worst 50 15 9.42µs 10.72µs 91279. 0B 27.4
#> 9 best 100 15 8.47µs 9.83µs 98437. 0B 39.4
#> 10 worst 100 15 12.02µs 13.42µs 73122. 0B 21.9
#> 11 best 3 100 7.55µs 8.79µs 110936. 0B 33.3
#> 12 worst 3 100 7.79µs 9.1µs 106966. 0B 42.8
#> 13 best 5 100 7.49µs 8.83µs 110495. 0B 33.2
#> 14 worst 5 100 7.89µs 9.2µs 105735. 0B 31.7
#> 15 best 10 100 7.54µs 8.88µs 108897. 0B 32.7
#> 16 worst 10 100 8.19µs 9.54µs 99223. 0B 29.8
#> 17 best 50 100 7.82µs 9.16µs 105228. 0B 31.6
#> 18 worst 50 100 12.82µs 14.25µs 68271. 0B 20.5
#> 19 best 100 100 8.73µs 10.17µs 95641. 0B 28.7
#> 20 worst 100 100 19.15µs 20.67µs 47312. 0B 14.2And 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.15µs 10.6µs 90786. 0B 27.2
#> 2 worst 3 15 9.44µs 10.8µs 88974. 0B 35.6
#> 3 best 5 15 9.12µs 10.6µs 90944. 0B 27.3
#> 4 worst 5 15 9.52µs 11µs 87174. 0B 34.9
#> 5 best 10 15 9.04µs 10.6µs 90859. 0B 36.4
#> 6 worst 10 15 9.84µs 10.6µs 93273. 0B 28.0
#> 7 best 50 15 9.75µs 10.7µs 92493. 0B 27.8
#> 8 worst 50 15 13.12µs 13.9µs 71170. 0B 28.5
#> 9 best 100 15 11.08µs 11.9µs 82333. 0B 32.9
#> 10 worst 100 15 17.82µs 19.1µs 51086. 0B 20.4
#> 11 best 3 100 9.4µs 10.5µs 92654. 0B 27.8
#> 12 worst 3 100 10.04µs 11.2µs 86615. 0B 34.7
#> 13 best 5 100 9.18µs 10.4µs 92729. 0B 37.1
#> 14 worst 5 100 10.21µs 11.4µs 85476. 0B 25.7
#> 15 best 10 100 9.14µs 10.4µs 93180. 0B 37.3
#> 16 worst 10 100 11.44µs 12.6µs 77021. 0B 30.8
#> 17 best 50 100 10.53µs 11.7µs 82259. 0B 32.9
#> 18 worst 50 100 19.45µs 20.7µs 47116. 0B 14.1
#> 19 best 100 100 11.45µs 12.7µs 76035. 0B 30.4
#> 20 worst 100 100 30.33µs 32.2µs 30204. 0B 12.1