StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

POConvert this Scheme function into a different form?
text
Body
copied!<p>So here's one way to define a sum as a message passing object:</p> <pre><code> (define (make-sum . exps) (let ((len (length exps))) ;; first handle variable length operands (cond ((= len 0) (make-number 0)) ;; base case for addition ((= len 1) (car exps)) ;; might as well drop the sum if only 1 argument ((> len 2) (make-sum (car exps) (apply make-sum (cdr exps)))) ;; apply is described in section 2.4, footnote 47 ;; > 2 operands: break up into 2 for simplicity in handling (else ;; must be exactly 2 operands (let ((op1 (car exps)) (op2 (cadr exps))) (cond ((op1 'zero?) op2) ;; exp + 0 --> exp ((op2 'zero?) op1) ((and (op1 'number?) (op2 'number?)) (make-number (+ (op1 'value) (op2 'value)))) ;; num + num --> num (else ;; create a new message-passing object representing the sum (lambda (m . args) (cond ((eq? m 'derive) (if (and (= (length args) 1) (symbol? (car args))) ;; derivative of a sum is the sum of the derivatives ;; of the parts of the sum (make-sum (op1 'derive (car args)) (op2 'derive (car args))) (error "derive needs a variable argument"))) ((eq? m 'print) (list '+ (op1 'print) (op2 'print))) ((eq? m 'zero?) #f) ((eq? m 'number?) #f) ((eq? m 'value) (error "should not be asking for the value of a sum expression")) ((eq? m 'evaluate) (if (and (= (length args) 2) (symbol? (car args)) (number? (cadr args))) (let ((eop1 (op1 'evaluate (car args) (cadr args))) (eop2 (op2 'evaluate (car args) (cadr args)))) (make-sum eop1 eop2)) (error "evaluate needs a variable symbol and a number"))) ((eq? m 'has-constant-multiplier?) #f) ((eq? m 'merge-constant) (error "should not be merging a constant with an addition")) (else (error "unknown message" m))))))))))) </code></pre> <p>But this can be rewritten as:</p> <pre><code>(define (make-sum exp1 exp2) (cond ((exp1 'zero?) exp2) ;; exp + 0 --> exp ((exp2 'zero?) exp1) ((and (exp1 'number?) (exp2 'number?)) (make-number (+ (exp1 'value) (exp2 'value)))) ;; num + num --> num (else ;; create a new message-passing object representing the sum (lambda (m . args) (cond ((eq? m 'derive) (if (and (= (length args) 1) (symbol? (car args))) (let ((variable (car args))) ;; derivative of a sum is the sum of the derivatives ;; of the parts of the sum (make-sum (exp1 'derive variable) (exp2 'derive variable))) (error "derive needs a variable argument"))) ((eq? m 'print) (list '+ (exp1 'print) (exp2 'print))) ((eq? m 'zero?) #f) ((eq? m 'number?) #f) ((eq? m 'value) (error "should not be asking for the value of a sum expression")) ((eq? m 'evaluate) (if (and (= (length args) 2) (symbol? (car args)) (number? (cadr args))) (let ((variable (car args)) (number (cadr args))) (let ((exp1-eval (exp1 'evaluate variable number)) (exp2-eval (exp2 'evaluate variable number))) (make-sum exp1-eval exp2-eval))) (error "evaluate needs a variable symbol and a number"))) (else (error "unknown message: " m))))))) </code></pre> <p>How would I change the function I wrote for defining a product as a message-passing object into the second format above? Here's the code I wrote:</p> <pre><code>(define (make-product . exps) (let ((len (length exps))) (cond ((= len 0) (make-number 1)) ;; base case for multiplication ((= len 1) (car exps)) ;; might as well drop the product if only 1 argument ((> len 2) (make-product (car exps) (apply make-product (cdr exps)))) (else (let ((op1 (car exps)) (op2 (cadr exps))) (cond ((op1 'zero?) (make-number 0)) ((op2 'zero?) (make-number 0)) ((and (op1 'number?) (= (op1 'value) 1)) op2) ;; multiplicative identity ((and (op2 'number?) (= (op2 'value) 1)) op1) ;; multiplicative identity ((and (op1 'number?) (op2 'has-constant-multiplier?)) (op2 'merge-constant (op1 'value))) ((and (op2 'number?) (op1 'has-constant-multiplier?)) (op1 'merge-constant (op2 'value))) (else (lambda (m . args) (cond ((eq? m 'derive) (if (and (= (length args) 1) (symbol? (car args))) (make-sum (make-product (op1 'derive (car args)) op2) (make-product op1 (op2 'derive (car args)))) (error "derive needs a variable argument"))) ((eq? m 'print) (list '* (op1 'print) (op2 'print))) ((eq? m 'zero?) #f) ((eq? m 'number?) #f) ((eq? m 'value) (error "should not be asking for the value of an product expression")) ((eq? m 'evaluate) (if (and (= (length args) 2) (symbol? (car args)) (number? (cadr args))) (let ((eop1 (op1 'evaluate (car args) (cadr args))) (eop2 (op2 'evaluate (car args) (cadr args)))) (make-product eop1 eop2)) (error "evaluate needs a variable symbol and a number"))) ((eq? m 'has-constant-multiplier?) (or (op1 'has-constant-multiplier?) (op2 'has-constant-multiplier?))) ((eq? m 'merge-constant) (if (and (= (length args) 1) (number? (car args))) (cond ((op1 'has-constant-multiplier?) (make-product (op1 'merge-constant (car args)) op2)) ((op2 'has-constant-multiplier?) (make-product op1 (op2 'merge-constant (car args)))) (else (error "should not be calling merge-constant on a product with no constant multiplier"))) (error "invalid arguments to merge-constant"))) (else (error "unknown message" m))))))))))) </code></pre>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload