Haskell で 覆面算 をやってみた。
DEBT + STAR = DEATH が与えられたとき、等式が成立するには
D = 1, E = 0, B = 8, T = 5, S = 9, A = 6, R = 7, H = 2
とならなければならない、という問題を解くものである。
先日とある脱出ゲームで出題されたが手計算ではまったく解けなかった。
ソースコードはこちら。
https://github.com/mitsuji/verbal-arithmetic
1. 特殊解
まずは、特殊ケースとして "DEBT + STAR = DEATH" だけを解くことを考える。
リストの要素を指定された数だけ使用した全ての順列に評価される関数
permutation を 作ると、下記のように総当りで解くことができる。
単語の先頭の数字はゼロにならないので、D != 0 と S != 0 を条件に追加している。
matchDeath :: [Int] -> Bool
matchDeath (a:b:d:e:h:s:t:r:[]) =
d/=0 && s/=0 && debt + star == death
where
debt = d * 1000 + e * 100 + b * 10 + t
star = s * 1000 + t * 100 + a * 10 + r
death = d * 10000 + e * 1000 + a * 100 + t * 10 + h
filterDeath =
map (zip "abdehstr") $ filter matchDeath $ permutation 8 [0,1,2,3,4,5,6,7,8,9]
また、繰り上がりを考えると等式を見ただけで D = 1 が明らかなので、
これを条件に加えると、試行回数が激減して実行時間を短縮できる。
matchDeath' :: [Int] -> Bool
matchDeath' (a:b:e:h:s:t:r:[]) =
debt + star == death
where
debt = d * 1000 + e * 100 + b * 10 + t
star = s * 1000 + t * 100 + a * 10 + r
death = d * 10000 + e * 1000 + a * 100 + t * 10 + h
d = 1
filterDeath' =
map (zip "abehstr") $ filter matchDeath' $ permutation 7 [0,2,3,4,5,6,7,8,9]
2. 一般化
ここからが本番だ。
脱出ゲームに勝つためには、わざわざ関数を書かなくても、
例えば下記のように記述したら解答を表示してくれるライブラリが必要だ。
test1 = print $ findConditions $ "debt" + "star" == "death" test2 = print $ findConditions $ "debt + star = death"
また､このような関数をあらかじめコンパイルしておけば､
main = do equ:_ <- getArgs print $ findConditions $ fromString equ
このように､コマンドにパラメータを渡すだけで解答を得ることができるだろう｡
$ verbal-arithmetic-general-exe "debt + star = death"
3. 式のデータ
まずは、入力となる数式(文字式?)を表現するためのデータ型を考えてみる。
今回は式(VExp)と等式(VEqu)を別の型として定義してみた｡
data VExp = Val [Char]
| Add VExp VExp
deriving(Show)
data VEqu = Equals VExp VExp
deriving(Show)
このデータ型を使用すると､
式 DEBT + STAR = DEATH は下記のようなデータになる。
ポーランド記法とかいうやつだ｡
equ1 = Equals (Add (Val "debt") (Val "star")) (Val "death")
関数を演算子として使えば、下記のように書くこともできる。
equ2 = Val "debt" `Add` Val "star" `Equals` Val "death"
ここで、下記の関数を定義してみると、
(+) = Add (==) = Equals
下記のような記述が可能になる。だいぶ見やすくなってきた。
equ3 = Val "debt" + Val "star" == Val "death"
そして、VExp を IsString 型クラスのインスタンスにして、
instance IsString VExp where fromString xs = Val xs
ソースコードの先頭に {-# LANGUAGE OverloadedStrings #-} を書くと
下記のような記述が可能になる。
これは、コード上に文字列リテラルがあり、VExp型に推論されるときは
VExp の fromString を使って、VExp型のデータを作りなさいという意味である｡
コード上で式を扱うには、まずはこれで充分だろう。
equ4 = "debt" + "star" == "death"
4. 一般解
特殊解の関数を参考にして作成した関数が下記である｡
chars 関数で式内のユニークな文字を抽出し、総当りの場合の数を決めている。
また、firstChars 関数で式内の単語の先頭の文字を抽出し、!= 0 条件を追加している。
findConditions :: VEqu -> [[(Char,Int)]]
findConditions equ =
let
cs = chars equ
in
filter (match equ) $ map (zip cs) $ permutation (length cs) [0..9]
match :: VEqu -> [(Char,Int)] -> Bool
match equ xs = (and $ map f $ firstChars equ) && evaluate equ xs
where
f x =
let Just y = lookup x xs
in y /= 0
match 関数に渡された数字を元に実際に計算を行う関数は下記のようになった。
listToInt 関数は、数字のリストを10進数で数値に変換する関数である。
evaluate :: VEqu -> [(Char,Int)] -> Bool
evaluate (Equals exp1 exp2) xs = expEvaluate exp1 xs P.== expEvaluate exp2 xs
where
expEvaluate :: VExp -> [(Char,Int)] -> Int
expEvaluate (Add exp1 exp2) xs = expEvaluate exp1 xs P.+ expEvaluate exp2 xs
expEvaluate (Val cs) xs = listToInt $ map f cs
where
f x =
let Just y = lookup x xs
in y
5. パーサー
ここまでで計算自体はできるようになったが、コマンドラインに式を渡せるようにするには、
式全体を文字列として受け取って、式のデータに変換するパーサーを書く必要がある。
こんな感じのパーサーになった。スペースの扱いで1日くらいハマった｡
pVal :: PS.Parser VExp
pVal = do
xs <- PS.many1 $ PS.letter <|> PS.alphaNum
return $ Val xs
pAdd :: PS.Parser (VExp -> VExp -> VExp)
pAdd = PS.char '+' >> return Add
pExp :: PS.Parser VExp
pExp = pValS `PS.chainl1` pOpS
where
pValS = do
val <- pVal
PS.spaces
return val
pOpS = do
op <- pAdd <|> mzero
PS.spaces
return op
pEquals :: PS.Parser VEqu
pEquals = do
exp1 <- pExp
PS.char '='
PS.spaces
exp2 <- pExp
return $ Equals exp1 exp2
最後に VEqu を IsString のインスタンスにして
式全体を文字列として記述し、直接式のデータとして扱えるようにした。
instance IsString VEqu where
fromString xs =
case PS.parse pEquals "verbal" xs of
Right equ -> equ
Left err -> error (show err)
6. まとめ・感想
- 実行形式バイナリにコンパイルすればHaskellでもそこそこ速かった。
- IsString 型クラスを使うと、いろんな型のデータを文字列リテラルから作れる。
- パーサーを書くときはスペースの処理が重複しないように注意しないとハマる。
- 式の表現は完璧なので、計算のアルゴリズムを改善してみたい。非総当りとか。
- 引き続き、掛け算と引き算くらいまでは対応してみたい。