Haskell

Tuesday, December 6, 2022

やり直し Haskellでポケモン組み合わせ問題を解く

Haskellでポケモン組み合わせ問題を解く というエントリーを書いたのですが、 よく見てみると結果のポケモンペアのリストに (Pikachu(electric),Squirtle(water)) と (Squirtle(water),Pikachu(electric)) が両方含まれていました。 これは、ポケモンの前後が入れ替わっただけでペアとして実質同じ内容なので同じペアとして扱いたい。 つまり、これらの一方のペアは結果のリストから除外したい。

前回の結果から該当ペアを除外する

isSamePair という関数を考えたい。こんな関数。

isSamePair :: (Pokemon, Pokemon) -> (Pokemon, Pokemon) -> Bool
isSamePair (a,b) (c,d) = or [(and [(a==c), (b==d)]), (and [(a==d), (b==c)])]

しかし、これを実行するとエラーになる。Pokemon データ型が Eq のインスタンスでないため同値判定ができない、とのこと。 そこで、Pokemon を Eq のインスタンスにします。

instance Eq Pokemon where
  Pokemon n _ == Pokemon n' _  = n == n'

名前が同じだったら同じポケモンと判定する。

厳密にはタイプ（kind）も同じであるべきだが、ポケモンの場合、ポケモン名が同じなのにタイプが異なるポケモンは存在しないはずなので、名前だけで同値性を決定します。

これで、 isSamePair 関数が意図通り機能するようになります。

あとは、以前実装した countif や ポケモンペアがリストに含まれるか判定 elem' などを使って 前回のエントリーで算出した結果 resultPokemonPairs から（ポケモンの前後が入れ替わっただけのポケモンペアを）除外します。

countif :: [(Pokemon,Pokemon)] -> (Pokemon,Pokemon) -> Int
countif pokemonPairs pair =
  length $ filter (\it -> isSamePair it pair) pokemonPairs

elem' :: (Pokemon,Pokemon) -> [(Pokemon,Pokemon)] -> Bool
elem' p px = (countif px p)>0

rejectIfExists :: [(Pokemon,Pokemon)] -> (Pokemon,Pokemon) -> [(Pokemon,Pokemon)]
rejectIfExists px p = if elem' p px then px else (px++[p])

resultPokemonPairs' =
  foldl (\acc p -> rejectIfExists acc p) [] resultPokemonPairs

main :: IO ()
main = putStrLn $ show resultPokemonPairs'

実行結果（改行は手動で入れた）:

[
 (Pikachu(electric),Squirtle(water))
,(Pikachu(electric),Charmander(fire))
,(Pikachu(electric),Golduck(water))
,(Squirtle(water),Charmander(fire))
,(Charmander(fire),Golduck(water))]

これで、前後が入れ替わっただけのペアを除外できました。

ここまでのコード main.hs

data Kind = E | W | F deriving (Eq)

data Pokemon =
  Pokemon String Kind

instance Show Kind where
  show E = "electric"
  show W = "water"
  show F = "fire"

instance Show Pokemon where
  show p = (name p) ++ "(" ++ (show $ kind p) ++ ")"
    where
      name (Pokemon n _) = n
      kind (Pokemon _ k) = k

isSameName (a, b) = (name a) == (name b)
  where
    name (Pokemon n _) = n

isSameKind (a, b) = (kind a) == (kind b)
  where
    kind (Pokemon _ k) = k


pikachu = Pokemon "Pikachu" E
squirtle = Pokemon "Squirtle" W
charmander = Pokemon "Charmander" F
golduck = Pokemon "Golduck" W
pokemons = [pikachu, squirtle, charmander, golduck]

pokemonPairs = pure (\a b -> (a, b)) <*> pokemons <*> pokemons

resultPokemonPairs =
  filter
    (\pair -> and [not (isSameName pair), not (isSameKind pair)])
    pokemonPairs

instance Eq Pokemon where
  Pokemon n _ == Pokemon n' _ = n == n'

isSamePair :: (Pokemon, Pokemon) -> (Pokemon, Pokemon) -> Bool
isSamePair (a, b) (c, d) =
  or [(and [(a == c), (b == d)]), (and [(a == d), (b == c)])]

countif :: [(Pokemon, Pokemon)] -> (Pokemon, Pokemon) -> Int
countif pokemonPairs pair =
  length $ filter (\it -> isSamePair it pair) pokemonPairs

elem' :: (Pokemon, Pokemon) -> [(Pokemon, Pokemon)] -> Bool
elem' p px = (countif px p) > 0

