The hardware and bandwidth for this mirror is donated by METANET, the Webhosting and Full Service-Cloud Provider.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]metanet.ch.
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) 3.69µs 4.14µs 233552. 0B 70.1
#> 2 foo_S3(x) 1.35µs 1.48µs 616660. 0B 0
#> 3 foo_S4(x) 1.48µs 1.64µs 586204. 0B 58.6
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) 6.89µs 7.63µs 125512. 0B 50.2
#> 2 bar_S4(x, y) 3.94µs 4.3µs 223593. 0B 44.7A 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 3.73µs 4.14µs 233715. 0B 46.8
#> 2 worst 3 15 3.85µs 4.26µs 226893. 0B 68.1
#> 3 best 5 15 3.73µs 4.1µs 235608. 0B 70.7
#> 4 worst 5 15 3.9µs 4.3µs 226792. 0B 68.1
#> 5 best 10 15 3.73µs 4.14µs 234855. 0B 70.5
#> 6 worst 10 15 4.06µs 4.51µs 215358. 0B 64.6
#> 7 best 50 15 4.1µs 4.51µs 215821. 0B 64.8
#> 8 worst 50 15 5.49µs 5.99µs 163775. 0B 49.1
#> 9 best 100 15 4.51µs 5.12µs 189758. 0B 56.9
#> 10 worst 100 15 7.42µs 8µs 123380. 0B 37.0
#> 11 best 3 100 3.77µs 4.18µs 233487. 0B 93.4
#> 12 worst 3 100 3.98µs 4.55µs 212867. 0B 63.9
#> 13 best 5 100 3.9µs 4.55µs 207037. 0B 41.4
#> 14 worst 5 100 4.43µs 4.96µs 192327. 0B 57.7
#> 15 best 10 100 3.73µs 4.22µs 223713. 0B 67.1
#> 16 worst 10 100 4.84µs 5.33µs 181142. 0B 54.4
#> 17 best 50 100 4.18µs 4.63µs 207896. 0B 41.6
#> 18 worst 50 100 10.21µs 10.87µs 89545. 0B 26.9
#> 19 best 100 100 4.47µs 5.04µs 186869. 0B 37.4
#> 20 worst 100 100 15.46µs 16.32µs 59365. 0B 17.8And 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 4.63µs 5.25µs 178156. 0B 71.3
#> 2 worst 3 15 4.84µs 5.62µs 162908. 0B 48.9
#> 3 best 5 15 4.67µs 5.25µs 178662. 0B 71.5
#> 4 worst 5 15 5.04µs 5.66µs 168251. 0B 50.5
#> 5 best 10 15 4.67µs 5.04µs 190060. 0B 76.1
#> 6 worst 10 15 5.25µs 5.66µs 171466. 0B 51.5
#> 7 best 50 15 5.29µs 5.7µs 167396. 0B 67.0
#> 8 worst 50 15 7.71µs 8.32µs 114879. 0B 34.5
#> 9 best 100 15 6.07µs 6.68µs 141150. 0B 56.5
#> 10 worst 100 15 11.52µs 12.3µs 78719. 0B 23.6
#> 11 best 3 100 4.59µs 5.08µs 187697. 0B 75.1
#> 12 worst 3 100 5.41µs 6.03µs 154788. 0B 46.5
#> 13 best 5 100 4.88µs 5.37µs 178631. 0B 71.5
#> 14 worst 5 100 5.54µs 6.03µs 160767. 0B 48.2
#> 15 best 10 100 5µs 5.66µs 160065. 0B 64.1
#> 16 worst 10 100 7.58µs 8.04µs 118897. 0B 35.7
#> 17 best 50 100 5.25µs 5.7µs 169331. 0B 50.8
#> 18 worst 50 100 15.29µs 16.15µs 59015. 0B 23.6
#> 19 best 100 100 5.95µs 6.44µs 149406. 0B 44.8
#> 20 worst 100 100 28.99µs 29.97µs 32367. 0B 9.71These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.