# 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)    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.7

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   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.8

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   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.71