Решение упражнения 2.57 из SICP

8 February, 2008 (22:10) | Решения упражнений

Как требуется в условии упражнения, будем менять только конструкторы и селекторы для суммы и произведения так, чтобы сделать возможной работу с произвольным числом слагаемых и множителей. Начнем с суммы.

Мы будем представлять сумму как список из символа + и последующего произвольного количества слагаемых. 

Селектор addend вообще не меняется:

(define (addend s) (cadr s))

Селектор augend будет возвращать либо одно последнее слагаемое, если слагаемых было всего два, либо сумму всех слагаемых, начиная со второго:

(define (make-sum-list seq) 
  (if (null? (cdr seq)) 
      (car seq) 
      (cons '+ seq)))
(define (augend s) 
  (make-sum-list (cddr s)))

Процедура make-sum-list вынесена специально, так как она нам еще понадобится.

При построении суммы с помощью make-sum мы будем делить все слагаемые на две группы: числа (константы), которые будen сразу суммироваться в число const, и выражения (с переменные значениями), которые будут накапливаться в списке vars. Затем в зависимости от результирующих значений мы будем их комбинировать для получения окончательного результата. Определение выглядит так:

(define (make-sum . seq) 
  (let ((vars (filter non-number? seq)) 
        (const (accumulate + 0 (filter number? seq)))) 
    (cond ((null? vars) const) 
          ((= 0 const) (make-sum-list vars)) 
          (else (make-sum-list (cons const vars))))))

Абсолютно аналогичные построения можно проделать и для произведения:

(define (multiplier p) (cadr p))
(define (make-product-list seq) 
  (if (null? (cdr seq)) 
      (car seq) 
      (cons '* seq)))
(define (multiplicand p) 
  (make-product-list (cddr s)))
(define (make-product . seq) 
  (let ((vars (filter non-number? seq)) 
        (const (accumulate * 1 (filter number? seq)))) 
    (cond ((null? vars) const) 
          ((= 0 const) 0) 
          ((= 1 const) (make-product-list vars)) 
          (else (make-product-list (cons const vars))))))

Попробуем вычислить производную из условия упражнения:

> (deriv '(* x y (+ x 3)) 'x) 
(+ (* x y) (* y (+ x 3)))

Результат ожидаемый.

Comments

Comment from qMax
Date: January 25, 2009, 4:06 am

логика работы вcтроенных операторов + и * подсказывает, что
(make-sum-list ‘()) => 0
(make-prod-list ‘()) => 1

Comment from Nikolay M
Date: April 7, 2012, 4:10 pm

А я сделал просто вот так (как описывалось в задание):

(define (augend s)
  (if (null? (cdddr s))  
      (caddr s)            
      (make-sum (addend (cdr s))
                (augend (cdr s)))))    

(define (multiplicand p)                          
  (if (null? (cdddr p))                              
      (caddr p)                                        
      (make-product (multiplier (cdr p))     
                    (multiplicand (cdr p)))))     

Comment from Sergk
Date: March 27, 2015, 12:29 pm

(define (augend s)
  (cond ((sum? (cddr s)) (cddr s))
        ((eq? (cdddr s) '()) (caddr s))
        (else (cons '+ (cddr s)))))

(define (multiplicand p)
  (cond ((product? (cddr p)) (cddr p))
        ((eq? (cdddr p) '()) (caddr p))
        (else (cons '* (cddr p)))))

Comment from Abra-kadabr
Date: January 18, 2016, 4:54 pm

(define (make-sum a1 a2)
  (define (sum a1 a2)
    (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else (list '+ a1 a2))))
  (define (f n l)
    (define (f-iter n l result)
      (if (null? l) (append '(+ n) result)
          (if (number? (car l))
              (append (list '+) result (list (+ n (car l))) (cdr l))
              (f-iter n (cdr l) (append (list (car l)) result)))))
    (f-iter n l (list )))
  (cond ((not (pair? a2)) (sum a1 a2))
        ((number? a1) (f a1 (cdr a2)))
        (else (append (list '+) (list a1) (cdr a2)))))

Comment from Abra-kadabr
Date: January 18, 2016, 4:55 pm

(define (augend x)
  (if (null? (cdddr x)) (caddr x)
      (append (list '+) (cddr x))))

Comment from Petrovich
Date: January 15, 2017, 10:04 am

Достаточно короткое решение с помощью accumulate:

(define (multiplicand p)
    (accumulate make-product 1 (cddr p)))
(define (augend s)
  (accumulate make-sum 0 (cddr s)))

Write a comment