commit 51c54867ee7da55a16dba28cc7543b2306785fbf
parent fda464d7ccb2728447d1e2bd68b91301b3eddec0
Author: Yuval Langer <yuval.langer@gmail.com>
Date: Sun, 2 Apr 2023 14:31:43 +0300
Add some solutions.
Diffstat:
6 files changed, 246 insertions(+), 159 deletions(-)
diff --git a/Makefile b/Makefile
@@ -1,6 +1,12 @@
poop:
echo poop
+2.75:
+ guile -L . sicp/tests/2_75.scm
+
+2.73:
+ guile -L . sicp/tests/2_73.scm
+
2.70:
guile -L . sicp/tests/2_70.scm
diff --git a/sicp/solutions/2_56.scm b/sicp/solutions/2_56.scm
@@ -1,156 +1,153 @@
-;; Exercise 2.56
-
-(define (deriv-stuff)
- ;; Original:
- ;; (define (make-sum a1 a2)
- ;; (list '+ a1 a2))
-
- (define (=number? exp num)
- (and (number? exp)
- (= exp num)))
-
- ;; Simplificating make-sum:
- (define (make-sum a1 a2)
- (cond
- ((=number? a1 0) a2)
- ((=number? a2 0) a1)
- ((and (number? a1)
- (number? a2))
- (+ a1 a2))
- (else (list '+ a1 a2))))
-
- (define (sum? x)
- (and (pair? x)
- (eq? (car x)
- '+)))
-
- (define (addend s)
- (cadr s))
-
- (define (augend s)
- (caddr s))
-
- ;; Original:
- ;; (define (make-product m1 m2)
- ;; (list '* m1 m2))
-
- ;; Simplificating make-product:
- (define (make-product m1 m2)
- (cond
- ((or (=number? m1 0)
- (=number? m2 0))
- 0)
- ((=number? m1 1) m2)
- ((=number? m2 1) m1)
- ((and (number? m1)
- (number? m2))
- (* m1 m2))
- (else (list '* m1 m2))))
-
- (define (product? x)
- (and (pair? x)
- (eq? (car x)
- '*)))
-
- (define (multiplier p)
- (cadr p))
-
- (define (multiplicand p)
- (caddr p))
-
- (define (make-exponentiation b e)
- (cond
- ((=number? e 0) 1)
- ((=number? b 1) b)
- (else (list '** b e))))
-
- ;; Exercise 2.56
- (define (exponentiation? e)
- (and (pair? e)
- (eq? (car e)
- '**)))
-
- (define (base e)
- (cadr e))
-
- (define (exponent e)
- (caddr e))
-
- (define (variable? x)
- (symbol? x))
-
- (define (same-variable? v1 v2)
- (and (variable? v1)
- (variable? v2)
- (eq? v1 v2)))
-
- (define (deriv exp var)
- (cond
- ((number? exp) 0)
- ((variable? exp)
- (if (same-variable? exp
- var)
- 1
- 0))
- ((sum? exp)
- (make-sum (deriv (addend exp)
- var)
- (deriv (augend exp)
- var)))
- ((product? exp)
- (make-sum
- (make-product (multiplier exp)
- (deriv (multiplicand exp)
- var))
- (make-product (deriv (multiplier exp)
+(define-library (sicp solutions 2_56)
+ (import (scheme base))
+ (import (scheme cxr))
+ (export
+ =number?
+ base
+ deriv
+ exponands
+ exponent
+ exponentiation?
+ make-exponentiation
+ make-product
+ make-sum
+ multiplicand
+ multiplier
+ product?
+ same-variable?
+ sum?
+ variable?
+ augend
+ addend
+ )
+
+ (begin
+
+ ;; Exercise 2.56
+
+ ;; Original:
+ ;; (define (make-sum a1 a2)
+ ;; (list '+ a1 a2))
+
+
+ (define (=number? exp num)
+ (and (number? exp)
+ (= exp num)))
+
+ ;; Simplificating make-sum:
+
+ (define (make-sum a1 a2)
+ (cond
+ ((=number? a1 0) a2)
+ ((=number? a2 0) a1)
+ ((and (number? a1)
+ (number? a2))
+ (+ a1 a2))
+ ((and (symbol? a1)
+ (symbol? a2)
+ (eq? a1 a2))
+ (list '+ 2 a1))
+ (else (list '+ a1 a2))))
+
+ (define (sum? x)
+ (and (pair? x)
+ (eq? (car x)
+ '+)))
+
+ (define (addend s)
+ (cadr s))
+
+ (define (augend s)
+ (caddr s))
+
+ ;; Original:
+ ;; (define (make-product m1 m2)
+ ;; (list '* m1 m2))
+
+ ;; Simplificating make-product:
+
+ (define (make-product m1 m2)
+ (cond
+ ((or (=number? m1 0)
+ (=number? m2 0))
+ 0)
+ ((=number? m1 1) m2)
+ ((=number? m2 1) m1)
+ ((and (number? m1)
+ (number? m2))
+ (* m1 m2))
+ ((and (symbol? m1)
+ (symbol? m2)
+ (eq? m1 m2))
+ (make-exponentiation m1 2))
+ (else (list '* m1 m2))))
+
+ (define (product? x)
+ (and (pair? x)
+ (eq? (car x)
+ '*)))
+
+ (define (multiplier p)
+ (cadr p))
+
+ (define (multiplicand p)
+ (caddr p))
+
+ (define (make-exponentiation b e)
+ (cond
+ ((=number? e 0) 1)
+ ((=number? e 1) b)
+ ((=number? b 1) 1)
+ (else (list '** b e))))
+
+ ;; Exercise 2.56
+
+ (define (exponentiation? e)
+ (and (pair? e)
+ (eq? (car e)
+ '**)))
+
+ (define (base e)
+ (cadr e))
+
+ (define (exponent e)
+ (caddr e))
+
+ (define (variable? x)
+ (symbol? x))
+
+ (define (same-variable? v1 v2)
+ (and (variable? v1)
+ (variable? v2)
+ (eq? v1 v2)))
+
+ (define (deriv exp var)
+ (cond
+ ((number? exp) 0)
+ ((variable? exp)
+ (if (same-variable? exp
var)
- (multiplicand exp))))
- ;; Exercise 2.56
- ((exponentiation? exp)
- ;; d(x**n)/dx = n*x**(n-1)
- (make-product (exponent exp)
- (make-exponentiation (base exp)
- (make-sum (exponent exp)
- -1))))
- (else (error "Unknown expression
- type: DERIV" exp))))
-
- (test-begin "deriv-stuff")
- ;; Original:
- ;; (test-equal
- ;; '(+ 1 0)
- ;; (deriv '(+ x 3) 'x))
- ;; (test-equal
- ;; '(+ (* x 0) (* 1 y))
- ;; (deriv '(* x y) 'x))
- ;; (test-equal
- ;; '(+ (* (* x
- ;; y)
- ;; (+ 1
- ;; 0))
- ;; (* (+ (* x 0)
- ;; (* 1 y))
- ;; (+ x 3)))
- ;; (deriv '(* (* x y) (+ x 3)) 'x))
-
- ;; Simplificating:
- (test-equal
- 1
- (deriv '(+ x 3) 'x))
- (test-equal
- 'y
- (deriv '(* x y) 'x))
- (test-equal
- '(+ (* x y)
- (* y
- (+ x 3)))
- (deriv '(* (* x y) (+ x 3)) 'x))
- (test-equal
- '(* 3 (** x 2))
- (deriv '(** x 3) 'x))
- (test-equal
- '()
- (deriv '(** x -1) 'x))
- (test-end "deriv-stuff"))
-
-(deriv-stuff)
+ 1
+ 0))
+ ((sum? exp)
+ (make-sum (deriv (addend exp)
+ var)
+ (deriv (augend exp)
+ var)))
+ ((product? exp)
+ (make-sum
+ (make-product (multiplier exp)
+ (deriv (multiplicand exp)
+ var))
+ (make-product (deriv (multiplier exp)
+ var)
+ (multiplicand exp))))
+ ;; Exercise 2.56
+ ((exponentiation? exp)
+ ;; d(x**n)/dx = n*x**(n-1)
+ (make-product (exponent exp)
+ (make-exponentiation (base exp)
+ (make-sum (exponent exp)
+ -1))))
+ (else (error "Unknown expression
+ type: DERIV" exp))))))
diff --git a/sicp/solutions/2_75.scm b/sicp/solutions/2_75.scm
@@ -0,0 +1,24 @@
+(define-library (sicp solutions 2_75)
+ (import (scheme base))
+ (import (only (rnrs) cos sin))
+ (import (sicp utils))
+ (export
+ make-from-mag-ang
+ )
+
+ (begin
+ (define (make-from-mag-ang mag ang)
+ (define (dispatch op)
+ (cond
+ ((eq? op 'real-part)
+ (* mag
+ (cos ang)))
+ ((eq? op 'imag-part)
+ (* mag
+ (sin ang)))
+ ((eq? op 'magnitude) mag)
+ ((eq? op 'angle) ang)
+ (else
+ (error "Unknown op: make-from-mag-ang" op))))
+
+ dispatch)))
diff --git a/sicp/tests/2_56.scm b/sicp/tests/2_56.scm
@@ -0,0 +1,41 @@
+(import (srfi :64))
+(import (sicp solutions 2_56))
+
+(test-begin "deriv-stuff")
+;; Original:
+;; (test-equal
+;; '(+ 1 0)
+;; (deriv '(+ x 3) 'x))
+;; (test-equal
+;; '(+ (* x 0) (* 1 y))
+;; (deriv '(* x y) 'x))
+;; (test-equal
+;; '(+ (* (* x
+;; y)
+;; (+ 1
+;; 0))
+;; (* (+ (* x 0)
+;; (* 1 y))
+;; (+ x 3)))
+;; (deriv '(* (* x y) (+ x 3)) 'x))
+
+;; Simplificating:
+
+(test-equal
+ 1
+ (deriv '(+ x 3) 'x))
+(test-equal
+ 'y
+ (deriv '(* x y) 'x))
+(test-equal
+ '(+ (* x y)
+ (* y
+ (+ x 3)))
+ (deriv '(* (* x y) (+ x 3)) 'x))
+(test-equal
+ '(* 3 (** x 2))
+ (deriv '(** x 3) 'x))
+(test-equal
+ '(* -1 (** x -2)) ;; hell oh hell...
+ (deriv '(** x -1) 'x))
+(test-end "deriv-stuff")
diff --git a/sicp/tests/2_75.scm b/sicp/tests/2_75.scm
@@ -0,0 +1,17 @@
+(import (srfi :64))
+(import (sicp solutions 2_75))
+
+(test-begin "2.75")
+(test-equal
+ ((make-from-mag-ang 1.0 0.0) 'real-part)
+ 1.0)
+(test-equal
+ ((make-from-mag-ang 1.0 0.0) 'imag-part)
+ 0.0)
+(test-equal
+ ((make-from-mag-ang 1.0 0.0) 'magnitude)
+ 1.0)
+(test-equal
+ ((make-from-mag-ang 1 0.0) 'angle)
+ 0.0)
+(test-end "2.75")
diff --git a/sicp/utils.scm b/sicp/utils.scm
@@ -1,9 +1,11 @@
(define-library (sicp utils)
(import (scheme base))
- (export enumerate-interval
- filter
- flatmap
- accumulate)
+ (import (scheme write))
+ (export
+ accumulate
+ filter
+ flatmap
+ enumerate-interval)
(begin
(define nil '())
