SICP問題2.93

SICP

約分しない make-ratを使用した有理数演算パッケージ。演算も汎用演算に変更する

(define (install-rational-package)
  ;; 内部手続き
  (define (numer x) (car x))
  (define (denom x) (cdr x))
;   (define (make-rat n d)
;     (let ((g (gcd n d)))
;       (cons (/ n g) (/ d g))))
  (define (make-rat n d)
      (cons n d))
  (define (add-rat x y)
    (make-rat (add (mul (numer x) (denom y))
                   (mul (numer y) (denom x)))
              (mul (denom x) (denom y))))
  (define (sub-rat x y)
    (make-rat (sub (mul (numer x) (denom y))
                   (mul (numer y) (denom x)))
              (mul (denom x) (denom y))))
  (define (mul-rat x y)
    (make-rat (mul (numer x) (numer y))
              (mul (denom x) (denom y))))
  (define (div-rat x y)
    (make-rat (mul (numer x) (denom y))
              (mul (denom x) (numer y))))
  (define (equ-rat x y)
    (= (mul (numer x) (denom y))
       (mul (numer y) (denom x))))
  (define (=zero-rat x)
    (and (=zero? (numer x))
         (not (=zero? (denom x)))))
  (define (negate-rat x)
    (make-rat (- (numer x)) (denom x)))
  ;; システムの他の部分へのインタフェース
  (define (tag x) (attach-tag 'rational x))
  (put 'add '(rational rational)
       (lambda (x y) (tag (add-rat x y))))
  (put 'sub '(rational rational)
       (lambda (x y) (tag (sub-rat x y))))
  (put 'mul '(rational rational)
       (lambda (x y) (tag (mul-rat x y))))
  (put 'div '(rational rational)
       (lambda (x y) (tag (div-rat x y))))
  (put 'equ? '(rational rational)
       (lambda (x y) (equ-rat x y)))
  (put '=zero? '(rational)
       (lambda (x) (=zero-rat x)))
  (put 'make 'rational
       (lambda (n d) (tag (make-rat n d))))
  (put 'negate '(rational)
       (lambda (x) (tag (negate-rat x))))
  'done)
(define (make-rational n d)
  ((get 'make 'rational) n d))
(install-rational-package)

教科書では

(define p1 (make-polynomial 'x '((2 1) (0 1))))
(define p2 (make-polynomial 'x '((3 1) (0 1))))
(define rf (make-rational p2 p1))

について、 add を使って rf に自分自身を足せ、となっているが、2.92でやったpolynomialパッケージをそのまま使いたいので、こんな感じに変更

(define p1 (make-polynomial '(x) '(((2) 1) ((0) 1))))
; p1
(define p2 (make-polynomial '(x) '(((3) 1) ((0) 1))))
; p2
(define rf (make-rational p2 p1))
; rf
(add rf rf)
; (rational (polynomial (x) ((5) 2) ((3) 2) ((2) 2) ((0) 2)) polynomial (x) ((4) 1) ((2) 2) ((0) 1))

OK