14 R6

14.1 Prerequisites

To solve the exercises in this chapter we will have to to create R6 objects, which are implemented in the R6 package.

library(R6)

14.2 Classes and methods

  1. Q: Create a bank account R6 class that stores a balance and allows you to deposit and withdraw money. Create a subclass that throws an error if you attempt to go into overdraft. Create another subclass that allows you to go into overdraft, but charges you a fee.

    A: Let’s start with a basic bank account, similar to the Accumulator class in the text book.

    BankAccount <- R6Class("BankAccount", list(
      balance = 0,
      deposit = function(dep = 0) {
        self$balance = self$balance + dep
        invisible(self)
      },
      withdraw = function(draw) {
        self$balance = self$balance - draw
        invisible(self)
      }
    ))

    To test this class we create one instance and leave it with a negative balance.

    my_account <- BankAccount$new()
    my_account$balance
    #> [1] 0
    
    my_account$
      deposit(5)$
      withdraw(15)$
      balance
    #> [1] -10

    Now, we create the first subclass that prevents us from going into overdraft and throws an error in case we attempt to withdraw more than our current balance.

    BankAccountStrict <- R6Class("BankAccount",
      inherit = BankAccount,
      public = list(
        withdraw = function(draw = 0) {
          if (self$balance - draw < 0) {
            stop("Your `withdraw` must be smaller ",
                 "than your `balance`.", call. = FALSE)
          }
          super$withdraw(draw = draw)
        }
    ))

    This time our test should throw an error.

    my_strict_account <- BankAccountStrict$new()
    my_strict_account$balance
    #> [1] 0
    
    my_strict_account$
      deposit(5)$
      withdraw(15)
    #> Error: Your `withdraw` must be smaller than your `balance`.
    
    my_strict_account$balance
    #> [1] 5

    Finally, we create a class that charges a constant fee (of 1) for each withdraw which leaves the account with a negative balance.

    BankAccountCharging <- R6Class("BankAccount",
      inherit = BankAccount,
      public = list(
        withdraw = function(draw = 0) {
          if (self$balance - draw < 0) {
            draw = draw + 1
          }
          super$withdraw(draw = draw)
        }
    ))

    And provide a regarding test, which should result in -12, since we pay the fee twice.

    my_charging_account <- BankAccountCharging$new()
    my_charging_account$balance
    #> [1] 0
    
    my_charging_account$
      deposit(5)$
      withdraw(15)$
      withdraw(0)
    
    my_charging_account$balance
    #> [1] -12
  2. Q: Create an R6 class that represents a shuffled deck of cards. You should be able to draw cards from the deck with $draw(n), and return all cards to the deck and reshuffle with $reshuffle(). Use the following code to make a vector of cards.

    suit <- c("♠", "♥", "♦", "♣")
    value <- c("A", 2:10, "J", "Q", "K")
    cards <- paste0(rep(value, 4), suit)

    A: To keep the class flexible, we allow to specify any deck of cards at initialisation with the cards deck from the exercise text as the default value.

    ShuffledDeck <- R6Class("ShuffledDeck", public = list(
      cards = {
        suit <- c("♠", "♥", "♦", "♣")
        value <- c("A", 2:10, "J", "Q", "K")
        paste0(rep(value, 4), suit)
      },
      deck = NULL,
      initialize = function(deck = self$cards) {
        self$cards = deck
        self$deck = sample(deck)
      },
      reshuffle = function(deck = self$cards) {
        self$deck = sample(deck)
        invisible(self)
      },
      draw = function(n){
        output <- self$deck[seq_len(n)]
        self$deck <- self$deck[-seq_len(n)]
        output
      }
    ))

    To test this class we initialise one instance, draw 20 cards and reshuffle the deck.

    my_deck <- ShuffledDeck$new()
    my_deck$draw(20)
    #>  [1] "6♠"  "10♦" "Q♣"  "J♠"  "Q♥"  "8♦"  "5♦"  "4♣"  "9♣"  "9♠"  "5♠" 
    #> [12] "3♥"  "J♣"  "2♦"  "K♠"  "2♥"  "2♠"  "8♠"  "8♥"  "6♥"
    my_deck$
      reshuffle()$
      deck
    #>  [1] "6♦"  "2♣"  "Q♦"  "9♣"  "J♦"  "K♥"  "9♦"  "2♥"  "10♦" "3♥"  "3♦" 
    #> [12] "Q♥"  "4♣"  "A♠"  "6♥"  "9♥"  "K♣"  "6♠"  "K♦"  "J♥"  "8♥"  "7♦" 
    #> [23] "Q♣"  "J♠"  "9♠"  "10♥" "7♥"  "2♠"  "5♦"  "4♥"  "3♠"  "A♥"  "5♠" 
    #> [34] "J♣"  "5♣"  "4♠"  "7♣"  "6♣"  "K♠"  "Q♠"  "2♦"  "5♥"  "8♦"  "3♣" 
    #> [45] "10♣" "4♦"  "10♠" "A♣"  "8♣"  "7♠"  "A♦"  "8♠"
  3. Q: Why can’t you model a bank account or a deck of cards with an S3 class?

    A: (TODO: Check the requirements to how the class should look like). It is not clear why this should not be possible. Of course this would look different than R6, but one could still build up an S3 class based on i.e. a list or environment. Here an S3 version of a bank account and one method:

    # On top of a list
    ba1 <- list(balance = 0)
    class(ba1) <- "bank_account"
    
    withdraw <- function(ba, draw) {
      UseMethod("withdraw")
    }
    
    withdraw.bank_account <- function(ba, draw) {
      ba$balance <- ba$balance - draw
      ba
    }
    
    ba1 <- withdraw.bank_account(ba1, 5)
    ba1
    #> $balance
    #> [1] -5
    #> 
    #> attr(,"class")
    #> [1] "bank_account"
    
    # On top of an environment
    ba2 <- new.env()
    ba2$balance <- 0
    
    class(ba2) <- "bank_account"
    withdraw(ba2, 5)
    #> <environment: 0x77fef98>
    #> attr(,"class")
    #> [1] "bank_account"
    ba2$balance
    #> [1] -5
  4. Q: Create an R6 class that allows you to get and set the current timezone. You can access the current timezone with Sys.timezone() and set it with Sys.setenv(TZ = "newtimezone"). When setting the time zone, make sure the new time zone is in the list provided by OlsonNames().

    A: To create an R6 class that allows us to get and set the timezone, we provide the regarding functions as public methods to the R6 class.

    TimeSetter <- R6Class("TimeSetter", public = list(
      get_timezone = Sys.timezone,
      set_timezone = function(TZ, tzdir = NULL) {
        stopifnot(TZ %in% as.character(OlsonNames(tzdir = tzdir)))
        Sys.setenv(TZ = TZ)
      })
    )

    Now let us create one instance of this class and test, if we can can set and get the timezone as we prefer.

    time_setter <- TimeSetter$new()
    
    (old_tz <- time_setter$get_timezone())
    #> [1] "UTC"
    time_setter$set_timezone("Antarctica/South_Pole")
    time_setter$get_timezone()
    #> [1] "Antarctica/South_Pole"
    time_setter$set_timezone(old_tz)
  5. Q: Create an R6 class that manages the current working directory. It should have $get() and $set() methods.

    A: As the requirements are quite overseeable, our proposal for a WDManager class is also quite minimalistic:

    WDManager <- R6Class("WDManager", list(
      get = getwd,
      set = setwd
    ))
  6. Q: Why can’t you model the time zone or current working directory with an S3 class?

    A:

  7. Q: What base type are R6 objects built on top of? What attributes do they have?

    A: R6 objects are built on top of environments and have a class attribute, which is a character vector containing the class name, the name of any super classes (if existent) and as the last element the string "R6".

