commit d6ae70873d7d44d0ed41ddf28a1c6b8b8a4548b7 parent e1321500cc73b45fe0d5584ccb56170e925b551a Author: Yuval Langer <yuval.langer@gmail.com> Date: Mon, 27 Nov 2023 23:01:10 +0200 Convert chapter-1 exercise-19 (1.19). Diffstat:
| M | sicp/solutions/chapter-1/exercise-19.scm | | | 130 | ++++++++++++++++++++++++++++++++++++++----------------------------------------- |
| A | sicp/tests/chapter-1/exercise-19.scm | | | 14 | ++++++++++++++ |
2 files changed, 76 insertions(+), 68 deletions(-)
diff --git a/sicp/solutions/chapter-1/exercise-19.scm b/sicp/solutions/chapter-1/exercise-19.scm @@ -1,71 +1,65 @@ +(define-library (sicp solutions chapter-1 exercise-19) + (import (scheme base)) + (export fib + fast-fib) -;; Exercise 1.19 +;;; T +;;; a <- (a + b) +;;; b <- a +;;; +;;; Tpq = +;;; a <- bq + aq + ap +;;; a <- bq + a(q + p) +;;; b <- bp + aq +;;; +;;; Tpq^2 = +;;; a' <- (bp + aq)q + (bq + aq + ap)q + (bq + aq + ap)p +;;; a' <- bpq + aq^2 + bq^2 + aq^2 + apq + bpq + apq + ap^2 +;;; a' <- 2bpq + 2aq^2 + bq^2 + 2apq + ap^2 +;;; a' <- b(2pq + q^2) + (2apq + ap^2 + 2aq^2) +;;; a' <- b(2pq + q^2) + a(2pq + p^2 + 2q^2) +;;; q = 2pq + q^2 +;;; p + q = 2pq + p^2 + 2q^2 +;;; p = (2pq + p^2 + 2q^2) - (2pq + q^2) +;;; p = 2pq + p^2 + 2q^2 - 2pq - q^2 +;;; p = p^2 + q^2 +;;; a' <- b(2pq + q^2) + a(2pq + q^2) + a(p^2 + q^2) +;;; +;;; oh. i'm dumb. we already have q' and p' in terms of q and p here: +;;; +;;; b' <- (bp + aq)p + (bq + aq + ap)q +;;; b' <- bp^2 + apq + bq^2 + aq^2 + apq +;;; b' <- bp^2 + 2apq + bq^2 + aq^2 +;;; b' <- bp^2 + bq^2 + 2apq + aq^2 +;;; b' <- b(p^2 + q^2) + a(2pq + q^2) -;; T -;; a <- (a + b) -;; b <- a -;; -;; Tpq = -;; a <- bq + aq + ap -;; a <- bq + a(q + p) -;; b <- bp + aq -;; -;; Tpq^2 = -;; a' <- (bp + aq)q + (bq + aq + ap)q + (bq + aq + ap)p -;; a' <- bpq + aq^2 + bq^2 + aq^2 + apq + bpq + apq + ap^2 -;; a' <- 2bpq + 2aq^2 + bq^2 + 2apq + ap^2 -;; a' <- b(2pq + q^2) + (2apq + ap^2 + 2aq^2) -;; a' <- b(2pq + q^2) + a(2pq + p^2 + 2q^2) -;; q = 2pq + q^2 -;; p + q = 2pq + p^2 + 2q^2 -;; p = (2pq + p^2 + 2q^2) - (2pq + q^2) -;; p = 2pq + p^2 + 2q^2 - 2pq - q^2 -;; p = p^2 + q^2 -;; a' <- b(2pq + q^2) + a(2pq + q^2) + a(p^2 + q^2) -;; -;; oh. i'm dumb. we already have q' and p' in terms of q and p here: -;; -;; b' <- (bp + aq)p + (bq + aq + ap)q -;; b' <- bp^2 + apq + bq^2 + aq^2 + apq -;; b' <- bp^2 + 2apq + bq^2 + aq^2 -;; b' <- bp^2 + bq^2 + 2apq + aq^2 -;; b' <- b(p^2 + q^2) + a(2pq + q^2) + (begin + (define (fib n) + (cond + ((= n 0) 0) + ((= n 1) 1) + (else (+ (fib (- n 1)) + (fib (- n 2)))))) -(define (fib n) - (cond - ((= n 0) 0) - ((= n 1) 1) - (else (+ (fib (1- n)) - (fib (- n 2)))))) - -(define (fast-fib n) - (define (fib-iter a b p q count) - (cond - ((= count 0) b) - ((even? count) - (fib-iter a - b - (+ (* p p) - (* q q)) - (+ (* 2 p q) - (* q q)) - (/ count 2))) - (else - (fib-iter (+ (* b q) - (* a q) - (* a p)) - (+ (* b p) - (* a q)) - p - q - (1- count))))) - (fib-iter 1 0 0 1 n)) - -(test-begin "1.19") -(test-equal (fib 0) (fast-fib 0)) -(test-equal (fib 1) (fast-fib 1)) -(test-equal (fib 2) (fast-fib 2)) -(test-equal (fib 3) (fast-fib 3)) -(test-equal (fib 4) (fast-fib 4)) -(test-equal (fib 5) (fast-fib 5)) -(test-end "1.19") + (define (fast-fib n) + (define (fib-iter a b p q count) + (cond + ((= count 0) b) + ((even? count) + (fib-iter a + b + (+ (* p p) + (* q q)) + (+ (* 2 p q) + (* q q)) + (/ count 2))) + (else + (fib-iter (+ (* b q) + (* a q) + (* a p)) + (+ (* b p) + (* a q)) + p + q + (- count 1))))) + (fib-iter 1 0 0 1 n)))) diff --git a/sicp/tests/chapter-1/exercise-19.scm b/sicp/tests/chapter-1/exercise-19.scm @@ -0,0 +1,14 @@ +(define-library (sicp tests chapter-1 exercise-19) + (import (scheme base) + (srfi :64) + (sicp solutions chapter-1 exercise-19)) + + (begin + (test-begin "chapter-1-exercise-19") + (test-equal (fib 0) (fast-fib 0)) + (test-equal (fib 1) (fast-fib 1)) + (test-equal (fib 2) (fast-fib 2)) + (test-equal (fib 3) (fast-fib 3)) + (test-equal (fib 4) (fast-fib 4)) + (test-equal (fib 5) (fast-fib 5)) + (test-end "chapter-1-exercise-19")))