Haskellで有限状態機械を書いてみました。

題材

手元にあった実例で学ぶゲームAIプログラミングより、
西部の鉱夫の生活をFSMで表現したものをHaskellで書いてみました。

作者: Mat Buckland,松田晃一
出版社/メーカー: オライリー・ジャパン
発売日: 2007/09/28
メディア: 大型本
購入: 8人クリック: 262回
この商品を含むブログ (43件) を見る

ソース説明

鉱夫の状態は以下の4種類です。

data MinnerState = MS_EnterMineAndDigForNugget -- 鉱山で金を探す
                 | MS_VisitBankAndDepositGold  -- 銀行に行き手持ちの金を預ける
                 | MS_QuenchThirst             -- 喉の乾きを癒しに酒場に行ってお酒を飲む
                 | MS_GoHomeAndSleepTilRested  -- 家に帰り眠って疲れをとる
                   deriving (Show, Eq)

各状態の遷移は以下のようになります。

鉱夫は以下のようなdataで表現されています。

data MinnerFSM = MinnerFSM{
        state       :: MinnerState
      , thirst      :: Int -- 喉の乾き
      , fatigue     :: Int -- 疲労度
      , goldCarried :: Int -- 所持金塊
      , location    :: Location
      , moneyInBank :: Int
    } deriving (Show, Eq)

そして鉱夫の状態は、

updateMinnerState :: MinnerState -> MinnerFSM -> MinnerFSM

という関数を使って更新されていきます。

例としてMS_EnterMineAndDigForNugget状態の場合の更新処理は以下のようになっています。

updateMinnerState MS_EnterMineAndDigForNugget m =
    m{state = newState, fatigue = newFatigue, goldCarried = newGold}
    where
      newState = if newGold > maxNuggets
                 then MS_VisitBankAndDepositGold
                 else if (thirst m) >= thirstLevel
                      then MS_QuenchThirst
                      else MS_EnterMineAndDigForNugget
      newGold = (goldCarried m) + 1
      newFatigue = (fatigue m) + 1

下で引数の状態変数の値でパターンマッチを行い、MS_EnterMineAndDigForNugget状態の場合にこの処理が呼ばれるようにしています。

updateMinnerState MS_EnterMineAndDigForNugget m =

さらにその一行下で戻値を定義し、whereの中で変更される値について具体的な定義をしています。

m{state = newState, fatigue = newFatigue, goldCarried = newGold}

このような処理が各状態ごとにありそれらを実行していき一定以上銀行預金が増えたら終了します。

思ったことなど

updateMinnerState :: MinnerState -> MinnerFSM -> MinnerFSM

でパターンマッチ用にMinnerStateのみ取り出して引数として渡していますが、もう少し綺麗に書けないかと思いました。
下のような感じでdataの全体を受け取りつつ中のフィールドの値でパターンマッチしたいと思いました。

updateMinnerState :: MinnerFSM -> MinnerFSM
updateMinnerState m{ state = MS_***} =

追記

下のような書き方でdata全体を受け取りつつ、フィールドでパターンマッチ出来るみたいです。

updateMinnerState m@MinnerFSM{state = MS_EnterMineAndDigForNugget} =

今後

今回のような規模のものだとかなり簡潔に書けました。
もう少し複雑なものを書く場合にどんな感じになるのか試してみようと思います。

ソース全文(一応)

--
-- MinnerFSM.hs
--

-- 定数
maxNuggets         = 10  -- 一度に持ち運べる金の個数
thirstLevel        = 10  -- 耐えられる喉の乾き
comfortLevel       = 5   -- 十分な銀行預金の残高
clearGold          = 100 -- ゲームクリアに必要な銀行預金の残高
tirednessThreshold = 0   -- fatigueがこの値以下であれば疲労していない

-- 鉱夫の状態
data MinnerState = MS_EnterMineAndDigForNugget -- 鉱山で金を探す
                 | MS_VisitBankAndDepositGold  -- 銀行に行き手持ちの金を預ける
                 | MS_QuenchThirst             -- 喉の乾きを癒しに酒場に行ってお酒を飲む
                 | MS_GoHomeAndSleepTilRested  -- 家に帰り眠って疲れをとる
                   deriving (Show, Eq)

