commit 6dc652e101ad8cc62c38d77f3de9a63a92fe1d69 parent 43d755157b2d40909a0feac5f53d62b93789ee1f Author: Yuval Langer <yuval.langer@gmail.com> Date: Sun, 16 Apr 2023 15:22:28 +0300 Add solution to exercise 3.17. Diffstat:
| A | sicp/solutions/3_17.scm | | | 38 | ++++++++++++++++++++++++++++++++++++++ |
| A | sicp/tests/3_17.scm | | | 40 | ++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 78 insertions(+), 0 deletions(-)
diff --git a/sicp/solutions/3_17.scm b/sicp/solutions/3_17.scm @@ -0,0 +1,38 @@ +(define-library (sicp solutions 3_17) + (import (scheme base)) + (export count-pairs) + + (begin + (define (count-pairs x) + (define (count-pairs' x known-pairs) + (cond + ((null? x) (cons 0 known-pairs)) + ((pair? x) + (if (memq x known-pairs) + (let* ([left-side (count-pairs' (car x) + known-pairs)] + [left-side-count (car left-side)] + [left-side-known-pairs (cdr left-side)] + [right-side (count-pairs' (cdr x) + left-side-known-pairs)] + [right-side-count (car right-side)] + [right-side-known-pairs (cdr right-side)]) + (cons (+ 0 + left-side-count + right-side-count) + right-side-known-pairs)) + (let* ([left-side (count-pairs' (car x) + (cons x known-pairs))] + [left-side-count (car left-side)] + [left-side-known-pairs (cdr left-side)] + [right-side (count-pairs' (cdr x) + left-side-known-pairs)] + [right-side-count (car right-side)] + [right-side-known-pairs (cdr right-side)]) + (cons (+ 1 + left-side-count + right-side-count) + right-side-known-pairs)))) + (else (cons 0 known-pairs)))) + + (car (count-pairs' x '()))))) diff --git a/sicp/tests/3_17.scm b/sicp/tests/3_17.scm @@ -0,0 +1,40 @@ +(define-library (sicp tests 3_17) + (import (scheme base)) + (import (srfi :64)) + (import (only (sicp solutions 3_17) count-pairs)) + + (begin + (test-begin "3.17") + + (define three-pairs '(1 2 3)) + + (test-equal + 3 + (count-pairs three-pairs)) + + (define four-pairs + (let ([a (list 1 2)] + [b (list 3)]) + (set-car! (cdr a) b) + (set-cdr! (cdr a) b) + a)) + + (test-equal + 3 + (count-pairs four-pairs)) + + (define seven-pairs + (let ([a (list 1)] + [b (list 2)] + [c (list 3)]) + (set-car! a b) + (set-cdr! a b) + (set-car! b c) + (set-cdr! b c) + a)) + + (test-equal + 3 + (count-pairs seven-pairs)) + + (test-end "3.17")))