Performance

library(S7)

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)    4.55µs   5.08µs   183376.        0B     55.0
#> 2 foo_S3(x)    1.23µs   1.39µs   639826.        0B     64.0
#> 3 foo_S4(x)    1.31µs   1.52µs   601461.        0B     60.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)   8.04µs   8.86µs   106807.        0B     42.7
#> 2 bar_S4(x, y)   3.77µs   4.18µs   223641.        0B     22.4

A 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   4.59µs   5.08µs   185038.        0B     55.5
#>  2 worst                3          15   4.71µs   5.33µs   174154.        0B     52.3
#>  3 best                 5          15   4.59µs   5.12µs   182587.        0B     73.1
#>  4 worst                5          15   4.76µs   5.29µs   180074.        0B     54.0
#>  5 best                10          15   4.59µs   5.17µs   181353.        0B     72.6
#>  6 worst               10          15   4.88µs   5.49µs   170799.        0B     51.3
#>  7 best                50          15   4.92µs   5.49µs   166707.        0B     66.7
#>  8 worst               50          15   6.23µs   6.89µs   136191.        0B     40.9
#>  9 best               100          15   5.33µs    5.9µs   158973.        0B     63.6
#> 10 worst              100          15   8.08µs   8.81µs   107820.        0B     32.4
#> 11 best                 3         100   4.59µs   5.21µs   180945.        0B     72.4
#> 12 worst                3         100      5µs   5.58µs   166365.        0B     49.9
#> 13 best                 5         100   4.71µs   5.37µs   170532.        0B     51.2
#> 14 worst                5         100   5.33µs   5.95µs   156466.        0B     62.6
#> 15 best                10         100   4.76µs   5.37µs   174363.        0B     52.3
#> 16 worst               10         100   6.11µs   6.64µs   140211.        0B     42.1
#> 17 best                50         100   5.08µs   5.66µs   163972.        0B     49.2
#> 18 worst               50         100  11.15µs   12.1µs    79485.        0B     31.8
#> 19 best               100         100   5.21µs   5.66µs   167653.        0B     67.1
#> 20 worst              100         100   16.4µs  17.06µs    56685.        0B     17.0

And 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   5.41µs   5.78µs   165060.        0B     66.1
#>  2 worst                3          15   5.66µs   6.03µs   158615.        0B     63.5
#>  3 best                 5          15   5.45µs   5.82µs   163255.        0B     65.3
#>  4 worst                5          15   5.82µs   6.36µs   151006.        0B     60.4
#>  5 best                10          15   5.54µs   6.15µs   154460.        0B     61.8
#>  6 worst               10          15   6.23µs   6.81µs   140228.        0B     56.1
#>  7 best                50          15   6.03µs   6.68µs   142722.        0B     57.1
#>  8 worst               50          15   8.73µs   9.35µs   102677.        0B     51.4
#>  9 best               100          15   6.76µs   7.42µs   126032.        0B     63.0
#> 10 worst              100          15  12.05µs  12.91µs    73986.        0B     37.0
#> 11 best                 3         100   5.45µs   6.11µs   153112.        0B     61.3
#> 12 worst                3         100   6.36µs   7.01µs   134501.        0B     53.8
#> 13 best                 5         100   5.45µs   6.11µs   154559.        0B     61.8
#> 14 worst                5         100   6.48µs   7.13µs   133415.        0B     53.4
#> 15 best                10         100    5.9µs   6.64µs   142185.        0B     56.9
#> 16 worst               10         100   7.58µs   8.36µs   112881.        0B     45.2
#> 17 best                50         100   6.36µs   7.09µs   133867.        0B     53.6
#> 18 worst               50         100  17.34µs  18.37µs    52561.        0B     26.3
#> 19 best               100         100   6.89µs   7.58µs   122626.        0B     61.3
#> 20 worst              100         100  31.73µs  33.13µs    29327.        0B     14.7