# 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.42µs   2.91µs   330701.        0B     99.2
    #> 2 foo_S3(x)  861.01ns   1.07µs   862274.        0B     86.2
    #> 3 foo_S4(x)  860.98ns   1.15µs   843830.        0B     84.4

    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.55µs   5.66µs   168263.        0B     67.3
    #> 2 bar_S4(x, y)   2.46µs   2.99µs   330169.        0B     66.0

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.46µs   3.03µs   320538.        0B     96.2
    #>  2 worst                3          15   2.54µs   3.03µs   326714.        0B     98.0
    #>  3 best                 5          15   2.38µs   2.95µs   336761.        0B     67.4
    #>  4 worst                5          15   2.58µs   3.08µs   319673.        0B     95.9
    #>  5 best                10          15   2.46µs   2.95µs   333903.        0B    100.
    #>  6 worst               10          15   2.67µs    3.2µs   305966.        0B     91.8
    #>  7 best                50          15   2.71µs    3.2µs   310232.        0B     93.1
    #>  8 worst               50          15   3.57µs   4.22µs   236754.        0B     71.0
    #>  9 best               100          15   2.99µs   3.57µs   277814.        0B     83.4
    #> 10 worst              100          15   4.92µs   5.78µs   171688.        0B     68.7
    #> 11 best                 3         100   2.54µs   3.08µs   317960.        0B     95.4
    #> 12 worst                3         100   2.79µs    3.4µs   286052.        0B     85.8
    #> 13 best                 5         100   2.54µs   3.08µs   313021.        0B     62.6
    #> 14 worst                5         100   2.79µs   3.32µs   289301.        0B     86.8
    #> 15 best                10         100   2.62µs    3.2µs   305120.        0B     91.6
    #> 16 worst               10         100   3.28µs    3.9µs   254938.        0B     76.5
    #> 17 best                50         100   2.71µs   3.32µs   294308.        0B     88.3
    #> 18 worst               50         100   5.58µs   6.48µs   154093.        0B     46.2
    #> 19 best               100         100   2.99µs   3.57µs   274455.        0B     82.4
    #> 20 worst              100         100  10.09µs  10.62µs    91679.        0B     27.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.08µs   3.69µs   263334.        0B     79.0
    #>  2 worst                3          15   3.32µs   3.94µs   249928.        0B    100.
    #>  3 best                 5          15   3.08µs   3.77µs   263260.        0B    105.
    #>  4 worst                5          15   3.28µs    3.9µs   256256.        0B     76.9
    #>  5 best                10          15   3.08µs   3.65µs   269725.        0B    108.
    #>  6 worst               10          15   3.48µs    4.1µs   243635.        0B     73.1
    #>  7 best                50          15   3.53µs    4.1µs   246041.        0B     98.5
    #>  8 worst               50          15   5.29µs   6.11µs   165180.        0B     49.6
    #>  9 best               100          15    4.1µs   4.76µs   208298.        0B     62.5
    #> 10 worst              100          15   7.46µs   8.61µs   117170.        0B     46.9
    #> 11 best                 3         100   3.08µs   3.65µs   273386.        0B     82.0
    #> 12 worst                3         100   3.65µs   4.26µs   235268.        0B     70.6
    #> 13 best                 5         100   3.32µs   3.98µs   251051.        0B     75.3
    #> 14 worst                5         100   4.06µs   4.67µs   214362.        0B     64.3
    #> 15 best                10         100   3.08µs   3.65µs   272562.        0B    109.
    #> 16 worst               10         100   4.43µs   5.08µs   196608.        0B     59.0
    #> 17 best                50         100   3.77µs   4.47µs   223699.        0B     67.1
    #> 18 worst               50         100  10.58µs  11.23µs    85277.        0B     25.6
    #> 19 best               100         100   4.26µs      5µs   197339.        0B     79.0
    #> 20 worst              100         100  17.02µs  17.63µs    55098.        0B     16.5