(load "util.scm") (display "\nex-3.12 - append!\n") (define (append x y) (if (null? x) y (cons (car x) (append (cdr x) y)))) (define (append! x y) (set-cdr! (last-pair x) y) x) (define (last-pair x) (if (null? (cdr x)) x (last-pair (cdr x)))) (define x (list 'a 'b)) (define y (list 'c 'd)) (define z (append x y)) (assert z '(a b c d)) (assert (cdr x) '(b)) (define w (append! x y)) (assert w '(a b c d)) (assert (cdr x) '(b c d)) (display "\nex-3.13 - make cycle\n") (define (make-cycle x) (set-cdr! (last-pair x) x) x) (define z (make-cycle (list 'a 'b 'c))) (display "[see comment]\n") ; infinite loop ; (last-pair z) (display "\nex-3.14 - mystery\n") ; reverse (define (mystery x) (define (loop x y) (if (null? x) y (let ((temp (cdr x))) (set-cdr! x y) (loop temp x)))) (loop x '())) (define v (list 'a 'b 'c 'd)) (define w (mystery v)) (display v) (newline) (display w) (newline) (display "\nex-3.15\n") (define x (list 'a 'b)) (define z1 (cons x x)) (define z2 (cons (list 'a 'b) (list 'a 'b))) (define (set-to-wow! x) (set-car! (car x) 'wow) x) (assert z1 '((a b) a b)) (set-to-wow! z1) (assert z1 '((wow b) wow b)) (set-to-wow! z2) (assert z2 '((wow b) a b)) (display "\nex-3.16 - count pairs\n") (define (count-pairs x) (if (not (pair? x)) 0 (+ (count-pairs (car x)) (count-pairs (cdr x)) 1))) (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") (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)) (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")