More than 1 year has passed since last update.

宣言的プログラミング(3) -ババ抜きシミュレータw-

Last updated at 2022-12-13Posted at 2022-12-12

はじめに

　前回、優先度の説明のところでババ抜きの例を出したので、番外編としてルールが具体的にどうなるかを書いてみました。

ババ抜きシミュレータ

　4人のプレーヤーA, B, C, D がババ抜きをするという想定で、そのババ抜きをシミュレーションするClipsプログラムを書いてみます。

データ(ファクト)構造

　まず、シミュレータで使うファクトの構造をdeftemplateを用いて記述します。最初にカードのファクトから

(deftemplate card
    (slot suit
        (type SYMBOL)
        (allowed-symbols spade heart diamond club joker))
    (slot rank
        (type INTEGER)
	    (range 0 13))
    (slot player
        (type SYMBOL)
        (allowed-symbols init A B C D discarded))
)

　カードそのものに必要となる属性として、suit(種類/マーク) と rank(数字)という名前のフィールド(スロット)をつくります。今回ババ抜きなので、joker を加えました。また rank の範囲が 0 から始まっているのは、0 を jokerに当てることにしたからで、そこで 0 始まりとしています。
　また、player というフィールドは、カードがどのプレーヤーの手札になっているかを示すものとします。ここで、init というのはプレーヤーに配る前の最初の状態、discarded というのは、ペアが成り立って手札から捨てた状態を表します。

　さて、次に今、誰の順番かを示すために「あなたの番です」というファクトをつくりました。現在の順番にあたっているプレーヤーを指定します。

(deftemplate anata_no_ban_desu
    (slot player
        (type SYMBOL)
        (allowed-symbols A B C D))
)

この他にdeftemplateで定義していない ordered fact もちょっとした制御用に使っていますが、これは次のdeffacts定義とともに説明します。

ファクト(deffacts)

　初期状態のファクト設定をdeffactsを使って定義します。

(deffacts cards
    (card (suit spade) (rank 1))
    (card (suit spade) (rank 2))
    (card (suit spade) (rank 3))

         ・・・(略)・・・

    (card (suit club) (rank 12))
    (card (suit club) (rank 13))
    (card (suit joker) (rank 0))

    (anata_no_ban_desu (player A))

    (next A B)
    (next B C)
    (next C D)
    (next D A)

    (deal-phase)
)

　card のファクトでは、特にplayerのフィールドを指定していませんが、Clipsの仕様上、指定していないとデフォルト値(この場合deftemplateのallowed-symbolsの最初の値 init )が自動的に設定されます。
　anata_no_ban_desuは、最初プレーヤーA からということで A に設定。
　さらに nextというのは順番を表し、Aの次はB、Bの次はC...ということをファクトで表しています(それぞれ(next A B)、(next B C)...)。そして後に、例えば C が上がってしまうと、(next B C) (next C D)を消して(next B D)を新たにつくるということにします。実際、ババ抜きである人があがったら、順番はその人を抜いた順番になるということをそのままモデル化しています。
　また(deal-phase)(カードを配る-deal-フェーズ)というファクトは、現在の処理がカードを配るフェーズであることを示すために使われます。ババ抜きの場合、まずカードを配って、それから実際のプレイを始めるという２つのフェーズに分けることができます。したがって最初に(deal-phase)というファクトを最初にassertしてカードを配り終わった後、最後のルールで(deal-phase)を削除し、(play-phase)というファクトをassertすることによってフェーズに分けた実行を実現するようにします¹。

ルール(カードを配るフェーズ)

　次にまずは、カードを配るルールを考えてみましょう。最初の初期状態((reset)コマンドを実行した状態)では、カードのファクトは、たとえば

(card (suit spade) (rank 8) (player init))

といった形で、特に playerの状態がinitになっているはずです。これを各プレーヤーに割り振っていきます。ルールは、

(defrule deal
    (deal-phase)
  ?a <- (anata_no_ban_desu (player ?player))
    (next ?player ?next)
  ?c <- (card (player init))
 =>
    (modify ?c (player ?player))
    (modify ?a (player ?next))
)

