2-14-R6.Rmd

```{r, include=FALSE}
source("common.R")
```

# R6

## Prerequisites

To solve the exercises in this chapter we need to create R6 objects with the similar named package.

```{r}
library(R6)
```

## Classes and methods

1. __<span style="color:red">Q</span>__: 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.

   __<span style="color:green">A</span>__: Let's start with a very basic bank account, similar to the `Accumulator` class in the text book.

    ```{r}
    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.
   
    ```{r}
    my_account <- BankAccount$new()
    my_account$balance

    my_account$
      deposit(5)$
      withdraw(15)$
      balance
    ```

   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.

    ```{r}
    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.
   
    ```{r, error = TRUE}
    my_strict_account <- BankAccountStrict$new()
    my_strict_account$balance
    
    my_strict_account$
      deposit(5)$
      withdraw(15)

    my_strict_account$balance
    ```

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

    ```{r}
    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.
    
    ```{r}
    my_charging_account <- BankAccountCharging$new()
    my_charging_account$balance
    
    my_charging_account$
      deposit(5)$
      withdraw(15)$
      withdraw(0)
      
    my_charging_account$balance
    ```

2. __<span style="color:red">Q</span>__: 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.
    
    ```{r}
    suit <- c("♠", "♥", "♦", "♣")
    value <- c("A", 2:10, "J", "Q", "K")
    cards <- paste0(rep(value, 4), suit)
    ```

   __<span style="color:green">A</span>__: 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.

    ```{r}
    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. 

    ```{r}
    my_deck <- ShuffledDeck$new()
    my_deck$draw(20)
    my_deck$
      reshuffle()$
      deck
    ```

3. __<span style="color:red">Q</span>__: Why can't you model a bank account or a deck of cards with an S3 class?
    
   __<span style="color:orange">A</span>__: (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:
   
    ```{r}
    # 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
    
    # On top of an environment
    ba2 <- new.env()
    ba2$balance <- 0
    
    class(ba2) <- "bank_account"
    withdraw(ba2, 5)
    ba2$balance
    ```

4. __<span style="color:red">Q</span>__: 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()`.

   __<span style="color:green">A</span>__: 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.
   
    ```{r}
    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.
                      
    ```{r}
    time_setter <- TimeSetter$new()
    
    (old_tz <- time_setter$get_timezone())
    time_setter$set_timezone("Antarctica/South_Pole")
    time_setter$get_timezone()
    time_setter$set_timezone(old_tz)
    ```

5. __<span style="color:red">Q</span>__: Create an R6 class that manages the current working directory. It should have `$get()` and `$set()` methods.
    
   __<span style="color:green">A</span>__: As the requirements are quite overseeable, our proposal for a `WDManager` class is also quite minimalistic:

    ```{r}
    WDManager <- R6Class("WDManager", list(
      get = getwd,
      set = setwd
    ))
    ```

6. __<span style="color:red">Q</span>__: Why can't you model the time zone or current working directory with an S3 class?
    
   __<span style="color:green">A</span>__:

7. __<span style="color:red">Q</span>__: What base type are R6 objects built on top of? What attributes do they have?

   __<span style="color:green">A</span>__: 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"`.

## Controlling access

1. __<span style="color:red">Q</span>__: 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.
    
   __<span style="color:green">A</span>__: 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. 
   
    ```{r, error = TRUE}
    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.

    ```{r, error = TRUE}
    my_account_strict_2 <- BankAccountStrict2$new()

    my_account_strict_2$deposit(5)
    my_account_strict_2$withdraw(10)
    ```

2. __<span style="color:red">Q</span>__: 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.

   __<span style="color:green">A</span>__: 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.
   
    ```{r}
    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.

    ```{r, error = TRUE}
    my_pw <- PWClass$new()
    my_pw$set_password(123)
    my_pw$password
    my_pw
    my_pw$check_password()
    ```

3. __<span style="color:red">Q</span>__: 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.

   __<span style="color:green">A</span>__: 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.
   
    ```{r}
    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.
    
    ```{r}
    x <- Rando$new()
    x$random
    x$random
    x$previous_random
    ```

4. __<span style="color:red">Q</span>__: Can subclasses access private fields/methods from their parent? Perform an experiment to find out.

   __<span style="color:green">A</span>__: 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`.

    ```{r}
    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()
    ```
    
   We conclude, that subclasses can access private fields from their superclasses, but not private methods.

## Reference semantics
1. __<span style="color:red">Q</span>__: 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()`.

   __<span style="color:green">A</span>__: 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.

    ```{r, eval = TRUE, error = TRUE}
    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.
                          
    ```{r}
    tmp_file <- tempfile(pattern = "test", tmpdir = tempdir(), fileext = ".txt")
    my_fw <- FileWriter$new(tmp_file)
    
    readLines(tmp_file)
    my_fw$append_line()
    my_fw$append_line()
    readLines(tmp_file)
    ```