diff --git a/ex-2_53-xx.scm b/ex-2_53-xx.scm index e2500df..f3f7a53 100644 --- a/ex-2_53-xx.scm +++ b/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)