となります。上のルールでは、カードを配るフェーズなので、まず(deal-phase)を指定しています。さらにカードを一枚一枚順番に配っていくことを想定し、anata_no_ban_desuファクトとnextファクトを使って配り順を制御します。これはたとえば条件部分で(anata_no_ban_desu (player A))ファクトと(next A B)ファクトにマッチした際に、実行部分でanata_no_ban_desuファクトを書き換えて、(anata_no_ban_desu (player B))と次のプレーヤーに進めます。さらに条件部分cardファクトパターンは、まだ各プレーヤーに配られていない状態を表すinit設定のカードのみを対象としていることに注意してみてください。その配られていないinit設定のカードファクトは、実行部分でanata_no_ban_desuファクトで指定されているプレーヤーに配られます。
　さて、このルールをそのまま動かすと順番に1枚1枚カードが配られていくのでカードの枚数的にはきれいに4人に分配されます。しかしルールとファクトの組の実行順は、デフォルトの競合解消戦略にもとづいて処理されるので何らかの規則的な配り方になり、常に勝敗の結果は同じ；；。つまりランダム性は担保されません。プレーヤーの手札がランダムになるよう配られるにはどうしたらよいでしょう？　実はClipsには、競合解消戦略に random strategy というのがあります。簡単にそれを使ってしまいましょう(したがって実際動かすとき前にset-strategyコマンドで、戦略を random strategy に変更してから実行します)。
　これ、イメージとしてはどのような感じかと言うと、たとえば最初、まずプレーヤーAに対して、53枚全部それぞれのカードを配る準備をし、(競合解消戦略に基づき)どのカードを配る行動を選択するかをランダムに判定し実行。次にプレーヤーBに対して、52枚のカードを配る準備をし、そのうちのどのカードを配る行動を選択するかをランダムに判定、実行...といった形で53枚全部を配りきることになります。

　さて配りきった後には、(deal-phase)から(play-phase)に移らないといけません。というわけで、次のルールを実行させます。

(defrule end_of_deal
    (declare (salience -10000))
  ?d <- (deal-phase)
  ?a <- (anata_no_ban_desu (player ?player))
=>
    (retract ?d)
    (assert (play-phase))
    (modify ?a (player A))
)

ルールの名前の行の次の行(declare (salience -10000))は優先度の定義です。デフォルトの優先度は 0 なので、(deal-phase)の2つのルールdeal(優先度 0), end_of_deal(優先度 -10000)のうち、先に実行されるのは相対的に優先度の高いdealルールになります。このdealルールがひととおり実行されきった後、最後にend_of_dealルールが動きます。このend_of_dealルールでは(deal-phase)を(play-phase)に切り替えるとともに、順番も最初のプレーヤーA からの状態にリセットします。

ルール(実際のプレーのフェーズ)

　さて実際のプレーのルールはどのようなものになるでしょうか。どんなルールが必要そうか以下にまとめてみました。

ふつうにカードを順繰りにとっていくルール
プレーヤーの手札の中で数字が2枚揃ったら捨てるルール
上がりのルール：手札が無くなったら上がり
負けのルール：手札としてカード 1枚だけジョーカーが残ったら負け

　処理の流れの考え方としては、

通常は1.のルール(カードを順番に隣からもらっていくルール)が動いている。言い換えると定常的な認知実行サイクルの動きとしては1.のルールが動いている。
一方、2.3.4.のルールについては、定常的な処理の流れに対して「割り込み」のような形でルールが動く。すなわち上の1.のルールによる定常的な処理が流れている途中で、2.3.4.のルールの条件がそれぞれマッチしたときに割り込むことで処理が実行される。

といったイメージになります。この「割り込み」を実現するためにルールに優先度をつけます。

優先度の検討

