R99Class

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

• You can define a R6 class by calling R99Class().
• You can pass expressions to public, private, and active by {...}.
• You can define members by := oparator.

Pros and cons

• Easier to define and easier to read.
• You don’t need to put , (comma) between definitions of each member.
• This really helps you. When you remove the member at the end, usually you need to remove a comma from the second last member, which usually you forget.
• When you add a member at the end, you also need to put comma anywhere, which confuses you in most cases.

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