learning-sicp

My embarrassing half assed SICP run.
git clone https://kaka.farm/~git/learning-sicp
Log | Files | Refs

exercise-16.scm (2138B)

      1 (define-library (sicp tests chapter-3 exercise-16)
      2   (import (scheme base))
      3   (import (srfi :64))
      4 
      5   (begin
      6     (test-begin "chapter-3-exercise-16")
      7 
      8     (define (count-pairs x)
      9       (if (not (pair? x))
     10           0
     11           (+ (count-pairs (car x))
     12              (count-pairs (cdr x))
     13              1)))
     14 
     15     (define three-pairs '(1 2 3))
     16 
     17     (define four-pairs
     18       (let ([a (list 1 2)]
     19             [b (list 3)])
     20         (set-car! (cdr a) b)
     21         (set-cdr! (cdr a) b)
     22         a))
     23 
     24     (define seven-pairs
     25       (let ([a (list 1)]
     26             [b (list 2)]
     27             [c (list 3)])
     28         (set-car! a b)
     29         (set-cdr! a b)
     30         (set-car! b c)
     31         (set-cdr! b c)
     32         a))
     33 
     34     ;;              +---+---+   +---+---+   +---+---+
     35     ;; three-pairs: | 1 | *-+-->| 2 | *-+-->| 3 | * |
     36     ;;              +---+---+   +---+---+   +---+---+
     37 
     38     ;;             +---+---+   +---+---+   +---+---+
     39     ;; four-pairs: | 1 | *-+-->| * | *-+-->| 3 | * |
     40     ;;             +---+---+   +-+-+---+   +---+---+
     41     ;;                           |             ^
     42     ;;                           |             |
     43     ;;                           +-------------+
     44 
     45     ;;              +---+---+   +---+---+   +---+---+
     46     ;; seven-pairs: | * | *-+-->| * | *-+-->| 3 | * |
     47     ;;              +-+-+---+   +-+-+---+   +---+---+
     48     ;;                |           | ^           ^
     49     ;;                |           | |           |
     50     ;;                +-----------|-+           |
     51     ;;                            |             |
     52     ;;                            +-------------+
     53 
     54     (test-equal
     55         '(1 2 3)
     56       three-pairs)
     57 
     58     (test-equal
     59         (cons 1
     60               (cons (cons 3 '())
     61                     (cons 3 '())))
     62       four-pairs)
     63 
     64     (test-equal
     65         (cons (cons (cons 3 '())
     66                     (cons 3 '()))
     67               (cons (cons 3 '())
     68                     (cons 3 '())))
     69       seven-pairs)
     70 
     71     (test-equal
     72         3
     73       (count-pairs three-pairs))
     74 
     75     (test-equal
     76         4
     77       (count-pairs four-pairs))
     78 
     79     (test-equal
     80         7
     81       (count-pairs seven-pairs))
     82 
     83     (test-end "chapter-3-exercise-16")))