setValidity e validObject

Fa parte della sezione Programmazione orientata agli oggetti del percorso R di Coddy. Lezione 30 di 57.

setValidity("Class", function(object) ...) aggiunge la regola di validità dopo la dichiarazione della classe, mantenendo breve una chiamata lunga a setClass(). Come setGeneric(), restituisce un valore che viene stampato al livello superiore, quindi racchiudilo in invisible():

setClass("Account", slots = c(owner = "character", balance = "numeric"))
invisible(setValidity("Account", function(object) {
  if (object@balance < 0) return("balance must not be negative")
  TRUE
}))
msg <- tryCatch(new("Account", owner = "Ada", balance = -1), error = function(e) conditionMessage(e))
cat(msg)

Output:

invalid class “Account” object: balance must not be negative

Le modifiche dovrebbero passare attraverso metodi che controllano il risultato. Un metodo withdraw() modifica lo slot, chiama validObject() e restituisce l'oggetto solo quando è ancora valido:

setClass("Account", slots = c(balance = "numeric"))
invisible(setValidity("Account", function(object) {
  if (object@balance < 0) "balance must not be negative" else TRUE
}))
invisible(setGeneric("withdraw", function(acc, amount) standardGeneric("withdraw")))
setMethod("withdraw", "Account", function(acc, amount) {
  acc@balance <- acc@balance - amount
  validObject(acc)
  acc
})
a <- new("Account", balance = 50)
a <- withdraw(a, 20)
msg <- tryCatch({ a <- withdraw(a, 100); "done" }, error = function(e) "refused")
cat(msg, a@balance)

Output:

refused 30

Una coppia di metodi di accesso può essere composta da generici: balance(x) legge e un generico di sostituzione "balance<-" scrive. Il suo metodo controlla l’oggetto, quindi balance(a) <- -5 viene rifiutato come qualsiasi altra modifica non valida:

setClass("Account", slots = c(balance = "numeric"),
  validity = function(object) if (object@balance < 0) "balance must not be negative" else TRUE)
invisible(setGeneric("balance", function(x) standardGeneric("balance")))
invisible(setGeneric("balance<-", function(x, value) standardGeneric("balance<-")))
setMethod("balance", "Account", function(x) x@balance)
setMethod("balance<-", "Account", function(x, value) {
  x@balance <- value
  validObject(x)
  x
})
a <- new("Account", balance = 10)
balance(a) <- 25
msg <- tryCatch({ balance(a) <- -5; "changed" }, error = function(e) "refused")
cat(balance(a), msg)

Output:

25 refused

validObject(x, test = TRUE) non si interrompe. Restituisce TRUE per un oggetto valido oppure il testo del problema, utile per un report:

setClass("Box", slots = c(w = "numeric"),
  validity = function(object) if (object@w <= 0) "w must be positive" else TRUE)
b <- new("Box", w = 2)
print(validObject(b, test = TRUE))
b@w <- 0
print(validObject(b, test = TRUE))

Output:

[1] TRUE
[1] "w must be positive"

Sfida

Facile

La classe Account in Account.R ha gli slot owner e balance. Completa il file:

aggiungi una regola con setValidity() (racchiusa in invisible()) che restituisca owner must not be empty oppure balance must not be negative;
crea i generici deposit(acc, amount) e withdraw(acc, amount) e i relativi metodi per Account: deposit si interrompe con amount must be positive (usa call. = FALSE) per importi pari o inferiori a 0; entrambi modificano il saldo, chiamano validObject() e restituiscono il conto;
aggiungi un metodo show() che stampa ada: 50 e va a capo.

Il codice fornito legge il proprietario, poi le righe dep 50 o wd 20, e stampa il conto dopo ogni modifica oppure refused: e il problema.

Il tuo codice va in Account.R. main.R contiene il codice di input/output fornito e non può essere modificato.

Provalo tu

source("Account.R")

# Codice di input/output fornito: lascialo così com'è
input <- suppressWarnings(readLines(file("stdin")))
acc <- tryCatch(new("Account", owner = input[1], balance = 0),
                error = function(e) { cat("error: ", sub(".*object: ", "", conditionMessage(e)), "\n", sep = ""); NULL })
if (!is.null(acc)) {
  for (line in input[-1]) {
    p <- strsplit(line, " ")[[1]]
    amount <- as.numeric(p[2])
    acc <- tryCatch({
      changed <- if (p[1] == "dep") deposit(acc, amount) else withdraw(acc, amount)
      print(changed)
      changed
    }, error = function(e) {
      cat("refused: ", sub(".*object: ", "", conditionMessage(e)), "\n", sep = "")
      acc
    })
  }
}