Implement till 3.19

ex-3_12-xx.scm

@@ -82,18 +82,96 @@
          (count-pairs (cdr x))
          1)))
 
-(define r3 '(1 2 3))
+(define l3 '(1 2 3))
-;(define r4 '())
+(assert (count-pairs l3) 3)
-;(define r7 '())
+
-;(define r-never '())
+(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")