8-QUEEN

まぁ8に限らないんですが、コンパイル時に数字が決めうちなのが悲しいです。
それと、何も考えずに実装しているので(たぶん)効率が悪いです。

import Control.Monad.State
import Data.List
type Coord = (Int, Int)
type Queens = [Coord]

-- solver
num = 16     -- borad size
putQueen :: Int -> StateT Queens [] ()
putQueen y | y == num  = return ()
           | otherwise =
    do queens <- get
       let usedxs = map fst queens
       newpos <- lift [ (newx,y) | newx <- [0..num-1] ?? usedxs ]
       guard $ notElem newpos $ concatMap slant queens
       put $ newpos:queens
       putQueen $ y+1
slant :: Coord -> [Coord]
slant (x,y) =
    (x,y) : zip upx upy ++ zip upx downy ++ zip downx upy ++ zip downx downy
    where (upx, downx) = ([x+1..num-1], [x-1,x-2..0])
          (upy, downy) = ([y+1..num-1], [y-1,y-2..0])
-- print the chess-board
toStr = foldl f (replicate num $ replicate num '*')
    where f l (x,y) = updateList (updateList 'Q' (l!!y) x) l y
updateList e l n = let (h, t:ts) = splitAt n l in h ++ e : ts
-- solve and print
solve = mapM_ putStrLn $ toStr . head $ execStateT (putQueen 0) []
main = solve

% time ./8queen
Q***************
**Q*************
****Q***********
*Q**************
************Q***
********Q*******
*************Q**
***********Q****
**************Q*
*****Q**********
***************Q
******Q*********
***Q************
**********Q*****
*******Q********
*********Q******
./8queen  1.92s user 0.03s system 99% cpu 1.952 total
%