SICP Solutions

1
2
3
4
5
6
7
8
9
10
11
> (define z (make-cycle (list 'a 'b 'c)))
> (has-cycle? z)
#t
> (has-cycle? (list 'a 'b 'c))
#f
> (has-cycle? (list 'z 'z 'z))
#f
> (define cc (make-cycle (list 'z 'z 'z)))
> (has-cycle? cc)
#t
> 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
#lang sicp

(define (has-cycle? l)
  (define (check l aux)
    (if (null? l)
        #f
        (if ((aux 'visited) l)
            #t
            (check (cdr l) (begin ((aux 'add) l) aux)))))
  (check l (pairs-list)))
            
(define (make-cycle x)
  (set-cdr! (last-pair x) x)
  x)

(define (pairs-list)
  (let ((pairs '()))
    (define (visited pair)
      (accumulate (lambda(cur-pair rs) (or rs (eq? pair cur-pair))) #f pairs))
    (define (add pair)
      (if (pair? pair)
          (if (null? pairs)
              (set! pairs (list pair))
              (append! pairs (list pair)))
          (error "Only pairs can be added")))
    (define (dispatch m)
      (cond
        ((eq? 'visited m) visited)
        ((eq? 'add m) add)
        (else (error "Invalid operation" m))))
    dispatch))
      

(define (accumulate op initial sequence)
  (if (null? sequence)
      initial
      (op (car sequence)
          (accumulate op initial (cdr sequence))
      )
  )
)

(define (last-pair x)
  (if (null? (cdr x))
      x
      (last-pair (cdr x))))

(define (append! x y)
  (set-cdr! (last-pair x) y)
  x)