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
自分で定義したデータ型に対して同値性もオレオレルールで設定できる。 これは便利。