　まず、1のルール(カードを順繰りにとっていく通常の流れのルール)は、定常的な流れということで優先度は特に指定せずデフォルトの 0 のままとしましょう。したがって、途中で割り込む2, 3, 4 のルールは 0より大きい優先度をつけます。
　まず、3の上がりのルールは、手札が無くなったらという条件が成立すると、直ちに上がりが成立すると考えられるので最優先として優先度1000くらいをつけておきます。
　2 の、ペアができたら捨てるルールは100くらいにしておきましょう。
　また、4の負けのルールは、優先度はどうつけても実質的な大差はないのですが、ペアのカードが残ってたら捨ててから...など、きれいにしてから負けとするということで、優先度10にしておきました。

　この優先度で良さそうか、処理の流れを見てみましょう。定常的には 1のルールが動いています。ここで、カードを取ってペアが揃ったという条件が成り立ったら何はともあれ 2のルールが動くということで定常的な 1のルールの優先度 0に対し、2のルールの優先度 100というのは妥当そうです。また、カードを順繰りに取っていって手札が無くなると直ちに上がるので 3のルールの優先度は1000として良さそうです。最後に手札にジョーカー1枚のみが残るといった状態になった負けということで、4のルールの優先度が10でも問題なさそうです。

各ルール

　さて、1, 2, 3, 4 それぞれのルールについて見ていきましょう。
最初は、1. ふつうにカードを順繰りにとっていくルールです。

(defrule taking_a_card
    (play-phase)
  ?a <- (anata_no_ban_desu (player ?player1))
    (next ?player1 ?player2&~?player1)
  ?c <- (card (player ?player2))
=>
    (modify ?c (player ?player1))
    (modify ?a (player ?player2))
    (printout t "player" ?player1 " takes a card from player" ?player2 crlf)
)

　まず、優先度については 0 のデフォルトとして特に宣言はつけていません。次に(play-phase)は、プレーフェーズを表すということで、以下すべてのルールの最初に記述しています。さらに次のパターンは現在の順番をあらわすあなたの番ですファクトのplayerが ?player1にマッチすることを示しています(なおこのルールの場面は、?player1が?player2の手札からカードを取ることを想定しています)。次のnextファクトでは?player1の次が?player2であることを表しています²。条件部最後のパターンは、?player2の手札にあるカードにマッチします。

　このルールの条件部分についてまとめると、まず現在の番になっている?player1が、?player2の手札の中のいずれかのカードをとろうとして、?player2の手札の数だけ、実行する候補(ルールと、マッチするファクトの組)をあげて(ちょうど?player1が、?player2の手札に対し、どれをとろうか順に指で挟んでいってる感じ...)、そのうちのどれか一つをランダムに選んで(競合解消戦略はrandom strategy!)実行に移すということになります。
　実行するルールとファクトの組を選んだら、そのカードに対して実行を行います。それを表すのが実行部分です。実行部分 1行目でカードは?player1の手札に移り、2行目で順番が?player2へと移ります。

次に、2. プレーヤーの手札の中で数字が2枚揃ったら捨てるルールです。

(defrule discarding_a_pair
    (declare (salience 100))
    (play-phase)
  ?c1 <- (card (suit ?suit1) (rank ?rank) (player ?player&~discarded))
  ?c2 <- (card (suit ?suit2&~?suit1) (rank ?rank) (player ?player))
=>
    (modify ?c1 (player discarded))
    (modify ?c2 (player discarded))
    (printout t  ?suit1 ?rank " and " ?suit2 ?rank " are discarded. - player" ?player crlf)
)

これは見てもらえばだいたいご理解いただけると思いますが、2枚の違う種類で同じ数字のカードがひとりのプレーヤーの手札に含まれて(かつ捨てられていない)いれば、そのカードは捨てるというルールになります。

さて、次に上がりのルールです。
これは仮にplayerという各プレーヤーを表すファクトが定義されているとすると、条件部の主要部分は、

       (player (name ?player))
  (not (card (player ?player)))

といった形に書けそうです。1行目のパターンは、playerファクトにマッチし、2行目で、そのプレーヤーの手札が無くなっている( not は、not以下で指定されているパターンにマッチするようなファクトが存在しないことを表す³)ことを表しています。

