Patron Fabrique

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

Une fabrique est une fonction qui crée des objets, de sorte que l’appelant n’a pas besoin de connaître la classe ni son constructeur. Elle reçoit une description, telle qu’un nom de type, et renvoie l’objet approprié :

area <- function(s) UseMethod("area")
area.circle <- function(s) pi * s$r^2
area.square <- function(s) s$side^2
make_shape <- function(type, size) {
  switch(type,
    circle = structure(list(r = size), class = "circle"),
    square = structure(list(side = size), class = "square"))
}
for (t in c("circle", "square")) cat(t, round(area(make_shape(t, 2)), 2), "\n")

Sortie :

circle 12.57 
square 4

Pour un type qu’elle ne connaît pas, switch() renvoie NULL. Une fabrique devrait plutôt s’arrêter avec un message qui nomme le type, afin que l’erreur apparaisse à l’endroit où elle a été commise :

make_shape <- function(type, size) {
  switch(type,
    circle = structure(list(r = size), class = "circle"),
    square = structure(list(side = size), class = "square"),
    stop("unknown shape: ", type, call. = FALSE))
}
msg <- tryCatch(make_shape("hexagon", 1), error = function(e) conditionMessage(e))
cat(msg)

Sortie :

unknown shape: hexagon

Un registre conserve les constructeurs dans une liste nommée, de sorte que la fabrique elle-même ne change jamais. Ici, le registre est un environnement, et register_shape() ajoute un nouveau type pendant l’exécution du programme :

registry <- new.env()
register_shape <- function(name, maker) assign(name, maker, envir = registry)
make_shape <- function(name, ...) {
  if (!exists(name, envir = registry, inherits = FALSE)) stop("unknown shape: ", name, call. = FALSE)
  get(name, envir = registry)(...)
}
register_shape("circle", function(r) structure(list(r = r), class = "circle"))
register_shape("rect", function(w, h) structure(list(w = w, h = h), class = "rect"))
print(class(make_shape("rect", 2, 3)))
print(sort(ls(registry)))

Sortie :

[1] "rect"
[1] "circle" "rect"

Le code qui utilise les objets ne dépend que des génériques, tels que area(). Une nouvelle classe qui est enregistrée et possède une méthode area() fonctionne avec ce code sans aucune modification :

registry <- new.env()
register_shape <- function(name, maker) assign(name, maker, envir = registry)
make_shape <- function(name, ...) get(name, envir = registry)(...)
area <- function(s) UseMethod("area")
total_area <- function(shapes) sum(vapply(shapes, area, numeric(1)))
register_shape("square", function(a) structure(list(a = a), class = "square"))
area.square <- function(s) s$a^2
register_shape("tri", function(b, h) structure(list(b = b, h = h), class = "tri"))
area.tri <- function(s) s$b * s$h / 2
print(total_area(list(make_shape("square", 2), make_shape("tri", 4, 3))))

Sortie :

[1] 10

Défi

Facile

Un enregistrement peut être exporté dans plusieurs formats. Exporters.R contient la fonction générique export(exporter, record) et la méthode pour csv_exporter, qui renvoie les valeurs séparées par des virgules. Complétez les deux autres méthodes à cet endroit :

json_exporter : {"name": "Ada", "age": "36"} ;
text_exporter : name=Ada; age=36.

Écrivez ensuite la fabrique make_exporter(format) dans Factory.R : csv, json ou text renvoient une liste vide avec la classe csv_exporter, json_exporter ou text_exporter, et tout autre format s’arrête avec unknown format: xml (utilisez call. = FALSE). Le code fourni lit les noms des champs et les valeurs, puis les noms des formats, et affiche chaque exportation ou error: suivi du message.

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

Essayez vous-même

source("Exporters.R")
source("Factory.R")

# Code d'entrée/sortie fourni : le garder tel quel
input <- suppressWarnings(readLines(file("stdin")))
fields <- strsplit(input[1], ",")[[1]]
values <- strsplit(input[2], ",")[[1]]
record <- setNames(values, fields)
for (fmt in input[-(1:2)]) {
  out <- tryCatch(export(make_exporter(fmt), record), error = function(e) paste("error:", conditionMessage(e)))
  cat(out, "\n", sep = "")
}