SICP/ex-3_12-20.scm

(load "shared/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")

(define (cons x y)
  (define (set-x! v) (set! x v))
  (define (set-y! v) (set! y v))
  (define (dispatch m)
    (cond ((eq? m 'car) x)
          ((eq? m 'cdr) y)
          ((eq? m 'set-car!) set-x!)
          ((eq? m 'set-cdr!) set-y!)
          (else (error "Undefined operation -- CONS" m))))
  dispatch)

(define (car z) (z 'car))
(define (cdr z) (z 'cdr))

(define (set-car! z new-value)
  ((z 'set-car!) new-value)
  z)

(define (set-cdr! z new-value)
  ((z 'set-cdr!) new-value)
  z)

(define x (cons 1 2))
(define z (cons x x))
(set-car! (cdr z) 17)
(assert (car x) 17)