Where is a good place to place code like this, so if I may be so bold,
people can learn from it?
{- Author Modifications: Casey Hawthorne
Author Original: Jeff Newbern
Maintainer: Casey Hawthorne
Maintainer?: Jeff Newbern
Time-stamp: Jeff
Time-stamp: Casey
License: GPL
The N-queens puzzle is to place N queens on an N by N chess board
so that no queen can attack another one.
Compiler Flags: ghc -O2 -fvia-c --make N-Queens.hs
Description
http://www.haskell.org/all_about_monads/html/stacking.html#example
Original Code
http://www.haskell.org/all_about_monads/examples/example25.hs
-}
{- Description
Example 25 - Using the StateT monad transformer
with the List monad to achieve non-deterministic
stateful computations, and the Writer monad to
do logging
Usage: Compile the code and run it with an argument between 1 and 8.
It will print a solution to the N-queens puzzle along with
a log of the number of choices it had at each step.
The N-queens puzzle is to place N queens on a chess board
so that no queen can attack another one. The original version
always used an 8x8 board.
Try: ./ex25 8
./ex25 1
./ex25 7
Added by Casey:
- different board sizes
-- up to a maximum 26x26 square board
- updated imports list
-}
import IO
import System
import Monad
import Data.Maybe
import Data.List
import Data.Char (toLower)
import Control.Monad.State
import Control.Monad.Writer
-- describe Chess Units and positions
type Rank = Int
data File = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O
| P | Q | R | S | T | U | V | X | Y | Z
deriving (Eq, Show, Ord, Enum)
data Position = Pos {file::File, rank::Rank}
deriving Eq
instance Show Position where
show (Pos f r) = (map toLower (show f)) ++ (show r)
instance Ord Position where
compare p1 p2 =
case (rank p1) `compare` (rank p2) of
LT -> GT
GT -> LT
_ -> (file p1) `compare` (file p2)
data Kind = Pawn | Knight | Bishop | Rook | Queen | King
deriving (Eq, Ord, Enum)
instance Show Kind where
show Pawn = "P"
show Knight = "N"
show Bishop = "B"
show Rook = "R"
show Queen = "Q"
show King = "K"
data Color = Black | White
deriving (Eq, Ord, Enum)
instance Show Color where
show Black = "b"
show White = "w"
data Unit = Unit {color::Color, kind::Kind}
deriving (Eq, Ord)
instance Show Unit where
show (Unit c k) = ((show c) ++ (show k))
data Board = Board {size::Int, psns::[(Unit,Position)]}
-- newtype Board = Board [(Unit,Position)]
-- newtype BoardMax = BoardMax Int
instance Show Board where
show (Board n ps) =
let ordered = (sort . swap) ps
ranks = map (showRank ordered) [n,(n-1)..1]
board = intersperse
(concat (take n (repeat "--+"))) ranks
rlabels = intersperse " " (map (\n->(twoSpaces n)++"
") [n,(n-1)..1])
flabels = take (n*3) " a b c d e f g h i j
k l m n o p q r s t u v w x y z"
twoSpaces n
| length (show n) == 2 = show n
| otherwise = " " ++ (show n)
in unlines $ zipWith (++) rlabels board ++ [flabels]
where
swap = map (\(a,b)->(b,a))
showRank ps r = let rnk = filter (\(p,_)->(rank p)==r)
ps
cs = map (showUnit rnk) (take n
[A .. Z])
in concat (intersperse "|" cs)
showUnit ps f = maybe " " (show . snd) (find
(\(p,_)->(file p)==f) ps)
data Diagonal = Ascending Position | Descending Position
deriving (Eq, Show)
-- define the diagonal according to its interesction with rank 1 or
size of board)
-- or with file a
normalize :: Int -> Diagonal -> Diagonal
normalize n d@(Ascending psn)
| (rank psn) == 1 = d
| (file psn) == A = d
| otherwise = normalize n (Ascending (Pos (pred
(file psn)) ((rank psn)-1)))
normalize n d@(Descending psn)
| (rank psn) == n = d
| (file psn) == A = d
| otherwise = normalize n (Descending (Pos (pred
(file psn)) ((rank psn)+1)))
-- get the diagonals corresponding to a location on the board
getDiags :: Int -> Position -> (Diagonal,Diagonal)
getDiags n p = (normalize n (Ascending p), normalize n (Descending p))
-- this is the type of our problem description
data NQueensProblem = NQP {board::Board,
ranks::[Rank],
files::[File],
asc::[Diagonal],
desc::[Diagonal]}
-- initial state = empty board, all ranks, files, and diagonals free
initialState n = let fileA = map (\r->Pos A r) [1..n]
rankMax = map (\f->Pos f n) (take n [A .. Z])
rank1 = map (\f->Pos f 1) (take n [A .. Z])
asc = map Ascending (nub (fileA ++ rank1))
desc = map Descending (nub (fileA ++
rankMax))
in NQP (Board n []) [1..n] (take n [A .. Z]) asc
desc
-- this is our combined monad type for this problem
type NDS a = WriterT [String] (StateT NQueensProblem []) a
-- Get the first solution to the problem, by evaluating the solver
computation with
-- an initial problem state and then returning the first solution in
the result list,
-- or Nothing if there was no solution.
getSolution :: NDS a -> NQueensProblem -> Maybe (a,[String])
getSolution c i = listToMaybe (evalStateT (runWriterT c) i)
-- add a Queen to the board in a specific position
addQueen :: Position -> NDS ()
addQueen p = do (Board n b) <- gets board
rs <- gets ranks
fs <- gets files
as <- gets asc
ds <- gets desc
let b' = (Unit Black Queen, p):b
rs' = delete (rank p) rs
fs' = delete (file p) fs
(a,d) = getDiags n p
as' = delete a as
ds' = delete d ds
tell ["Added Queen at " ++ (show p)]
put (NQP (Board n b') rs' fs' as' ds')
-- test if a position is in the set of allowed diagonals
inDiags :: Int -> Position -> NDS Bool
inDiags n p = do
let (a,d) = getDiags n p
as <- gets asc
ds <- gets desc
return $ (elem a as) && (elem d ds)
-- add a Queen to the board in all allowed positions
addQueens :: NDS ()
addQueens = do rs <- gets ranks
fs <- gets files
(Board n b) <- gets board
allowed <- filterM (inDiags n) [Pos f r | f <- fs, r <-
rs]
tell [show (length allowed) ++ " possible choices"]
msum (map addQueen allowed)
-- Start with an empty chess board and add the requested number of
queens,
-- then get the board and print the solution along with the log
main :: IO ()
main = do
args <- getArgs
let n = read (args!!0)
cmds = replicate n addQueens
sol = (`getSolution` (initialState n)) $
do sequence_ cmds
gets board
case sol of
Just (b,l) -> do putStr $ show b -- show the solution
putStr $ unlines l -- show the log
Nothing -> putStrLn "No solution"
-- END OF FILE
--
Regards,
Casey
