setValidity und validObject

Teil des Abschnitts Objektorientierte Programmierung der R-Journey von Coddy. Lektion 30 von 57.

setValidity("Class", function(object) ...) fügt die Gültigkeitsregel hinzu, nachdem die Klasse deklariert wurde, wodurch ein langer Aufruf von setClass() kurz bleibt. Wie setGeneric() gibt die Funktion einen Wert zurück, der auf der obersten Ebene ausgegeben wird; deshalb solltest du sie in invisible() einschließen:

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)

Ausgabe:

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

Änderungen sollten über Methoden vorgenommen werden, die das Ergebnis prüfen. Eine Methode withdraw() ändert den Slot, ruft validObject() auf und gibt das Objekt nur zurück, wenn es weiterhin gültig ist:

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)

Ausgabe:

refused 30

Ein Zugriffspaar kann aus Generics bestehen: balance(x) liest, und ein ersetzendes Generic "balance<-" schreibt. Seine Methode überprüft das Objekt, daher wird balance(a) <- -5 wie jede andere ungültige Änderung abgelehnt:

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)

Ausgabe:

25 refused

validObject(x, test = TRUE) bricht nicht ab. Für ein gültiges Objekt gibt es TRUE zurück, andernfalls den Problemtext, was für einen Bericht praktisch ist:

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))

Ausgabe:

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

Aufgabe

Einfach

Die Klasse Account in Account.R verfügt über die Slots owner und balance. Vervollständige die Datei:

füge eine Regel mit setValidity() (eingeschlossen in invisible()) hinzu, die owner must not be empty oder balance must not be negative zurückgibt;
erstelle die Generics deposit(acc, amount) und withdraw(acc, amount) sowie deren Account-Methoden: deposit bricht bei Beträgen von 0 oder weniger mit amount must be positive ab (verwende call. = FALSE); beide ändern den Kontostand, rufen validObject() auf und geben das Konto zurück;
füge eine show()-Methode hinzu, die ada: 50 und eine neue Zeile ausgibt.

Der bereitgestellte Code liest den Besitzer und anschließend Zeilen wie dep 50 oder wd 20 ein und gibt das Konto nach jeder Änderung oder refused: sowie das Problem aus.

Dein Code gehört in Account.R. main.R enthält den bereitgestellten Eingabe-/Ausgabecode und darf nicht bearbeitet werden.

Probier es selbst

source("Account.R")

# Gelieferter Ein-/Ausgabe-Code: belasse ihn wie er ist
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
    })
  }
}