ただし、今回はplayerファクトは定義していないので、その代わりにanata_no_ban_desuファクトとnextファクトを使いましょう。上がりになるケースを考えるうえで、わかりやすくするために上にあげた 1 のルール(ふつうにカードを順繰りにとっていくルール)が終わった時点での状況を以下の図に表しました。

この図を参照しながら上がりになるケースを考えると

player1 が、次の番にあたる player2 からカードを取って、同じ数の2枚ペアが完成し捨てることで手札が無くなり上がるケース
player2 が、player1 にカードを渡してしまったことで手札が無くなり上がるケース

の二つが考えられます。この二つのケースのそれぞれにルールをつくりましょう。また同時にプレーヤーが上がると順番も、そのプレーヤーを抜いた順になるので、同時にnextファクトや必要あればanata_no_ban_desuファクトも修正します。

　まず上がりのケース1.から

(defrule going_out1
    (declare (salience 1000))
    (play-phase)
    (anata_no_ban_desu (player ?next))
  ?n1 <- (next ?previous ?player)
  ?n2 <- (next ?player ?next)
  (not (card (player ?player)))
=>
    (printout t "player " ?player " wins! (going_out1)" crlf)
    (assert (player ?player wins the game))
    (assert (next ?previous ?next))
    (printout t "Now player" ?previous " is followed by player" ?next crlf)
    (retract ?n1 ?n2)
)

これは自分の番になっている状態で次のプレーヤーからカードを取り、ペアができて捨てたことで手札が無くなり上がった状態です。この場合順番について、自分が関係するnextファクトは削除して、新たに自分を飛ばしたnextファクトをつくります。なお anata_no_ban_desu については、上の図によれば、カードを取った時点で、すでに次のプレーヤーに順番を渡してしまっているので、特に修正の必要はありません。

　次に上がりのケース2.

(defrule going_out2
    (declare (salience 1000))
    (play-phase)
  ?a  <- (anata_no_ban_desu (player ?player))
  ?n1 <- (next ?previous ?player)
  ?n2 <- (next ?player ?next)
  (not (card (player ?player)))
=>
    (printout t "player " ?player " wins! (going_out2)" crlf)
    (assert (player ?player wins the game))
    (assert (next ?previous ?next))
    (modify ?a (player ?next))
    (printout t "Now player" ?previous " is followed by player" ?next crlf)
    (retract ?n1 ?n2)
)

これは、順番において自分よりひとつ前のプレーヤーがカードを取った時点で手札が無くなり上がった状態です。この場合上の図から、最後のカードを渡した時点で、anata_no_ban_desuファクトで自分の番になってしまっているので、次のプレーヤーに順番を移した上で、自分を順番からはずすことになります。

4.負けのルール：手札としてカード 1枚だけジョーカーが残ったら負け

(defrule what_a_pity_loser
    (declare (salience 10))
    (play-phase)
    (anata_no_ban_desu (player ?player))
    (card (suit joker) (player ?player))
  (not (card (suit ~joker) (player ?player)))
=>
  (printout t "player " ?player " loses the game." crlf)
  (assert (player ?player loses the game))
)

条件部分は、自分の順番が来て、ジョーカーを手元に持っているけれど、ジョーカー以外のカードは持っていないという条件を表しています。

以下は全ソース

(deftemplate card
    (slot suit
        (type SYMBOL)
        (allowed-symbols spade heart diamond club joker))
    (slot rank
        (type INTEGER)
	(range 0 13))
    (slot player
        (type SYMBOL)
        (allowed-symbols init A B C D discarded))
)

(deftemplate anata_no_ban_desu
    (slot player
        (type SYMBOL)
        (allowed-symbols A B C D))
)

(deffacts cards
    (card (suit spade) (rank 1))
    (card (suit spade) (rank 2))
    (card (suit spade) (rank 3))

         ・・・(略)・・・

    (card (suit club) (rank 11))
    (card (suit club) (rank 12))
    (card (suit club) (rank 13))
    (card (suit joker) (rank 0))

    (anata_no_ban_desu (player A))

    (next A B)
    (next B C)
    (next C D)
    (next D A)

    (deal-phase)
)

