M.Hiroi's Home Page

xyzzy Lisp Programming

Common Lisp 入門

[ PrevPage | xyzzy Lisp | NextPage ]

簡易エキスパートシステムの作成 (1)

●エキスパートシステムと Prolog

いよいよ目的である簡易エキスパートシステムの作成に進みましょう。記号のパターンマッチング(1) で簡単に説明しましたが、エキスパートシステムは専門家の知識をコンピュータに記憶しておいて、それを使って問題を解決する、あるいは問題解決のための手助けを行うように作られたシステムです。これから作るプログラムは「パターンマッチングとバックトラックを組み合わせてデータの中から解答を導き出す」という簡単なシステムです。

簡易システムとはいっても、Prolog とよく似た動作をさせることは可能です。逆に言えば、Prolog の動作はこれから作成する簡易エキスパートシステムの参考になるものです。解を求めるときのパターンマッチングとバックトラックの動作はどちらも同じです。そこで、今回は Prolog を例にして、パターンマッチングとバックトラックの動作を簡単に説明します。

●Prolog とは?

Prolog は 1971年フランスのマルセイユ大学の Alain Colmeraur によって開発されたプログラミング言語です。日本で行われた第五世代コンピュータプロジェクトで、中核となるプログラミング言語として採用され一躍有名になりました。C言語や BASIC が手続き型言語、Lisp が関数型言語と呼ばれているのに対し、Prolog は論理型言語と呼ばれています。これは Prolog の計算の仕組みが、論理学を基礎にして成り立っているからです。

Prolog は物事の間に成り立つ関係を定義していくことでプログラムを作成します。そして、もっとも基本的な関係を表したものを事実 (fact) といいます。Prolog のプログラムは、この事実関係を問い合わせることで動作します。すなわち、Prolog は今まで定義された事実を参照して、与えられた質問の答を導き出す言語、といってもいいでしょう。たとえば、「太郎はコーヒーが好きである」という関係があると、次の質問に答えることができます。

だれがコーヒーを好きか? => 太郎
太郎はなにが好きか?     => コーヒー

実際には、このような日本語を使ってプログラムできないので、文章の中の述語 (predicate) を中心にして、事実を次のように表します。

好き(太郎, コーヒー).

これはエジンバラ Prolog という処理系 [*3] での表現方法です。ほかの例も示しましょう。

「太郎はココアが好き」 --> 好き(太郎, ココア).
「花子は紅茶が好き」   --> 好き(花子, 紅茶).

このように、関係を示す言葉をいちばん前に持ってきて表現する方法を述語表記といい、後ろに続く言葉を引数といいます。最後のピリオドを除けばC言語の関数と形はよく似ていますね。

それでは、実際に今まで出た例を Prolog に入力してみます。

| 好き( 太郎, コーヒー).

| は Prolog インタプリタのプロンプト [*4] を表しています。入力した事実は Prolog 内にあるデータベースに格納されます。それでは、太郎がコーヒーを好きかたずねてみましょう。質問する場合は ?- を使います。

| ?-好き(太郎, コーヒー).
yes

まあ、これは当たり前ですね。では、花子は紅茶が好きか、たずねてみましょう。

| ?-好き(花子, 紅茶).
no

これは「花子は紅茶が好きである」という事実がないので、Prolog は違うといってきたのです。では、定義してみましょう。

| 好き(花子, 紅茶).
| ?-好き(花子, 紅茶).
yes

今度は、そうだよといってきました。

ある事実に対して yes か no しかたずねることができないのであれば面白くありませんね。事実が増えてくると、たとえば太郎が好きなものは何かとか、コーヒーを好きな人は誰か、といった質問をしたいと思うでしょう。

もちろん、Prolog はそのような質問を受け付けることができます。そのためには変数を使います。Prolog の変数はパターンマッチングのパターン変数と同じ働きをします。エジンバラ Prolog では、半角英大文字から始まる名前を変数として扱います。

Prolog には次の事実が入力されているものとします。

太郎が好きなものは何か質問してみましょう。

| ?-好き(太郎, X).
X = コーヒー ->

-> はほかの解答を調べるか、Prolog がたずねていることを示す記号です。ここで ; を入力すると、Prolog は別の解答を探します。

