Scheme - データによる抽象の構築(汎用演算のシステム(例: 記号代数(多項式の算術演算、項リストの表現、記号代数における型の階層構造(拡張問題: 有理関数(多項式、最大公約数、汎用化)))))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)

開発環境

• OS X Mavericks - Apple(OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.5(汎用演算のシステム)、2.5.3(例: 記号代数)、多項式の算術演算、項リストの表現、記号代数における型の階層構造、拡張問題: 有理関数、問題 2.97-a, b.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)

問題 2.97-a, b.

コード(BBEdit, Emacs)

sample.scm

(define (pseudoremainder-terms p1 p2)
  (let ((t1 (first-term p1))
        (t2 (first-term p2)))
    (let ((o1 (order t1))
          (o2 (order t2))
          (c2 (coeff t2)))
      (cadr (div-terms (mul (expt c2
                                  (+ 1
                                     (- o1 o2)))
                            p1)
                       p2)))))

(define (gcd-terms a b)
  (if (empty-termlist? b)
      a
      (gcd-terms (pseudoremainder-terms a b))))

(define (expt-term t x)
  (define (iter t n result)
    (if (= n 0)
        result
        (iter t (- n 1) (mul-term result))))
  (iter t x (make-term 0 1)))

;; a.
(define (reduce-terms n d)
  (let ((gcd (gcd-terms n d))
        (n-order (order (first-term n)))
        (d-orderd (order (first-term d))))
    (if (> order-n order-d)
        (let ((gcd-firstterm (first-term gcd)))
          (let ((gcd-coeff (coeff gcd-firstterm))
                (gcd-order (order gcd-firstterm)))
            (if (> n-order d-orderd)
                (let ((t (expt-term gcd-coeff
                                    (- (+ 1
                                          n-order)
                                       gcd-order))))
                  (list (div-terms (mul-term-by-all-terms t n)
                                   gcd)
                        (div-terms (mul-term-by-all-terms t d)
                                   gcd)))
                (let ((t (expt-term gcd-coeff
                                    (- (+ 1
                                          d-orderd)
                                       gcd-order))))
                  (list (div-terms (mul-term-by-all-terms  n)
                                   gcd)
                        (div-terms (mul-term-by-all-terms t d)
                                   gcd)))))))))

(define (reduce-poly p1 p2)
  (let ((v1 (variable p1))
        (v2 (variable p2)))
    (if (same-variable? v1 v2)
        (let ((t1 (term-list p1))
              (t2 (term-list p2)))
          (let ((nd (reduce-poly t1 t2)))
            (list (make-poly v1 (car nd))
                  (make-poly v1 (cadr nd)))))
        (error "Polys not in same var -- REDUCE-POLY"
               (list p1 p2)))))

;; b.
;; scheme-numberパッケージ
(define (install-scheme-number-package)
  ;; 内部手続き
  (define (reduce-integers n d)
    (let ((g (gcd n d)))
      (list (/ n g) (/ d g))))
  ;; 他の部分とのインターフェース
  (put 'reduce '(scheme-number scheme-number)
       (lambda (x y) (tag (reduce-integers x y))))
  'done)
;; 有理数パッケージ
(define (install-rational-package)
  ;; 内部手続き
  (define (make-rat n d)
    (let ((nd (reduce n d)))
      (cons (car nd) (cadr nd))))
  'done)
;; 多項式パッケージ
;; 他の部分とのインターフェース
(define (install-polynomial-package)
  (put 'reduce '(polynomial polynomial)
       (lambda (p1 p2)
         (let ((nd (reduce-poly p1 p2)))
           (list (tag (car nd))
                 (tag (cadr nd))))))
  'done)

;; 汎用演算
(define (reduce n d)
  (apply-generic 'reduce n d))

入出力結果(Terminal(gosh), REPL(Read, Eval, Print, Loop))

$ ./sample.scm
$