R99 supports much easir and more readable class definition of R6.

Definition

library(R6)
R99Class <- function(classname = NULL, public = {}, private = {}, active = {}, ..., parent.env = parent.frame()) {
  
  ee <- new.env()
  with(ee,{
    `:=` <-  function(x, y) {
      lis[[as.character(substitute(x))]] <<- y
      invisible()
      }})
  
  ee$lis <- list()
  eval(substitute(public), ee)
  pub <- ee$lis
  
  ee$lis <- list()
  eval(substitute(private), ee)
  pri <- ee$lis
  
  ee$lis <- list()
  eval(substitute(active), ee)
  act <- ee$lis
  
  R6Class(classname, pub, pri, act, ..., parent_env = parent.env)
  }

Usage

Pros and cons

Examples

Here, the examples of R6 are rewritten by R99. You can find the pure R6 examples at http://rpubs.com/wch/24456 .

Class definition with public members

Person <- R99Class(
  "Person",
  public = {
    name := NA
    hair := NA
    
    # initialize
    initialize := function(name, hair) {
      if (!missing(name)) self$name <- name
      if (!missing(hair)) self$hair <- hair
      self$greet()
      }
    
    # methods...
    set_hair := function(val) {
      self$hair <- val
      }
    
    greet := function() {
      cat(paste0("Hello, my name is ", self$name, ".\n"))
      }
    }
  )

It works!!

ann <- Person$new("Ann", "black")
## Hello, my name is Ann.
ann
## <Person>
##   Public:
##     greet: function
##     hair: black
##     initialize: function
##     name: Ann
##     set_hair: function
ann$hair
## [1] "black"
ann$greet()
## Hello, my name is Ann.
ann$set_hair("red")
ann$hair
## [1] "red"

Class definition with private members

Queue <- R99Class(
  "Queue",
  public = {
    initialize := function(...) {
      for (item in list(...)) {
        self$add(item)
        }
      }
    
    add := function(x) {
      private$queue <- c(private$queue, list(x))
      invisible(self)
      }
    
    remove := function() {
      if (private$length() == 0) return(NULL)
      # Can use private$queue for explicit access
      head <- private$queue[[1]]
      private$queue <- private$queue[-1]
      head
      }
    },
  private = {
    queue := list()
    length := function() base::length(private$queue)
    }
  )

use it!

q <- Queue$new(5, 6, "foo")
# Add and remove items
q$add("something")
q$add("another thing")
q$add(17)
q$remove()
## [1] 5
q$remove()
## [1] 6
q$queue
## NULL
q$length # error
## NULL

Class definition with active binding

Numbers <- R99Class(
  "Numbers",
  public = {
    x := 100
    },
  active = {
    x2 := function(value) {
      if (missing(value)) return(self$x * 2)
      else self$x <- value/2
      }
    rand := function() rnorm(1)
    }
  )

And it works.

n <- Numbers$new()
n$x
## [1] 100
n$x2
## [1] 200
n$x2 <- 1000
n$x
## [1] 500
n$rand
## [1] -0.1198
n$rand
## [1] 0.3755
n$rand <- 3 # error
## Error: unused argument (quote(3))

Inheritance

# Note that this isn't very efficient - it's just for illustrating inheritance.
HistoryQueue <- R99Class(
  "HistoryQueue",
  inherit = Queue,
  public = {
    show := function() {
      cat("Next item is at index", private$head_idx + 1, "\n")
      for (i in seq_along(private$queue)) {
        cat(i, ": ", private$queue[[i]], "\n", sep = "")
        }
      }
    remove := function() {
      if (private$length() - private$head_idx == 0) return(NULL)
      private$head_idx <<- private$head_idx + 1
      private$queue[[private$head_idx]]
      }
    },
  private = {
    head_idx := 0
    }
  )

Works without problem

hq <- HistoryQueue$new(5, 6, "foo")
hq$show()
## Next item is at index 1 
## 1: 5
## 2: 6
## 3: foo
hq$remove()
## [1] 5
hq$show()
## Next item is at index 2 
## 1: 5
## 2: 6
## 3: foo
hq$remove()
## [1] 6

portable and non-portable

portable

NP <- R99Class(
  "NP",
  portable = FALSE,
  public = {
    x := NA
    getx := function() x
    setx := function(value) x <<- value
    }
  )

np <- NP$new()
np$setx(10)
np$getx()
## [1] 10

non portable

P <- R99Class(
  "P",
  portable = TRUE,  # This is default
  public = {
    x := NA
    getx := function() self$x
    setx := function(value) self$x <- value
  }
)

p <- P$new()
p$setx(10)
p$getx()
## [1] 10