Function for standard active binding in R6-CodePudding

I'm writing some R6 classes for a project and I tend to have many values within each class that are read-only. This means that I create lots of active fields with the same exact structure, ending up with code that looks like this:

randomObject <- R6::R6Class("randomObject",
  public = list(
    initialize = function(size){
      private$.size <- size
      private$.num <- sample(1:100,size)
      private$.letter <- sample(letters,size)
      private$.place <- sample(names(islands),size)
    },
    print = function(){
      cat("Random Object with ",private$size," items:")
      cat("number(s): ",paste0(private$num))
      cat("letter(s): ",paste(private$letter))
      cat("place(s): ",paste(private$place))
    }
  ),
  private = list(
    .size = NULL, .num = NULL, .letter = NULL, .place = NULL
  ),
  active = list(
    size = function(value){
      if(missing(value)){
        private$.size
      }else{
        warning("Field size cannot be changed")
      }
    },
    num = function(value){
      if(missing(value)){
        private$.num
      }else{
        warning("Field num cannot be changed")
      }
    },
    letter = function(value){
      if(missing(value)){
        private$.letter
      }else{
        warning("Field letter cannot be changed")
      }
    },
    place = function(value){
      if(missing(value)){
        private$.place
      }else{
        warning("Field place cannot be changed")
      }
    }
  ))

This works of course:

test <- randomObject$new(5)
test$size
test$num
test$letter
test$place
test$place <- "someplace"
#> Warning message:
#> In (function (value)  : Field place cannot be changed

But I thought that all these active fields look the same, so I could probably generate some function that makes the code more elegant. It should be a function that returns a function, and I have the impression that I should do it with environments and expressions, but I can't get it to work. Here is one of the iterations I tried so far (with no success).

library(rlang)
active_access <- function(priv,warn.msg = "Field cannot be modified"){
  function(value, returnval = priv){
    if(missing(value)){
      eval(returnval)
    }else{
      warning(warn.msg)
    }
  }
}

randomObject <- R6::R6Class("randomObject",
  public = list(
    initialize = function(size){
      private$.size <- size
      private$.num <- sample(1:100,size)
      private$.letter <- sample(letters,size)
      private$.place <- sample(names(islands),size)
    },
    print = function(){
      cat("Random Object with ",private$size," items:")
      cat("number(s): ",paste0(private$num))
      cat("letter(s): ",paste(private$letter))
      cat("place(s): ",paste(private$place))
    }
  ),
  private = list(
    .size = NULL, .num = NULL, .letter = NULL, .place = NULL
  ),
  active = list(
    size = active_access(expr(private$.size)),
    num = active_access(expr(private$.num)),
    letter = active_access(expr(private$.letter)),
    place = active_access(expr(private$.place))
  )
)

test <- randomObject$new(5)
test$size
#> Error in (function (arg)  : object 'priv' not found
#> Called from: (function (arg) 
#> {
#>     .External(ffi_capturearginfo, environment(), parent.frame())
#> })(priv)

I've tried different combinations of expr() and enxepr() and enquo() to no avail. I understand that I'm not managing to send the right expression to be evaluated through the active_access() function, but I don't know how to solve it. If anyone has any ideas I'd love to hear them...

CodePudding user response：

I don't think you really need rlang for this. You can just use base R function. For example here we use substitute to inject the expression into a function

active_access <- function(expr,warn.msg = "Field cannot be modified"){
  eval(substitute(function(value){
    if(missing(value)){
      expr
    }else{
      warning(warn.msg)
    }
  }))
}

Then when you are defining your object you can just use

active = list(
    size = active_access(private$.size),
    num = active_access(private$.num),
    letter = active_access(private$.letter),
    place = active_access(private$.place)
  )