さかもとのブログ

つらつらと

SICP演習問題3.16~18

;;exercise3.16,17
;;;exercise3.16
(define (count-pairs x)
  (if (not (pair? x))
      0
      (+ (count-pairs (car x))
          (count-pairs (cdr x))
         1)))

;;;exercise3.17
(define (new-count-pairs x)
  (define already-list '())
  (define (count-pairs x)
    (cond [(not (pair? x)) 0]
             [(memq x already-list) 0]
             [else
              (set! already-list (cons x already-list))
              (+ (count-pairs (car x))
                   (count-pairs (cdr x))
                   1)]))
   (count-pairs x))

;;3
(define a (cons 'x (cons 'x (cons 'x 'x))))
(print "count-pairs:        " (count-pairs a))
(print "new-count-pairs: " (new-count-pairs a))

;;4
(define a (cons 'x 'x))
(define b (cons a 'y))
(define c (cons b a))
(print "count-pairs:        " (count-pairs c))
(print "new-count-pairs: " (new-count-pairs c))

;;7
(define a (cons 'x 'x))
(define b (cons a a))
(define c (cons b b))
(print "count-pairs:        " (count-pairs c))
(print "new-count-pairs: " (new-count-pairs c))

;;;exercise3.18
;これだと途中からの循環には気がつかない
;SICP解答をチラ見して気付いた
(define (exist-cycle? lis)
  (let loop ((cmp-lis (cdr lis)))
    (cond [(or (null? cmp-lis) (not (pair? cmp-lis))) #f]
          [(eq? lis cmp-lis) #t]
          [else (loop (cdr cmp-lis))])))
(exist-cycle? z) ;exercise3.13のz

;改訂版
(define (new-exist-cycle? lis)
  (define already-list '())
  (define (exist-cycle? lis)
    (cond [(or (null? lis) (not (pair? lis))) #f]
             [(memq is already-list) #t]
             [else
                (set! already-list (cons lis already-list))
                (exist-cycle? (cdr lis))]))
    (exist-cycle? lis))

(new-exist-cycle? z)