所用で行き当たりばったりなJavaScript書いてたら飽きたので前から手を付けようと思って手を付けてなかったHaskellにでも手つけてみっかという感じ。すごいH本は暇つぶしに何回も読んでるので「りろんはしってる」状態。
Nクイーン
のチェス盤に
個のクイーンを互いに移動先が塞がれないように配置するパズル。クイーンは上下左右と斜め方向どこまでも動ける（飛車と角を足した動き）。例えば
ならこんな配置。
Q . . . .
. . . Q .
. Q . . .
. . . . Q
. . Q . .
とりあえず例とかは検索せず知ってる知識だけで書いていこー。
実践
type Pos = (Int,Int)
isPlace :: Pos -> Pos -> Bool
isPlace x y | fst x == fst y = False
| snd x == snd y = False
| abs(fst x - fst y) == abs(snd x - snd y) = False
| otherwise = True
コマの位置はタプルで行と列を表し、それと置けるかどうか判定する関数。
placeble :: [Pos] -> [Pos]
placeble hist = [(x,length hist) | x <- [0..], all (isPlace (x,length hist)) hist]
前の行までの置いてあるコマの位置のリストを取って次の行に置ける位置を返す。Haskellらしく？無限リスト使ってみたりした。
search :: Int -> Int -> [[Pos]] -> [[Pos]]
search 1 m p = p
search n m p = search (n-1) m (concat (map (\q->(map (\r->q++[r]) (takeWhile (\s->fst s<m) (placeble q)))) p))
探す深さ（行）と深さの最大値、それから解候補を入れて解候補の次の位置に置ける位置を連結する関数。ポイントは次の位置における位置がない場合空リストが返ってくるのでバックトラッキングができてること……だと思う。リスト内包使えばもっときれいに書けたんでないか、と言うかナイトツアーの方ではそうしてる。
solve :: Int -> [[Pos]]
solve n = search n n [[(x,0)]|x<-[0..n-1]]
あとは1行目に置く位置のリスト作ってsearchに突っ込む関数作っておしまい。
Prelude> :l eightqueen.hs
[1 of 1] Compiling Main ( eightqueen.hs, interpreted )
Ok, modules loaded: Main.
*Main> length $ solve 8
92
の時の回転合同とかも含めた時における解の数と一致、うまくいきました。あとで調べたら解候補は順列作ってやれば楽って出てきてあーってなったけどきちんとバックトラッキングしてるおかげかこっちのほうが速い気がするのでそれはそれでいいんじゃないかという事にしておいた。
ナイトツアー
別名「騎士の巡歴」。
のチェス盤でナイトが一筆書できる手順を探すパズル。ナイト（N）はXの位置に動ける。
. X . X .
X . . . X
. . N . .
X . . . X
. X . X .
の解の例は以下の通り。
1 8 3
4 11 6
7 2 9
10 5 12
同じく実装例自体は検索せず行ってみる。
import Data.List
type Pos = (Int,Int)
nextmove :: Pos -> [Pos]
nextmove p = [(fst p + x,snd p + y)| x<-[-2,-1,1,2], y<-[-2,-1,1,2], abs x /= abs y]
movable :: Int -> Int -> [Pos] -> [[Pos]]
movable x y hist = [hist++[q]| q<- (nextmove $ last hist), notElem q hist, crop q]
where crop r = foldl (&&) True [fst r>=0, snd r>=0, fst r<x, snd r<y]
あとで使うのでData.Listをimport。位置はまたタプルで行列の順。nextmoveは次動ける場所を返す。movableは盤面の縦横と今まで動いてきた位置を取って次動ける場所を連結して返す。はみ出しの処理とかはここ。
isEnd :: Int -> Int-> [Pos] -> Bool
isEnd x y p = x*y == (length $ nub p)
search :: Int -> Int -> [[Pos]] -> [[Pos]]
search x y p = if null cand then [r | r<-p, isEnd x y r]
else search x y cand
where cand = concat[movable x y q | q<-p]
isEndで解候補が終了してるか判定。通ってきた位置の数が盤面の数と一致すればゴールにしてある。一応同じ位置はnubで排除してるけど無くていい。searchで次置ける場所を再帰的に探索。ここでも次動ける場所がなければ連結されないのでバックトラッキングになってる、はず。
solve :: Int -> Int -> [[Pos]]
solve x y = concat[search x y [[(a,b)]| a<-[0..x-1], b<-[0..y-1]]]
Prelude> :l knighttour.hs
[1 of 1] Compiling Main ( knighttour.hs, interpreted )
Ok, modules loaded: Main.
*Main> length $ solve 3 4
16
一応全スタート地点から探索する関数も書いたけど、そもそも探索範囲が大きすぎてえらい遅い。でも一応正しい結果は出ているということで。
雑感
手続き型だと結構長くなっちゃうけどHaskellだとかなり簡潔に書けたなーという印象。Haskellの力と言うよりリスト内包とかの威力の気もするので他の言語（Python）でも割りと完結に書けそうな気はしますが。
あまりHaskell的？なファンクタ？とかモナド？とかに触れてなかったのでそういうのも触れていきたいですね。
その前に冬コミの原稿しなきゃ……。
