SICP 読み (104) 3.3.1 可変リスト構造

引き続き問題 3.18 以降を。

問題 3.18

cdr をメモしながら car と比較すれば良い、と (順番逆)。ただ、この手法では件数が多い場合に使うスペースが元のリストと同じ量になる。とりあえず試験を以下に。

#!/usr/bin/env gosh

(use test.unit)
(require "3.18")

(define-test-suite "3.18"

  ("default test"
   ("normal list"
    (let ((l (list 'a 'b 'c)))
      (assert-false (check-cycle l))
      )
    )

   ("detection of looped list"
    (let ((l (make-cycle (list 'a 'b 'c))))
      (assert-true (check-cycle l))
      )
    )
   )
)

で、3.17 みたく car なソレは相手にしなくて良い、と。ループの要件としては、cdr が指してるセルが元に戻っている、という形のハズ。最初の一発目の処理が云々、などと言っている内にさくっと出来上がった。
最初、check-cycle 手続きが戻す値を逆にする、というボケをカマしてましたが、本当にちゃんと動いてるんだろうか、途中でループするソレも作っておこう。

って、cdr が、ってコトは途中でループなんてあり得んコトに今さら気づく (を

とりあえず以下に実装を。

(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)

(define (check-cycle l)
  (define (search l m)
    (cond ((null? m) #t)
	  ((eq? l (car m)) #f)
	  (else
	   (search l (cdr m)))))

  (define (end-of-l l)
    (if (null? (cdr l))
	l
	(end-of-l (cdr l))))

  (let f ((l (cdr l)) (m (cons l '())))
    (cond ((null? l) #f)
	  ((search l m)
	   (set-cdr! (end-of-l m) (cons l '()))
	   (f (cdr l) m))
	  (else
	   #t)))
  )

なんかすごいさくっとデキちゃって逆に不安。先頭ではなくって途中に戻るような循環は記述可能だな。試験に追加。

  ("cycle at midflow"
   ("cycle at midflow"
    (let ((l (list 'a 'b 'c 'd 'e)))
      (set-cdr! (cdr (cdr (cdr (cdr l)))) (cdr (cdr l)))
      (assert-true (check-cycle l)))
    )
   )

う。微妙。一応パスはしてます。

問題 3.19

これは聞いたコトあるソレなので略したいな。確か、ポインタを 1 増分、2 増分なパースで末端に行くまでに同じ場所を指してたらループ認定、だったような。
試験はそのままで良いハズなんで実装の検討なんですが、cons なセルで (以下略

で、以下のような実装をでっち上げたんですが、動かず。

(define (check-cycle l)
  (let f ((check (cons (car l) (cdr l))))
    (cond ((null? (cdr check)) #f)
	  ((eq? (car check) (cdr check)) #t)
	  (else
	   (f (cons (cdr (car check)) (cdr (cdr (cdr check))))))))
  )

よく見りゃ、cons してるし。

で、以下のように修正。

(define (check-cycle l)
  (define (reset-cons l left right)
    (set-car! l left)
    (set-cdr! l right)
    )

  (let ((check (cons '() '())))
    (reset-cons check l (cdr l))
    (let f ((check check))
      (cond ((null? (cdr check)) #f)
	    ((null? (cdr (cdr check))) #f)
	    ((eq? (car check) (cdr check)) #t)
	    (else
	     (reset-cons check (cdr (car check)) (cdr (cdr (cdr check))))
	     (f check)))))
  )

しかし未だに段差がない S 式の羅列に目が慣れん。void な手続きとゆーのも微妙。