Herencia y callSuper

Parte de la sección Programación orientada a objetos del Journey de R de Coddy. Lección 40 de 57.

contains = "Account" hace que una Clase de Referencia herede cada campo y método de Account. La subclase añade sus propios campos y métodos:

Account <- suppressMessages(setRefClass("Account",
  fields = list(owner = "character", balance = "numeric"),
  methods = list(deposit = function(x) balance <<- balance + x)
))
Savings <- suppressMessages(setRefClass("Savings", contains = "Account",
  fields = list(rate = "numeric"),
  methods = list(add_interest = function() deposit(balance * rate))
))
s <- Savings$new(owner = "Ada", balance = 100, rate = 0.05)
s$deposit(100)
s$add_interest()
cat(s$balance, is(s, "Account"))

Salida:

210 TRUE

Una subclase sobrescribe un método definiendo uno con el mismo nombre. Dentro de él, callSuper(...) llama a la versión de la clase padre, por lo que la clase hija solo añade lo que es nuevo:

Account <- suppressMessages(setRefClass("Account",
  fields = list(balance = "numeric"),
  methods = list(withdraw = function(x) {
    if (x > balance) stop("insufficient funds", call. = FALSE)
    balance <<- balance - x
  })
))
Savings <- suppressMessages(setRefClass("Savings", contains = "Account",
  methods = list(withdraw = function(x) {
    if (x > 500) stop("limit is 500", call. = FALSE)
    callSuper(x)
  })
))
s <- Savings$new(balance = 300)
s$withdraw(200)
for (x in c(600, 400)) cat(tryCatch({ s$withdraw(x); "ok" }, error = function(e) conditionMessage(e)), "\n")
cat(s$balance, "\n")

Salida:

limit is 500 
insufficient funds 
100

initialize se hereda y se sobrescribe como cualquier método. El initialize de una clase hija llama a callSuper(...) para permitir que la clase padre establezca sus campos y, después, establece sus propios valores predeterminados:

Account <- suppressMessages(setRefClass("Account",
  fields = list(owner = "character", balance = "numeric"),
  methods = list(initialize = function(...) {
    initFields(...)
    if (length(balance) == 0) balance <<- 0
    invisible(.self)
  })
))
Savings <- suppressMessages(setRefClass("Savings", contains = "Account",
  fields = list(rate = "numeric"),
  methods = list(initialize = function(...) {
    callSuper(...)
    if (length(rate) == 0) rate <<- 0.01
    invisible(.self)
  })
))
s <- Savings$new(owner = "Bo")
cat(s$owner, s$balance, s$rate)

Salida:

Bo 0 0.01

Los objetos de diferentes subclases responden a la misma llamada de método a su manera, por lo que un bucle sobre una lista mixta no necesita comprobaciones de la clase:

Account <- suppressMessages(setRefClass("Account",
  fields = list(balance = "numeric"),
  methods = list(month_end = function() balance <<- balance - 2)
))
Savings <- suppressMessages(setRefClass("Savings", contains = "Account",
  methods = list(month_end = function() balance <<- balance * 1.01)
))
bank <- list(Account$new(balance = 100), Savings$new(balance = 100))
for (a in bank) a$month_end()
cat(vapply(bank, function(a) a$balance, numeric(1)))

Salida:

98 101

Desafío

Fácil

Las cuentas y las cuentas de ahorro son Clases de Referencia en dos archivos. Completa los métodos:

Account en Account.R (campos owner, balance): initialize establece el balance en 0 cuando no se proporciona; deposit(x); withdraw(x) se detiene con insufficient funds; month_end() cobra una tarifa de 1; describe() devuelve ada: 99.
Savings en Savings.R (contiene Account, campo rate): withdraw(x) se detiene con limit is 500 por encima de 500 y, de lo contrario, llama a callSuper(x); month_end() añade intereses, balance * rate, en lugar de la tarifa; describe() añade (savings) con callSuper().

Usa call. = FALSE. Ambas definiciones están envueltas en suppressMessages(). El código proporcionado lee savings ada 0.1 o account bo, después dep 100, wd 30 o month, e imprime describe() o refused: y el mensaje después de cada uno.

Tu código va en Account.R y Savings.R. main.R contiene el código proporcionado de entrada/salida y no se puede editar.

Pruébalo tú mismo

source("Account.R")
source("Savings.R")

# Código de entrada/salida suministrado: déjalo como está
input <- suppressWarnings(readLines(file("stdin")))
p <- strsplit(input[1], " ")[[1]]
acc <- if (p[1] == "savings") Savings$new(owner = p[2], rate = as.numeric(p[3])) else Account$new(owner = p[2])
for (line in input[-1]) {
  q <- strsplit(line, " ")[[1]]
  msg <- tryCatch({
    if (q[1] == "dep") acc$deposit(as.numeric(q[2]))
    if (q[1] == "wd") acc$withdraw(as.numeric(q[2]))
    if (q[1] == "month") acc$month_end()
    acc$describe()
  }, error = function(e) paste("refused:", conditionMessage(e)))
  cat(line, ": ", msg, "\n", sep = "")
}