12 R6
Prerequisites
To solve the exercises in this chapter we will have to create R6 objects, which are implemented in the R6 package.22
12.1 Classes and methods
Q1: 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 Advanced R.
BankAccount <- R6Class(
classname = "BankAccount",
public = 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] -10Now, 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(
classname = "BankAccountStrict",
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] 5Finally, we create another subclass that charges a constant fee of 1 for each withdrawal which leaves the account with a negative balance.
BankAccountCharging <- R6Class(
classname = "BankAccountCharging",
inherit = BankAccount,
public = list(
withdraw = function(draw = 0) {
if (self$balance - draw < 0) {
draw <- draw + 1
}
super$withdraw(draw = draw)
}
)
)Let’s take a look at the implemented functionality. We expect a final balance of -12, because 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] -12Q2: 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("SPADE", "HEARTS", "DIAMOND", "CLUB")
value <- c("A", 2:10, "J", "Q", "K")
cards <- paste(rep(value, 4), suit)(This question was altered slightly to avoid the unicode characters.)
A: Our new ShuffledDeck class will use sample() and positive integer subsetting to implement the reshuffling and drawing functionality. We also add a check, so you cannot draw more cards than there are left in the deck.
ShuffledDeck <- R6Class(
classname = "ShuffledDeck",
public = list(
deck = NULL,
initialize = function(deck = cards) {
self$deck <- sample(deck)
},
reshuffle = function() {
self$deck <- sample(cards)
invisible(self)
},
n = function() {
length(self$deck)
},
draw = function(n = 1) {
if (n > self$n()) {
stop("Only ", self$n(), " cards remaining.", call. = FALSE)
}
output <- self$deck[seq_len(n)]
self$deck <- self$deck[-seq_len(n)]
output
}
)
)To test this class, we create a deck (initialise an instance), draw all the cards, then reshuffle, checking we get different cards each time.
my_deck <- ShuffledDeck$new()
my_deck$draw(52)
#> [1] "6 SPADE" "10 DIAMOND" "Q CLUB" "J SPADE" "Q HEARTS"
#> [6] "8 DIAMOND" "5 DIAMOND" "4 CLUB" "9 CLUB" "9 SPADE"
#> [11] "5 SPADE" "3 HEARTS" "J CLUB" "2 DIAMOND" "K SPADE"
#> [16] "2 HEARTS" "2 SPADE" "8 SPADE" "8 HEARTS" "6 HEARTS"
#> [21] "7 HEARTS" "6 CLUB" "K CLUB" "3 CLUB" "10 SPADE"
#> [26] "3 DIAMOND" "Q SPADE" "9 HEARTS" "J DIAMOND" "7 DIAMOND"
#> [31] "9 DIAMOND" "7 SPADE" "4 DIAMOND" "10 HEARTS" "2 CLUB"
#> [36] "4 SPADE" "4 HEARTS" "8 CLUB" "K HEARTS" "A SPADE"
#> [41] "A HEARTS" "5 HEARTS" "A DIAMOND" "5 CLUB" "7 CLUB"
#> [46] "Q DIAMOND" "A CLUB" "10 CLUB" "3 SPADE" "K DIAMOND"
#> [51] "J HEARTS" "6 DIAMOND"
my_deck$draw(10)
#> Error: Only 0 cards remaining.
my_deck$reshuffle()$draw(5)
#> [1] "6 DIAMOND" "2 CLUB" "Q DIAMOND" "9 CLUB" "J DIAMOND"
my_deck$reshuffle()$draw(5)
#> [1] "8 CLUB" "9 SPADE" "2 SPADE" "Q HEARTS" "6 SPADE"Q3: Why can’t you model a bank account or a deck of cards with an S3 class?
A: Because S3 classes obey R’s usual semantics of copy-on-modify: every time you deposit money into your bank account or draw a card from the deck, you’d get a new copy of the object.
It is possible to combine S3 classes with an environment (which is how R6 works), but it is ill-advised to create an object that looks like a regular R object but has reference semantics.
Q4: Create an R6 class that allows you to get and set the current time zone. You can access the current time zone 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 time zone, we provide the respective functions as public methods to the R6 class.
Timezone <- R6Class(
classname = "Timezone",
public = list(
get = function() {
Sys.timezone()
},
set = function(value) {
stopifnot(value %in% OlsonNames())
old <- self$get()
Sys.setenv(TZ = value)
invisible(old)
}
)
)(When setting, we return the old value invisibly because this makes it easy to restore the previous value.)
Now, let us create one instance of this class and test, if we can set and get the time zone as intended.
tz <- Timezone$new()
old <- tz$set("Antarctica/South_Pole")
tz$get()
#> [1] "Antarctica/South_Pole"
tz$set(old)
tz$get()
#> [1] "UTC"Q5: Create an R6 class that manages the current working directory. It should have $get() and $set() methods.
A: Take a look at the following implementation, which is quite minimalistic:
WorkingDirectory <- R6Class(
classname = "WorkingDirectory",
public = list(
get = function() {
getwd()
},
set = function(value) {
setwd(value)
}
)
)Q6: Why can’t you model the time zone or current working directory with an S3 class?
A: Because S3 classes are not suitable for modelling a state that changes over time. S3 methods should (almost) always return the same result when called with the same inputs.
Q7: What base type are R6 objects built on top of? What attributes do they have?
A: R6 objects are built on top of environments. They have a class attribute, which is a character vector containing the class name, the name of any super classes (if existent) and the string "R6" as the last element.
12.2 Controlling access
Q1: Create a bank account class that prevents you from directly setting the account balance, but that you can still withdraw from and deposit to. Throw an error if you attempt to go into overdraft.
A: To fulfil this requirement, we make balance a private field. The user has to use the $deposit() and $withdraw() methods which have access to the balance field.
BankAccountStrict2 <- R6Class(
classname = "BankAccountStrict2",
public = 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`.Q2: 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 Password will get its own print method which hides the password.
Password <- R6Class(
classname = "Password",
public = list(
print = function(...) {
cat("<Password>: ********\n")
invisible(self)
},
set = function(value) {
private$password <- value
},
check = function(password) {
identical(password, 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, but still check-able.
my_pw <- Password$new()
my_pw$set("snuffles")
my_pw$password
#> NULL
my_pw
#> <Password>: ********
my_pw$check("snuggles")
#> [1] FALSE
my_pw$check("snuffles")
#> [1] TRUEQ3: 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 $random() to write to this field, whenever it is called. To access the $last_random field we provide $previous().
Rando <- R6::R6Class(
classname = "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 = 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.349
x$random
#> [1] 0.947
x$previous
#> [1] 0.947Q4: Can subclasses access private fields/methods from their parent? Perform an experiment to find out.
A: To find out if private fields/methods can be accessed from subclasses, we first create a class A with a private field foo and a private method bar(). Afterwards, an instance of a subclass B is created and calls the foobar() methods, which tries to access the foo field and the bar() method from its superclass A.
A <- R6Class(
classname = "A",
private = list(
field = "foo",
method = function() {
"bar"
}
)
)
B <- R6Class(
classname = "B",
inherit = A,
public = list(
test = function() {
cat("Field: ", super$field, "\n", sep = "")
cat("Method: ", super$method(), "\n", sep = "")
}
)
)
B$new()$test()
#> Field:
#> Method: barWe conclude that subclasses can access private methods from their superclasses, but not private fields.
12.3 Reference semantics
Q1: 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 appending text. Otherwise, cat() would only work when applied to files, but not with connections as explicitly asked for in the exercise. Further, we add the append_line() method and a close() statement as finalizer.
FileWriter <- R6::R6Class(
classname = "FileWriter",
public = list(
con = NULL,
initialize = function(filename) {
self$con <- file(filename, open = "a")
},
finalize = function() {
close(self$con)
},
append_line = function(x) {
cat(x, "\n", sep = "", file = self$con)
}
)
)Let’s see, if new instances of our class work as expected.