תבנית Factory

חלק מהיחידה תכנות מונחה עצמים במסלול ה-R של Coddy. שיעור 43 מתוך 57.

מפעל הוא פונקציה שיוצרת אובייקטים, כך שהקוד הקורא לה לא צריך לדעת מה המחלקה או הבנאי שלה. היא מקבלת תיאור, כגון שם של סוג, ומחזירה את האובייקט המתאים:

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

פלט:

circle 12.57 
square 4

עבור סוג שאינו מוכר לה, switch() מחזירה NULL. במקום זאת, מפעל צריך לעצור ולהציג הודעה שמציינת את הסוג, כדי שהטעות תתגלה במקום שבו נעשתה:

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)

פלט:

unknown shape: hexagon

מרשם שומר את הבנאים ברשימה בעלת שמות, כך שמפעל היצירה עצמו לעולם אינו משתנה. כאן המרשם הוא סביבה, ו־register_shape() מוסיפה סוג חדש בזמן שהתוכנית פועלת:

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

פלט:

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

קוד שמשתמש באובייקטים תלוי רק בגנריות, כמו area(). מחלקה חדשה שנרשמה ויש לה מתודת area() פועלת עם הקוד הזה ללא כל שינוי בו:

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

פלט:

[1] 10

אתגר

קל

אפשר לייצא רשומה בכמה פורמטים. Exporters.R מכיל את export(exporter, record) הכללית ואת המתודה עבור csv_exporter, שמחזירה את הערכים כשהם מחוברים בפסיקים. השלימו שם את שתי המתודות האחרות:

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

לאחר מכן כתבו את מפעל היצירה make_exporter(format) ב-Factory.R: הערכים csv, json או text מחזירים רשימה ריקה עם המחלקה csv_exporter, json_exporter או text_exporter, וכל פורמט אחר עוצר עם unknown format: xml (השתמשו ב-call. = FALSE). הקוד שסופק קורא את שמות השדות ואת הערכים, ולאחר מכן את שמות הפורמטים, ומדפיס כל ייצוא או את error: ואת הודעת השגיאה.

יש לכתוב את הקוד שלכם ב-Exporters.R וב-Factory.R. הקובץ main.R מכיל את קוד הקלט/פלט שסופק, ואי אפשר לערוך אותו.

נסו בעצמכם

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

# קוד הקלט/פלט שסופק: יש להשאיר אותו כפי שהוא
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 = "")
}