M.Hiroi's Home Page

Scheme Programming

Yet Another Scheme Problems

[ PrevPage | Scheme | NextPage ]

●問題61

次に示す uint の比較関数を定義してください。なお、x, y の桁は同じものとします。

表 : uint の比較関数
関数名機能
uint-equal? x yx と y が等しいとき #t を返す
uint-greater? x yx が y より大きいとき #t を返す
uint-less? x yx が y より小さいとき #t を返す
uint-zero? xx が 0 のとき #t を返す
gosh> (uint-equal? '(#t #t #t #t) '(#t #t #t #t))
#t
gosh> (uint-equal? '(#t #t #t #t) '(#t #t #f #t))
#f
gosh> (uint-zero? '(#t #t #t #t))
#f
gosh> (uint-zero? '(#f #f #f #f))
#t
gosh> (uint-greater? '(#f #f #f #t) '(#f #f #f #f))
#t
gosh> (uint-greater? '(#f #f #f #f) '(#f #f #f #f))
#f
gosh> (uint-greater? '(#f #f #f #f) '(#f #f #f #t))
#f
gosh> (uint-less? '(#f #f #f #f) '(#f #f #f #f))
#f
gosh> (uint-less? '(#f #f #f #t) '(#f #f #f #f))
#f
gosh> (uint-less? '(#f #f #f #f) '(#f #f #f #t))
#t

解答

●問題62

2 つの uint を乗算する関数 uint-mul x y を定義してください。桁あふれは無視してください。なお、x, y の桁は同じものとします。

gosh> (uint-mul '(#f #f #t #t) '(#f #f #t #t))
(#t #f #f #t)
gosh> (uint-mul '(#t #f #f #f) '(#f #f #t #f))
(#f #f #f #f)

解答

●問題63

2 つの uint を除算する関数 uint-div x y を定義してください。uint-div は商と余りを多値で返します。なお、x, y の桁は同じものとします。

gosh> (uint-div '(#t #t #t #t) '(#f #t #f #f))
(#f #f #t #t)
(#f #f #t #t)
gosh> (uint-div '(#t #t #t #t) '(#t #f #f #f))
(#f #f #f #t)
(#f #t #t #t)

解答

●問題64

2 つのリストを破壊的にマージ [補足] する関数 merge-list! comp xs ys を定義してください。返り値はマージしたリストです。comp x y は x と y を比較して、x < y であれば負の値を、x と y が等しければ 0 を、x > y であれば正の値を返すものとします。

gosh> (define (comp x y) (- x y))
comp
gosh> (merge-list! comp '(1 3 5 7) '(2 4 6 8))
(1 2 3 4 5 6 7 8)
gosh> (define a '(1 3 5 7 9))
a
gosh> (define b '(0 2 4 6 8))
b
gosh> (merge-list! comp a b)
(0 1 2 3 4 5 6 7 8 9)
gosh> a
(1 2 3 4 5 6 7 8 9)
gosh> b
(0 1 2 3 4 5 6 7 8 9)
-- 補足 (2015/10/24) --------

破壊的にマージするとは、引数のリストをつなぎ直して、一つのリストにまとめることです。たとえば、(1 3) と (2 4) をマージすると (1 2 3 4) となりますが、merge-list! は引数のセルの CDR 部を書き換えて、(1 2 3 4) というリストを作ります。このとき、変数の値もかわります。次の図を見てください。

     A            B
a -> [ 1 | B ] -> [ 3 |  ] -> ()

     C            D
b -> [ 2 | D ] -> [ 4 |  ] -> ()

(merge-list! a b) を実行すると

     A            B
a -> [ 1 | C ]   [ 3 | D ]
           |     |     |
           C     |     D
b -------> [ 2 | B ]   [ 4 |  ] -> ()

変数 a のリスト (1 3) はセル A と B を連結していて、変数 b のリスト (2 4) はセル C と D を連結しているとします。このセルをつなぎ直してマージすると、A - C - B - D になります。変数 a からみるとマージしたリスト (1 2 3 4) になり、変数 b からみると (2 3 4) になります。

解答

●問題65

merge-list! を使ってリストを破壊的にマージソートする関数 merge-sort! comp ls n を定義してください。comp x y は x と y を比較して、x < y であれば負の値を、x と y が等しければ 0 を、x > y であれば正の値を返すものとします。

gosh> (define a '(5 6 4 7 3 8 2 9 1 0))
a
gosh> (merge-sort! comp a 10)
(0 1 2 3 4 5 6 7 8 9)
gosh> a
(5 6 7 8 9)

解答

●問題66

ベクタ vec の部分列 (start 番目から end - 1 番目まで) の中から最小値の位置を求める関数 min-vector comp vec start end を定義してください。comp x y は x と y を比較して、x < y であれば負の値を、x と y が等しければ 0 を、x > y であれば正の値を返すものとします。

gosh> (min-vector comp #(5 4 6 3 7 8 2 9 1) 0 9)
8

解答

●問題67

ベクタ vec を選択ソートする関数 select-sort-vector comp vec を定義してください。comp x y は x と y を比較して、x < y であれば負の値を、x と y が等しければ 0 を、x > y であれば正の値を返すものとします。なお、vec は破壊的に修正されるものとします。

gosh> (define a #(5 6 4 7 3 8 2 9 1 0))
a
gosh> (select-sort-vector comp a)
#(0 1 2 3 4 5 6 7 8 9)
gosh> a
#(0 1 2 3 4 5 6 7 8 9)

解答

●問題68

ベクタ vec をクイックソートする関数 quick-sort-vector comp vec を定義してください。comp x y は x と y を比較して、x < y であれば負の値を、x と y が等しければ 0 を、x > y であれば正の値を返すものとします。なお、vec は破壊的に修正されるものとします。

gosh> (define a #(5 6 4 7 3 8 2 9 1 0))
a
gosh> (quick-sort-vector comp a)
#(0 1 2 3 4 5 6 7 8 9)
gosh> a
#(0 1 2 3 4 5 6 7 8 9)

解答

●問題69

逆ポーランド記法で書かれた数式を計算するプログラムを作ってください。演算子は +, -, *, / で、数式はリストで表すものとにします。

逆ポーランド記法について簡単に説明します。私達が普通に式を書く場合、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 つの結果を掛け算して答えが求まります。

gosh> (rpn '(1 2 + 3 4 + *))
21
gosh> (rpn '(1 2 + 3 4 - *))
-3
gosh> (rpn '(1 2 + 3 4 + 5 6 + * *))
231
gosh> (rpn '(1 2 + 3 4 + 5 6 + * /))
3/77
gosh> (rpn '(1 2 + 3 4 + * 5 6 + /))
21/11

解答

●問題70

中置記法で書かれた数式を計算するプログラムを作ってください。演算子は +, -, *, - で、カッコを使用することができます。数式はリストで表すことにします。

gosh> (expression '(1 + 2 * 3 + 4))
11
()
gosh> (expression '((1 + 2) * (3 + 4)))
21
()
gosh> (expression '((1 + 2) / (3 + 4)))
3/7
()

解答


●解答61

リスト : uint の比較関数

; 等しいか?
(define (uint-equal? x y) (equal? x y))

; ゼロか?
(define (uint-zero? x) (not (member #t x)))

; 大きいか?
(define (uint-greater? x y)
  (cond ((null? x) #f)
        ((eq? (car x) (car y))
         (uint-greater? (cdr x) (cdr y)))
        (else (car x))))

; 小さいか?
(define (uint-less? x y)
  (cond ((null? x) #f)
        ((eq? (car x) (car y))
         (uint-less? (cdr x) (cdr y)))
        (else (car y))))

uint-equal? は述語 equal? を呼び出すだけです。unit-zero? は関数 member で #t を探します。#t が見つかれば 0 ではありません。結果を not で反転します。uint-greater? は x と y の要素を先頭から順番に比較し、x の要素と y の要素が等しい場合は uint-greater? を再帰呼び出しします。要素が異なる場合、(car x) が #t ならば x が大きいので #t を返します。そうでなければ #f を返します。つまり、(car x) の値を返せば良いわけです。uint-less? も同様にプログラムできます。

●解答62

筆算のアルゴリズムをそのまま 2 進数に適用します。たとえば、#b1101 と #b101 の乗算は次のように計算します。

       1 1 0 1
 *       1 0 1
 --------------
       1 1 0 1
     0 0 0 0
   1 1 0 1
 -------------
 1 0 0 0 0 0 1

図 : 1101 * 101

このアルゴリズムはビットシフトと加算で実現することができます。桁あふれのチェックは行わないことにすると、プログラムは次のようになります。

リスト : uint の 乗算

(define (uint-mul x y)
  (car (fold-right
         (lambda (n a)
           (cons (if n
                     (uint-add (car a) (cdr a))
                   (car a))
                 (uint-sll (cdr a))))
         (cons (make-zero (length x)) x)
         y)))

fold-right で y の LSB から計算を始めます。ラムダ式の引数 n が y の要素、引数 a にはコンスセルを渡します。(car a) が累積値、(cdr a) が累積値に加算する値です。最初は 0 と x に初期化します。n が真のときは (car a) に (cdr a) を加算します。そうでなければ、(cdr a) を加算しません。この値と uint-sll で (cdr a) を 1 ビット左シフトした値をコンスセルに格納して返します。最後に fold-right の返り値に car を適用して累積値を返します。

●解答63

筆算のアルゴリズムをそのまま 2 進数に適用します。次の図を見てください。

     1 0 1 0 1
---------------
 1 1 0 1 0 1 1
 1 0 1 0 0 0 0
---------------
     1 1 0 1 1
     1 0 1 0 0
   ------------
         1 1 1
         1 0 1
         ------
           1 0

図 : 1101011 / 101

x (1101011) を y (101) で除算する場合、最初に y を左シフトして桁合わせを行います。上図の場合、1101011 から y を 4 ビットシフトした値 z (1010000) を引き算して余り q が 11011 になります。このとき、商 p に 1 をセットします。次に、z を右へ 1 ビットシフトした 101000 と q を比較します。この場合、q のほうが小さいので引き算できません。p の値は左へ 1 ビットシフトして 10 になります。

あとは同様に、z を右へ 1 ビットシフトして q と比較します。引き算できる場合は p を左へ 1 ビットシフトしてから値を +1 します。引き算できない場合は p を左へ 1 ビットシフトするだけです。上図の場合、10100 は 11011 よりも小さいので、p の値は 101 になり、q の値は 111 になります。次に、1010 は 111 よりも大きいので p の値は 1010 になります。最後に、101 は 111 よりも小さいので、p の値は 10101 になり、q の値は 10 になります。これで商 p と余り q を求めることができます。

プログラムは再帰定義を使うと簡単です。次のリストを見てください。

リスト : uint の除算

(define (uint-div x y)
  (cond ((uint-less? x y)
         (values (make-zero (length x)) x))
        ((or (uint-equal? x y) (car y))
         (values (uint-inc (make-zero (length x))) (uint-sub x y)))
        (else
         (receive (p q) (uint-div x (uint-sll y))
           (if (uint-less? q y)
               (values (uint-sll p) q)
             (values (uint-inc (uint-sll p)) (uint-sub q y)))))))

uint-div は再帰呼び出しするたびに引数 y を 1 ビット左シフトして桁合わせを行います。x が y よりも小さい場合は除算できないので商 0 と余り x を多値で返します。x と y が等しい、または y の MSB が #t の場合、商は 1 で余りが x - y になります。

これ以外の場合、y を 1 ビット左シフトして uint-div を再帰呼び出しします。余り q が y よりも小さい場合、p を 1 ビット左シフトした値と q を返します。そうでなければ、p を 1 ビット左シフトしてから +1 した値と q - y を返します。これで商と余りを求めることができます。

●解答64

リスト : マージ (破壊版)

(define (merge-list! comp xs ys)
  (let ((header (list #f)))
    (let loop ((xs xs) (ys ys) (tail header))
      (cond ((null? xs)
             (set-cdr! tail ys)
             (cdr header))
            ((null? ys)
             (set-cdr! tail xs)
             (cdr header))
            ((positive? (comp (car xs) (car ys)))
             (set-cdr! tail ys)
             (loop xs (cdr ys) ys))
            (else
             (set-cdr! tail xs)
             (loop (cdr xs) ys xs))))))

merge-list! はダミーのヘッダセル header を用意すると簡単です。 named-let で loop を形成します。末尾のセルを tail に保持します。tail の初期値は header になります。xs が空リストになったなら、tail に ys を連結します。ys が空リストになったら xs を tail に連結します。返り値は (cdr header) になります。xs と ys に要素がある場合、comp で (car x) と (car y) を比較し、小さいほうのセルを tail に連結します。そして、loop で次のセルへ進めます。このとき、tail の値をつなげたセルに更新します。

●解答65

リスト : マージソート (破壊版)

(define (merge-sort! comp ls n)
  (if (= n 1)
      (begin (set-cdr! ls '()) ls)
    (let* ((m  (quotient n 2))
           (ys (drop ls m)))
      (merge-list! comp
                         (merge-sort! comp ls m)
                   (merge-sort! comp ys (- n m))))))

merge-sort! は連結リストを分割する処理で、新しい連結リストを作らないことに注意してください。次の図を見てください。

上図の連結リストを二分割する場合、前半部分は x と n/2 で表し、後半部分を y と (n - n/2) で表します。y は連結リストを n / 2 回たどれば求めることができます。

n が 1 になったら ls の cdr を空リスト ( ) に書き換えます。これが再帰の停止条件で、要素数が一つの連結リスト、つまりソート済みの連結リストを返すことになります。n が 1 よりも大きい場合は、連結リストを二分割して merge-sort! を再帰呼び出しし、その結果を merge-list! でマージすればいいわけです。

●解答66

リスト : ベクタの中から最小値を求める

(define (min-vector comp buff start end)
  (let loop ((pos start)
             (val (vector-ref buff start))
             (i (+ start 1)))
    (cond ((= i end) pos)
          ((negative? (comp (vector-ref buff i) val))
           (loop i (vector-ref buff i) (+ i 1)))
          (else
           (loop pos val (+ i 1))))))

最小値を変数 val に、その位置を変数 pos に格納します。最初は仮の最小値として start 番目の要素をセットします。あとは i + 1 番目から end - 1 番目までの要素と val を comp で比較して、その要素が val よりも小さい場合は val と pos の値を更新します。この処理を named-let で行っています。

●解答67

選択ソート (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 を交換してソート終了
            + +


        図 : 選択ソート

このように、選択ソートは単純でわかりやすいアルゴリズムです。プログラムは次のようになります。

リスト : 選択ソート

; 値の交換
(define (swap buff x y)
  (let ((z (vector-ref buff x)))
    (vector-set! buff x (vector-ref buff y))
    (vector-set! buff y z)))

; ソート
(define (select-sort-vector comp buff)
  (do ((i 0 (+ i 1))
       (e (vector-length buff)))
      ((= i e) buff)
    (swap buff i (min-vector comp buff i e))))

ベクタの i 番目から末尾までの中から min-vector で要素を選び、それと i 番目の要素を交換するだけです。

●解答68

クイックソートはある値を基準にして、要素をそれより大きいものと小さいものの 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 になったときが再帰の停止条件になります。

プログラムは次のようになります。

リスト : クイックソート

; 値の交換
(define (swap buff x y)
  (let ((z (vector-ref buff x)))
    (vector-set! buff x (vector-ref buff y))
    (vector-set! buff y z)))

; ソート
(define (quick-sort-vector comp buff)
  (define (qsort low high)
    (let ((pivot (vector-ref buff (quotient (+ low high) 2))))
      (let loop ((i low) (j high))
        (do ()
            ((<= 0 (comp (vector-ref buff i) pivot)))
          (inc! i))
        (do ()
            ((<= 0 (comp pivot (vector-ref buff j))))
          (dec! j))
        (cond ((>= i j)
               (if (< low (- i 1)) (qsort low (- i 1)))
               (if (< (+ j 1) high) (qsort (+ j 1) high))
               buff)
              (else
               (swap buff i j)
               (loop (+ i 1) (- j 1)))))))
  ;
  (qsort 0 (- (vector-length buff) 1)))

実際のソートは局所関数 qsort で行います。引数 low が区間の下限値、high が区間の上限値です。qsort は buff の low から high までの区間をソートします。最初に区間の中央にあるデータを枢軸 pivot として選び、pivot を基準にして区間を 2 つに分けます。

loop の中の最初の do ループで左側から枢軸以上の要素を探しています。ここでは枢軸以上という条件を、枢軸より小さい間は探索位置を進める、というように置き換えています。同様に次の do ループで右側から枢軸以下の要素を探します。お互いの探索位置 i, j が交差したら分割は終了です。そうでなければお互いの要素を交換します。

そして、分割した区間に対して qsort を再帰呼び出しします。このとき要素数をチェックして、2 個以上ある場合に再帰呼び出しを行います。この停止条件を忘れると正常に動作しません。ご注意ください。

●解答69

逆ポーランド記法の数式はスタックを使うと簡単に計算することができます。アルゴリズムは次のようになります。

1. 数値はスタックに追加する。
2. 演算子であればスタックから 2 つ数値を取り出し、演算結果をスタックに追加する。
3. 最後にスタックに残った値が答えになる。

たったこれだけの規則で数式を計算することができます。それでは、実際に 1 2 + 3 4 + * を試してみましょう。次の表を見てください。

表 : 計算過程
数式操作スタック
1PUSH( 1 )
2PUSH( 2 1 )
+POP (2)( 1 )
POP (1)( )
1+2=3( )
PUSH( 3 )
3PUSH( 3 3 )
4PUSH( 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 の動作は、数値であればスタックにプッシュして、ワードであればそれを実行する、というシンプルなものです。これでプログラミングができるのですから、とてもユニークな言語ですね。

プログラムは次のようになります。

リスト : 数式の計算 (後置記法)

; 演算子の取得
(define (getop sym)
  (case sym
    ((+) +)
    ((-) -)
    ((*) *)
    ((-) -)
    (else
     (error "invalid operation"))))

; 後置記法の数式を計算する
(define (rpn ls)
  (let loop ((ls ls) (a '()))
    (cond ((null? ls)
           (if (null? (cdr a))
               (car a)
             (error "invalid expression")))
          ((number? (car ls))
           (loop (cdr ls) (cons (car ls) a)))
          ((symbol? (car ls))
           (if (or (null? a) (null? (cdr a)))
               (error "stack underflow")
             (let ((val ((getop (car ls)) (cadr a) (car a))))
               (loop (cdr ls) (cons val (drop a 2))))))
          (else
           (error "invalid data")))))

関数 rpn の引数 ls が数式を表すリストです。named-let の変数 a がスタックを表します。ls が空リストになったら、スタックトップの値を返します。このとき、スタックに複数の値が格納されている場合はエラーを送出します。

次に、ls の要素が数値の場合はそれをスタックに追加します。シンボルの場合、最低でも 2 つの値がスタックになければいけません。0 個または 1 個しかない場合はエラーを送出します。そうでなければ、関数 getop でシンボルの関数値を取り出し、スタックに格納されている値を渡して評価します。ここで、先頭の要素が第 2 引数、2 番目の要素が第 1 引数になることに注意してください。評価結果はスタックから関数に渡した値を削除したあとで追加します。

●解答70

参考文献 [1] の「式の評価」によると、四則演算の数式は次の構文規則で表すことができます。

式 := 項 (+ | -) 項 (+ | -) 項 ...
項 :- 因子 (* | /) 因子 (* | /) 因子 ...
因子 := 数 | (式)

これをそのままプログラムすると、次のようになります。

リスト : 数式の計算 (中置記法)

; 優先順位
(define (weight op)
  (case op
    ((+) 1)
    ((-) 1)
    ((*) 2)
    ((/) 2)
    (else (error "invalid operation"))))

; 因子の評価
(define (factor ls)
  (cond ((number? (car ls))
         (values (car ls) (cdr ls)))
        ((pair? (car ls))
         (values (expression (car ls)) (cdr ls)))
        (else
         (error "invalid expression"))))

; 項の評価
(define (term ls)
  (receive (x xs) (factor ls)
    (let loop ((x x) (xs xs))
      (cond ((null? xs) (values x '()))
            ((= (weight (car xs)) 2)
             (receive (y ys) (factor (cdr xs))
               (loop ((getop (car xs)) x y) ys)))
            (else (values x xs))))))

; 式の評価
(define (expression ls)
  (receive (x xs) (term ls)
    (let loop ((x x) (xs xs))
      (cond ((null? xs) (values x '()))
            ((= (weight (car xs)) 1)
             (receive (y ys) (term (cdr xs))
               (loop ((getop (car xs)) x y) ys)))
            (else (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] 奥村晴彦,『C言語による最新アルゴリズム事典』, 技術評論社, 1991

Copyright (C) 2011 Makoto Hiroi
All rights reserved.

[ PrevPage | Scheme | NextPage ]