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)    2.34µs   2.91µs   321523.        0B     64.3
#> 2 foo_S3(x)  820.03ns   1.02µs   890660.        0B      0  
#> 3 foo_S4(x)  901.99ns   1.11µs   854665.        0B     85.5

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)   4.51µs   5.33µs   185525.        0B     55.7
#> 2 bar_S4(x, y)   2.42µs   2.87µs   346314.        0B     69.3

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    2.3µs   2.91µs   327845.        0B     65.6
#>  2 worst                3          15   2.42µs   2.91µs   326477.        0B     98.0
#>  3 best                 5          15   2.42µs   2.91µs   335745.        0B    101. 
#>  4 worst                5          15   2.54µs   3.12µs   312902.        0B     93.9
#>  5 best                10          15   2.38µs   2.91µs   332566.        0B     66.5
#>  6 worst               10          15   2.62µs   3.16µs   308933.        0B     92.7
#>  7 best                50          15   2.58µs   3.12µs   308225.        0B     92.5
#>  8 worst               50          15   3.53µs   4.18µs   238042.        0B     47.6
#>  9 best               100          15   2.91µs   3.53µs   275800.        0B     82.8
#> 10 worst              100          15   4.51µs   5.58µs   171812.        0B     51.6
#> 11 best                 3         100    2.5µs   3.16µs   295462.        0B     88.7
#> 12 worst                3         100   2.54µs   3.12µs   308540.        0B     92.6
#> 13 best                 5         100   2.42µs   2.95µs   337441.        0B    101. 
#> 14 worst                5         100   2.79µs   3.32µs   299633.        0B     59.9
#> 15 best                10         100   2.46µs   2.99µs   324368.        0B     64.9
#> 16 worst               10         100   3.12µs   3.85µs   242909.        0B     72.9
#> 17 best                50         100   2.62µs   3.24µs   294293.        0B     88.3
#> 18 worst               50         100   5.86µs   6.72µs   149265.        0B     29.9
#> 19 best               100         100   2.87µs   3.48µs   280761.        0B     56.2
#> 20 worst              100         100   8.98µs   9.88µs    94950.        0B     28.5

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   3.03µs   3.69µs   260087.        0B     78.0
#>  2 worst                3          15   3.08µs   3.73µs   256996.        0B    103. 
#>  3 best                 5          15   2.91µs   3.57µs   276035.        0B     82.8
#>  4 worst                5          15   3.12µs   3.81µs   246617.        0B     98.7
#>  5 best                10          15   3.03µs   3.69µs   250444.        0B     75.2
#>  6 worst               10          15   3.28µs   3.98µs   240903.        0B     96.4
#>  7 best                50          15   3.48µs    4.1µs   240246.        0B     72.1
#>  8 worst               50          15   5.04µs   5.86µs   170030.        0B     68.0
#>  9 best               100          15   3.98µs   4.67µs   212001.        0B     84.8
#> 10 worst              100          15   7.26µs   8.36µs   119896.        0B     48.0
#> 11 best                 3         100   2.99µs   3.57µs   276679.        0B     83.0
#> 12 worst                3         100   3.53µs   4.14µs   241812.        0B     96.8
#> 13 best                 5         100   2.99µs   3.57µs   279756.        0B     84.0
#> 14 worst                5         100   3.77µs   4.43µs   225702.        0B     67.7
#> 15 best                10         100   2.99µs   3.61µs   267764.        0B     80.4
#> 16 worst               10         100   4.76µs   5.45µs   181277.        0B     54.4
#> 17 best                50         100   3.48µs   4.35µs   217679.        0B     65.3
#> 18 worst               50         100  10.13µs  10.91µs    86121.        0B     25.8
#> 19 best               100         100    4.1µs   4.92µs   198078.        0B     79.3
#> 20 worst              100         100  18.29µs  19.43µs    48216.        0B     14.5