Friday, February 25, 2022

Haskell / ポケモンのモデル化とその進化 Monad による連続変換処理（その１）

Haskell で練習のためキャタピー進化系のモデル化をやってみます。 Maybe Monad を使ってトレーニングとバトルでゲットしたキャタピーを進化させよう。

Step1 キャタピー進化をモデル化

キャタピーのレベルに応じた進化を考えてみます。設定は以下のようにします。

キャタピー(Caterpi)は レベル5 以上でトランセル(Metapod)に進化
トランセルは レベル10 以上でバタフリー(Butterfree)に進化
train するとレベルが +1 される
fight するとレベルが +3 される

これをコードにします:

data Pokemon = Caterpie Int | Metapod Int | Butterfree Int

instance Show Pokemon where
  show pokemon = toString pokemon
    where
      toString (Caterpie l)   = "Caterpie Level=" ++ (show l)
      toString (Metapod l)    = "Metapod Level=" ++ (show l)
      toString (Butterfree l) = "Butterfree Level=" ++ (show l)


train :: Pokemon -> Pokemon
train (Caterpie l)
    | (l+1)>=5 = Metapod $ l+1
    | otherwise = Caterpie $ l+1
train (Metapod l)
    | (l+1)>=10 = Butterfree $ l+1
    | otherwise = Metapod $ l+1
train (Butterfree l) = Butterfree $ l+1


fight :: Pokemon -> Pokemon
fight (Caterpie l)
    | (l+3)>=5 = Metapod $ l+3
    | otherwise = Caterpie $ l+3
fight (Metapod l)
    | (l+3)>=10 = Butterfree $ l+3
    | otherwise = Metapod $ l+3
fight (Butterfree l) = Butterfree $ l+3


getPokemon :: Pokemon
getPokemon = Caterpie 1

この状況からまずポケモンをゲット myPokemon = getPokemon してキャタピー(レベル1)を得ます。そして、マイポケモンであるキャタピーに対してトレーニングやバトルでレベルアップを目指します。

myPokemon1 = getPokemon
myPokemon2 = train myPokemon1 
myPokemon3 = train myPokemon2 
myPokemon4 = fight myPokemon3 
myPokemon5 = train myPokemon4

レベル1 の状態から 2回トレーニング/1回バトル/1回トレーニングしたので myPokemon5 はどうなっているでしょうか？確認してみましょう。

GHCi で調べ見てましょう。

> myPokemon5
Metapod Level=7

レベル7になり、トランセル(Metapod)に進化しています。

これを以下のように記述することもできます。

myPokemon = getPokemon
myPokemon' = train $ fight $ train $ train myPokemon

GHCi で確認:

> :reload
> myPokemon'
Metapod Level=7

連続して変換する記述 train $ fight $ train $ train myPokemon のようになっていますが、これはつまりこれ train ( fight ( train ( train myPokemon ) ) ) と同じことなので、 train して train して fight して train となります。

変換処理の適用順が 右から左 になっている。これは、コードとして読みづらいですね。

Step2 Monad を使おう

ならば以前のエントリーでやったように Monad で bind ( >>= ) を使えばいいのでは？

こんな感じでできないのか？

myPokemon' = myPokemon >>= train >>= train >>= fight >>= train

もちろん、これは動きません。

前回は以下のような型になっていたのでうまくいったのでした。

Maybe [Computer] >>= ([Computer] -> Maybe [Computer]) >>= ([Computer] -> Maybe [Computer]) >>= ([Computer] -> Maybe [Computer])

では、Maybe で Pokemon を包めば bind で連続処理できるようになるのでは？つまりこのように:

Maybe Pokemon >>= (Pokemon -> Maybe Pokemon) >>= (Pokemon -> Maybe Pokemon) >>= (Pokemon -> Maybe Pokemon)

実際にコードしてみましょう。

まずポケモンをゲットして Maybe で包みます。

myPokemonM :: Maybe Pokemon
myPokemonM = Just getPokemon

それから、これを bind で変換します。試しに一回だけ train してみます。

