SICP問題2.58

b問題がちょっと難しかったので、記録しておきます。

b問題
不要なかっこは省き, 乗算は加算より前に行うと仮定する(x + 3 * (x + y + 2))のような, 標準の代数記法を許すと問題は実質的に難しくなる. われわれの微分プログラムが相変わらず動作するように, この記法の適切な述語, 選択子, 構成子が設計できるか.
(『計算機プログラムの構造と解釈 第2版』より)

以下のような方針で解きました。
○加算の方針

・最初に見つかった+より前にあるものがtermならばsum
・termがaddend
・+より後にあるものがaugend

○乗算の方針

・最初に見つかった演算子が*で、*より後にあるものがtermならばproduct
・*より前にあるものがmultiplier
・termがmultiplicand

解答は以下です。

(define (variable? x) (symbol? x))

(define (rm-paren x)
  (if (one-elem-list? x)
      (if (or (number? (car x)) (variable? (car x)))
	  (car x)
	  (rm-paren (car x)))
      x))

(define (one-elem-list? x)
  (and (pair? x) (null? (cdr x))))

(define (sum? x)
  (let ((item (rm-paren x)))
    (and (pair? item) (term? (previous '+ item)))))

(define (term? x)
  (if (not (pair? x))
      (or (number? x) (variable? x))
      (or (one-elem-list? x) (not (member? '+ x)))))

(define (member? item x)
  (cond [(null? x) #f]
	[(eq? item (car x)) #t]
	[else (member? item (cdr x))]))

(define (previous item x)
  (letrec ((iter (lambda (result rest)
		   (cond [(null? rest) '()]
			 [(eq? (car rest) item) (reverse result)]
			 [else (iter (cons (car rest) result) (cdr rest))]))))
    (iter '() x)))

(define (next item x)
  (cond [(null? x) '()]
	[(eq? (car x) item) (cdr x)]
	[else (next item (cdr x))]))

(define (addend s)
  (rm-paren (previous '+ (rm-paren s))))

(define (augend s)
  (rm-paren (next '+ (rm-paren s))))

(define (operators x)
  (filter (lambda (y) (or (eq? y '+) (eq? y '*))) x))

(define (product? x)
  (let ((item (rm-paren x)))
    (and (pair? item)
	 (not (null? (operators item)))
	 (eq? (car (operators item)) '*)
	 (term? (next '* item)))))

(define (multiplier p)
  (rm-paren (previous '* (rm-paren p))))

(define (multiplicand p)
  (rm-paren (next '* (rm-paren p))))

(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) var)
			(multiplicand exp)))]
	[else (error "unknown expression type -- DERIV" exp)]))

(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))

(define (=number? exp num)
  (and (number? exp) (= exp num)))

(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)]))

試しに評価してみると、正しい値であることがわかります。