14.3 Controlling access

  1. Q: Create a bank account class that prevents you from directly setting the account balance, but you can still withdraw from and deposit to. Throw an error if you attempt to go into overdraft.

    A: To fulfill this requirement, we make balance a private field. The user has to use the deposit() and withdraw() methods which will still have access to the balance field.

    BankAccountStrict2 <- R6Class(
      "BankAccountStrict2",
      list(
        deposit = function(dep = 0) {
          private$balance = private$balance + dep
          invisible(self)
        },
        withdraw = function(draw = 0) {
          if (private$balance - draw < 0) {
            stop("Your `withdraw` must be smaller ",
                 "than your `balance`.",
                 call. = FALSE)
          }
          private$balance = private$balance - draw
          invisible(self)
        }
      ),
      private = list(balance = 0)
    )

    To test our new class, we create an instance and try to go into overdraft.

    my_account_strict_2 <- BankAccountStrict2$new()
    
    my_account_strict_2$deposit(5)
    my_account_strict_2$withdraw(10)
    #> Error: Your `withdraw` must be smaller than your `balance`.
  2. Q: Create a class with a write-only $password field. It should have $check_password(password) method that returns TRUE or FALSE, but there should be no way to view the complete password.

    A: To protect the password from changes and direct access, the password will be a private field. Further, our PWClass will get it’s own print method, which hides the password.

    PWClass <- R6Class(
      "PWClass",
      list(
        print = function(...) {
          cat("PWClass: \n")
          invisible(self)
        },
        set_password = function(password) {
          private$password <- password
        },
        check_password = function(password) {
          !is.null(private$password)
        }
      ),
      private = list(password = NULL)
    )

    Let’s create one instance of our new class and confirm that the password is neither accessible nor visible.

    my_pw <- PWClass$new()
    my_pw$set_password(123)
    my_pw$password
    #> NULL
    my_pw
    #> PWClass:
    my_pw$check_password()
    #> [1] TRUE
  3. Q: Extend the Rando class with another active binding that allows you to access the previous random value. Ensure that active binding is the only way to access the value.

    A: To access the previous random value from an instance, we add a private last_random field to our class, and we modify the random() method to write to this field whenever it is called. To access the last_random field we provide a prvious_random method.

    Rando <- R6::R6Class(
      "Rando",
      private = list(last_random = NULL),
      active = list(
        random = function(value) {
          if (missing(value)) {
            private$last_random <- runif(1)
            private$last_random
          } else {
            stop("Can't set `$random`", call. = FALSE)
          }
        },
        previous_random = function(value) {
          if (missing(value)) {
            private$last_random
          }
        }
      )
    )

    Now, we initiate a new Rando object and see, if it behaves as expected.

    x <- Rando$new()
    x$random
    #> [1] 0.663
    x$random
    #> [1] 0.857
    x$previous_random
    #> [1] 0.857
  4. Q: Can subclasses access private fields/methods from their parent? Perform an experiment to find out.

    A: To find out if private fields/classes can be accessed from subclasses, we first create a class A with a private field foo and a privte method bar. Afterwards, an instance of a subclass B and call the foobar() methods, which tries to access the foo field and the bar() method from its superclass A.

    A <- R6Class(
      classname = "A",
      private = list(
        foo = "foo",
        bar = function() {
          "bar"
        }
      )
    )
    
    B <- R6Class(
      classname = "B",
      inherit = A,
      public = list(
        foobar = function() {
          print(super$foo)
          print(super$bar())
        }
      )
    )
    
    x <- B$new()
    x$foobar()
    #> NULL
    #> [1] "bar"

    We conclude, that subclasses can access private fields from their superclasses, but not private methods.

14.4 Reference semantics

  1. Q: Create a class that allows you to write a line to a specified file. You should open a connection to the file in $initialize(), append a line using cat() in $append_line(), and close the connection in $finalize().

    A: Our FileWriter class will create a connection to a file at initialization. Therefore, we open a connection to a user specified file during the initialisation. Note that we need to set open = "a" in file() to open connection for appeding text. Otherwise cat would only work when applied to files, but not with connctions as explicitly asked for in the exercise. Further, we add the append_line() method and a close() statement as finalizer.

    FileWriter <- R6::R6Class(
      "FileWriter",
      list(
        con = NULL,
        initialize = function(filename) {
          self$con <- file(filename, open = "a")
        },
        append_line = function() {
          cat("\n", file = self$con)
        },
        finalize = function() {
          close(self$con)
        }
      )
    )

    Let’s see, if new instances of our class work as expected.

    tmp_file <- tempfile(pattern = "test", tmpdir = tempdir(), fileext = ".txt")
    my_fw <- FileWriter$new(tmp_file)
    
    readLines(tmp_file)
    #> character(0)
    my_fw$append_line()
    my_fw$append_line()
    readLines(tmp_file)
    #> [1] "" ""