setValidity et validObject

Fait partie de la section Programmation orientée objet du Journey R de Coddy. Leçon 30 sur 57.

setValidity("Class", function(object) ...) ajoute la règle de validité après la déclaration de la classe, ce qui permet de garder un appel setClass() long et concis. Comme setGeneric(), il renvoie une valeur qui est affichée au niveau supérieur ; enveloppez-le donc dans 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)

Sortie :

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

Les modifications doivent passer par des méthodes qui vérifient le résultat. Une méthode withdraw() modifie le slot, appelle validObject() et ne renvoie l’objet que lorsqu’il est toujours valide :

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)

Sortie :

refused 30

Une paire d’accesseurs peut être constituée de génériques : balance(x) lit et un générique de remplacement "balance<-" écrit. Sa méthode vérifie l’objet, donc balance(a) <- -5 est refusé comme toute autre modification incorrecte :

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)

Résultat :

25 refused

validObject(x, test = TRUE) ne s’arrête pas. Elle renvoie TRUE pour un objet valide, ou le texte du problème, ce qui est pratique pour un rapport :

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

Sortie :

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

Défi

Facile

La classe Account dans Account.R possède les emplacements owner et balance. Complétez le fichier :

ajoutez une règle avec setValidity() (encapsulée dans invisible()) qui renvoie owner must not be empty ou balance must not be negative ;
créez les génériques deposit(acc, amount) et withdraw(acc, amount) ainsi que leurs méthodes Account : deposit s'arrête avec amount must be positive (utilisez call. = FALSE) pour les montants inférieurs ou égaux à 0 ; les deux modifient le solde, appellent validObject() et renvoient le compte ;
ajoutez une méthode show() qui affiche ada: 50 et une nouvelle ligne.

Le code fourni lit le propriétaire, puis les lignes dep 50 ou wd 20, et affiche le compte après chaque modification ou refused: suivi du problème.

Votre code doit être placé dans Account.R. main.R contient le code d'entrée/sortie fourni et ne peut pas être modifié.

Essayez vous-même

source("Account.R")

# Code d'entrée/sortie fourni : le garder tel quel
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
    })
  }
}