diff --git a/ex-3_12-xx.scm b/ex-3_12-xx.scm index c72769b..54f2022 100644 --- a/ex-3_12-xx.scm +++ b/ex-3_12-xx.scm @@ -82,18 +82,96 @@ (count-pairs (cdr x)) 1))) -(define r3 '(1 2 3)) -;(define r4 '()) -;(define r7 '()) -;(define r-never '()) +(define l3 '(1 2 3)) +(assert (count-pairs l3) 3) + +(define l4 '(1 2 3)) +(set-car! l4 (last-pair l4)) +(assert (count-pairs l4) 4) + +(define l7p3 (cons 3 '())) +(define l7p2 (cons l7p3 l7p3)) +(define l7p1 (cons l7p2 l7p2)) +(define l7 l7p1) +(assert (count-pairs l7) 7) + +(define ln '(1 2 3)) +(set-car! (last-pair ln) ln) +;(count-pairs ln) +(display "[endless-loop]\n") -(assert (count-pairs r3) 3) -;(assert (count-pairs r4) 4) -;(assert (count-pairs r7) 7) -;(assert (count-pairs r-never) '()) (display "\nex-3.17 - count pairs improved\n") +(define (count-pairs x) + (define visited '()) + (define (count-pairs-iter x) + (if (or (not (pair? x)) + (contains x visited)) + 0 + (begin + (set! visited (cons x visited)) + (+ (count-pairs-iter (car x)) + (count-pairs-iter (cdr x)) + 1)))) + (count-pairs-iter x)) -(display "\nex-3.18\n") +(assert (count-pairs l3) 3) +(assert (count-pairs l4) 3) +(assert (count-pairs l7) 3) +(assert (count-pairs ln) 3) + +(display "\nex-3.18 - has cycle\n") + +(define x (list 'a 'b 'c)) +(define z (make-cycle (list 'a 'b 'c))) + +(define (has-cycle? x) + (define (iter x visited) + (cond + ((null? x) #f) + ((contains x visited) #t) + (else + (iter (cdr x) (cons x visited))))) + (iter x '())) + +(assert (has-cycle? x) #f) +(assert (has-cycle? l3) #f) +(assert (has-cycle? l4) #f) +(assert (has-cycle? l7) #f) +(assert (has-cycle? z) #t) + +; ln contains a cycle in the sense that it lead to an endless-loop for +; count-pairs. However, this question tells us that the criterion for a cycle +; is whether cdr leads to an endless-loop. Consequently, I would say it is +; legit that we get #f here. +(assert (has-cycle? ln) #f) + +(display "\nex-3.19 - has cycle with constant space\n") + +(define x (list 'a 'b 'c)) + +(define (has-cycle? original-xs) + (define (find x xs) + (define (find-iter xs index) + (cond + ((null? xs) 'notfound) + ((eq? x (car xs)) index) + (else (find-iter (cdr xs) (inc index))))) + (find-iter xs 0)) + + (define (cycle-iter xs index) + (if (null? xs) + #f + (let ((find-index (find (car xs) original-xs))) + (if (or (eq? find-index 'notfound) + (= find-index index)) + (cycle-iter (cdr xs) (inc index)) + #t)))) + (cycle-iter original-xs 0)) + +(assert (has-cycle? l7) #f) +(assert (has-cycle? z) #t) + +(display "\nex-3.20\n")