Generating similar methods via loop in R package

Question

I tried to write a for loop to create getters and setters for slots of an S4 class.

A similar reprex with a smaller class and only methods for the getters is:

library(methods)
library(testthat)

get_slot <- function(slot) {
  function(x) slot(x, slot)
}

setClass("TEST", slots = list(a = "character", b = "character"))

for (e in c("a", "b")) {
  def <- eval(parse(text = sprintf("function(x) standardGeneric('%s')", e)))
  setGeneric(e, def = def)
  setMethod(e, "TEST", get_slot(e))
}

test_that("getters work", {
  o <- new("TEST")
  o@a <- "a"
  o@b <- "b"
  expect_equal(a(o), "a")
  expect_equal(b(o), "b")
})
#> ── Failure ('<text>:20:3'): getters work ───────────────────────────────────────
#> a(o) not equal to "a".
#> 1/1 mismatches
#> x[1]: "b"
#> y[1]: "a"
#> Error in `reporter$stop_if_needed()`:
#> ! Test failed
#> Backtrace:
#>      ▆
#>   1. └─testthat::test_that(...)
#>   2.   └─withr (local) `<fn>`(`<env>`)
#>   3.     ├─base::tryCatch(...)
#>   4.     │ └─base (local) tryCatchList(expr, classes, parentenv, handlers)
#>   5.     │   └─base (local) tryCatchOne(expr, names, parentenv, handlers[[1L]])
#>   6.     │     └─base (local) doTryCatch(return(expr), name, parentenv, handler)
#>   7.     └─base::eval(handler$expr, handler$envir)
#>   8.       └─base::eval(handler$expr, handler$envir)
#>   9.         └─reporter$stop_if_needed()
#>  10.           └─rlang::abort("Test failed") at testthat/R/reporter-stop.R:56:8

getMethod("a", signature = "TEST")
#> Method Definition:
#> 
#> function (x) 
#> slot(x, slot)
#> <environment: 0x55bb459bec98>
#> 
#> Signatures:
#>         x     
#> target  "TEST"
#> defined "TEST"
getMethod("b", signature = "TEST")
#> Method Definition:
#> 
#> function (x) 
#> slot(x, slot)
#> <bytecode: 0x55bb45b97558>
#> <environment: 0x55bb45ab1258>
#> 
#> Signatures:
#>         x     
#> target  "TEST"
#> defined "TEST"

^{Created on 2023-09-18 with reprex v2.0.2}

I would expect that a(o) is equal to "a" and b(o) is equal to "b". I do not understand why the slot argument is wrong not correct for the first getter.

Answer 1

Not exactly sure what's going on, but if you eval() and parse() the whole setGeneric() and setMethod() functions, it works. Generally people don't like eval-parse answers, but it does work here.

library(methods)
library(testthat)

get_slot <- function(slot) {
  function(x) slot(x, slot)
}

setClass("TEST", slots = list(a = "character", b = "character"))

for(e in c("a", "b")){
  eval(parse(text = sprintf("setGeneric('%s', def=function(x) standardGeneric('%s'))", e, e)))
  eval(parse(text = sprintf("setMethod('%s', 'TEST', get_slot('%s'))", e, e)))
}

test_that("getters work", {
  o <- new("TEST")
  o@a <- "a"
  o@b <- "b"
  expect_equal(a(o), "a")
  expect_equal(b(o), "b")
})
#> Test passed 

^{Created on 2023-09-18 with reprex v2.0.2}

Answer 2

First, I will change the argument slot in function get_slot to s as slot is an existing R function. I think this is a good practice.
1. Now we have:

get_slot <- function(s) {
    function(x) slot(x, s)
}

2. We continue with your code:

setClass("TEST", slots = list(a = "character", b = "character"))

for (e in c("a", "b")) {
    def <- eval(parse(text = sprintf("function(x) standardGeneric('%s')", e)))
    setGeneric(e, def = def)
    setMethod(e, "TEST", get_slot(e)) # NOTE: Due to this call, variable e is link to argument s within function get_slot above
}

o <- new("TEST")
o@a <- "a"
o@b <- "b"

### The results are
> e
[1] "b"

> getMethod("a", "TEST")
Method Definition:

function (x) 
slot(x, s)
<environment: 0x000001989e703ef0>

Signatures:
        x     
target  "TEST"
defined "TEST"

> getMethod("b", "TEST")
Method Definition:

function (x) 
slot(x, s)
<bytecode: 0x000001989e3dddd0>
<environment: 0x000001989e628d90>

Signatures:
        x     
target  "TEST"
defined "TEST"

> o
An object of class "TEST"
Slot "a":
[1] "a"

Slot "b":
[1] "b"

At this stage, nothing is evaluated due to lazy evaluation. Only when you call a(o) does R starts evaluating things. So, the current value of e = "b" is used, variable e is link to argument s within function get_slot, and you have:

a(o) # "b"
b(o) # "b"

You can play around by clearing all variables, refresh R sessions (Rstudio > Session > Restart R) then run 1 and 2 above, then:

e <- "a"
a(o) # "a"
b(o) # "a"

### Clear all variables and refresh R sessions, then run 1 and 2 above then

e <- "a"
a(o) # "a"
e <- "b"
b(o) # "b"

To sum it up, this is the result of lazy evaluation and the way functions work in R. You can read more here and help(force) (read through the "Examples" section for ease of understanding). To fix it, simply add force(s) to get_slot to force evaluation of s and capture its value for the next statement function(x) slot(x, s):

get_slot <- function(s) {
    force(s)
    function(x) slot(x, s)
}

P.S. Regarding comment about avoiding eval(parse()) you can improve by using eval(substitute()) or eval(bquote()):

for (e in c("a", "b")) {
    eval(substitute(setGeneric(sn, function(x) standardGeneric(sn)), list(sn = e)))
    # eval(bquote(setGeneric(.(e), function(x) standardGeneric(.(e)))))
    setMethod(e, "TEST", get_slot(e))
}