●問題61
述語 pred を満たす要素の位置を求める関数 list-index pred ls1 ls2 ... を定義してください。list-index は複数のリストを引数に受け取ります。引数のリストの長さが異なる場合は、短いリストの要素がなくなった時点で nil を返すことにします。なお、リストの要素は 0 から数え始めるものとします。
> (list-index #'= '(1 3 5 7 9) '(1 3 5 7 9)) 0 > (list-index #'/= '(1 3 5 7 9) '(1 3 5 7 9)) NIL > (list-index #'(lambda (x y) (= (* x 10) y)) '(1 2 3 4 5) '(46 47 48 49 50)) 4
●問題62
リストの先頭から順番に関数 fn を適用して畳み込み (縮約) を行う関数 fold-left fn a ls1 ls2 ... を定義してください。fold-left は複数のリストを引数に受け取ります。引数のリストの長さが異なる場合は、短いリストの長さに合わせてください。たとえば、短いリストの長さが n の場合、各リストの 0 から n - 1 番目の要素が畳み込みの対象となります。
> (fold-left #'(lambda (a x y) (cons (cons x y) a)) nil '(a b c d) '(1 2 3 4)) ((d . 4) (c . 3) (b . 2) (a . 1)) > (fold-left #'(lambda (a x y) (cons (* x y) a)) nil '(10 11 12 13) '(1 2 3 4)) (52 36 22 10) > (fold-left #'(lambda (a x y) (+ (* x y) a)) 0 '(10 11 12 13) '(1 2 3 4)) 120
●問題63
リストの末尾から順番に関数 fn を適用して畳み込み (縮約) を行う関数 fold-right fn a ls1 ls2 ... を定義してください。fold-right は複数のリストを引数に受け取ります。引数のリストの長さが異なる場合は、短いリストの長さに合わせてください。たとえば、短いリストの長さが n の場合、各リストの 0 から n - 1 番目の要素が畳み込みの対象となります。
> (fold-right #'(lambda (a x y) (cons (cons x y) a)) nil '(a b c d) '(1 2 3 4)) ((a . 1) (b . 2) (c . 3) (d . 4)) > (fold-right #'(lambda (a x y) (cons (* x y) a)) nil '(10 11 12 13) '(1 2 3 4)) (10 22 36 52) > (fold-right #'(lambda (a x y) (+ (* x y) a)) 0 '(10 11 12 13) '(1 2 3 4)) 120
●問題64
リストの先頭から順番に添字と要素を関数 fn に渡して畳み込み (縮約) を行う関数 fold-left-with-index fn a ls1 ls2 ... を定義してください。
> (fold-left-with-index #'(lambda (a i x) (cons (cons x i) a)) nil '(a b c d e)) ((e . 4) (d . 3) (c . 2) (b . 1) (a . 0)) > (fold-left-with-index #'(lambda (a i x) (if (evenp i) (cons (cons x (car a)) (cdr a)) (cons (car a) (cons x (cdr a))))) nil '(a b c d e f)) ((e c a) f d b)
●問題65
リストの末尾から順番に添字と要素を関数 fn に渡して畳み込み (縮約) を行う関数 fold-right-with-index fn a ls1 ls2 ... を定義してください。
> (fold-right-with-index #'(lambda (a i x) (cons (cons x i) a)) nil '(a b c d e)) ((a . 0) (b . 1) (c . 2) (d . 3) (e . 4)) > (fold-right-with-index #'(lambda (a i x) (if (evenp i) (cons (cons x (car a)) (cdr a)) (cons (car a) (cons x (cdr a))))) nil '(a b c d e f)) ((a c e) b d f)
●問題66
添字付きのマップ関数 map-with-index fn ls1 ls2 ... を定義してください。map-with-index は複数のリストを引数に受け取ります。引数のリストの長さが異なる場合は、短いリストの要素がなくなった時点で処理を終了します。
> (map-with-index #'(lambda (i x) (cons x i)) '(a b c d e)) ((a . 0) (b . 1) (c . 2) (d . 3) (e . 4)) > (map-with-index #'(lambda (i x y) (list x y i)) '(a b c d) '(e f g h i)) ((a e 0) (b f 1) (c g 2) (d h 3))
●問題67
2 つのリストを破壊的にマージする関数 nmerge-list comp xs ys を定義してください。comp x y は x と y を比較して、x < y であれば負の値を、x と y が等しければ 0 を、x > y であれば正の値を返すものとします。
> (defun comp (x y) (- x y)) comp > (nmerge-list #'comp '(1 3 5 7) '(2 4 6 8)) (1 2 3 4 5 6 7 8) > (setq a '(1 3 5 7 9)) (1 3 5 7 9) > (setq b '(0 2 4 6 8)) (0 2 4 6 8) > (nmerge-list #'comp a b) (0 1 2 3 4 5 6 7 8 9) > a (1 2 3 4 5 6 7 8 9) > b (0 1 2 3 4 5 6 7 8 9)
●問題68
nmerge-list を使ってリストを破壊的にマージソートする関数 nmerge-sort comp ls n を定義してください。comp x y は x と y を比較して、x < y であれば負の値を、x と y が等しければ 0 を、x > y であれば正の値を返すものとします。
> (setq a '(5 6 4 7 3 8 2 9 1 0)) (5 6 4 7 3 8 2 9 1 0) > (nmerge-sort comp a 10) (0 1 2 3 4 5 6 7 8 9) > a (5 6 7 8 9)
●問題69
ベクタ vec の部分列 (start 番目から end - 1 番目まで) の中から最小値の位置を求める関数 min-vector comp vec start end を定義してください。comp x y は x と y を比較して、x < y であれば負の値を、x と y が等しければ 0 を、x > y であれば正の値を返すものとします。
> (min-vector #'comp #(5 4 6 3 7 8 2 9 1) 0 9) 8
●問題70
ベクタ vec を選択ソートする関数 select-sort-vector comp vec を定義してください。comp x y は x と y を比較して、x < y であれば負の値を、x と y が等しければ 0 を、x > y であれば正の値を返すものとします。なお、vec は破壊的に修正されるものとします。
> (setq a #(5 6 4 7 3 8 2 9 1 0)) #(5 6 4 7 3 8 2 9 1 0) > (select-sort-vector comp a) #(0 1 2 3 4 5 6 7 8 9) > a #(0 1 2 3 4 5 6 7 8 9)
●問題71
ベクタ vec をクイックソートする関数 quick-sort-vector comp vec を定義してください。comp x y は x と y を比較して、x < y であれば負の値を、x と y が等しければ 0 を、x > y であれば正の値を返すものとします。なお、vec は破壊的に修正されるものとします。
> (setq a #(5 6 4 7 3 8 2 9 1 0)) #(5 6 4 7 3 8 2 9 1 0) > (quick-sort-vector comp a) #(0 1 2 3 4 5 6 7 8 9) > a #(0 1 2 3 4 5 6 7 8 9)
●問題72
逆ポーランド記法で書かれた数式を計算するプログラムを作ってください。演算子は +, -, *, / で、数式はリストで表すものとにします。
逆ポーランド記法について簡単に説明します。私達が普通に式を書く場合、1 + 2 のように演算子を真ん中に置きます。この書き方を「中置記法」といいます。このほかに、「前置記法」と「後置記法」という書き方があります。前置記法は演算子を前に置く書き方で、ポーランド記法 (Polish Notation) と呼ばれることもあります。たとえば、1 + 2 であれば + 1 2 と書きます。数式にカッコをつけてみると (+ 1 2) となり、Lisp / Scheme のプログラムになります。
後置記法は演算子を後ろに置く書き方で、逆ポーランド記法 (RPN : Reverse Polish Notation) と呼ばれることもあります。1 + 2 であれば 1 2 + のように書きます。逆ポーランド記法の利点は、計算する順番に演算子が現れるため、カッコが不要になることです。たとえば、1 と 2 の和と 3 と 4 の和との積という数式を表してみましょう。
中置記法： (1 + 2) * (3 + 4) 後置記法： 1 2 + 3 4 + *
逆ポーランド記法は、日本語の読み方とまったく同じです。1 2 + で 1 と 2 の和を求め、3 4 + で 3 と 4 を求め、最後に 2 つの結果を掛け算して答えが求まります。
> (rpn '(1 2 + 3 4 + *)) 21 > (rpn '(1 2 + 3 4 - *)) -3 > (rpn '(1 2 + 3 4 + 5 6 + * *)) 231 > (rpn '(1 2 + 3 4 + 5 6 + * /)) 3/77 > (rpn '(1 2 + 3 4 + * 5 6 + /)) 21/11
●問題73
中置記法で書かれた数式を計算するプログラムを作ってください。演算子は +, -, *, - で、カッコを使用することができます。数式はリストで表すことにします。
> (expression '(1 + 2 * 3 + 4)) 11 NIL > (expression '((1 + 2) * (3 + 4))) 21 NIL > (expression '((1 + 2) / (3 + 4))) 3/7 NIL
●問題74
前置記法の数式を後置記法に変換する関数 prefix->postfix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。
> (prefix->postfix '(* (+ 1 2) (- 3 4))) (1 2 + 3 4 - *) > (prefix->postfix '(* (+ 1 2) (- 3 (/ 4 5)))) (1 2 + 3 4 5 / - *)
●問題75
後置記法の数式を前置記法に変換する関数 postfix->prefix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。
> (postfix->prefix '(1 2 + 3 4 - *)) (* (+ 1 2) (- 3 4)) > (postfix->prefix '(1 2 + 3 4 5 / - *)) (* (+ 1 2) (- 3 (/ 4 5)))
●問題76
前置記法の数式を中置記法に変換する関数 prefix->infix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。なお、中置記法はカッコを使うことができます。
> (prefix->infix '(* (+ 1 2) (- 3 4))) ((1 + 2) * (3 - 4)) > (prefix->infix '(* (+ 1 2) (- 3 (/ 4 5)))) ((1 + 2) * (3 - (4 / 5)))
●問題77
中置記法で冗長なカッコをはずす関数 flatexpr expr を定義してください。
> (flatexpr '((1 + 2) * (3 - 4))) ((1 + 2) * (3 - 4)) > (flatexpr '((1 + 2) + (3 - 4))) (1 + 2 + 3 - 4) > (flatexpr '((1 * 2) + (3 / 4))) (1 * 2 + 3 / 4)
●問題78
中置記法の数式を前置記法に変換する関数 infix->prefix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。中置記法はカッコを使うことができます。
> (infix->prefix '(1 + 2 + 3 + 4)) (+ (+ (+ 1 2) 3) 4) NIL > (infix->prefix '((1 + 2) * (3 - 4))) (* (+ 1 2) (- 3 4)) NIL > (infix->prefix '(1 * 2 + 3 / 4)) (+ (* 1 2) (/ 3 4)) NIL
●問題79
後置記法の数式を中置記法に変換する関数 postfix->infix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。中置記法はカッコを使うことができます。
> (postfix->infix '(1 2 + 3 4 - *)) ((1 + 2) * (3 - 4)) > (postfix->infix '(1 2 + 3 4 5 / - *)) ((1 + 2) * (3 - (4 / 5)))
●問題80
中置記法の数式を後置記法に変換する関数 infix->postfix expr を定義してください。数式はリストで表して、演算子は +, -, *, / とします。中置記法はカッコを使うことができます。
> (infix->postfix '(1 + 2 - 3 + 4)) (1 2 + 3 - 4 +) NIL > (infix->postfix '((1 + 2) * (3 - 4))) (1 2 + 3 4 - *) NIL > (infix->postfix '((1 + 2) * (3 - 4 / 5))) (1 2 + 3 4 5 / - *) NIL
●解答61
リスト : 述語 pred が真となる位置を求める
(defun list-index (pred &rest args)
(labels ((list-index-sub (i &rest args)
(cond ((member nil args) nil)
((apply pred (mapcar #'car args)) i)
(t (apply #'list-index-sub (1+ i) (mapcar #'cdr args))))))
(apply #'list-index-sub 0 args)))
; 別解
(defun list-index1 (pred &rest args)
(do ((args args (mapcar #'cdr args))
(i 0 (1+ i)))
((member nil args) nil)
(when (apply pred (mapcar #'car args))
(return i))))
実際の処理は局所関数 list-index-sub で行います。引数 i が添字を表します。リストは引数 args に格納されています。最初に member で args に空リスト (nil) があるかチェックし、そうであれば nil を返します。次に、各リストの先頭要素を (mapcar #'car args) で取り出し、それを述語 pred に渡して呼び出します。返り値が真の場合は添字 i を返します。偽の場合は、list-index-sub を再帰呼び出しして、次の要素を調べます。このとき、(mapcar #'cdr args) で各リストの先頭要素を取り除きます。別解は再帰呼び出しを繰り返しに変換したものです。
●解答62
リスト : 畳み込み (1)
(defun fold-left (fn a &rest args)
(if (member nil args)
a
(apply #'fold-left fn (apply fn a (mapcar #'car args)) (mapcar #'cdr args))))
; 別解
(defun fold-left1 (fn a &rest args)
(do ((args args (mapcar #'cdr args)))
((member nil args) a)
(setq a (apply fn a (mapcar #'car args)))))
fold-left も簡単です。mapcar でリストの先頭要素を取り出し、それを関数 fn に渡して呼び出せばいいわけです。このとき、累積変数 a は fn の第 1 引数になることに注意してください。fold-left を再帰呼び出しするときはリストの先頭要素を mapcar で取り除きます。別解は末尾再帰を繰り返しに変換したものです。
●解答63
リスト : 畳み込み (2)
(defun fold-right (fn a &rest args)
(if (member nil args)
a
(apply fn (apply #'fold-right fn a (mapcar #'cdr args)) (mapcar #'car args))))
fold-left と同様に fold-right も簡単です。fold-left と違って末尾再帰にはならないことに注意してください。
●解答64
リスト : 添字付き畳み込み (1)
(defun fold-left-with-index (fn a &rest args)
(labels ((fold-sub (i a args)
(if (member nil args)
a
(fold-sub (1+ i)
(apply fn a i (mapcar #'car args))
(mapcar #'cdr args)))))
(fold-sub 0 a args)))
; 別解
(defun fold-left-with-index1 (fn a &rest args)
(do ((args args (mapcar #'cdr args))
(i 0 (1+ i)))
((member nil args) a)
(setq a (apply fn a i (mapcar #'car args)))))
fold-left-with-index は fold-left に添字の処理を追加しただけです。関数 fn を呼び出すとき、第 1 引数が累積変数、第 2 引数が添字、それ以降にリストの要素が渡されることに注意してください。別解は末尾再帰を繰り返しに変換したものです。
●解答65
リスト : 添字付き畳み込み (2)
(defun fold-right-with-index (fn a &rest args)
(labels ((fold-sub (i a args)
(if (member nil args)
a
(apply fn
(fold-sub (1+ i) a (mapcar #'cdr args))
i
(mapcar #'car args)))))
(fold-sub 0 a args)))
fold-right-with-index は fold-right に添字の処理を追加しただけです。関数 fn を呼び出すとき、第 1 引数が累積変数、第 2 引数が添字、それ以降にリストの要素が渡されることに注意してください。
●解答66
リスト : 添字付きマップ関数
(defun map-with-index (fn &rest args)
(labels ((map-sub (i args)
(if (member nil args)
nil
(cons (apply fn i (mapcar #'car args))
(map-sub (1+ i) (mapcar #'cdr args))))))
(map-sub 0 args)))
; 別解
(defun map-with-index1 (fn &rest args)
(do ((args args (mapcar #'cdr args))
(i 0 (1+ i))
(a nil))
((member nil args) (nreverse a))
(push (apply fn i (mapcar #'car args)) a)))
map-with-index も簡単です。実際の処理は局所関数 map-sub で行います。引数 i が添字を表します。関数 fn の第 1 引数に添字を渡すことに注意してください。別解は繰り返しでプログラムしたもので、最後に nreverse でリストを破壊的に反転してから返します。
●解答67
リスト : リストのマージ (破壊的修正)
(defun nmerge-list (pred xs ys)
(do* ((header (list nil))
(tail header))
((or (null xs) (null ys))
(rplacd tail (if (null xs) ys xs))
(cdr header))
(cond ((minusp (funcall pred (car xs) (car ys)))
(rplacd tail xs)
(setf tail xs)
(pop xs))
(t
(rplacd tail ys)
(setf tail ys)
(pop ys)))))
nmerge-list はダミーのヘッダセル header を用意すると簡単です。do* でループを形成して、末尾のセルを変数 tail に保持します。tail の初期値は header になります。xs が空リストになったなら、rplacd で tail に ys を破壊的に連結します。ys が空リストになったら xs を tail に連結します。返り値は (cdr header) になります。
xs と ys に要素がある場合、pred で (car x) と (car y) を比較します。返り値が負の値であれば xs の要素が小さいので、セル xs を tail に連結します。そうでなければセル ys を tail に連結します。そして、tail の値をつなげたセルに更新してから、先頭要素を pop で取り除きます。これで次のセルへ進めることができます。
●解答68
リスト : マージソート (破壊的修正)
(defun nmerge-sort (pred ls n)
(if (= n 1)
(rplacd ls nil)
(let ((m (floor n 2)))
(nmerge-list pred
; 後半からソートすること
(nmerge-sort pred (nthcdr m ls) (- n m))
(nmerge-sort pred ls m)))))
nmerge-sort は連結リストを分割する処理で、新しい連結リストを作らないことに注意してください。次の図を見てください。
上図の連結リストを二分割する場合、前半部分は x と n/2 で表し、後半部分を y と (n - n/2) で表します。y は連結リストを n / 2 回たどれば求めることができます。
n が 1 になったら ls の cdr を nil に書き換えます。これが再帰の停止条件で、要素数が一つの連結リスト、つまりソート済みの連結リストを返すことになります。n が 1 よりも大きい場合は、連結リストを二分割して nmerge-sort を再帰呼び出しし、その結果を nmerge-list でマージすればいいわけです。このとき、リストの後半部分からソートすることに注意してください。そうしないと、nthcdr でリストをたどることができなくなります。
●解答69
リスト : ベクタの中から最小値を求める
(defun min-vector (comp buff start end)
(do ((pos start)
(i (1+ start) (1+ i)))
((= i end) pos)
(when (minusp (funcall comp (aref buff i) (aref buff pos)))
(setf pos i))))
最小値の位置を変数 pos に格納します。最初は仮の最小値として start 番目の要素をセットします。あとは i + 1 番目から end - 1 番目までの要素と pos 番目の要素を comp で比較して、i 番目の要素が pos 番目の要素よりも小さい場合は pos の値を更新します。
●解答70
選択ソート (selection sort) は、ソートしていないデータの中から最小値（または最大値）を見つけ、それを先頭のデータと交換する、という手順を繰り返すことでソートを行います。最初は、すべてのデータの中から最小値を探し、それを配列の先頭 buff[0] と交換します。次は、buff[1] 以降のデータの中から最小値を探し、それを buff[1] と交換します。これを繰り返すことでソートすることができます。
[9 5 3 7 6 4 8] 3 と 9 を交換する
+ +
3 [5 9 7 6 4 8] 5 と 4 を交換する
+ +
3 4 [9 7 6 5 8] 9 と 5 を交換する
+ +
3 4 5 [7 6 9 8] 7 と 6 を交換する
+ +
3 4 5 6 [7 9 8] 7 と 7 を交換する
+
3 4 5 6 7 [9 8] 9 と 8 を交換してソート終了
+ +
図 : 選択ソート
このように、選択ソートは単純でわかりやすいアルゴリズムです。プログラムは次のようになります。
リスト : 選択ソート
(defun select-sort-vector (comp buff)
(do ((i 0 (1+ i))
(e (length buff)))
((= i e) buff)
(rotatef (aref buff i) (aref buff (min-vector comp buff i e)))))
ベクタの i 番目から末尾までの中から min-vector で要素を選び、それと i 番目の要素を交換するだけです。
●解答71
クイックソートはある値を基準にして、要素をそれより大きいものと小さいものの 2 つに分割していくことでソートを行います。2 つに分けた各々の区間を同様に分割して 2 つの区間に分けます。最後は区間の要素がひとつになってソートが完了します。
9 5 3 7 6 4 2 8 最初の状態
9 5 3 7 6 4 2 8 7 を枢軸にして左側から 7 以上の値を探し、
L R 右側から 7 以下の値を探す。
2 5 3 7 6 4 9 8 交換する
L R
2 5 3 7 6 4 9 8 検索する
L R
2 5 3 4 6 7 9 8 交換する
L R
2 5 3 4 6 7 9 8 検索する。R と L が交差したら分割終了。
R L
[2 5 3 4 6] [7 9 8] この 2 つの区間について再び同様な分割を行う
図 : クイックソート
基準になる値のことを「枢軸 (pivot) 」といいます。枢軸は要素の中から適当な値を選びます。今回は中央にある要素を選ぶことにしましょう。上図を見てください。左側から枢軸 7 以上の要素を探し、左側から 7 以下の要素を探します。探索のときは枢軸が番兵の役割を果たすので、ソート範囲外の要素を探索することはありません。見つけたらお互いの要素を交換します。探索位置が交差したら分割は終了です。
あとは同じ手順を分割した 2 つの区間に適用します。これは再帰定義を使えば簡単に実現できます。分割した区間の要素数が 1 になったときが再帰の停止条件になります。
プログラムは次のようになります。
リスト : クイックソート
(defun qsort (buff low high comp)
(do ((pivot (aref buff (floor (+ low high) 2)))
(i low (1+ i))
(j high (1- j)))
()
(do ()
((<= 0 (funcall comp (aref buff i) pivot)))
(incf i))
(do ()
((<= 0 (funcall comp pivot (aref buff j))))
(decf j))
(when (>= i j)
(when (< low (1- i))
(qsort buff low (1- i) comp))
(when (< (1+ j) high)
(qsort buff (1+ j) high comp))
(return))
(rotatef (aref buff i) (aref buff j))))
(defun quick-sort-vector (pred buff)
(qsort buff 0 (1- (length buff)) pred)
buff)
実際のソートは qsort で行います。引数 low が区間の下限値、high が区間の上限値、comp が比較関数です。qsort は buff の low から high までの区間をソートします。最初に区間の中央にあるデータを枢軸 pivot として選び、pivot を基準にして区間を 2 つに分けます。
do ループの中の最初の do ループで左側から枢軸以上の要素を探します。同様に、次の do ループで右側から枢軸以下の要素を探します。お互いの探索位置 i, j が交差したら分割は終了です。そうでなければお互いの要素を交換します。そして、分割した区間に対して qsort を再帰呼び出しします。このとき要素数をチェックして、2 個以上ある場合に再帰呼び出しを行います。この停止条件を忘れると正常に動作しません。ご注意ください。
●解答72
逆ポーランド記法の数式はスタックを使うと簡単に計算することができます。アルゴリズムは次のようになります。
1. 数値はスタックに追加する。 2. 演算子であればスタックから 2 つ数値を取り出し、演算結果をスタックに追加する。 3. 最後にスタックに残った値が答えになる。
たったこれだけの規則で数式を計算することができます。それでは、実際に 1 2 + 3 4 + * を試してみましょう。次の表を見てください。
| 数式 | 操作 | スタック |
|---|---|---|
| 1 | PUSH | ( 1 ) |
| 2 | PUSH | ( 2 1 ) |
| + | POP (2) | ( 1 ) |
| POP (1) | ( ) | |
| 1+2=3 | ( ) | |
| PUSH | ( 3 ) | |
| 3 | PUSH | ( 3 3 ) |
| 4 | PUSH | ( 4 3 3 ) |
| + | POP (4) | ( 3 3 ) |
| POP (3) | ( 3 ) | |
| 3+4=7 | ( 3 ) | |
| PUSH | ( 7 3 ) | |
| * | POP (7) | ( 3 ) |
| POP (3) | ( ) | |
| 3*7=21 | ( ) | |
| PUSH | ( 21 ) |
スタックはリスト ( ) で表します。最初の 1 と 2 は数値なのでスタックにプッシュします。次は演算子 + なので、スタックからデータを取り出して 1 + 2 を計算します。そして、計算結果 3 をスタックにプッシュします。次に、3 と 4 は数値なのでスタックにプッシュします。その次は演算子 + なので同じように処理して、計算結果 7 をスタックにプッシュします。
スタックの中身は ( 7 3 ) となり、最初の計算結果 3 と次に計算した結果 7 がスタックに格納されています。この状態で最後の * を処理します。7 と 3 を取り出すとスタックは空の状態になります。そして、3 * 7 を計算して 21 をスタックにプッシュします。これで計算は終了です。スタックに残っている値 21 が計算結果となります。
このように、スタックを使うことで逆ポーランド記法で書かれた数式を簡単に計算することができます。実は数式だけではなく、スタックを用いてプログラムを実行することもできます。プログラミング言語 Forth は「数値」と「ワード」という 2 種類のデータしかありません。ワードには +, -, *, / などの演算子のほかに、いろいろな処理が定義されています。もちろん、ユーザが新しいワードを定義することもできます。
Forth の動作は、数値であればスタックにプッシュして、ワードであればそれを実行する、というシンプルなものです。これでプログラミングができるのですから、とてもユニークな言語ですね。
プログラムは次のようになります。
リスト : 数式の計算 (後置記法)
; 演算子の取得
(defun getop (sym)
(case sym
((+) #'+)
((-) #'-)
((*) #'*)
((/) #'/)
(t
(error "invalid operation"))))
; 後置記法の数式を計算する
(defun rpn (ls)
(do ((ls ls (cdr ls))
(a nil))
((null ls)
(if (null (cdr a))
(car a)
(error "invalid expression")))
(cond ((numberp (car ls))
(push (car ls) a))
((symbolp (car ls))
(if (or (null a) (null (cdr a)))
(error "stack underflow")
(let ((x (pop a))
(y (pop a)))
(push (funcall (getop (car ls)) y x) a))))
(t (error "invalid data")))))
関数 rpn の引数 ls が数式を表すリストです。do の局所変数 a がスタックを表します。ls が空リストになったら、スタックトップの値を返します。このとき、スタックに複数の値が格納されている場合はエラーを送出します。
次に、ls の要素が数値の場合はそれをスタックに追加します。シンボルの場合、最低でも 2 つの値がスタックになければいけません。0 個または 1 個しかない場合はエラーを送出します。そうでなければ、関数 getop でシンボルの関数値を取得し、スタックに格納されている値を渡して評価します。このとき、先頭の要素が第 2 引数、2 番目の要素が第 1 引数になることに注意してください。評価結果はスタックから関数に渡した値を削除したあとで追加します。
なお、Common Lisp では getop のかわりに関数 symbol-function を使って関数値を取得することができます。SBCL での使用例を示します。
* (symbol-function '+) #<FUNCTION +> * (funcall (symbol-function '+) 1 2 3) 6
●解答73
参考文献 [1] の「式の評価」によると、四則演算の数式は次の構文規則で表すことができます。
式 := 項 (+ | -) 項 (+ | -) 項 ... 項 :- 因子 (* | /) 因子 (* | /) 因子 ... 因子 := 数 | (式)
これをそのままプログラムすると、次のようになります。
リスト : 数式の計算 (中置記法)
; 優先順位
(defun weight (op)
(case op
((+) 1)
((-) 1)
((*) 2)
((/) 2)
(t (error "invalid operation"))))
; 因子の評価
(defun factor (ls)
(cond ((numberp (car ls))
(values (car ls) (cdr ls)))
((consp (car ls))
(values (expression (car ls)) (cdr ls)))
(t
(error "invalid expression"))))
; 項の評価
(defun term (ls)
(multiple-value-bind (x xs)
(factor ls)
(do ((x x) (xs xs))
((null xs) (values x nil))
(if (= (weight (car xs)) 2)
(multiple-value-bind (y ys)
(factor (cdr xs))
(setq x (funcall (getop (car xs)) x y)
xs ys))
(return (values x xs))))))
; 式の評価
(defun expression (ls)
(multiple-value-bind (x xs)
(term ls)
(do ((x x) (xs xs))
((null xs) (values x nil))
(if (= (weight (car xs)) 1)
(multiple-value-bind (y ys)
(term (cdr xs))
(setq x (funcall (getop (car xs)) x y)
xs ys))
(return (values x xs))))))
関数 expression は「式」を評価します。最初に関数 term を呼び出して「項」を評価します。返り値は多値で、評価結果と残りのリストです。あとは、演算子が + または - の場合は term を呼び出して評価を行い、返り値を y と ys にセットします。関数 weight は演算子の優先順位を返します。+, - の場合は 1 を返すので、そのときは x に y を加算または減算します。そうでなければ、評価結果 x と残りのリスト xs を values で返します。
関数 term も同様の処理を行います。この場合は最初に関数 factor を呼び出して「因子」を評価します。そして、演算子が * または / の場合は factor を呼び出して評価を続行します。そうでなければ、評価結果 x と残りのリスト xs を values で返します。関数 factor は簡単で、引数 ls の先頭要素が数値の場合はそれをそのまま返し、リストであればそれを expression に渡して評価します。それ以外の場合はエラーを送出します。
[1] 奥村晴彦,『Ｃ言語による最新アルゴリズム事典』, 技術評論社, 1991
●解答74
前置記法を後置記法に変換するのは簡単です。次の図を見てください。
上図のように、前置記法の数式は二分木そのものです。再帰呼び出しで二分木をたどり、(op x y) を (x y op) に変換すればいいだけです。プログラムは次のようになります。
リスト : 前置記法 -> 後置記法
(defun prefix->postfix (expr)
(cond ((consp expr)
(append (prefix->postfix (cadr expr))
(prefix->postfix (caddr expr))
(list (car expr))))
(t (list expr))))
引数 expr が数式を表すリストです。expr がリストの場合、prefix->postfix を再帰呼び出します。prefix->postfix の返り値はリストなので、カッコを外すために append で連結します。expr がリストでない場合、list で expr をリストに格納して返します。
●解答75
postfix->prefix は、後置記法の計算で作成した関数 rpn を改造すると簡単です。次のリストを見てください。
リスト :
(defun postfix->prefix (ls)
(do ((ls ls (cdr ls))
(a nil))
((null ls)
(if (null (cdr a))
(car a)
(error "invalid expression")))
(cond ((numberp (car ls))
(push (car ls) a))
((symbolp (car ls))
(if (or (null a) (null (cdr a)))
(error "stack underflow")
(let ((x (pop a))
(y (pop a)))
(push (list (car ls) y x) a))))
(t (error "invalid data")))))
演算子を処理する場合、値を計算するかわりに前置記法に変換した数式 (op x y) をスタック a に追加するだけです。
●解答76
前置記法から中置記法へ変換する場合、冗長なカッコを取り除かないでよければとても簡単です。数式 (op x y) を (x op y) に変換するだけでいいのです。プログラムは次のようになります。
リスト : 前置記法 -> 中置記法
(defun prefix->infix (expr)
(if (consp expr)
(list (prefix->infix (cadr expr))
(car expr)
(prefix->infix (caddr expr)))
expr))
最初に expr をチェックして、リストでなければ expr をそのまま返します。これが再帰の停止条件になります。リストの場合は記法の変換を行います。prefix->infix を再帰呼び出しして引数を中置記法に変換します。そして、演算子を引数の間にセットして返します。
●解答77
冗長なカッコは、演算子の優先度を考慮することで取り除くことができます。たとえば、数式が ((1 + 2) * (3 / 4)) の場合を考えてみましょう。
((1 + 2) * (3 / 4)) => ((1 + 2) * 3 / 4)
演算子 * と + では、+ の方の重みが小さいですね。この場合、+ の方はカッコをはずすことができません。次の演算子 / は * と重みが同じなので、カッコをはずすことができます。
基本的な処理はこれでいいのですが、ひとつだけ問題があります。それは演算子が - と / のときにカッコをはずす場合です。次の例を見てください。
(1 - (2 - (3 - 4))) => (1 - (2 - 3 + 4))
=> (1 - 2 + 3 - 4)
(1 / (2 / (3 / 4))) => (1 / (2 / 3 * 4))
=> (1 / 2 * 3 / 4)
このように、演算子が - のときはカッコ内の + と - を、/ のときはカッコ内の * と / を反転させないといけません。この処理は map を使うと簡単に実現できます。
> (mapcar #'(lambda (x) (case x (+ '-) (- '+) (t x))) '(2 - 3 + 4)) (2 + 3 - 4) > (mapcar #'(lambda (x) (case x (+ '-) (- '+) (t x))) '(2 * (3 - 4))) (2 * (3 - 4))
リストの要素が + であれば - に、- であれば + に変更します。それ以外の要素はそのまま出力します。map はリストのトップレベルの要素に対してラムダ式を適用するので、たとえば、数式 (2 * (3 - 4)) の - を + に変更することはありません。
プログラムは次のようになります。
リスト : 余分なカッコをはずす
(defun change-op1 (expr)
(mapcar #'(lambda (x) (case x ((+) '-) ((-) '+) (t x)))
expr))
(defun change-op2 (expr)
(mapcar #'(lambda (x) (case x ((*) '/) ((/) '*) (t x)))
expr))
(defun check-op1 (expr)
(if (consp (cdr expr))
(case (cadr expr)
((+ -) (list expr))
(t expr))
expr))
(defun flatexpr (expr)
(if (consp expr)
(let ((e1 (flatexpr (car expr)))
(e2 (flatexpr (caddr expr))))
(case (cadr expr)
((+)
(append e1 (list '+) e2))
((-)
(append e1 (list '-) (change-op1 e2)))
((*)
(append (check-op1 e1) (list '*) (check-op1 e2)))
((/)
(append (check-op1 e1) (list '/) (change-op2 (check-op1 e2))))))
(list expr)))
関数 change-op1 は + と - を反転します。関数 change-op2 は * と / を反転します。関数 check-op1 は、演算子が + と - のとき、数式 expr をリストに格納して返します。これは演算子が * と / のときに呼び出します。
関数 flatexpr は引数 expr の余分なカッコをはずします。expr がリストの場合、flatexpr を再帰呼び出しします。(x op y) の x を変換して e1 に、y を変換して e2 にセットします。次に、op によって処理を分けます。+ の場合、append で e1 と (+) と e2 を連結するだけです。- の場合、change-op1 で e2 を変換して append で連結します。
* の場合、check-op1 で e2 の演算子をチェックします。+ と - の場合、e2 はリストに格納されて返されるので、カッコがはずされることはありません。* と / の場合はカッコがはずされます。/ の場合は、check-op1 の返り値を change-op2 で変換します。これでカッコをはずしたあとで、* と / を反転することができます。
●解答78
中置記法を前置記法に変換する関数 infix->prefix は、中置記法を数式を計算する関数 expression を改造すると簡単です。次のリストを見てください。
リスト : 中置記法 -> 前置記法
(defun inf-pre-factor (ls)
(cond ((numberp (car ls))
(values (car ls) (cdr ls)))
((consp (car ls))
(values (infix->prefix (car ls)) (cdr ls)))
(t
(error "invalid expression"))))
(defun inf-pre-term (ls)
(multiple-value-bind (x xs)
(inf-pre-factor ls)
(do ((x x) (xs xs))
((null xs) (values x '()))
(if (= (weight (car xs)) 2)
(multiple-value-bind (y ys)
(inf-pre-factor (cdr xs))
(setq x (list (car xs) x y)
xs ys))
(return (values x xs))))))
(defun infix->prefix (ls)
(multiple-value-bind (x xs)
(inf-pre-term ls)
(do ((x x) (xs xs))
((null xs) (values x '()))
(if (= (weight (car xs)) 1)
(multiple-value-bind (y ys)
(inf-pre-term (cdr xs))
(setq x (list (car xs) x y)
xs ys))
(return (values x xs))))))
項の処理を関数 inf-pre-term で、因子の処理を inf-pre-factor で行います。値を計算するかわりに、x op y を (op x y) に変換して返すだけです。
●解答79
postfix->infix は、後置記法の計算で作成した関数 rpn を改造すると簡単に作成できます。次のリストを見てください。
リスト : 後置記法 -> 中置記法
(defun postfix->infix (ls)
(do ((ls ls (cdr ls)) (a '()))
((null ls)
(if (null (cdr a))
(car a)
(error "invalid expression")))
(cond ((numberp (car ls))
(push (car ls) a))
((symbolp (car ls))
(if (null (cdr a))
(error "stack underflow")
(let ((x (pop a))
(y (pop a)))
(push (list y (car ls) x) a))))
(t (error "invalid data")))))
演算子を処理する場合、値を計算するかわりに中置記法に変換した数式 (x op y) をスタック a に追加するだけです。余分なカッコをはずす場合は flatexpr を適用してください。
●解答80
中置記法を後置記法に変換する関数 infix->postfix は、中置記法を数式を計算する関数 expression を改造すると簡単です。次のリストを見てください。
リスト : 中置記法 -> 後置記法
(defun inf-post-factor (ls)
(cond ((numberp (car ls))
(values (list (car ls)) (cdr ls)))
((consp (car ls))
(values (infix->postfix (car ls)) (cdr ls)))
(else
(error "invalid expression"))))
(defun inf-post-term (ls)
(multiple-value-bind (x xs)
(inf-post-factor ls)
(do ((x x) (xs xs))
((null xs) (values x '()))
(if (= (weight (car xs)) 2)
(multiple-value-bind (y ys)
(inf-post-factor (cdr xs))
(setq x (append x y (list (car xs)))
xs ys))
(return (values x xs))))))
(defun infix->postfix (ls)
(multiple-value-bind (x xs)
(inf-post-term ls)
(do ((x x) (xs xs))
((null xs) (values x '()))
(if (= (weight (car xs)) 1)
(multiple-value-bind (y ys)
(inf-post-term (cdr xs))
(setq x (append x y (list (car xs)))
xs ys))
(return (values x xs))))))
項の処理を関数 inf-post-term で、因子の処理を inf-post-factor で行います。値を計算するかわりに、x op y を (x y op) に変換します。このとき、append で連結してカッコをはずすことに注意してください。