Implement till 2.58

ex-2_53-xx.scm

@@ -93,7 +93,7 @@
 ;      (+  x 3)))
 
 
-(display "\n\nex-2.56\n")
+(display "\n\nex-2.56 - exponentiation\n")
 
 (define (exponentiation? x) (and (pair? x) (eq? (car x) '**)))
 (define base cadr)
@@ -108,6 +108,132 @@
 (display (deriv (make-exponentiation 'x 3) 'x))
 
 
-(display "\n\nex-2.57") (newline)
+(display "\n\nex-2.57 - arbitrary length sums and products") (newline)
 
-(display "\n\nex-2.58") (newline)
+(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 (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 (addend s) (cadr s))
+(define (augend s)
+  (if (null? (cdddr s))
+    (caddr s)
+    (cons '+ (cddr s))))
+
+(define (multiplier s) (cadr s))
+(define (multiplicand s)
+  (if (null? (cdddr s))
+    (caddr s)
+    (cons '* (cddr s))))
+
+(define e '(* x y (+ x 3) 42))
+(display e) (newline)
+(display (multiplier e)) (newline)
+(display (multiplicand e)) (newline)
+(display (deriv '(* (* x y) (+ x 3)) 'x)) (newline)
+(display (deriv '(* x y (+ x 3)) 'x))
+
+(display "\n\nex-2.58 - infix notation") (newline)
+
+(display "a)\n")
+(define (addend s) (car s))
+(define (augend s) (caddr s))
+(define (multiplier s) (car s))
+(define (multiplicand s) (caddr s))
+
+(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 (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 (sum? x)
+  (and (pair? x) (eq? (cadr x) '+)))
+(define (product? x)
+  (and (pair? x) (eq? (cadr x) '*)))
+
+(define x-infix '(x + (3 * (x + (y + 2)))))
+(display x-infix) (newline)
+(display (deriv x-infix 'x)) (newline)
+
+(display "b)\n")
+; If there is at least one + in the expression it is a
+; sum. If it is not a sum and there is at least one * in
+; the expression it is a product.
+
+(define (sum? x)
+  (cond
+    ((null? (cdr x)) #f)
+    ((eq? (cadr x) '+) #t)
+    (else (sum? (cddr x)))))
+
+(define (product? x)
+  (cond
+    ((null? (cdr x)) #f)
+    ((sum? x) #f)
+    ((eq? (cadr x) '*) #t)
+    (else (product? (cddr x)))))
+
+(define (lift x) (if (null? (cdr x)) (car x) x))
+
+(define (addend s)
+  (define (go-addend s)
+    (cond
+      ((not (pair? s)) '())
+      ((eq? (cadr s) '+) (list (car s)))
+      (else (cons (car s) (cons (cadr s) (go-addend (cddr s)))))))
+  (lift (go-addend s)))
+
+(define (augend s)
+  (define (go-augend s)
+    (cond
+      ((not (pair? s)) '())
+      ((eq? (cadr s) '+) (cddr s))
+      (else (go-augend (cddr s)))))
+  (lift (go-augend s)))
+
+(define (multiplier s)
+  (define (go-multiplier s)
+    (cond
+      ((not (pair? s)) '())
+      ((eq? (cadr s) '*) (list (car s)))
+      (else (cons (car s) (cons (cadr s) (go-multiplier (cddr s)))))))
+  (lift (go-multiplier s)))
+
+(define (multiplicand s)
+  (define (go-multiplicand s)
+    (cond
+      ((not (pair? s)) '())
+      ((eq? (cadr s) '*) (cddr s))
+      (else (go-multiplicand (cddr s)))))
+  (lift (go-multiplicand s)))
+
+(define x-infix '(x + 3 * (x + y + 2)))
+;(display (sum? x-infix)) (newline)
+;(display (product? x-infix)) (newline)
+;(display (addend x-infix)) (newline)
+;(display (augend x-infix)) (newline)
+;(display (multiplier x-infix)) (newline)
+;(display (multiplicand x-infix)) (newline)
+
+(display x-infix) (newline)
+(display (deriv x-infix 'x)) (newline)
+
+(display "\nex-2.59") (newline)
+
+
+(display "\nex-2.60") (newline)