myPokemonM' = myPokemonM >>= (\p -> Just (train p))

GHCi で確認:

> :reload
> myPokemonM'
Just Caterpie Level=2

うまくいきました!!

では、先程と同じようにトランセル(Metapod) まで進化させてみましょう。

myPokemonM' = myPokemonM >>= (\p -> Just (train p)) >>= (\p -> Just (train p)) >>= (\p -> Just (fight p)) >>= (\p -> Just (train p))

GHCi で確認:

> :reload
> myPokemonM'
Just Metapod Level=7

意図通りできています。

これは型がどうなっているかと言えば...

Maybe Pokemon から出発して bind ( >>= ) すると bind の右側の関数には Maybe の 中身だけ が渡される。
そこで (\p -> Just (train p)) のラムダ関数で Pokemon から Maybe Pokemon に変換します。 p には Pokemon 値が入ってくる。Just (train p) することで再度 Maybe Pokemon の型を作り出して次の bind に渡しています。
あとは、その繰り返し。

という仕組み。

ラムダ関数ではなく、名前付きの関数 trainM, fightM を用意して型シグネチャを明示しよう。

trainM :: Pokemon -> Maybe Pokemon
trainM p = Just (train p)

fightM :: Pokemon -> Maybe Pokemon
fightM p = Just (fight p)

これを使えば bind で連続変換する部分は以下のように書けます:

myPokemonM' = myPokemonM >>= trainM >>= trainM >>= fightM >>= trainM

コードがそのまま意味を表すようになりました。つまり、myPokemonM から trainM して trainM して fightM して trainM した結果が myPokemonM' になる、と。

これが DSL とか言われる理由なのかな？

まとめ

ポケモンをモデル化して、キャタピーの進化をモナドを使って連続変換するコードを bind でつくりました。

Monad を使うことで...

これが:

myPokemon' = train $ fight $ train $ train myPokemon

このように:

myPokemonM' = myPokemonM >>= trainM >>= trainM >>= fightM >>= trainM

記述できるようになりました。

確かに、連続変換処理として train, fight や trainM, fightM の適用順が 右から左 から 左から右 に変わっただけじゃないか、と。でも、Maybe で包むことで、この順番が自然になった以上の効果があります。それは次のエントリーで書く予定です。

コード全体 pokemon.hs:

-- ポケモンモデル
data Pokemon = Caterpie Int | Metapod Int | Butterfree Int

instance Show Pokemon where
  show pokemon = toString pokemon
    where
      toString (Caterpie l)   = "Caterpie Level=" ++ (show l)
      toString (Metapod l)    = "Metapod Level=" ++ (show l)
      toString (Butterfree l) = "Butterfree Level=" ++ (show l)


-- トレーニング(train)とバトル(fight)によるレベルアップ
train :: Pokemon -> Pokemon
train (Caterpie l)
    | (l+1)>=5  = Metapod $ l+1
    | otherwise = Caterpie $ l+1
train (Metapod l)
    | (l+1)>=10 = Butterfree $ l+1
    | otherwise = Metapod $ l+1
train (Butterfree l) = Butterfree $ l+1


fight :: Pokemon -> Pokemon
fight (Caterpie l)
    | (l+3)>=5  = Metapod $ l+3
    | otherwise = Caterpie $ l+3
fight (Metapod l)
    | (l+3)>=10 = Butterfree $ l+3
    | otherwise = Metapod $ l+3
fight (Butterfree l) = Butterfree $ l+3


-- ポケモンゲットだぜ
getPokemon :: Pokemon
getPokemon = Caterpie 1

-- トレーニングとバトルのモナド版
trainM :: Pokemon -> Maybe Pokemon
trainM p = Just (train p)

fightM :: Pokemon -> Maybe Pokemon
fightM p = Just (fight p)


-- ポケモンをゲットして育成
myPokemonM :: Maybe Pokemon
myPokemonM = Just getPokemon
myPokemonM' = myPokemonM >>= trainM >>= trainM >>= fightM >>= trainM

モナド完全に理解した（してない）。

Liked some of this entry? Buy me a coffee, please.