結城浩のSICP日記 RSSフィード

2006-05-14

[]p.152:循環検査 p.152:循環検査 - 結城浩のSICP日記 を含むブックマーク

ひげぽんさんが問題3.18近辺にチャレンジしているので、結城も考えた。

問題3.18: リストが循環しているかどうかを調べる関数を定義する。

結城の解答(cyclic?関数)

(define (cyclic? x)
  (define visited '())
  (let loop ((x x))
    (cond ((not (pair? x)) #f)
          ((memq x visited) #t)
          (else
            (set! visited (cons x visited))
            (loop (cdr x))))))

;以下、テスト。
(define (last-pair x)
  (if (null? (cdr x))
      x
      (last-pair (cdr x))))

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

(cyclic? 'a)
;=> #f

(cyclic? (list 'a 'b 'c))
;=> #f

(cyclic? (make-cycle (list 'a)))
;=> #t

(cyclic? (make-cycle (list 'a 'b)))
;=> #t

(cyclic? (make-cycle (list 'a 'b 'c)))
;=> #t

問題3.19: リストが循環しているかどうかを調べる関数を定義する。ただしメモリを食わない方法で。

結城の解答(cyclic?関数)

  • xとyの追っかけっこ。
  • xが先行。xが2歩進むとき、yは1歩進む。つまり差は1歩ずつ開いていく。
  • ループに入ったら、先行していたはずのxがyに1歩ずつ近づいていく。yが一周する前には必ずxが追いつく。
(define (cyclic? x)
  (define (loop? x y)
    (cond ((not (pair? x)) #f)
          ((eq? x y) #t)
          ((not (pair? (cdr x))) #f)
          (else
            (loop? (cddr x) (cdr y)))))
  (cond ((not (pair? x)) #f)
        (else
          (loop? (cdr x) x))))

;以下、テスト。
(define (last-pair x)
  (if (null? (cdr x))
      x
      (last-pair (cdr x))))

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

(cyclic? 'a)
;=> #f

(cyclic? (list 'a 'b 'c))
;=> #f

(cyclic? (make-cycle (list 'a)))
;=> #t

(cyclic? (make-cycle (list 'a 'b)))
;=> #t

(cyclic? (make-cycle (list 'a 'b 'c)))
;=> #t

(define p (cons 'a 'a))
(set-cdr! p p)
(cyclic? p)
;=> #t

[]p.152:対の個数を数える p.152:対の個数を数える - 結城浩のSICP日記 を含むブックマーク

ひげぽんさんとIRCでしゃべっていて問題3.17がおもしろいという話をお聞きしたので、私も考えた。

問題3.17: 対の個数を数える(シェアしている対をダブって数えないこと)

結城の解答

(define (count-pairs x)
  (define visited '())
  (define (count-pairs-sub x)
    (cond ((not (pair? x)) 0)
          ((memq x visited) 0)
          (else
            (set! visited (cons x visited))
            (+ 1
               (count-pairs-sub (car x))
               (count-pairs-sub (cdr x))))))
  (count-pairs-sub x))

; テスト
(define a (cons (list 'a 'b) (list 'a 'b)))
(define b (cons a a))
(count-pairs a) ;=> 5
(count-pairs b) ;=> 6

いつものようにnamed-letを使う練習も。

(define (count-pairs x)
  (define visited '())
  (let visit ((x x))
    (cond ((not (pair? x)) 0)
          ((memq x visited) 0)
          (else
            (set! visited (cons x visited))
            (+ 1
               (visit (car x))
               (visit (cdr x)))))))
  • memqを使う。memberを使ってはいけないはず。

追記:ひげぽんさんの解答を読んでこういう書き方もあることに気づきました。最後に数えますけれど。

(define (count-pairs x)
  (define visited '())
  (let visit ((x x))
    (if (and (pair? x) (not (memq x visited)))
          (begin
            (set! visited (cons x visited))
            (visit (car x))
            (visit (cdr x)))))
  (length visited))