rejectIfExists ::
     [(Pokemon, Pokemon)] -> (Pokemon, Pokemon) -> [(Pokemon, Pokemon)]
rejectIfExists px p =
  if elem' p px
    then px
    else (px ++ [p])

resultPokemonPairs' =
  foldl (\acc p -> rejectIfExists acc p) [] resultPokemonPairs

main :: IO ()
main = putStrLn $ show resultPokemonPairs'

無駄に長いコードになってしまった。

リファクタリング

意図通り作動するコードはできたのですが、後付けであれこれ手直ししてわかりづらいコードになってしまった。 とくに、ポケモンのペアのリストから実質同じペア（ポケモンの前後が異なるだけのペア）を除去するために、いろいろコードを書いているが、 リストをユニークにする いわゆる unique 相当の関数一発でその部分解決したい。

ということで、これをリファクタリングします。

まず、ポケモンペアを今までタプルとして表現していたがそれをやめてデータ型 Pair を定義します。

data Pair =
  Pair Pokemon Pokemon

そして、Pair の同値性を定義:

instance Eq Pair where
  Pair a b == Pair c d =
    or [(and [(a == c), (b == d)]), (and [(a == d), (b == c)])]

前後が入れ替わったとしても同じポケモンペアと判断するように設定しました。

Pairを表示できるように Show のインスタンスにします。

instance Show Pair where
  show pair = "(" ++ (first pair) ++ "," ++ (second pair) ++ ")"
    where
      first (Pair a b) = show a
      second (Pair a b) = show b

ここまでのコード 修正版 main.hs

data Kind = E | W | F deriving (Eq)

data Pokemon =
  Pokemon String Kind

instance Show Kind where
  show E = "electric"
  show W = "water"
  show F = "fire"

instance Show Pokemon where
  show p = (name p) ++ "(" ++ (show $ kind p) ++ ")"
    where
      name (Pokemon n _) = n
      kind (Pokemon _ k) = k

instance Eq Pokemon where
  Pokemon n _ == Pokemon n' _ = n == n'

data Pair =
  Pair Pokemon Pokemon

instance Eq Pair where
  Pair a b == Pair c d =
    or [(and [(a == c), (b == d)]), (and [(a == d), (b == c)])]

instance Show Pair where
  show pair = "(" ++ (first pair) ++ "," ++ (second pair) ++ ")"
    where
      first (Pair a b) = show a
      second (Pair a b) = show b

これが意図通り作動するかテストしてみます。

テスト用のポケモンを用意:

pikachu = Pokemon "Pikachu" E
squirtle = Pokemon "Squirtle" W
charmander = Pokemon "Charmander" F
golduck = Pokemon "Golduck" W

ここまでのコードをロードして、ポケモンペアを比較:

Prelude> :load main.hs
[1 of 1] Compiling Main             ( main.hs, interpreted )
Ok, one module loaded.
*Main> (Pair pikachu squirtle)==(Pair pikachu squirtle)
True
*Main> (Pair squirtle pikachu)==(Pair pikachu squirtle)
True
*Main> (Pair golduck pikachu)==(Pair pikachu squirtle)
False

意図通り作動しているようです。

では、main.hs に以下の記述を追加してコンパイル実行してみましょう。

pokemons = [pikachu, squirtle, charmander, golduck]
pokemonPairs = (\a b -> Pair a b) <$> pokemons <*> pokemons
--pokemonPairs = pure (\a b -> Pair a b) <*> pokemons <*> pokemons

main :: IO ()
main = putStrLn $ show pokemonPairs

コンパイル＆実行。

$ ghc main.hs
$ ./main
[(Pikachu(electric),Pikachu(electric)),(Pikachu(electric),Squirtle(water)),(Pikachu(electric),Charmander(fire)),(Pikachu(electric),Golduck(water)),(Squirtle(water),Pikachu(electric)),(Squirtle(water),Squirtle(water)),(Squirtle(water),Charmander(fire)),(Squirtle(water),Golduck(water)),(Charmander(fire),Pikachu(electric)),(Charmander(fire),Squirtle(water)),(Charmander(fire),Charmander(fire)),(Charmander(fire),Golduck(water)),(Golduck(water),Pikachu(electric)),(Golduck(water),Squirtle(water)),(Golduck(water),Charmander(fire)),(Golduck(water),Golduck(water))]

とりあえず、全てのポケモンペアを生成できたところまで完成。

