setValidity i validObject

Część sekcji Programowanie obiektowe ścieżki R w Coddy. Lekcja 30 z 57.

setValidity("Class", function(object) ...) dodaje regułę poprawności po zadeklarowaniu klasy, dzięki czemu długie wywołanie setClass() pozostaje krótkie. Podobnie jak setGeneric(), zwraca wartość, która jest wyświetlana na najwyższym poziomie, więc opakuj je w 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)

Wynik:

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

Zmiany powinny odbywać się za pośrednictwem metod, które sprawdzają wynik. Metoda withdraw() zmienia slot, wywołuje validObject() i zwraca obiekt tylko wtedy, gdy nadal jest prawidłowy:

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)

Wynik:

refused 30

Para akcesorów może składać się z metod generycznych: balance(x) odczytuje wartość, a generyczna funkcja zastępująca "balance<-" ją zapisuje. Jej metoda sprawdza obiekt, więc balance(a) <- -5 zostaje odrzucone, podobnie jak każda inna nieprawidłowa zmiana:

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)

Wynik:

25 refused

validObject(x, test = TRUE) nie przerywa działania. Zwraca TRUE dla prawidłowego obiektu albo tekst opisujący problem, co przydaje się w raporcie:

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

Wynik:

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

Wyzwanie

Łatwy

Klasa Account w pliku Account.R ma sloty owner i balance. Uzupełnij plik:

dodaj regułę za pomocą setValidity() (opakowaną w invisible()), która zwraca owner must not be empty lub balance must not be negative;
utwórz generyki deposit(acc, amount) i withdraw(acc, amount) oraz ich metody dla Account: deposit zgłasza błąd z komunikatem amount must be positive (użyj call. = FALSE) dla kwot równych 0 lub mniejszych; obie metody zmieniają saldo, wywołują validObject() i zwracają konto;
dodaj metodę show(), która wyświetla ada: 50 i znak nowej linii.

Dostarczony kod odczytuje właściciela, a następnie wiersze dep 50 lub wd 20, po czym wyświetla konto po każdej zmianie albo refused: i opis problemu.

Umieść swój kod w pliku Account.R. Plik main.R zawiera dostarczony kod wejścia/wyjścia i nie można go edytować.

Spróbuj swoich sił

source("Account.R")

# Dostarczony kod wejścia/wyjścia: pozostaw go bez zmian
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
    })
  }
}