それでは、別の解があるか調べてみましょう。

X = コーヒー -> ;
X = ココア -> ;
no

Prolog の変数はパターン変数と同様に複数使うこともできます。好き(X, Y). と質問すれば、「好き」という関係をもつすべての事実を求めることができます。ただし、述語の部分を変数にすることはできません。

| ?-好き(X, Y).
X = 太郎
Y = コーヒー -> ;
X = 花子
Y = 紅茶 -> ;
X = 太郎
Y = ココア -> ;
no

別解を求める場合は代入された変数を未束縛の状態に戻します。そして次に定義されている事実とマッチングを行います。つまり、バックトラックすることでデータベース全体を検索するわけです。

-- note --------
[*3] イギリスのエジンバラ大学で作られた処理系で Prolog の標準とされています。
[*4] プロンプトは Prolog 処理系によって違います。 Prolog Programming で使っている SWI-Prolog の場合、質問を受け付けるプロンプト ?- が表示されます。この場合、事実をそのまま入力することはできません。ご注意くださいませ。

●Prolog のプログラムとは?

Prolog は複数の事実を用いてひとつの事実を表すことができます。これを規則 (rule) といいます。一般に規則は次のような形をとります。

head :- goal1, goal2, ... goalN.

これは goal1 から goalN までの規則がすべて成り立てば規則 head が成立する、ということを表します。つまり、規則を「~かつ~」(AND) で結びつけているのです。先頭の head を頭部といい、残りの goal をまとめて体部といいます。また、各々の goal をゴールといいます。そして、事実、規則および質問のことをまとめて節 (clause) と呼びます。簡単な例を示します。

| 飛ぶ(X) :- 飛行機(X).

| 飛行機(ジェット機).

| 飛行機(ヘリコプター).

最初の節は「飛行機は空を飛ぶ」という規則を表しています。次の 2 つの節は、「ジェット機は飛行機である」と「ヘリコプターは飛行機である」という事実を表しています。このことから、「ジェット機は空を飛ぶ」という結論を導くことができます。では、Prolog に質問してみましょう。

| ?-飛ぶ(ジェット機).
yes

それでは、太郎君は空を飛べるか質問してみましょう。

| ?-飛ぶ(太郎).
no

太郎君は空を飛べません。ところで、空を飛べるのは飛行機だけではありません。スーパーマンも空を飛べますね。実は、太郎君はなんとスーパーマンだったのです。その規則を追加しましょう。

| 飛ぶ(X) :- スーパーマン(X).
| スーパーマン(太郎).

もう一度、太郎君が飛べるか質問してみます。

| ?-飛ぶ(太郎).
yes

太郎君は空を飛ぶことができました。変数を使うと、空を飛べるものがすべてわかります。

| ?-飛ぶ(Y).
Y = ジェット機 -> ;
Y = ヘリコプター -> ;
Y = 太郎 -> ;
no

それでは、Prolog の動作を詳細に追いかけてみましょう。

まず質問と節の頭部をパターンマッチングし、それに成功する節を選びます。この例では 飛ぶ(Y) と 飛ぶ(X) がパターンマッチングに成功します。変数を含むパターン同士のマッチングですから、ユニフィケーションが行われるわけです。これにより変数 Y と X が関連付けられます。

次に、体部の実行に移ります。体部の実行はゴールを順番に質問していくことと同じです。この場合、飛行機(X) が実行され、これとパターンマッチングする節が選択されます。その結果、飛行機(ジェット機) とマッチングし、変数 X は「ジェット機」という値になります。

選択された節は事実なので、実行する体部はありません。元の節に戻りますが、次に実行するゴールはないので、この節が成功したことになります。したがって、飛ぶ(X) は成功するのです。そのあと、質問の節に戻り、Y は X とマッチングしているので、 その値が「ジェット機」となります。

次は、別解を探索する動作を説明しましょう。Prolog では、別解を探索することを再試行といいます。再試行する場合、いちばん最後に実行したゴールから行われます。このとき、束縛された変数は自由変数に戻されることに注意してください。

