今回は「パズル」を題材にプログラムを作ってみましょう。どのプログラミング言語でもそうですが、上達の秘訣は実際にプログラムを作って動作を確認してみることです。ところが、いざとなると「さて何を作ろうか」と困ってしまう方もいるのではないでしょうか。
このようなときにぴったりな題材が「パズルの解法」です。なんといっても、実際にパズルが解けたときの喜びはとても大きく、プログラムを作る意欲をかきたててくれます。そこで、今回は順列を生成するプログラムを使って簡単なパズルを解いてみましょう。
計算式の数字を文字や記号に置き換えて、それを元の数字に戻すパズルを「覆面算」といいます。異なる文字は異なる数字を表し、同じ文字は同じ数字を表します。使用する数字は 0 から 9 までで、最上位の桁に 0 を入れることはできません。
問題はデュードニーが 1924 年に発表したもので、覆面算の古典といわれる有名なパズルです。
S E N D
+ M O R E
-------------
M O N E Y
図 : 覆面算
それではプログラムを作りましょう。式 SEND + MORE = MONEY は足し算なので、M が 1 であることはすぐにわかります。ここでは、それ以外の数字を求めるプログラムを作りましょう。次のリストを見てください。
リスト : 覆面算
check_hukumen :: [Int] -> [String] -> [String]
check_hukumen (s:e:n:d:o:r:y:[]) a =
if send + more == money then expr:a else a
where send = s * 1000 + e * 100 + n * 10 + d
more = 1000 + o * 100 + r * 10 + e
money = 10000 + o * 1000 + n * 100 + e * 10 + y
expr = show send ++ "+" ++ show more ++ "=" ++ show money
hukumen_solver :: [String]
hukumen_solver =
foldr check_hukumen [] (permutation 7 [0,2,3,4,5,6,7,8,9])
1 を除いた 9 個の数字の中から 7 個の数字を選んで順列を生成します。あとは関数 check_hukumen で数値 send, more, money を計算して、send + more = money を満たしているかチェックします。とても簡単なプログラムですね。さっそく実行してみましょう。
ghci> hukumen_solver ["9567+1085=10652"]
答えは 9567 + 1085 = 10652 の 1 通りしかありません。興味のある方は、もっとクールな方法でプログラムを作ってみてください。
「8 クイーン」はコンピュータに解かせるパズルの中でも特に有名な問題です。8 クイーンは 8 行 8 列のチェスの升目に、8 個のクイーンを互いの利き筋が重ならないように配置する問題です。クイーンは将棋の飛車と角をあわせた駒で、縦横斜めに任意に動くことができます。解答の一例を次に示します。
列
1 2 3 4 5 6 7 8
*-----------------*
1 | Q . . . . . . . |
2 | . . . . Q . . . |
3 | . . . . . . . Q |
行 4 | . . . . . Q . . |
5 | . . Q . . . . . |
6 | . . . . . . Q . |
7 | . Q . . . . . . |
8 | . . . Q . . . . |
*-----------------*
図 : 8 クイーンの解答例
8 クイーンを解くには、すべての置き方を試してみるしか方法はありません。最初のクイーンは、盤上の好きなところへ置くことができるので、64 通りの置き方があります。次のクイーンは 63 通り、その次は 62 通りあります。したがって、置き方の総数は 64 から 57 までの整数を掛け算した 178462987637760 通りもあります。
ところが、解答例を見ればわかるように、同じ行と列に 2 つ以上のクイーンを置くことはできません。上図の解答例をリストを使って表すと、 次のようになります。
1 2 3 4 5 6 7 8 <--- 列の位置
---------------------------
[1, 7, 5, 8, 2, 4, 6, 3] <--- 要素が行の位置を表す
図 : リストでの行と列の表現方法
列をリストの位置に、行番号を要素に対応させれば、各要素には 1 から 8 までの数字が重複しないで入ることになります。すなわち、1 から 8 までの順列の総数である 8! = 40320 通りの置き方を調べるだけでよいのです。パズルを解く場合は、そのパズル固有の性質をうまく使って、調べなければならない場合の数を減らすように工夫することが大切です。
あとは、その順列が 8 クイーンの条件を満たしているかチェックすればいいわけです。このように、正解の可能性があるデータを作りそれをチェックするという方法を「生成検定法 (generate and test)」といいます。覆面算の解法プログラムも単純な生成検定法です。
可能性のあるデータをもれなく作る場合、「バックトラック (backtrack)」という方法が適しています。たとえば、簡単な例として迷路を考えてみましょう。ある地点 A で道が左右に分かれているとします。ここで、左の道を選んで先へ進むと、行き止まりになってしまいました。この場合は A 地点まで戻って右の道へ進まないといけません。つまり、失敗したら後戻りして別の道を選ぶ、という試行錯誤をゴールに行き着くまで繰り返すわけです。これが「バックトラック」です。
バックトラックは再帰定義で簡単にプログラムを作ることができます。順列を生成するプログラムもバックトラックを使っています。バックトラックはパズルの解法だけではなく、いろいろな分野の問題に応用できる方法です。ただし、「生成するデータ数が多くなると時間がとてもかかる」という弱点があるので注意してください。
それでは、プログラムを作りましょう。次のリストを見てください。
リスト : 8 クイーンの解法 safe :: [Int] -> Bool safe [] = True safe (x:xs) = if attack 1 x xs then False else safe xs queen :: [Int] -> [[Int]] queen xs = filter safe $ permutations xs
述語 safe は 8 クイーンの条件を満たしているかチェックします。関数 queen は permutations で順列を生成し、filter で safe を満たす順列だけを取り出します。関数 safe はリストの先頭の要素からチェックしていきます。衝突のチェックは斜めの利き筋を調るだけです。端にあるクイーンから順番に調べるとすると、斜めの利き筋は次のように表せます。
1 2 3 --> 調べる方向
*-------------
| . . . . . .
| . . . -3. . 5 - 3 = 2
| . . -2. . . 5 - 2 = 3
| . -1. . . . 5 - 1 = 4
| Q . . . . . Q の位置は 5
| . +1. . . . 5 + 1 = 6
| . . +2. . . 5 + 2 = 7
| . . . +3. . 5 + 2 = 8
*-------------
図 : 衝突の検出
図を見てもらえばおわかりのように、Q が行 5 にある場合、ひとつ隣の列は 4 と 6 が利き筋に当たります。2 つ隣の列の場合は 3 と 7 が利き筋に当たります。このように単純な足し算と引き算で、利き筋を計算することができます。これをプログラムすると次のようになります。
リスト : 衝突の検出 attack :: Int -> Int -> [Int] -> Bool attack _ _ [] = False attack n x (y:ys) = if x == y + n || x == y - n then True else attack (n + 1) x ys
attack はリストの先頭から斜めの利き筋に当たるか調べます。第 1 引数が位置の差分、第 2 引数がクイーンの位置、第 3 引数がリストになります。最初の節がクイーンを全て調べた場合です。クイーンは衝突していないので False を返します。次の節で、リストから先頭の要素 y を取りだし、利き筋に当たるか調べます。これは、y + n または y - n が x と等しいかチェックするだけです。衝突している場合は True を返します。そうでなければ、attack を再帰呼び出しして次のクイーンを調べます。このとき、差分 n の値を +1 することをお忘れなく。
これでプログラムは完成です。それでは実行してみましょう。
ghci> queen [1..5] [[1,3,5,2,4], [1,4,2,5,3], [2,4,1,3,5], [2,5,3,1,4], [3,1,4,2,5], [3,5,2,4,1], [4,1,3,5,2], [4,2,5,3,1], [5,2,4,1,3], [5,3,1,4,2]] ghci> queen [1..6] [[2,4,6,1,3,5], [3,6,2,5,1,4], [4,1,5,2,6,3], [5,3,1,6,4,2]] ghci> :set +s ghci> length $ queen [1..8] 92 (0.26 secs, 135,435,128 bytes) ghci> length $ queen [1..9] 352 (2.64 secs, 1,366,330,720 bytes) ghci> length $ queen [1..10] 724 (29.27 secs, 15,142,056,608 bytes) 実行環境 : Ubunts 22.04 (WSL2), Intel Core i5-6200U 2.30GHz
8 クイーンの場合、解は全部で 92 通りあります。ところで、クイーンの個数を増やすと、プログラムの実行時間は極端に遅くなります。実はこのプログラム、とても非効率なことをやっているのです。
実行速度が遅い理由は、失敗することがわかっている順列も生成してしまうからです。たとえば、最初 (1, 1) の位置にクイーンを置くと、次のクイーンは (2, 2) の位置に置くことはできませんね。したがって、[1, 2, X, X, X, X, X, X,] という配置はすべて失敗するのですが、順列を発生させてからチェックする方法では、このような無駄を省くことができません。
そこで、クイーンの配置を決めるたびに衝突のチェックを行うことにします。これをプログラムすると次のようになります。
リスト : 8 クイーン (改良版) -- 要素の選択 select :: [a] -> [(a, [a])] select [x] = [(x, [])] select (x:xs) = (x, xs) : map (\(y, ys) -> (y, x:ys)) (select xs) -- クイーンの選択 select_queen :: ([Int], [Int]) -> [([Int], [Int])] select_queen (xs, ys) = foldr (\(z, zs) a -> if attack 1 z ys then a else (zs, z:ys):a) [] $ select xs -- 8 クイーンの解法 queen_fast :: [Int] -> [[Int]] queen_fast xs = iter (length xs) [(xs, [])] where iter 0 xs = map snd xs iter n xs = iter (n - 1) $ concatMap select_queen xs
select は順列の生成で作成した関数です。関数 select_queen は、クイーンを配置したリストと残りのリストをタプルで受け取ります。第 1 要素 xs が残りのリスト、第 2 要素 ys がクイーンを配置したリストです。foldr でクイーンを配置できたタプルだけを集めます。select xs で xs から要素をひとつ選びます。ラムダ式の引数 z が選んだ要素、zs が残りの要素のリストです。attack で z を ys に追加できるかチェックし、大丈夫であれば (zs, z:ys) を累積変数 a のリストに追加します。そうでなければ a をそのまま返します。
select_queen の実行例を示します。
ghci> select_queen ([1,2,3,4], []) [([2,3,4],[1]),([1,3,4],[2]),([1,2,4],[3]),([1,2,3],[4])] ghci> select_queen ([2,3,4], [1]) [([2,4],[3,1]),([2,3],[4,1])] ghci> select_queen ([2,4], [3,1]) []
select_queen を使うと、8 クイーンの解法プログラム queen_fast は簡単です。実際の処理は局所関数 iter で行います。iter の引数 xs はタプル (残りのリスト, クイーンのリスト) を格納したリストです。concatMap で xs に select_queen を適用して、その結果を平坦化します。1 回実行すると、1 つのクイーンを配置したリストが得られ、2 回実行すると、2 つのクイーンを配置したリストが得られます。あとは、クイーンの個数だけ繰り返して、タプルの第 2 要素を map snd で取り出すだけです。
このように、できるだけ早い段階でチェックを入れることで、無駄なデータをカットすることを「枝刈り」と呼びます。バックトラックを使って問題を解く場合、この枝刈りのよしあしによって実行時間が大きく左右されます。ところが、枝刈りの方法はパズルによって違います。パズル固有の性質をよく調べて、適切な枝刈りを考えることが重要なのです。パズル自体はコンピュータに解かせるのですが、枝刈りの条件は私達が考えるのです。これも「パズルの解法」の面白いところでしょう。解を求めるだけでなく、いかに効率の良い条件を見つけて実行時間を短縮するか、ということでも楽しむことができます。
それでは実行してみましょう。
ghci> length $ queen_fast [1..8] 92 (0.03 secs, 12,486,648 bytes) ghci> length $ queen_fast [1..9] 352 (0.13 secs, 59,145,480 bytes) ghci> length $ queen_fast [1..10] 724 (0.58 secs, 291,515,192 bytes)
インタプリタ ghci での実行ですが、とても速くなりましたね。枝刈りの効果は十分に出ていると思います。
ところで、「リストモナド」を使うと、もっと簡単にプログラムを作ることができます。ご参考までに、順列の生成と 8 クイーンの解法プログラムを示します。
リスト : 順列の生成と 8 クイーンの解法
import Control.Monad
-- 順列の生成
permutation' :: Eq a => [a] -> [[a]]
permutation' xs = iter xs [] where
iter [] ys = return (reverse ys)
iter xs ys = do
x <- xs
iter (filter (/=x) xs) (x:ys)
-- 8 クイーンの解法
queen_m :: [Int] -> [[Int]]
queen_m xs = queen' xs [] where
queen' [] ys = return (reverse ys)
queen' xs ys = do
x <- xs
guard(not (attack 1 x ys))
queen' (filter (/=x) xs) (x:ys)
リストモナドは「非決定性」をシミュレートすることができます。拙作のページ「お気楽 Scheme プログラミング入門」の「非決定性」をお読みの方であれば、リストモナドは bag_of と同じ働きをしていて、x <- xs が amb で、guard が assert で、return は解をリスト (bag) に格納すると考えると、やっていることはなんとなくわかると思います。詳しい説明は「モナド (1)」をお読みください。
このほかにも、Haskell らしいクールな解き方があると思います。興味のある方は挑戦してみてください。
[6, 2, 8, 1] : 正解
-------------------------------------
1. [0, 1, 2, 3] : cows 2 : bulls 0
2. [1, 0, 4, 5] : cows 1 : bulls 0
3. [2, 3, 5, 6] : cows 2 : bulls 0
4. [3, 2, 7, 4] : cows 0 : bulls 1
5. [3, 6, 0, 8] : cows 2 : bulls 0
6. [6, 2, 8, 1] : cows 0 : bulls 4
図 : マスターマインドの動作例
パズルではありませんが、簡単な例題として「マスターマインド」を解くプログラムを作りましょう。マスターマインドは拙作のページ「お気楽 Scheme プログラミング入門」 "数当てゲーム [2]" で作成した、0 から 9 までの重複しない 4 つの数字からなる隠しコードを当てるゲームです。数字は合っているが位置が間違っている個数を cows で表し、数字も位置も合っている個数を bulls で表します。bulls が 4 になると正解です。
今回は、私達が出した問題をコンピュータに答えてもらうことにします。それはちょっと難しいのではないか、と思った人もいるかもしれませんね。ところが、とても簡単な方法があるのです。このゲームでは、10 個の数字の中から 4 個選ぶわけですから、全体では 10 * 9 * 8 * 7 = 5040 通りのコードしかありません。コードを生成する処理は順列と同じですから、簡単にプログラムできます。
次に、この中から正解を見つける方法ですが、質問したコードとその結果を覚えておいて、それと矛盾しないコードを作るようにします。具体的には、4 つの数字の順列を生成し、それが今まで質問したコードと矛盾しないことを確かめます。これは生成検定法と同じですね。
矛盾しているかチェックする方法も簡単で、以前に質問したコードと比較して、bulls と cows が等しいときは矛盾していません。たとえば、次の例を考えてみてください。
[6, 2, 8, 1] が正解の場合
[0, 1, 2, 3] =>, bulls = 0, cows = 2
[0, 1, 2, 3] と比較する
--------------------------------------------------------
[0, X, X, X] 0 から始まるコードは bulls = 1
になるので矛盾する。
・・・・
[1, 0, 3, 4] cows = 3, bulls = 0 になるので矛盾する
・・・・
[1, 0, 4, 5] cows = 2, bulls = 0 で矛盾しない。
--------------------------------------------------------
[1, 0, 4, 5] =>, bulls = 0, cows = 1
次は、[0, 1, 2, 3] と [1, 0, 4, 5] に矛盾しない数字を選ぶ
図 : マスターマインドの推測アルゴリズム
[0, 1, 2, 3] で bulls が 0 ですから、その位置にその数字は当てはまりません。したがって、[0, X, X, X] というコードは [0, 1, 2, 3] と比較すると bulls が 1 となるので、矛盾していることがわかります。
次に [1, 0, 3, 4] というコードを考えてみます。[0, 1, 2, 3] の結果は cows が 2 ですから、その中で合っている数字は 2 つしかないわけです。ところが、[1, 0, 3, 4] と [0, 1, 2, 3] と比較すると cows が 3 になります。当たっている数字が 2 つしかないのに、同じ数字を 3 つ使うのでは矛盾していることになりますね。
次に [1, 0, 4, 5] というコードと比較すると、bulls が 0 で cows が 2 となります。これは矛盾していないので、このコードを質問することにします。その結果が bulls = 0, cows = 1 となり、今度は [0, 1, 2, 3] と [1, 0, 4, 5] に矛盾しないコードを選択するのです。
それでは、プログラムを作りましょう。最初に bulls と cows を求める関数を作ります。
リスト : bulls と cows を求める
-- x と等しい要素の個数をカウントする
count :: Eq a => a -> [a] -> Int
count x xs = foldl (\a y -> if x == y then a + 1 else a) 0 xs
-- bulls を数える
count_bulls :: [Int] -> [Int] -> Int
count_bulls xs ys = count True $ zipWith (==) xs ys
-- 同じ数字を数える
count_same_number :: [Int] -> [Int] -> Int
count_same_number xs ys = length $ intersect xs ys
-- bulls と cows を求める
check_code :: [Int] -> [Int] -> (Int, Int)
check_code code1 code2 = (bulls, cows)
where bulls = count_bulls code1 code2
cows = count_same_number code1 code2 - bulls
関数 count x xs は x と等しい要素の個数を返します。関数 count_bulls は count と zipWith を使うと簡単です。zipWith は 2 つのリストを受け取るマップ関数です。簡単な実行例を示しましょう。
ghci> :t zipWith zipWith :: (a -> b -> c) -> [a] -> [b] -> [c] ghci> zipWith (==) [1,2,3,4] [1,2,3,4] [True,True,True,True] ghci> zipWith (==) [1,2,3,4] [4,3,2,1] [False,False,False,False] ghci> zipWith (+) [1,2,3,4] [4,3,2,1] [5,5,5,5] ghci> zipWith (*) [1,2,3,4] [4,3,2,1] [4,6,6,4]
zipWith で 2 つの要素の等値を判定し、count で True の個数を数えれば bulls を求めることができます。
次は、cows を数える処理を作ります。いきなり cows を数えようとすると難しいのですが、2 つのリストに共通の数字を数えることは簡単にできます。この方法では、bulls の個数を含んだ数を求めることになりますが、そこから bulls を引けば cows を求めることができます。
関数名は count_same_number としました。この処理は Data.List の関数 intersect を使うと簡単です。intersect xs ys は引数のリストを集合とみなして、xs と ys の積集合を求める関数です。これで xs と ys の共通の要素を取り出すことができます。あとは length で個数を数えるだけです。
関数 check_code は 2 つのコードを受け取り、bulls と cows を求めてタプルに格納して返します。
次は生成したコードが今までの結果と矛盾していないか調べる処理を作ります。次のリストを見てください。
リスト : 今までの質問と矛盾しているか check_query :: [Int] -> ([Int], Int, Int) -> Bool check_query code (old_code, old_bulls, old_cows) = bulls == old_bulls && cows == old_cows where (bulls, cows) = check_code code old_code select_code :: [Int] -> [([Int], Int, Int)] -> [Int] -> [([Int], Int, Int)] select_code collect query code = if all (check_query code) query then (code, bulls, cows) : query else query where (bulls, cows) = check_code collect code
質問したコードとその結果はタプル (code, bulls, cows) にまとめてリストに格納します。最初が質問したコード、次が bulls の個数、最後が cows の個数です。
関数 check_query はデータをパターンマッチングで取り出して、局所変数 old_bulls, old_cows, old_code にセットします。そして、code と old_colde から bulls と cows を check_code で求めます。bulls と old_bulls が等しくて、cows と old_cows が等しい場合、code は矛盾していないので、true を返します。そうでなれば false を返します。
関数 select_code は質問するコードを選択します。引数 collect が正解のコード、query が今まで質問したコードと結果を格納したリスト、code が生成したコードです。最初に関数 all と check_query で code が今までの質問と矛盾していないかチェックします。
all pred xs は述語 pred をリスト xs の要素に適用し、返り値がすべて真であれば all は真を返します。簡単な実行例を示します。
ghci> :t all all :: (a -> Bool) -> [a] -> Bool ghci> all even [2,4,6,8,10] True ghci> all even [2,4,6,8,1] False
select_code は code に矛盾がなければ、check_code で collect と code の bulls と cows を求め、タプルに格納して qyery に追加して返します。そうでなければ、query をそのまま返します。
マスターマインドを解くプログラムは次のようになります。
リスト : マスターマインドの解法 mastermind :: [Int] -> [([Int], Int, Int)] mastermind collect = reverse $ foldl (select_code collect) [] (permutation 4 [0 .. 9])
前回作成した関数 permutation でリスト [0 .. 9] から 4 個の数字を選ぶ順列を生成します。あとは foldl でコードを順番に取り出して、select_code collect を呼び出すだけです。質問したコードは逆順に格納されるので、最後に reverse で反転します。
これでプログラムは完成です。それでは実行例を示しましょう。
ghci> mastermind [9,8,7,6] [([0,1,2,3],0,0), ([4,5,6,7],0,2), ([5,4,8,9],0,2), ([6,7,9,8],0,4), ([8,9,7,6],2,2), ([9,8,7,6],4,0)] ghci> mastermind [9,4,3,1] [([0,1,2,3],0,2), ([1,0,4,5],0,2), ([2,3,5,4],0,2), ([3,4,0,6],1,1), ([3,5,6,1],1,1), ([6,5,0,2],0,0), ([7,4,3,1],3,0), ([8,4,3,1],3,0), ([9,4,3,1],4,0)]
肝心の質問回数ですが、5, 6 回で当たる場合が多いようです。実際に、5040 個のコードをすべて試してみたところ、平均は 5.56 回になりました。これは参考文献「数当てゲーム (MOO, マスターマインド)」の結果と同じです。質問回数の最大値は 9 回で、そのときのコードは [9, 4, 3, 1], [9, 2, 4, 1], [5, 2, 9, 3], [9, 2, 0, 4], [9, 2, 1, 4] でした。
なお、参考文献 1 には平均質問回数がこれよりも少なくなる方法が紹介されています。単純な数当てゲームと思っていましたが、その奥はけっこう深いようです。興味のある方はいろいろ試してみてください。