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.06µs 8.47µs 112848. 0B 56.5
#> 2 foo_S3(x) 2.48µs 2.87µs 313675. 0B 62.7
#> 3 foo_S4(x) 2.75µs 3.31µs 291519. 0B 29.2
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.29µs 15.4µs 62217. 0B 49.8
#> 2 bar_S4(x, y) 7.62µs 8.73µs 110941. 0B 44.4A 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.19µs 8.72µs 109867. 0B 66.0
#> 2 worst 3 15 7.39µs 8.95µs 106412. 0B 53.2
#> 3 best 5 15 7.31µs 8.85µs 108265. 0B 65.0
#> 4 worst 5 15 7.58µs 9.14µs 104278. 0B 62.6
#> 5 best 10 15 7.36µs 8.86µs 107710. 0B 64.7
#> 6 worst 10 15 7.76µs 9.31µs 103026. 0B 61.9
#> 7 best 50 15 7.76µs 9.39µs 101831. 0B 61.1
#> 8 worst 50 15 9.53µs 11.21µs 85176. 0B 51.1
#> 9 best 100 15 8.19µs 9.32µs 95651. 0B 19.1
#> 10 worst 100 15 11.78µs 13.02µs 75673. 0B 15.1
#> 11 best 3 100 7.16µs 8.43µs 116221. 0B 11.6
#> 12 worst 3 100 7.31µs 8.55µs 115089. 0B 23.0
#> 13 best 5 100 7.08µs 8.22µs 119284. 0B 23.9
#> 14 worst 5 100 7.79µs 8.96µs 109673. 0B 11.0
#> 15 best 10 100 7.25µs 8.39µs 115648. 0B 23.1
#> 16 worst 10 100 8.12µs 9.24µs 106336. 0B 21.3
#> 17 best 50 100 7.75µs 9.04µs 107264. 0B 21.5
#> 18 worst 50 100 12.77µs 14.07µs 65742. 0B 6.57
#> 19 best 100 100 8.29µs 9.49µs 101973. 0B 10.2
#> 20 worst 100 100 19.35µs 20.57µs 47825. 0B 9.57And 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.85µs 9.99µs 97974. 0B 19.6
#> 2 worst 3 15 9.06µs 10.37µs 94593. 0B 18.9
#> 3 best 5 15 8.91µs 10.19µs 96341. 0B 19.3
#> 4 worst 5 15 9.36µs 10.59µs 92704. 0B 18.5
#> 5 best 10 15 8.87µs 10.29µs 95119. 0B 19.0
#> 6 worst 10 15 9.7µs 11.03µs 85266. 0B 17.1
#> 7 best 50 15 9.89µs 11.21µs 86801. 0B 17.4
#> 8 worst 50 15 13.19µs 14.5µs 67078. 0B 13.4
#> 9 best 100 15 10.98µs 12.41µs 77534. 0B 15.5
#> 10 worst 100 15 17.82µs 19.21µs 51082. 0B 10.2
#> 11 best 3 100 9.22µs 10.58µs 89729. 0B 17.9
#> 12 worst 3 100 9.8µs 11.16µs 86005. 0B 17.2
#> 13 best 5 100 9.02µs 10.41µs 92189. 0B 18.4
#> 14 worst 5 100 9.94µs 11.32µs 85912. 0B 17.2
#> 15 best 10 100 9.19µs 10.58µs 91900. 0B 18.4
#> 16 worst 10 100 11.15µs 12.45µs 78488. 0B 15.7
#> 17 best 50 100 10.36µs 11.73µs 82756. 0B 16.6
#> 18 worst 50 100 20.32µs 21.7µs 45176. 0B 9.04
#> 19 best 100 100 11.28µs 12.78µs 75319. 0B 15.1
#> 20 worst 100 100 31.2µs 32.65µs 30157. 0B 9.05