最初に、飛行機(X) が再試行されます。まず、変数 X が自由変数に戻されます。飛行機(X) の実行によって束縛された変数を自由変数に戻すのであって、それ以前に束縛された変数は自由変数に戻しません。

そして、飛行機(X) とマッチングする節を再度探索します。このとき、すでにマッチングした 飛行機(ジェット機) は探索の対象から外されます。今度は 飛行機(ヘリコプター) とマッチングしました。X の値は「ヘリコプター」に定まります。飛ぶ(X) が成功したので、この再試行も成功です。Y = ヘリコプター という結果になります。

もう一度、再試行しましょう。飛行機(X) を実行するですが、これ以上事実は定義されていません。したがって、飛行機(X) は失敗します。失敗した場合は、ひとつ前のゴールを再試行します。すべてのゴールの再試行に失敗したら、その節は失敗となります。この場合、再試行するゴールはありませんので、規則 飛ぶ(X) :- 飛行機(X). が失敗します。

節が失敗した場合は、その節を呼び出した節を再試行します。この場合、質問 飛ぶ(Y) を再試行します。飛ぶ(Y) とマッチングする節を探すと、飛ぶ(X) :- スーパーマン(X). が見つかります。今度は、この節を実行します。同じようにゴールを実行して、「太郎」という答えが見つかります。

さらに再試行します。まず、スーパーマン(X) を再試行しますが、マッチングする節が見つかりません。規則飛ぶ(X) :- スーパーマン(X). は失敗します。そして、質問 ?-飛ぶ(Y). を再試行しますが、もはやマッチングする節はありません。飛ぶ(Y) は失敗します。飛ぶ(Y) は質問でしたから no という結果が表示されます。

これが Prolog の基本的な動作です。これから作成する「簡易エキスパートシステム」は、Prolog と同様にパターンマッチングとバックトラックによって解を探索します。


ちょっと寄り道

■ペグ・ソリテア・スターを解く

今回は「ペグ・ソリテア・スター」を Lisp で解いてみましょう。ペグ・ソリテア・スターを下図に示します。

ここではペグをどれかひとつ取り除き、最初に取り除いた位置と最後に残ったペグの位置が同じになる「補償型の解」の最小手数を求めることにします。

プログラムは「反復深化+下限値枝刈り法」で作成します。ちょっと寄り道「ペグ・ソリテア 18 穴盤に挑戦!」 の「下限値枝刈り法のプログラム」とほとんど同じですが、「補償型の解」を求めるように反復深化のプログラムを修正します。次のリストを見てください。

List 1 : 反復深化+下限値枝刈り法

(defun solve-id (n jc limit goal board history)
  (when (<= (+ jc (get-lower-value board (third (car history)))) limit)
    (if (= n 11)
        (if (nth goal board)
            (print-answer (reverse history)))
        (dolist (pattern (get-move-pattern board))
          (solve-id (1+ n)
                    (if (eql (third (car history)) (first pattern))
                        jc
                        (1+ jc))
                    limit
                    goal
                    (move-peg 0 board pattern)
                    (cons pattern history))))))

関数 solve-id の引数 n がペグを動かした回数、jc が手数(跳んだ回数)、limit が反復深化の上限値、goal が最後に残るペグの位置、board が盤面、history がペグの移動手順(履歴)を表します。

ペグ・ソリテア・スターの場合、ペグは最初 12 個あるので 11 回ペグを移動すると残りのペグは 1 個になります。このとき、残ったペグの位置が goal であれば「補償型の解」になります。この条件を (nth goal board) でチェックします。解を見つけたら print-answer で手順を表示します。

下限値はコーナーペグの個数を利用します。ペグ・ソリテア・スターの場合、コーナーは 0, 1, 4, 8, 11, 12 の 6 か所もあります。下限値はこれだけで十分でしょう。あとはペグの跳び先表を変更するだけです。詳細は プログラムリスト をお読みくださいませ。

■実行結果

それでは実行してみましょう。最初に取り除くペグの位置は、盤の対称性から 0 と 2 の 2 か所だけで十分です。結果は次のようになりました。

(solve-peg-star 0)
----- 5 手 を探索 -------
----- 6 手 を探索 -------
----- 7 手 を探索 -------
[7, 0][12, 7][8, 10][11, 9, 3][4, 10][1, 9][0, 7, 12, 5, 0]
t

