パズル「カードの三角形」を内包表記で解く

１．カードの三角形

イアン・スチュアートさんが書いている「数学の秘密の本棚」に「カードの三角形」というパズルがある。パズルは「1から15までの数字を書いた紙がある。これを三角形に並べたい。ただし、それぞれのカードがその下にある２枚のカードの差になっているようにしたい」である。ヒントがないままで問題を解くことになると大変な時間がかかるので、本では一番上の3枚は数字が示されているが、ここでは、Haskellで解くので、すべての数字を隠しておく。問題を図で示すと、
f:id:bitterharvest:20141201071304p:plain

２．問題の解析

問題を解く前にこの問題がどの程度時間がかかるかを知っておくことは大切である。問題の設定から、a1からa５までの数字を与えると、残りの数字はすべて決まることがわかる。そこで、１から１５までの数字を、同じ数字を使わないようにして、a1からa5まで与え、パズルの条件を満たすものを探すことで、このパズルを解くことができる。a1からa5までに数字を与えることは、１５の数字の中から５つの数字を取り出し、それを横一列に並べることと同じである。従って、１５から５を選ぶ順列となるので、その数は15!/10!となる。即ち、360360通りである。

ある二つの解で、片方の解を左右反転させたとき、他方の解と一致する場合には、一つの解とみなすことにして、計算の回数を減らしたとしても、上記の回数が半分になるだけなので、この問題を紙と鉛筆だけで解くのは絶望的であることがわかる。

３．プログラム化する

それでは、プログラムで問題を解くことを考える。まず、a1からa5に順番に数字を与えていくことにする。その時、数字を与えたことで、上のほうにあるカードの数字も決まってくるので、それらがパズルの条件を満たすかどうかを調べ、そうであれば処理を継続し、そうでなければ処理を打ち切り次の選択に移ることとする。

最初にa1に１から１５までの数字を順番に与えるので、これは次のようになる。

a1 <- [1..15]

a1の値が決まると、a2の値が決まるが、a1の値と同じであってはいけないので、これは次のようになる。

a2 <- [1..15], a2 != a1

a1とa2によってb1が定まる。これはa1,a2と同じではいけないので次のようになる。

b1 = abs ((-) a1 a2), notElem b1 [a1,a2]

である。
これをa5まで続ければよいので、変数のスコープ（a1からa5以外の変数にはletをつける）に注意して内包表記を用いてプログラムを書くと、次のようになる。

toc :: [(Integer, Integer, Integer, Integer, Integer)]
toc = [(a1,a2,a3,a4,a5) | 
           a1 <- [1..15], 
           a2 <- [1..15],            notElem a2 [a1],  
           let b1 = abs ((-) a1 a2), notElem b1 [a1,a2],
           a3 <- [1..15],            notElem a3 [a1,a2, b1], 
           let b2 = abs ((-) a2 a3), notElem b2 [a1,a2, a3, b1], 
           let c1 = abs ((-) b1 b2), notElem c1 [a1,a2, a3, b1, b2],
           a4 <- [1..15],            notElem a4 [a1,a2, a3, b1, b2, c1], 
           let b3 = abs ((-) a3 a4), notElem b3 [a1,a2, a3, a4, b1, b2, c1], 
           let c2 = abs ((-) b2 b3), notElem c2 [a1,a2, a3, a4, b1, b2, b3, c1],
           let d1 = abs ((-) c1 c2), notElem d1 [a1,a2, a3, a4, b1, b2, b3, c1, c2],
           a5 <- [1..15],            notElem a5 [a1,a2, a3, a4, b1, b2, b3, c1, c2, d1], 
           let b4 = abs ((-) a4 a5), notElem b4 [a1,a2, a3, a4, a5, b1, b2, b3, c1, c2, d1], 
           let c3 = abs ((-) b3 b4), notElem c3 [a1,a2, a3, a4, a5, b1, b2, b3, b4, c1, c2, d1],
           let d2 = abs ((-) c2 c3), notElem d2 [a1,a2, a3, a4, a5, b1, b2, b3, b4, c1, c2, c3, d1],
           let e1 = abs ((-) d1 d2), notElem e1 [a1,a2, a3, a4, a5, b1, b2, b3, b4, c1, c2, c3, d1, d2], a1 < a5]