2011/05/25

consでqueue

仕事のコードレビュー(?)でtlistを見た。(どんな職場だ)(良い職場だ)
どこかで見たと思ったらLOLPAIPだった。LOLのtlistは基本的にはSICPのqueueと同じもので、PAIPにも同様のもの(tconc)とその改良版としてのqueueが掲載されていた。
まずは、LOLのtlist(基本的にSICPのqueueと同じもの)と、PAIPのtconc。
;; car : キューの内容へのポインタ
;; cdr : 最後のconsへのポインタ

(define (make-queue)
  (cons '() '()))

;; PAIP P.322 ~
(define (tconc item q)
  (set! (cdr q)
        (let ((v (cons item '())))
          (if (null? (cdr q))
              (set! (car q) v)
              (set! (cddr q) v))
          v))
  q)


;; LOL P.213 ~
;; SICP P.153 ~
(define (tlist-push! tl elm)
  (let ((x (cons elm '())))
    (if (null? (car tl))
        (set! (car tl) x)
        (set! (cddr tl) x))
    (set! (cdr tl) x)
    tl))

PAIP P.322 ~
tconcの実装には欠点がある。最初の要素をキューへ追加する場合と、次の要素を追加する場合で処理が異なるので、取るべきアクションを決定するために、if文を使用する必要があることである。下記に示したキューの定義では、賢明な技法を使用して欠点を回避している。最初に、2つのフィールドの順序が反転されている。consセルのcarが最後の要素で、cdrがキューの内容である。2番目に、空のキューは、cdr(キューの内容)はnilで、car(最後の要素)はcons自身である。

PAIPの改良版queue。以前gauche書いていたものを再掲。
;; PAIP P.322 ~
;; car : 最後のconsへのポインタ
;; cdr : キューの内容へのポインタ

(define (queue-contents q)
  (cdr q))

(define (make-queue)
  (rlet1 q (cons '() '())
         (set! (car q) q)))

(define (enqueue item q)
  (set! (car q)
        (rlet1 f (cons item '())
               (set! (cdr (car q)) f)))
  q)

(define (dequeue q)
  (pop! (cdr q))
  (when (null? (cdr q))
    (set! (car q) q))
  q)

(define (front q)
  (car (queue-contents q)))

(define (empty-queue? q)
  (null? (queue-contents q)))
(define (queue-append! q ls)
  (set! (cdr (car q)) ls)
  (set! (car q)
        (last-pair q))
  q)
実用 Common Lisp (IT Architects’Archive CLASSIC MODER)

0 件のコメント:

コメントを投稿