Fabrikmuster

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

Eine Factory ist eine Funktion, die Objekte erstellt, sodass der Aufrufer die Klasse oder ihren Konstruktor nicht kennen muss. Sie nimmt eine Beschreibung, beispielsweise einen Typnamen, entgegen und gibt das richtige Objekt zurück:

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

Ausgabe:

circle 12.57 
square 4

Für einen Typ, den es nicht kennt, gibt switch() NULL zurück. Eine Factory sollte stattdessen mit einer Meldung abbrechen, die den Typ nennt, damit der Fehler dort sichtbar wird, wo er gemacht wurde:

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)

Ausgabe:

unknown shape: hexagon

Eine Registry bewahrt die Konstruktoren in einer benannten Liste auf, sodass sich die Factory selbst niemals ändert. Hier ist die Registry eine Umgebung, und register_shape() fügt eine neue Variante hinzu, während das Programm läuft:

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

Ausgabe:

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

Code, der die Objekte verwendet, hängt nur von den Generika wie area() ab. Eine neue Klasse, die registriert wird und über eine area()-Methode verfügt, funktioniert mit diesem Code ohne jegliche Änderung daran:

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

Ausgabe:

[1] 10

Aufgabe

Einfach

Ein Datensatz kann in mehreren Formaten exportiert werden. Exporters.R enthält den generischen export(exporter, record) und die Methode für csv_exporter, die die durch Kommas verbundenen Werte zurückgibt. Vervollständige dort die beiden anderen Methoden:

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

Schreibe dann die Factory make_exporter(format) in Factory.R: csv, json oder text liefern eine leere Liste mit der Klasse csv_exporter, json_exporter oder text_exporter, und jedes andere Format bricht mit unknown format: xml ab (verwende call. = FALSE). Der bereitgestellte Code liest die Feldnamen und die Werte, anschließend die Formatnamen, und gibt jeden Export oder error: sowie die Meldung aus.

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

Probier es selbst

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

# Bereitgestellter Ein-/Ausgabecode: belasse ihn wie er ist
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 = "")
}