Schemeの課題(2012) --- (7p)

Copyright(C)2006 by 桜川貴司

式の展開

式の展開以降については,式の展開,論理式の標準形,リバーシのプログラム のうち,どれか一つについて課題を提出すればよい(もちろん複数について 提出してもよい).

;
;  式の展開
;
;
;ここでは,以下のような考え方に基づいて式の展開を行うプログラムを書いて
;みる.なお,ここに書いたのは一つの考え方であって,こうしなければならな
;いというものではない.自分の気に入るデータの表現方法やアルゴリズムを使
;用してよいし,その方が望まれる.ただし,ここでは,以下で示す考え方に基
;づいて,プログラムの一部を出題者側で用意して,足りない部分をどのように
;補えばよいかという課題を出しているため,独自の考え方に基づいてプログラ
;ムを書く場合には,1からプログラムを書かなければならないことになるし,
;回答には,考え方を含めて十分な説明が必要となることに留意されたい.
;
;  kadaip28-1,p28-2,p29,p30,p31
;
;  以下の方針に基づいて,S式で表された多項式の展開を求めるプログラムを
;  記述した.以下は,そのプログラムであるが,一部を省略してある.
;  省略した部分を埋めてできる関数を記述せよ.
;
;  kadaip32
;
;  以下に出てくる展開された多項式を,通常に近い形で表示する関数pppを
;  記述せよ.
;  (ppp '((1 a b c) (3 x x z) (-2 z z))
;  a*b*c + 3*x^2*z -2*z^2
;
;  (ppp '())
;  0
;  
;  ヒント: write, write-char, newlineなどの関数を用いて,副作用として
;  多項式を表示せよ.
;  (write 'a)           a
;  (write '(1 2 3))     (1 2 3)
;  (write-char #\ )      (空白を一つ表示する)
;  (newline)            (改行文字を一つ出力する)
;
;  (kadaip32の表示形式が気に入らなければその旨書いて,別の表示の形式を
;  記述して,それに従った関数としてもよいものとする.)
;
;  kadaip33
;
;  関数convについて,-が出てきても処理できるように機能を拡張せよ.
;
;
;  以下が方針とプログラムである.
;
;  方針
;
;  単項式は,最初に係数,後に変数の名前順にソートされた変数のリスト
;  (係数と各変数の積を意味する)で表現する.
;  整理された単項式の表現方法を以下に例示する.
;  1            (1)
;  0            (0)
;  x            (1 x)
;  x*y          (1 x y)
;  3*a*x*y      (3 a x y)
;
;  単項式の表現を求める途中では,以下の左側のような表現が一時的に現
;  れることがあるかも知れないが,最終的には右側の表現で表すこととする.
;  (a b)        (1 a b)
;  (y x)        (1 x y)
;  (2 3 y)      (6 y)
;  (0 3 x)      (0)
;  ()           (1)
;
;
;  展開された多項式は,単項式のリスト(各単項式の和を意味する)で表現する.
;  ただし,各単項式は,ソートしておく.ソートの順序は,
;  係数部分を無視して,変数名の辞書式順序によるものとする.
;  式を展開すると,必ず単項式の和で表すことができることに注意.
;  多項式の表現方法を以下に例示する.
;  0            ()
;  x+y          ((1 x) (1 y))
;  x*y + 2*z^3  ((1 x y) (2 z z z))
;
;  展開された多項式の表現を求める途中では,以下の左側のような表現が一時
;  的に現れることがあるかも知れないが,最終的には右側の表現で表すことと
;  する.
;  ((0 x))                            ()
;  ((1 a b) (2 a b))                  ((3 a b))
;  ((1 a a) (1 a b) (1 b a) (1 b b))  ((1 a a) (2 a b) (1 b b))
;
;
;
;   xが定数,変数の積を表すソートしたリスト(定数部分が先に来る)のとき,
;   (econst1 x)はxの定数部分を単純化したものである.
;
;   (econst1 '(2 3 a b)) = (6 a b)
;   (econst1 '(0 a b)) = (0)
;   (econst1 '()) = (1)
;   (econst1 '(a b c)) = (1 a b c)
;
    (define (econst1 x)
	(cond ((null? x) '(1))
	      ((number? (car x)) (econst2 (car x) (cdr x)))
	      (#t (cons 1 x))))
;
;   econst2はeconst1の下請け関数である.
;   定数項に0が現れれば,単項式全体を0('(0)で表される)とする.
;
    (define (econst2 x l)
        (cond ((null? l) (list x))
	      ((= x 0) '(0))
	      ((number? (car l)) (econst2 (* x (car l)) (cdr l)))
	      (#t (cons x l))))
;
;   esort1は,ソートされた2つの単項式をマージして変数をソートする関数である.
;   要するに,2つの単項式の積を求める関数である.
;   ここではインサーションソートを行っているが,さらに効率の良いアルゴリズ
;   ムを用いた方が良いかもしれない.
;   ここに書いた関数は,一つ目の列はソートされていなくてもよいものとする.
;   (このことは,インサーションソートを用いることと,一つ目のリストを
;   2つめのリストにインサートしていけばよいというヒントになっている)
;   結果には,係数部分が2つ以上出てくることも許している.
;
;   (esort1 '(1 a d b) '(2 c d)) = (1 2 a b c d d)または(2 1 a b c d d)
;   (esort1 '(1 3 a d b) '(2 c d)) = (1 3 2 a b c d d)
;   これらの例で,係数部分は順序が入れ替わってよい.
;
    (define (esort1 x y)
;   kadaip28-1 この関数を完成せよ.
;   ヒント: 後2行で書けます.einsert1を呼び出します.
    )
;
;   インサーションを行う関数
;
;   esort1の下請け関数である.(必ずしもこれを用いなくてもよい)
;   変数または係数xをそれらのリストlの正しい位置にインサートする.
;   ここで,ecomp?はどの位置にインサートすべきかを決めるための比較
;   関数で,後で定義される.
;
    (define (einsert1 x l)
        (if (null? l) (list x)
	    (let ((r (ecomp? x (car l))))
	       (cond ((<= r 0) (cons x l))
		     (#t (cons (car l) (einsert1 x (cdr l))))))))
;
;   esort2は,ソートされた2つの単項式の列をマージしてソートする関数である.
;   要するに,2つの多項式の和を求めて整理する関数である.
;   ここではインサーションソートを行っているが,さらに効率の良いアルゴリズ
;   ムを用いた方が良いかもしれない.
;   ここに書いた関数は,一つ目の列はソートされていなくてもよいとする.
;   (このことは,インサーションソートを用いることと,一つ目のリストを
;   2つめのリストにインサートしていけばよいというヒントになっている)
;   ソートしてまとめられる単項式をまとめる.
;   また,入力の各単項式はソートされているとする.
;
;   (esort2 '((1 a b c) (2 a a c)) '((3 a a b) (4 a b d)))
;   =((3 a a b) (2 a a c) (1 a b c) (4 a b d))
;   (esort2 '((1 a b c) (2 a a c)) '((3 a a c) (-1 a b c)))
;   =((5 a a c))
;
    (define (esort2 x y)
;   kadaip28-2 この関数を完成せよ.einsert2を呼び出します.
;   ヒント: 後2行で書けます.
    )
;
;   インサーションを行う関数
;
;   esort2の下請け関数である.
;
    (define (einsert2 x l)
        (if (null? l) (list x)
	    (let ((r (ecomp? x (car l))))
	       (cond ((< r 0) (cons x l))
      	             ((= r 0)
		      (let ((y (eadd2 x (car l))))
			(if (= (car y) 0) (cdr l)
			    (cons y (cdr l)))))
		     (#t (cons (car l) (einsert2 x (cdr l))))))))
;
;   2つの単項式の和を求める関数.両方ともソートされて標準形になっていることを
;   仮定している.
;   einsert2の下請け関数である.
;   2つの単項式がまとめられる時に,まとめた単項式を計算する.
;   2つの引数がまとめられない単項式の時はないと仮定してよい.
;
;   (eadd2 '(1 a b c) '(2 a b c)) = (3 a b c)
;   (eadd2 '(a b c) '(a b c)) = (2 a b c)
;   (eadd2 '(a b c) '(3 a b c)) = (4 a b c)
;   (eadd2 '() '(1)) = (2)
;   (eadd2 '(2) '(1)) = (3)
;
;; condの最初のほうのいくつかの条件は実際には満足される場合が
;; ない可能性もあります.
;
    (define (eadd2 x y)
        (cond ((and (number? x) (number? y)) (list (+ x y)))
	      ((and (symbol? x) (symbol? y)) (list 2 x))
	      ((and (null? x) (null? y)) '(2))
	      ((and (null? x) (number? y)) (list (+ 1 y)))
	      ((null? x) (list (+ 1 (car y))))
	      ((and (null? y) (number? x)) (list (+ 1 x)))
	      ((null? y) (list (+ 1 (car x))))
	      ((and (number? (car x)) (number? (car y)))
	       (cons (+ (car x) (car y)) (cdr x)))
	      ((number? (car x)) (cons (+ (car x) 1) (cdr x)))
	      ((number? (car y)) (cons (+ (car y) 1) (cdr y)))
	      (#t (cons 2 x))))
;
;   ソーティングの比較関数
;
;   xとyが両方とも係数または変数の時,あるいは,両方とも単項式の時,
;   比較結果を返す.<のとき-1, =のとき0, >のとき1を返す.
;
;   (ecomp? 'x 'x) = 0
;   (ecomp? 'x 'y) = -1
;   (ecomp? 'y 'x) = 1
;   (ecomp? 1 2) = 0  (係数同士の場合には0を返す)
;   (ecomp? 'x 1) = 1
;   (ecomp? 1 'x) = -1
;
;   (ecomp? '() '()) = 0
;   (ecomp? '() '(1 a b)) = -1
;   (ecomp? '(1 a b) '()) = 1
;   (ecomp? '(1 a b) '(1 a b)) = 0
;   (ecomp? '(1 a b) '(2 a b)) = 0
;   (ecomp? '(1 a b) '(2 a c)) = -1
;   (ecomp? '(1 a c) '(2 a b)) = 1
;
;   (以下の関数は,この仕様を満たすものとしては冗長だしあまりきれいではない)
;
    (define (ecomp? x y)
        (cond ((and (null? x) (null? y)) 0)
	      ((null? x) -1)
	      ((null? y) 1)
	      ((and (number? x) (number? y)) 0)
	      ((number? x) -1)
	      ((number? y) 1)
	      ((and (symbol? x) (symbol? y))
	       (cond ((eq? x y) 0)
	             ((string<? (symbol->string x) (symbol->string y)) -1)
	             (#t 1)))
	      ((symbol? x) -1)
	      ((symbol? y) 1)
	      ((number? (car x)) (ecomp? (cdr x) y))
	      ((number? (car y)) (ecomp? x (cdr y)))
	      ((eq? (car x) (car y)) (ecomp? (cdr x) (cdr y)))
	      ((string=? (symbol->string (car x)) (symbol->string (car y))) 0)
	      ((string<? (symbol->string (car x)) (symbol->string (car y))) -1)
	      (#t 1)))
;
;   展開された多項式のリストを与えられて,それらの積を求める関数
;
;   (mult '(((1 a a) (2 a b)) ((1 x y) (-1 y y))))
;   = ((1 a a x y) (-1 a a y y) (2 a b x y) (-2 a b y y))
;   (a*a + 2*a*b)*(x*y - y*y) = a*a*x*y - a*a*y*y + 2*a*b*x*y -2*a*b*y*y
;   を意味する.
;
;   (mult '(((1 a) (1 b)) ((1 a) (1 b)) ((1 a) (1 b))))
;   = ((1 a a a) (3 a a b) (3 a b b) (1 b b b))
;   (a + b)^3 = a*a*a + 3*a*a*b + 3*a*b*b + b*b*b
;   を意味する.
;
;   (mult '(((1 a a) (2 a b))))
;   = ((1 a a) (2 a b))
;   引数が一つの場合にはそのまま返す.
;
;   (mult '())
;   = ((1))
;   空リストの場合には((1))を返す.
;
    (define (mult x)
;   kadaip29 multを完成せよ.
;   ヒント:後2行で完成させることもできます.下請け関数mult2を使います.
    )
;
;   2つの展開された多項式の積を求める関数
;   multの下請け関数である.(これを下請けに使わなくてもよい)
;
;   (mult2 '((1 a a) (2 a b)) '((1 x y) (-1 y y)))
;   = ((1 a a x y) (-1 a a y y) (2 a b x y) (-2 a b y y))
;   (a*a + 2*a*b)*(x*y - y*y) = a*a*x*y - a*a*y*y + 2*a*b*x*y -2*a*b*y*y
;   を意味する.
;
;   (mult2 '() '(...))
;   = ()
;   0*(...)は0である.
;
;   (mult2 '(...) '())
;   = ()
;   (...)*0は0である.
;
    (define (mult2 x y)
;   kadaip30 mult2を完成せよ.
;   ヒント:後3行で完成させることもできます.mapを使うとよいかもしれません.
;   課題作成者の書いたプログラムの場合には,esort1, esort2, econst1を呼
;   び出しました.
    )
;
;   展開された多項式のリストを与えられて,それらの和を求める関数
;
;   (sum '(((1 a a) (2 a b)) ((1 x y) (-1 y y))))
;   = ((1 a a) (2 a b) (1 x y) (-1 y y))
;   (a*a + 2*a*b) + (x*y - y*y) = a*a + 2*a*b + x*y - y*y
;   を意味する.
;
;   (sum '(((1 a a) (2 a b)) ((1 a a) (-1 a b))))
;   = ((2 a a) (1 a b))
;   (a*a + 2*a*b) + (a*a - a*b) = 2*a*a + a*b
;   を意味する.
;
    (define (sum x)
;   kadaip31 sumを完成せよ.
;   ヒント:後1行で完成させることもできます.
;   課題作成者の書いたプログラムの場合には,esort2, allappendを呼び出
;   しました
    )
;
;   sumの下請け関数
;
;   (allappend '((a b c) (d e f) (1 2 3)))
;   = (a b c d e f 1 2 3)
;
;   (allappend '((a b c) ()))
;   = (a b c)
;
;   (allappend '())
;   = ()
;
    (define (allappend x)
        (if (null? x) '()
	    (append (car x) (allappend (cdr x)))))
;
;   LISPのS式で表された多項式を展開する関数
;   (このプログラムのメインの関数)
;   ただし,S式中の関数の位置には+,*,^のみが現れてもよいものとする.
;
;   (conv '(* x y (+ 1 4 x)))
;   = ((1 x x y) (5 x y))
;
;   (conv '(^ (+ x y) 3))
;   = ((1 x x x) (3 x x y) (3 x y y) (1 y y y))
;
;   (conv '(+ (^ (+ x y) 2) (^ (+ x (* -1 y)) 2)))
;   = ((2 x x) (2 y y))
;
    (define (conv x)
        (cond ((number? x) (list (list x)))
	      ((symbol? x) (list (list 1 x)))
	      ((eq? (car x) '+) (sum (map conv (cdr x))))
	      ((eq? (car x) '*) (mult (map conv (cdr x))))
	      ((eq? (car x) '^) (power (conv (cadr x)) (caddr x)))))
;
;   展開された多項式と,自然数nを与えられて,多項式のn乗を求める関数
;
;   (power '((1 a) (1 b)) 3)
;   = ((1 a a a) (3 a a b) (3 a b b) (1 b b b))
;
;   (power '((1 a) (1 b)) 0)
;   = ((1))
;
    (define (power x n)
        (cond ((= n 0) '((1)))
	      (#t (mult2 x (power x (- n 1))))))
;
;