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

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

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

今回は Composite パターンです。

入れ物と要素を同一のものとみなし、同様のインターフェースで再帰的に処理できるようなパターンとのことです。

再帰的な構造といえばLISPではリストが代表格かと思いますが、今回は容器(sequence/string除く)と要素(atom)の両方に対して適用できるメソッドを定義して、ちょっとした応用として sequence 全般(といってもlistとvectorですが)に適用できるflattenを作成してみました。

今回のコードでは、結果の型が一番最後に処理した型になってしまいますが、とりあえず良しとします。型の指定も工夫できると思います。

ということで、クラスはビルトインのものを利用しているのみで自前で定義していません。sequence より一般的なクラスを定義しても良いかと思います。

;;; sequence(容器)と要素(atom)の両方に対して適用できるメソッドを定義
(defgeneric empty? (obj))
(defgeneric concat (obj1 obj2))
(defgeneric container? (obj)
  (:method (obj) nil))
(defgeneric head (obj))
(defgeneric tail (obj))
(defgeneric construct (elt obj))

;;; flatten を作ってみる
(defgeneric generic-flatten (obj)
  (:method (obj)
    (cond ((empty? obj) obj)
          ((not (container? obj)) obj)
          ((container? (head obj))
           (concat (generic-flatten (head obj))
                   (generic-flatten (tail obj))))
          ('T (construct (head obj)
                         (generic-flatten (tail obj)))))))

;; sequence 全般
(defmethod empty? ((obj sequence))
  (zerop (length obj)))
(defmethod concat ((sequence1 sequence) (sequence2 sequence))
  (let ((type (class-of sequence1)))
    (concatenate type sequence1 sequence2)))
(defmethod container? ((obj sequence))
  (and (typep obj 'sequence) (not (stringp obj))))
(defmethod head ((obj sequence))
  (elt obj 0))
(defmethod tail ((obj sequence))
  (subseq obj 1))
(defmethod construct (elt (obj sequence))
  (let ((type (class-of obj)))
    (concatenate type 
                 (make-sequence type 1 :initial-element elt)
                 obj)))

;; list に特定化
(defmethod empty? ((obj list))
  (null obj))
(defmethod concat ((list1 list) (list2 list))
  (append list1 list2))
(defmethod container? ((obj list))
  (listp obj))
(defmethod head ((obj list))
  (car obj))
(defmethod tail ((obj list))
  (cdr obj))
(defmethod construct (elt (obj list))
  (cons elt obj))

;; vector にちょっと特定化
(defmethod head ((obj vector))
  (aref obj 0))

;;; 動作
(generic-flatten '(5 (6 7 8 9) 10))
;=> #(5 6 7 8 9 10)
(generic-flatten #(5 #(6 7 8 9) 10))
;=> (1 2 3 4)
(generic-flatten '(1 2 3 4))
;=> #(1 2 3 4 5 6 7 8 9 10)
(generic-flatten '(1 2 3 4 (5 #(6 7 8 9) 10)))
;=> (1 2 3 4 5 6 7 8 9 10)
(generic-flatten #(1 2 3 4 #(5 (6 7 8 9) 10)))
;=> (1 2 3 4 5 6 7 8 9 10)
(generic-flatten #(1 2 3 4 (5 "6 7 8 9" 10)))
;=> (1 2 3 4 5 "6 7 8 9" 10)

ゲスト



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