あとは、Pair に対していわゆる unique にすればOKです。

unique 相当の機能を使うには import Data.List して nub すればよい。

import Data.List

...

main = putStrLn $ show $ nub pokemonPairs

実行してみます。

[
 (Pikachu(electric),Pikachu(electric))
,(Pikachu(electric),Squirtle(water))
,(Pikachu(electric),Charmander(fire))
,(Pikachu(electric),Golduck(water))
,(Squirtle(water),Squirtle(water))
,(Squirtle(water),Charmander(fire))
,(Squirtle(water),Golduck(water))
,(Charmander(fire),Charmander(fire))
,(Charmander(fire),Golduck(water))
,(Golduck(water),Golduck(water))]

おっと。 同じポケモンペアで入れ違いのペアはうまく除去できましたが、 (Pikachu, Pikachu) のような同じポケモンのペアを除外するのを忘れていました。

ここから not(isSameName pair) で filter すればよさそうです。

isSameName :: Pair -> Bool
isSameName pair = (name $ first pair) == (name $ second pair)
  where
    name (Pokemon n _) = n
    first (Pair a b) = a
    second (Pair a b) = b

main :: IO ()
main =
  putStrLn $
  show $
  filter (\pair -> not(isSameName pair)) $
  nub pokemonPairs

実行:

[
 (Pikachu(electric),Squirtle(water))
,(Pikachu(electric),Charmander(fire))
,(Pikachu(electric),Golduck(water))
,(Squirtle(water),Charmander(fire))
,(Squirtle(water),Golduck(water))
,(Charmander(fire),Golduck(water))]

できました。

いやまてまて、同じタイプのペアだったら(例 (Squirtle(water),Golduck(water)) 両方とも水タイプ) それも除去するというルールでしたね。 ならば isSameKind 関数を使ってさらに filter します。

isSameKind :: Pair -> Bool
isSameKind pair = (kind $ first pair) == (kind $ second pair)
  where
    kind (Pokemon _ k) = k
    first (Pair a b) = a
    second (Pair a b) = b

main :: IO ()
main =
  putStrLn $
  show $
  filter (\pair -> and [not (isSameName pair), not (isSameKind pair)]) $
  nub pokemonPairs

実行:

[
 (Pikachu(electric),Squirtle(water))
,(Pikachu(electric),Charmander(fire))
,(Pikachu(electric),Golduck(water))
,(Squirtle(water),Charmander(fire))
,(Charmander(fire),Golduck(water))]

今度こそできました。

最後に完成したコード全体を掲載します。

main.hs

import Data.List

data Kind = E | W | F deriving (Eq)

data Pokemon =
  Pokemon String Kind

instance Show Kind where
  show E = "electric"
  show W = "water"
  show F = "fire"

instance Show Pokemon where
  show p = (name p) ++ "(" ++ (show $ kind p) ++ ")"
    where
      name (Pokemon n _) = n
      kind (Pokemon _ k) = k

instance Eq Pokemon where
  Pokemon n _ == Pokemon n' _ = n == n'

data Pair =
  Pair Pokemon Pokemon

instance Eq Pair where
  Pair a b == Pair c d =
    or [(and [(a == c), (b == d)]), (and [(a == d), (b == c)])]

instance Show Pair where
  show pair = "(" ++ (first pair) ++ "," ++ (second pair) ++ ")"
    where
      first (Pair a b) = show a
      second (Pair a b) = show b


isSameName :: Pair -> Bool
isSameName pair = (name $ first pair) == (name $ second pair)
  where
    name (Pokemon n _) = n
    first (Pair a b) = a
    second (Pair a b) = b

isSameKind :: Pair -> Bool
isSameKind pair = (kind $ first pair) == (kind $ second pair)
  where
    kind (Pokemon _ k) = k
    first (Pair a b) = a
    second (Pair a b) = b



pikachu = Pokemon "Pikachu" E
squirtle = Pokemon "Squirtle" W
charmander = Pokemon "Charmander" F
golduck = Pokemon "Golduck" W

pokemons = [pikachu, squirtle, charmander, golduck]
pokemonPairs = (\a b -> Pair a b) <$> pokemons <*> pokemons


main :: IO ()
main =
  putStrLn $
  show $
  filter (\pair -> and [not (isSameName pair), not (isSameKind pair)]) $
  nub pokemonPairs

Makefile

run: main
	./main

main: main.hs
	ghc main.hs

まとめ

自分で定義したデータ型に対して同値性もオレオレルールで設定できる。 これは便利。