(defrule deal
    (deal-phase)
  ?a <- (anata_no_ban_desu (player ?player))
    (next ?player ?next)
  ?c <- (card (player init))
 =>
    (modify ?c (player ?player))
    (modify ?a (player ?next))
)

(defrule end_of_deal
    (declare (salience -10000))
  ?d <- (deal-phase)
  ?a <- (anata_no_ban_desu (player ?player))
=>
    (retract ?d)
    (assert (play-phase))
    (modify ?a (player A))
)

(defrule taking_a_card
    (play-phase)
  ?a <- (anata_no_ban_desu (player ?player1))
    (next ?player1 ?player2&~?player1)
  ?c <- (card (player ?player2))
=>
    (modify ?c (player ?player1))
    (modify ?a (player ?player2))
    (printout t "player" ?player1 " takes a card from player" ?player2 crlf)
)

(defrule discarding_a_pair
    (declare (salience 100))
    (play-phase)
  ?c1 <- (card (suit ?suit1) (rank ?rank) (player ?player&~discarded))
  ?c2 <- (card (suit ?suit2&~?suit1) (rank ?rank) (player ?player))
=>
    (modify ?c1 (player discarded))
    (modify ?c2 (player discarded))
    (printout t  ?suit1 ?rank " and " ?suit2 ?rank " are discarded. - player" ?player crlf)
)

(defrule going_out1
    (declare (salience 1000))
    (play-phase)
    (anata_no_ban_desu (player ?next))
  ?n1 <- (next ?previous ?player)
  ?n2 <- (next ?player ?next)
  (not (card (player ?player)))
=>
    (printout t "player " ?player " wins! (going_out1)" crlf)
    (assert (player ?player wins the game))
    (assert (next ?previous ?next))
    (printout t "Now player" ?previous " is followed by player" ?next crlf)
    (retract ?n1 ?n2)
)

(defrule going_out2
    (declare (salience 1000))
    (play-phase)
  ?a  <- (anata_no_ban_desu (player ?player))
  ?n1 <- (next ?previous ?player)
  ?n2 <- (next ?player ?next)
  (not (card (player ?player)))
=>
    (printout t "player " ?player " wins! (going_out2)" crlf)
    (assert (player ?player wins the game))
    (assert (next ?previous ?next))
    (modify ?a (player ?next))
    (printout t "Now player" ?previous " is followed by player" ?next crlf)
    (retract ?n1 ?n2)
)

(defrule what_a_pity_loser
    (declare (salience 10))
    (play-phase)
    (anata_no_ban_desu (player ?player))
    (card (suit joker) (player ?player))
  (not (card (suit ~joker) (player ?player)))
=>
  (printout t "player " ?player " loses the game." crlf)
  (assert (player ?player loses the game))
)

実行

さて、このプログラムを実行してみましょう。上にあげたソースが OldMaid.clp⁴ というファイルに記述されているとして⁵、CLIPSIDEを立ち上げて、ソースを読み込んで、戦略を設定したところが以下の画面になります。

ここでちょっとした注意ですが、set-strategyを実行すると、表示される値は以前に設定されていた戦略の名称となります。したがってここではデフォルトのdepthが返ってきています。ちゃんとrandomに指定されていますのでご安心ください。

ここで実行の状況は、(facts)コマンドなどを使ってみてもよいのですが、見やすいようにAgenda BrowserやFact Browserを立ち上げておきましょう。メニュー[Debug]の[Agenda Browser]と[Fact Browser]を指定すると、以下のような画面になります。

この状態で(reset)コマンドを実行し、ファクトの初期化をしてみます。ファクトブラウザーのタブを選択すると初期状態のファクトが見られます。

3カラムのうちの真ん中がファクトの一覧、一番右のカラムがファクトの中身の表示になります。
また、アジェンダブラウザの方もみておきます。アジェンダブラウザのタブを選択すると、現在、条件部分がマッチしているルールとファクトの組の一覧が出てきます。一覧の列は左から優先度(Salience)、ルール名(Rule)、マッチしているファクトの組(Basis)となります。ここで見えているルールとファクトの組は、カード53枚分のdealルールと、deal-phaseの最後に動くend_of_dealのルールとなります。

