Scheme - データによる抽象の構築(汎用演算のシステム(例: 記号代数(多項式の算術演算、項リストの表現(濃い多項式と薄い多項式、2つの項リストの表現をシステムに組み込む方法)))

計算機プログラムの構造と解釈[第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.90.を解いてみる。

その他参考書籍

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

問題 2.90.

コード(BBEdit, Emacs)

polynomial.scm

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-

;; 項
(define (install-term-package)
  ;; 内部手続き
  (define (make-term order coeff)
    (list order coeff))
  (define (order term) (car term))
  (define (coeff term) (cadr term))

  (define (tag x) (attach-tag 'term x))
  (put 'make-term '(term)
       (lambda (order coeff)
         (tag (make-term order coeff))))
  (put 'order '(term) order)
  (put 'coeff '(term) 'coeff)
  'done)

;; 汎用
(define (make-term order coeff)
  (apply-generic 'make-term order coeff))
(define (order term) (apply-generic 'order term))
(define (coeff term) (apply-generic 'coeff term))

;; 濃い項リスト
(define (install-dense-package)
  ;; 内部手続き
  (define (make-from-dense term-list) term-list)
  (define (make-from-sparse term-list)
    (if (null? term-list)
        term-list
        (let ((coeff (car term-list))
              (rest-terms (cdr term-list)))
          (if (=zero? coeff)
              (make-from-sparse rest-terms)
              (cons (make-term (- (length term-list) 1)
                               coeff)
                    (make-from-sparse rest-terms))))))
  (define (adjoin-term term term-list)
    (if (=zero? (coeff term))
        term-list
        (cons term term-list)))
  (define (the-empty-termlist) '())
  (define (first-term term-list) (car term-list))
  (define (rest-terms term-list) (cdr term-list))
  (define (empty-termlist? term-list) (null? term-list))
  
  ;; 他の部分とのインタフェース
  (define (tag x) (attach-tag 'dense x))
  (put 'make-from-dense 'dense
       (lambda (terms)
         (tag (make-from-dense terms))))
  (put 'make-from-sparse 'dense
       (lambda (terms)
         (tag (make-from-sparse terms))))
  (put 'adjoin-term '(dense) adjoin-term)
  (put 'the-empty-termlist '(dense) the-empty-termlist)
  (put 'first-term '(dense) first-term)
  (put 'rest-terms '(dense) rest-terms)
  (put 'empty-termlist? '(dense) empty-termlist?)
  'done)

;; 薄い項リスト
(define (install-sparse-package)
  ;; 内部手続き
  (define (make-from-dense term-list)
    )
  (define (make-from-sparse term-list) term-list)
  (define (adjoin-term term term-list)
    (define (iter n)
      (if (= n 0)
          '()
          (cons 0 (iter (- n 1)))))
    (let ((c (coeff term)))
      (if (=zero? c)
          term-list
          (append (cons c (iter (- (order term)
                                   (length term-list))))
                  term-list))))
  (define (the-empty-termlist) '())
  (define (first-term term-list)
    (make-term (- (length term-list) 1)
               (car term-list)))
  (define (rest-terms term-list) (cdr term-list))
  (define (empty-termlist? term-list) (null? term-list))

  ;; 他の部分とのインタフェース
  (define (tag x) (attach-tag 'sparse x))
  (put 'make-from-dense 'sparse
       (lambda (terms)
         (tag (make-from-dense terms))))
  (put 'make-from-sparse 'sparse
       (lambda (terms)
         (tag (make-from-sparse terms))))
  (put 'adjoin-term '(sparse) adjoin-term)
  (put 'the-empty-termlist '(sparse) the-empty-termlist)
  (put 'first-term '(sparse) first-term)
  (put 'rest-terms '(sparse) rest-terms)
  (put 'empty-termlist? '(sparse) empty-termlist?)
  'done)

;; 汎用
(define (adjoin-term term term-list)
  (apply-generic 'adjoin-term term term-list))
(define (the-empty-termlist)
  (apply-generic 'the-empty-termlist))
(define (first-term term-list)
  (apply-generic 'first-term term-list))
(define (rest-terms term-list)
  (apply-generic 'rest-terms term-list))
(define (empty-termlist? term-list)
  (apply-generic 'empty-termlist? term-list))

(define (make-from-dense term-list)
  ((get 'make-from-dense 'dense) term-list))
(define (make-from-sparse term-list)
  ((get 'make-from-sparse 'sparse) term-list))

;; 多項式の算術演算
(define (install-polynomial-package)
  ;; 内部手続き
  (define (make-poly variable term-list)
    (cons variable term-list))
  (define (variable p) (car p))
  (define (term-list p) (cdr p))
  (define (variable? x) (symbole? x))
  (define (same-variable? v1 v2)
    (and (variable? v1)
         (variable? v2)
         (eq? v1 v2)))
  (define (add-terms L1 L2)
    ;; 省略
    )
  (define (mul-term-by-all-terms t1 L)
    ;; 省略
    )
  (define (mul-terms L1 L2)
    ;; 省略
    )
  (define (add-poly p1 p2)
    ;; 省略
    )
  (define (mul-poly p1 p2)
    ;; 省略
    )

  ;; 他の部分とのインターフェース
  (define (tag p) (attach-tag 'polynomial p))
  (put 'make 'polynomial
       (lambda (var terms)
         (tag (make-poly var terms))))
  (put 'add '(polynomial polynomial)
       (lambda (p1 p2)
         (tag (add-poly p1 p2))))
  (put 'mul '(polynomial polynomial)
       (lambda (p1 p2)
         (tag (mul-poly p1 p2))))
  'done)

;; 汎用
(define (add p1 p2)
  (apply-generic 'add p1 p2))
(define (mul p1 p2)
  (apply-generic 'mul p1 p2))

(define (make var terms)
  ((get 'make 'polynomial) var terms))

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

$ ./polynomial.scm 
$