Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2008-12-08

CLとデザインパターン - Abstract Factory

| 22:30 | CLとデザインパターン - Abstract Factory - わだばLisperになる を含むブックマーク はてなブックマーク - CLとデザインパターン - Abstract Factory - わだばLisperになる

今回はAbstract Factoryパターンです。

お題としては、今回も8. AbstractFactory パターン | TECHSCORE(テックスコア)の鍋を作る例をCLで再現。

Norvig氏のDesign Patterns in Dynamic Programmingでは、Abstract Factoryはファーストクラスのクラスがあると容易に実現できるような事を書いていますが、確かにクラスをそのまま渡すことができれば簡単な気がします。

今回は、クラスをファーストクラス扱いしないお題をそのまま写したmainと、クラスを渡したmain2と、インスタンスの生成にフックを掛けてみたパターンを作成してみました。

Factory Methodの時にも思ったのですが、インスタンスの生成に関係するパターンは、ずばりmake-instanceに細工をする方がCLOS的なのかもしれません。

;; 鍋
(defclass hotpot ()
  ((pot :initform () :accessor hotpot.pot)
   (soup :initform () :accessor hotpot.soup)
   (protein :initform () :accessor hotpot.main)
   (vegetables :initform ()  :accessor hotpot.vegetables)
   (other-ingredients :initform () :accessor hotpot.other-ingredients)))

;; factory
(defclass factory () ())
(defgeneric get-soup (factory))
(defgeneric get-main (factory))
(defgeneric get-vegetables (factory))
(defgeneric get-other-ingredients (factory))

;; factoryそれぞれ
(progn
  ;; 水炊き
  (defclass mizutaki-factory (factory) ())
  (defmethod get-soup ((fact mizutaki-factory)) 
    "鳥ガラスープ")
  (defmethod get-main ((fact mizutaki-factory)) 
    "鶏肉")
  (defmethod get-vegetables ((fact mizutaki-factory)) 
    (list "白菜" "長ネギ" "春菊"))
  (defmethod get-other-ingredients ((fact mizutaki-factory))
    (list "その他")))

(progn
  ;; キムチ鍋
  (defclass kimuchi-factory (factory) ())
  (defmethod get-soup ((fact kimuchi-factory))
    "鳥ガラスープ")
  (defmethod get-main ((fact kimuchi-factory))
    "鶏肉")
  (defmethod get-vegetables ((fact kimuchi-factory))
    (list "白菜" "長ネギ"))
  (defmethod get-other-ingredients ((fact kimuchi-factory))
    (list "キムチ")))

(progn
  ;; すき焼き
  (defclass sukiyaki-factory (factory) ())
  (defmethod get-soup ((fact sukiyaki-factory))
    "昆布だし")
  (defmethod get-main ((fact sukiyaki-factory))
    "牛肉")
  (defmethod get-vegetables ((fact sukiyaki-factory))
    (list "白菜"))
  (defmethod get-other-ingredients ((fact sukiyaki-factory))
    (list  "豆腐" "しらたき")))

(defun create-factory (name)
  (case name
    (kimuchi (make-instance 'kimuchi-factory))
    (sukiyaki (make-instance 'sukiyaki-factory))
    (otherwise (make-instance 'mizutaki-factory))))

;; 鍋をつくるメイン
(defun main (arg)
  (let ((hotpot (make-instance 'hotpot))
        (factory (create-factory arg)))
    (with-accessors ((soup hotpot.soup)
                     (main hotpot.main)
                     (vegetables hotpot.vegetables)
                     (other-ingredients hotpot.other-ingredients)) hotpot
      (setf soup (get-soup factory)
            main (get-main factory)
            vegetables (get-vegetables factory)
            other-ingredients (get-other-ingredients factory))
      hotpot)))

;; 実行
(describe (main 'nil))
;; Instance: #<HOTPOT {400723BA12}>
;; Class: #<STANDARD-CLASS HOTPOT {4002421AD2}>
;;  The following slots have :instance allocation:
;;   POT                 NIL
;;   SOUP                "鳥ガラスープ"
;;   PROTEIN             "鶏肉"
;;   VEGETABLES          ("白菜" "長ネギ" "春菊")
;;   OTHER-INGREDIENTS   ("その他")

(describe (main 'sukiyaki))
;; Instance: #<HOTPOT {4007332A12}>
;; Class: #<STANDARD-CLASS HOTPOT {4002421AD2}>
;;  The following slots have :instance allocation:
;;   POT                 NIL
;;   SOUP                "昆布だし"
;;   PROTEIN             "牛肉"
;;   VEGETABLES          ("白菜")
;;   OTHER-INGREDIENTS   ("豆腐" "しらたき")

クラスはファーストクラスなので、直に渡してみました版

(defun main2 (type)
  (let ((hotpot (make-instance 'hotpot))
        (factory (make-instance type)))
    (with-accessors ((soup hotpot.soup)
                     (main hotpot.main)
                     (vegetables hotpot.vegetables)
                     (other-ingredients hotpot.other-ingredients)) hotpot
      (setf soup (get-soup factory)
            main (get-main factory)
            vegetables (get-vegetables factory)
            other-ingredients (get-other-ingredients factory))
      hotpot)))

;; 実行
(describe (main2 'sukiyaki-factory))
;; Instance: #<HOTPOT {40077B7A12}>
;; Class: #<STANDARD-CLASS HOTPOT {4002421AD2}>
;;  The following slots have :instance allocation:
;;   POT                 NIL
;;   SOUP                "昆布だし"
;;   PROTEIN             "牛肉"
;;   VEGETABLES          ("白菜")
;;   OTHER-INGREDIENTS   ("豆腐" "しらたき")

インスタンスを作成するときにfactoryも指定できるのでは版

(defclass hotpot2 ()  ; hotpotと全く同じ
  ((pot :initform ()  :accessor hotpot.pot)
   (soup :initform () :accessor hotpot.soup)
   (protein :initform () :accessor hotpot.main)
   (vegetables :initform ()  :accessor hotpot.vegetables)
   (other-ingredients :initform () :accessor hotpot.other-ingredients)))

(defmethod initialize-instance :after ((inst hotpot2) &key factory)
  (with-slots (pot soup (main protein) vegetables other-ingredients) inst
    (let ((factory (make-instance factory)))
      (setf soup (get-soup factory)
            main (get-main factory)
            vegetables (get-vegetables factory)
            other-ingredients (get-other-ingredients factory)))
    inst))

(describe (make-instance 'hotpot2 :factory 'kimuchi-factory))
;; Instance: #<HOTPOT2 {4006F90CF2}>
;; Class: #<STANDARD-CLASS HOTPOT2 {4002EA3DB2}>
;;  The following slots have :instance allocation:
;;   POT                 NIL
;;   SOUP                "鳥ガラスープ"
;;   PROTEIN             "鶏肉"
;;   VEGETABLES          ("白菜" "長ネギ")
;;   OTHER-INGREDIENTS   ("キムチ")

ゲスト



トラックバック - http://cadr.g.hatena.ne.jp/g000001/20081208