(solve-peg-star 2)
----- 6 手 を探索 -------
----- 7 手 を探索 -------
[8, 2][12, 5][11, 9][4, 10, 8][1, 9][0, 5, 7][8, 10, 4, 2]
t

どちらの場合も最短手数は 7 手になりました。実行時間は M.Hiroi のオンボロマシン (Pentium 166 MHz) でも 1 秒かかりません。下限値枝刈り法を使うことで高速に解くことができました。


■プログラムリスト

;
; peg_star.l : ペグ・ソリテア・スター
;
;  「反復深化+下限値枝刈り法」で補償型の解を求める
;
;   Copyright (C) 2003 Makoto Hiroi
;

; 跳び先表 : (跳び越される位置 . 着地位置)
(defvar *jump-table*  #(((2 . 5) (3 . 7))            ; 0
                        ((2 . 3) (5 . 9))            ; 1
                        ((3 . 4) (5 . 8) (6 . 10))   ; 2
                        ((2 . 1) (6 . 9) (7 . 11))   ; 3
                        ((3 . 2) (7 . 10))           ; 4
                        ((2 . 0) (6 . 7) (9 . 12))   ; 5
                        nil                          ; 6
                        ((3 . 0) (6 . 5) (10 . 12))  ; 7
                        ((5 . 2) (9 . 10))           ; 8
                        ((5 . 1) (6 . 3) (10 . 11))  ; 9
                        ((6 . 2) (7 . 4) (9 . 8))    ; 10
                        ((7 . 3) (10 . 9))           ; 11
                        ((9 . 5) (10 . 7))))         ; 12


; 下限値の計算
(defun get-lower-value (board from)
  (let ((value 0))
    ; コーナーペグのチェック
    (dolist (c '(0 1 4 8 11 12) value)
      (if (and (not (eql c from)) (nth c board))
          (incf value)))))


; ペグを動かす
(defun move-peg (n board pos)
  (if board
      (cons (if (member n pos)
                (not (car board))
                (car board))
            (move-peg (1+ n) (cdr board) pos))))


; ペグの跳び方を求める (from del to)
(defun get-move-pattern (board)
  (let (result del to)
    (dotimes (from 13 result)
      (when (nth from board)
        (dolist (pos (aref *jump-table* from))
          (setq del (car pos)
                to  (cdr pos))
          (if (and (nth del board) (not (nth to board)))
              (push (list from del to) result)))))))


; 解を表示する
(defun print-answer (history)
  (let ((prev (third (car history))))
    ; 初手を表示
    (format t "[~D, ~D" (first (car history)) prev)
    ; 2 手目以降を表示
    (dolist (pos (cdr history))
      (cond ((= prev (first pos))
             ; 同じ駒が跳んでいる
             (setq prev (third pos))
             (format t ", ~D" prev))
            (t ; 違う駒が跳ぶ
             (setq prev (third pos))
             (format t "][~D, ~D" (first pos) prev))))
    (format t "]~%")
    (throw 'find-answer t)))


; 反復深化+下限値枝刈り法
(defun solve-id (n jc limit goal board history)
  (when (<= (+ jc (get-lower-value board (third (car history)))) limit)
    (if (= n 11)
        (if (nth goal board)
            (print-answer (reverse history)))
        (dolist (pattern (get-move-pattern board))
          (solve-id (1+ n)
                    (if (eql (third (car history)) (first pattern))
                        jc
                        (1+ jc))
                    limit
                    goal
                    (move-peg 0 board pattern)
                    (cons pattern history))))))


; ペグ・ソリテア・スターの解法
(defun solve-peg-star (pos)
  (let ((board (make-list 13 :initial-element t)))
    ; ペグをひとつ取り除く
    (setf (nth pos board) nil)
    (catch 'find-answer
      (do ((limit (get-lower-value board pos) (1+ limit)))
          ((> limit 10))
        (format t "----- ~D 手 を探索 -------~%" limit)
        (solve-id 0 0 limit pos board nil)))))

戻る


Copyright (C) 2000-2003 Makoto Hiroi
All rights reserved.

[ PrevPage | xyzzy Lisp | NextPage ]