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

CLとデザインパターン - Builder

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

今回はBuilderパターンです。

自分はデザインパターンにはTemplate Methodが変化したものが多いような気がして来たのですが、今回のBuilderもそんな感じに思えました。

お題としては、7. Builder パターン | TECHSCORE(テックスコア)の食塩水を作成する例をCLで再現。

Norvig氏のDesign Patterns in Dynamic Programmingでは、Builderは、マルチメソッドがあれば、Directorか、Builderのどっちかは不要だろう、ということなのですが、確かにマルチメソッドだと引数それぞれでディスパッチでき、切り換えたい項目をそのまま引数の項目として表現できるので、Builerパターンを意識することもあまりないのかもしれません。

(defclass saltwater ()
  ((salt :initform 0 :initarg :salt :accessor saltwater.salt) 
   (water :initform 0 :initarg :water :accessor saltwater.water)))

(defclass builder () ())

(defgeneric add-solute (builer soulte-amount))
(defgeneric add-solvent (builder solvent-amount))
(defgeneric abandon-solution (builder solution-amount))
(defgeneric get-result (builder))

(defclass director () 
  ((builder :initarg :builder)))

(defgeneric construct (director)
  (:method ((dir director))
    (with-slots (builder) dir
      (add-solvent builder 100)         ;溶媒を100加える
      (add-solute builder 40)           ;溶質40を加える
      (abandon-solution builder 70)     ;70捨てる
      (add-solvent builder 100)         ;溶媒を100加える
      (add-solute builder 15))))        ;溶質を15加える

(defclass saltwater-builder (builder) 
  ((saltwater :initform (make-instance 'saltwater :water 0 :salt 0)
              :accessor saltwater)))

(defmethod add-solute ((builder saltwater-builder) (salt-amount number))
  (incf (saltwater.salt (saltwater builder)) salt-amount))

(defmethod add-solvent ((builder saltwater-builder) (water-amount number))
  (incf (saltwater.water (saltwater builder)) water-amount))

(defmethod abandon-solution ((builder saltwater-builder) (saltwater-amount number))
  (with-accessors ((w saltwater.water)
                   (s saltwater.salt)) (saltwater builder)
    (setq s (float (* s (- 1 (/ saltwater-amount (+ w s)))))
          w (float (* w (- 1 (/ saltwater-amount (+ w s))))))
    builder))

(defmethod get-result ((builder saltwater-builder))
  (saltwater builder))

(let* ((b (make-instance 'saltwater-builder))
       (dir (make-instance 'director :builder b)))
  (construct dir)
  (describe (get-result b)))
;-> #<SALTWATER {100B562B51}> is an instance of class #<STANDARD-CLASS SALTWATER>.
;   The following slots have :INSTANCE allocation:
;    SALT     35.0
;    WATER    141.66667

マルチメソッド版

(defclass saltwater ()
  ((salt :initform 0 :initarg :salt :accessor saltwater.salt) 
   (water :initform 0 :initarg :water :accessor saltwater.water)))

(defclass builder () ())

(defgeneric add-solute (builer soulte-amount))
(defgeneric add-solvent (builder solvent-amount))
(defgeneric abandon-solution (builder solution-amount))
(defgeneric get-result (builder))

(defclass job-flow () ())

(defgeneric construct-mm (job-flow builder))
(defmethod construct-mm ((jf job-flow) (builder saltwater-builder))
  (add-solvent builder 100)             ;溶媒を100加える
  (add-solute builder 40)               ;溶質40を加える
  (abandon-solution builder 70)         ;70捨てる
  (add-solvent builder 100)             ;溶媒を100加える
  (add-solute builder 15))              ;溶質を15加える

(defclass saltwater-builder (builder) 
  ((saltwater :initform (make-instance 'saltwater :water 0 :salt 0)
              :accessor saltwater)))

(defmethod add-solute ((builder saltwater-builder) (salt-amount number))
  (incf (saltwater.salt (saltwater builder)) salt-amount))

(defmethod add-solvent ((builder saltwater-builder) (water-amount number))
  (incf (saltwater.water (saltwater builder)) water-amount))

(defmethod abandon-solution ((builder saltwater-builder) (saltwater-amount number))
  (with-accessors ((w saltwater.water)
                   (s saltwater.salt)) (saltwater builder)
    (setq s (float (* s (- 1 (/ saltwater-amount (+ w s)))))
          w (float (* w (- 1 (/ saltwater-amount (+ w s))))))
    builder))

(defmethod get-result ((builder saltwater-builder))
  (saltwater builder))

;; 実行
(let* ((b (make-instance 'saltwater-builder))
       (jf (make-instance 'director)))
  (construct-mm jf b)
  (describe (get-result b)))
;-> #<SALTWATER {100B562B51}> is an instance of class #<STANDARD-CLASS SALTWATER>.
;   The following slots have :INSTANCE allocation:
;    SALT     35.0
;    WATER    141.66667