-- 場所の種類
data Location = LOCATION_Home
              | LOCATION_Mine
              | LOCATION_Bank
              | LOCATION_Bar
                deriving (Show, Eq)

-- 鉱夫データ
data MinnerFSM = MinnerFSM{
        state       :: MinnerState
      , thirst      :: Int -- 喉の乾き
      , fatigue     :: Int -- 疲労度
      , goldCarried :: Int -- 所持金塊
      , location    :: Location
      , moneyInBank :: Int
    } deriving (Show, Eq)

-- メイン関数
main :: IO ()
main = do game

-- ゲームの実行 
game :: IO ()
game = do putStr "start."
          gameInner MinnerFSM{  state       = MS_EnterMineAndDigForNugget
                              , thirst      = 0
                              , fatigue     = 0
                              , goldCarried = 0
                              , location    = LOCATION_Mine
                              , moneyInBank = 50}
          putStr "end."

-- ゲームの更新
gameInner :: MinnerFSM -> IO MinnerFSM
gameInner m = do newFSM <- return $ updateMinner m
                 putStrLn $ show newFSM
                 -- クリア判定
                 if moneyInBank newFSM < clearGold
                 then gameInner newFSM
                 else return newFSM

-- 状態変更の通知
beginState :: MinnerFSM -> MinnerState -> MinnerState -> MinnerFSM
endState :: MinnerFSM -> MinnerState -> MinnerState -> MinnerFSM

-- 状態が変化したら状態にあった場所に移動させる
beginState m _ MS_EnterMineAndDigForNugget = m{location = LOCATION_Mine}
beginState m _ MS_VisitBankAndDepositGold = m{location = LOCATION_Bank}
beginState m _ MS_QuenchThirst = m{location = LOCATION_Bar}
beginState m _ MS_GoHomeAndSleepTilRested = m{location = LOCATION_Home}
beginState m _ _ = m

endState m _ _ = m

-- 鉱夫の更新 状態変化の通知管理
updateMinner :: MinnerFSM -> MinnerFSM
updateMinner m = if (state newFSM) /= (state m)
                then beginState newFSM' (state m) (state newFSM')
                else newFSM
    where newFSM = updateMinnerInner m
          newFSM' = (endState newFSM (state m) (state newFSM))

-- 鉱夫の状態更新処理
updateMinnerInner :: MinnerFSM -> MinnerFSM
updateMinnerInner m = updateMinnerState (state m) m{thirst = (thirst m) + 1} -- 毎フレーム喉の乾きは増していく

-- 鉱夫の状態別更新処理
updateMinnerState :: MinnerState -> MinnerFSM -> MinnerFSM

-- 鉱山で金を探す
updateMinnerState MS_EnterMineAndDigForNugget m =
    m{state = newState, fatigue = newFatigue, goldCarried = newGold}
    where
      newState = if newGold > maxNuggets
                 then MS_VisitBankAndDepositGold
                 else if (thirst m) >= thirstLevel
                      then MS_QuenchThirst
                      else MS_EnterMineAndDigForNugget
      newGold = (goldCarried m) + 1
      newFatigue = (fatigue m) + 1

-- 銀行に行き手持ちの金を預ける
updateMinnerState MS_VisitBankAndDepositGold m =
    m{state = newState, goldCarried = 0, moneyInBank = newBankInMoney}
    where
      newState = if newBankInMoney > comfortLevel
                 then MS_GoHomeAndSleepTilRested
                 else MS_EnterMineAndDigForNugget
      newBankInMoney = (moneyInBank m) + (goldCarried m)

-- 喉の乾きを癒しに酒場に行ってお酒を飲む
updateMinnerState MS_QuenchThirst m =
    m{state = newState, thirst = newThirst, moneyInBank = newMoneyInBank}
    where
      newState = MS_EnterMineAndDigForNugget
      newMoneyInBank = (moneyInBank m) - 3
      newThirst = 0

-- 家に帰り休む
updateMinnerState MS_GoHomeAndSleepTilRested m =
    m{state = newState, fatigue = newFatigue}
    where
      newState = if newFatigue < tirednessThreshold
                 then MS_EnterMineAndDigForNugget
                 else MS_GoHomeAndSleepTilRested
      newFatigue = (fatigue m) - 1