Constructor performance

[t-kalinowski]

While chatting at useR in Warsaw, @bnaras mentioned that the performance of the S7 constructor could be improved for performance-sensitive applications such as CVXR. This also matches our experience in r-xla/anvl.

It would be good for us to optimize the generated constructor and/or new_object(). Some big performance gains seem achievable with a little caching. @bnaras was kind enough to share a script (generated with AI assistance) demonstrating this:

## Self-contained reproducible example:
## The `paste` overhead in S7's object constructor, and how CVXR's
## `.fast_new` sidesteps it.
##
## THE PROBLEM
## -----------
## Every `new_object()` call rebuilds the class-dispatch vector via S7's
## internal `class_dispatch()`, which walks the parent chain and calls
##     S7_class_name(x)  ==  paste(c(x@package, x@name), collapse = "::")
## once per level.  For a class N levels deep that is N `paste()` calls on
## EVERY construction -- yet the resulting vector
##     c("pkg::Var", "pkg::Leaf", "pkg::Expr", ..., "S7_object")
## is a CONSTANT of the class.  CVXR builds it once and caches it.
##
## Writeup: notes/s7_paste_overhead.md .  Canonical `.fast_new`:
## CVXR/rsrc_tree/zzz_R_specific/utility.R (ADR D_PERF.1).
##
## Run:  Rscript scripts/s7_paste_overhead.R

stopifnot(requireNamespace("S7", quietly = TRUE),
          requireNamespace("bench", quietly = TRUE))
library(S7)

## ---------------------------------------------------------------------------
## 1. A 5-level hierarchy, mimicking CVXR's Expression -> Leaf -> Variable
## ---------------------------------------------------------------------------
Expr  <- new_class("Expr",  package = "demo",
                   properties = list(id = class_integer))
Node  <- new_class("Node",  parent = Expr,  package = "demo")
Atom  <- new_class("Atom",  parent = Node,  package = "demo")
Leaf  <- new_class("Leaf",  parent = Atom,  package = "demo")
Var   <- new_class("Var",   parent = Leaf,  package = "demo",
                   properties = list(nm = class_character),
                   ## a normal S7 constructor: the hot path we are measuring
                   constructor = function(id, nm) {
                     new_object(S7_object(), id = id, nm = nm)
                   })

## ---------------------------------------------------------------------------
## 2. CVXR-style .fast_new: cache the dispatch vector once per class,
##    attach attributes directly, skip validation.  Public S7 API only.
## ---------------------------------------------------------------------------
.fast_new <- local({
  cache <- new.env(hash = TRUE, parent = emptyenv())
  build_dispatch <- function(cls) {
    out <- character(0L); cur <- cls
    while (inherits(cur, "S7_class") && !identical(cur, S7::S7_object)) {
      out <- c(out, paste0(cur@package, "::", cur@name))   # paste PAID ONCE
      cur <- cur@parent
    }
    c(out, "S7_object")
  }
  function(.class, .parent, ...) {
    cn <- .class@name
    cd <- get0(cn, envir = cache, ifnotfound = NULL)
    if (is.null(cd)) { cd <- build_dispatch(.class); assign(cn, cd, cache) }
    obj <- .parent
    attributes(obj) <- c(list(class = cd, S7_class = .class), list(...))
    obj
  }
})

Var_fast <- function(id, nm) {
  if (FALSE) new_object(S7_object())          # S7 static-check guard
  .fast_new(Var, S7_object(), id = id, nm = nm)
}

## ---------------------------------------------------------------------------
## 3. Correctness: the two paths produce identical objects
## ---------------------------------------------------------------------------
a <- Var(1L, "x")
b <- Var_fast(1L, "x")
stopifnot(identical(class(a), class(b)),
          identical(a@id, b@id), identical(a@nm, b@nm),
          S7_inherits(b, Expr), S7_inherits(b, Leaf))
cat("class vector:", paste(class(a), collapse = " < "), "\n\n")

## ---------------------------------------------------------------------------
## 4. Where the time goes: profile 2e5 normal constructions
## ---------------------------------------------------------------------------
pf <- tempfile(fileext = ".out")
Rprof(pf, interval = 0.002)
for (i in 1:200000L) Var(i, "x")
Rprof(NULL)
cat("---- Rprof: self-time hot spots in the normal constructor ----\n")
print(head(summaryRprof(pf)$by.self, 12))

## ---------------------------------------------------------------------------
## 5. Benchmark: normal vs fast (report GC-free `min` and mem_alloc first)
## ---------------------------------------------------------------------------
cat("\n---- bench::mark (single construction) ----\n")
bm <- bench::mark(
  normal = Var(1L, "x"),
  fast   = Var_fast(1L, "x"),
  check = FALSE, min_iterations = 5000
)
print(bm[, c("expression", "min", "median", "mem_alloc", "n_gc")])
cat(sprintf("\nspeedup (median normal / median fast): %.1fx\n",
            as.numeric(bm$median[1]) / as.numeric(bm$median[2])))

This produces the following output with the current CRAN release of S7:

class vector: demo::Var < demo::Leaf < demo::Atom < demo::Node < demo::Expr < S7_object 

---- Rprof: self-time hot spots in the normal constructor ----
# A data.frame: 12 × 4
   self.time self.pct total.time total.pct
       <dbl>    <dbl>      <dbl>     <dbl>
 1     0.856    16.9       1.40      27.8 
 2     0.558    11.0       0.606     12   
 3     0.446     8.83      0.978     19.4 
 4     0.322     6.37      5.01      99.2 
 5     0.322     6.37      0.678     13.4 
 6     0.302     5.98      2.52      50.0 
 7     0.276     5.46      0.276      5.46
 8     0.214     4.24      0.214      4.24
 9     0.2       3.96      0.458      9.07
10     0.146     2.89      0.306      6.06
11     0.14      2.77      0.76      15.0 
12     0.12      2.38      1.10      21.7 

---- bench::mark (single construction) ----
# A tibble: 2 × 5
  expression      min   median mem_alloc  n_gc
  <bch:expr> <bch:tm> <bch:tm> <bch:byt> <dbl>
1 normal      42.44µs  47.52µs        0B    27
2 fast         2.34µs   2.71µs    9.99KB     2

speedup (median normal / median fast): 17.6x