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-11-06

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

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

Norvig氏もGreg Sullivan氏のGOF Design Patterns in a Dynamic OO Languageでもファースト・クラスの関数は、Strategyパターンより応用がきく、というようなことを書いてますが、関数がファースト・クラスでない場合にはStrategyパターンで対処することになるのでしょう。

ということで、LISP系言語のsort関数は比較関数を動作にとって動作を変えるのが極普通ですが、関数を直接引数に取らない縛りでqsortを書いてみました。

昇順と、降順の2つがそれぞれ戦略になります。もちろんqsort総称関数以外の戦略も追加すれば可能です。

感想としては、これもStateや、Template-Method等に似てるなあという感じですが、ずばりファースト・クラスの関数があればあまり使うこともないパターンかなとも思えました。

(defpackage :design-patterns (:use :cl))
(in-package :design-patterns)

(defclass gt () ())
(defclass lt () ())
(defun make-strategy (strategy)
  (make-instance strategy))

(defgeneric qsort (class numlist)
  (:method (class numlist) () ))

(defmethod qsort ((strategy lt) lst)
  (if (null lst)
      ()
      (destructuring-bind (p &rest rest) lst
        `(,@(qsort strategy 
                   (remove-if-not (lambda (x) (> p x)) rest))
            ,p
            ,@(qsort strategy
                     (remove-if-not (lambda (x) (<= p x)) rest))))))

(defmethod qsort ((strategy gt) lst)
  (if (null lst)
      ()
      (destructuring-bind (p &rest rest) lst
        `(,@(qsort strategy 
                   (remove-if-not (lambda (x) (< p x)) rest))
            ,p
            ,@(qsort strategy
                     (remove-if-not (lambda (x) (>= p x)) rest))))))

;; 動作
(qsort (make-strategy 'lt)
       '(2 1 3 4 5 5 5 5 5 100 -1))
;=> (-1 1 2 3 4 5 5 5 5 5 100) 

(qsort (make-strategy 'gt)
       '(2 1 3 4 5 5 5 5 5 100 -1))
;=> (100 5 5 5 5 5 4 3 2 1 -1) 

;; ここまででも良さそうなもの


;; さらに動作の切り替え
(defclass qsorter ()
  ((strategy :accessor strategy :initarg :strategy)))

(defun make-qsorter (&key strategy)
  (make-instance 'qsorter :strategy strategy))

(defgeneric qsorter (qsorter list)
  (:method ((qsorter qsorter) list)
    (qsort (strategy qsorter) list)))

;; 動作
(let ((qs (make-qsorter :strategy (make-strategy 'gt))))
  ;; 降順
  (print (qsorter qs '(2 1 3 4 5 5 5 5 5 100 -1)))

  ;; 昇順に切り替え
  (setf (strategy qs) (make-strategy 'lt))
  (print (qsorter qs '(2 1 3 4 5 5 5 5 5 100 -1))))

;>>>
(100 5 5 5 5 5 4 3 2 1 -1) 
(-1 1 2 3 4 5 5 5 5 5 100) 

;; 比較:ファースト・クラスの関数の場合
(defun qsort++ (lst compfn)
  (if (null lst)
      ()
      (destructuring-bind (p &rest rest) lst
        (let ((comp (lambda (x) (funcall compfn p x))))
          `(,@(qsort++ (remove-if-not comp rest) compfn)
              ,p
              ,@(qsort++ (remove-if comp rest) compfn))))))


(let* ((comp #'>)
       (qs (lambda (data) (qsort++ data comp))))
  ;; 降順
  (print (funcall qs '(2 1 3 4 5 5 5 5 5 100 -1)))
  
  ;; 昇順に切り替え
  (setq comp #'<)
  (print (funcall qs '(2 1 3 4 5 5 5 5 5 100 -1))))

;>>>
(-1 1 2 3 4 5 5 5 5 5 100) 
(100 5 5 5 5 5 4 3 2 1 -1) 

ゲスト



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