ここで、カード53枚を配ってみます。(run 53)を実行してみましょう。これは53回の認知実行サイクルが動くことを示しています。

最後にアジェンダに残っているのは、end_of_dealルールのみです(この状態でファクトも確認してみましょう。配り終わっている-プレーヤーが割り当てられている-ことがわかるでしょう)。ここで(run 1)を実行してみます。するとend_of_dealルールが動いて、(play-phase)になります。おそらくアジェンダブラウザにdiscarding_a_pairルールが表示されているはずです。これはババ抜きの最初に皆が手札から同じ数のペアを選んで捨てようとしていることを示しています。

ここで(run 1)を繰り返すことで次々とペアが捨てられていきます。ひととおり捨て終わるといよいよ最初のプレーヤーから隣のプレーヤーのカードを取っていくことになります。

アジェンダにtaking_a_cardのルールとファクトの組が5つ載っていますが、これは隣のプレーヤーが5枚の手札を持っていて、その中から取るカードを選択することを意味します。この状態でまた(run 1)を実行すると、

カードを取ったら、どうも手札に同じ数があったようです(discarding_a_pairのルールがアジェンダにあらわれていることに注意)。

実行すると、ペアが捨てられて次のプレーヤーが隣のプレーヤーのカードを取って...と進んでいきます。プレーヤーが上がるとたとえばこんな感じ

後は、(run)コマンドで最後まで一気に実行するとこんな感じ

プレーヤーCが負けてしまったようです。

まとめ

　Clipsに限らず、前向き推論のプロダクションシステムのプログラムをつくっていく感触はだいたい以上のようになります。この前向き推論のプロダクションシステムは、現在のBRMSの基盤であるということは前にも書きましたが、現在のBRMSが対象としているシステムは、ツールの性質とも相まって、上記のようなつくりを意識しなくても何となく書けてしまう場合が多く、こういった話はなかなかまとまった形での記述を見かけません。そこでせっかくなので今回番外編としてまとめてみました。現在のBRMSの応用は診断とか査定とか、昔でいうところの診断型的なケースがほとんどで、解を構成していくような設計・計画型的なケースはあまりないのですが、たまにプロジェクトでそういったことをやることがあります(生産計画とか配車計画とか...)。そういったときは、このような動きを意識しないとプログラムをつくっていくのは難しいのではないかと思います。
　次回は、書く書く詐欺状態になっているポーカーの役判定(実用的な面では、たとえばショッピングカート内である商品の組み合わせによって割引するなどといったときに使えそう)について書こうと思います。
　あと今回の記事を書きながら、トイプログラム的なことばかりをやっていてもあまりおもしろくないので、そのうちClipsを使って簡単なスケジューリング問題を解いてみることなども書いてみようかとも思いました。

連載記事

Clipsには、Moduleという概念があって開発を分割統治したり、実行制御に使ったりします。ここでもModuleは使えて、一般的にちゃんとやるにはその方が望ましいと言えるのですが、今回それほど大きなプログラムでないことと、Moduleなどがないもっとプリミティブなプロダクションシステム言語などでは、こんな感じでフェーズを表すファクトを書き換えて実行順序を制御したりもするので簡単にこの方法を採用してしまいました。 ↩
最後に&~?player1がついていますが、これは、だんだんとプレーヤーが上がっていくにつれて、次の順番を表すnextファクトが縮退していって最終的には最後に残ったプレーヤーだけが残ってしまうケース((next A A)になってしまう)をケースを考えての条件です。そのようなnextファクトにはマッチしないような条件を一応つけています ↩
パターンにマッチするファクトが存在しないことを表すのがnotですが、ほかに2つ以上のパターンに対して、どれも存在することを表すandやどれかが存在することを表すorなどもある。 ↩
Clipsのファイルの拡張子は通常.clpです。 ↩
Clipsのデフォルトのパスはメニューの[Environment]→[Set Directory]で設定できます。 ↩

You get articles that match your needs
You can efficiently read back useful information
You can use dark theme

What you can do with signing up