G'day all.
Quoting Don Stewart <[EMAIL PROTECTED]>:
So, team, anyone want to implement a Knight's Tour solver in a list
monad/list comprehension one liner? These little puzzles are made for
fast languages with backtracking monads....
I conjecture that any one-liner won't be efficient.
Anyway, here's my ~30 min attempt. The showBoard and main are both very
quick and dirty, and I'm sure someone can do much better.
I particularly like the fact that changing "Maybe" to "[]" will make
knightsTour return all tours starting at the upper left-hand corner,
rather than just one. Warm fuzzy things rule.
Cheers,
Andrew Bromage
module Main where
import qualified Data.Set as S
import Data.List
import Data.Function
import Control.Arrow
import Control.Monad
import System
knightsTour :: Int -> Maybe [(Int,Int)]
knightsTour size
= tour [(0,0)] (S.fromAscList [ (x,y) | x <- [0..size-1], y <-
[0..size-1],
x /= 0 || y /= 0 ])
where
jumps = [(2,1),(1,2),(2,-1),(-1,2),(-2,1),(1,-2),(-2,-1),(-1,-2)]
tour moves@(pos:_) blank
| S.null blank = return (reverse moves)
| otherwise = msum [ tour (npos:moves) (npos `S.delete` blank) |
npos <- nextPositions pos ]
where
nextPositions = map snd . sortBy (compare `on` fst) .
map (length . neighbours &&& id) .
neighbours
neighbours (x,y) = [ npos | (x',y') <- jumps,
let { npos = (x+x',y+y') }, npos `S.member` blank ]
showBoard :: Int -> [(Int,Int)] -> ShowS
showBoard size
= inter bdr .
map (inter ('|':) . map (shows . fst)) .
groupBy ((==) `on` fst.snd) .
sortBy (compare `on` snd) .
zip [1..]
where
bdr = ('\n':) . inter ('+':) (replicate size (replicate width '-' ++))
. ('\n':)
width = length . show $ size*size
pad s = \r -> replicate (width - length (s "")) ' ' ++ s r
inter sep xs = sep . foldr (.) id [ pad x . sep | x <- xs ]
main :: IO ()
main = do
a <- getArgs
size <- case a of
[] -> return 8
(s:_) -> return (read s)
putStrLn $ case knightsTour size of
Nothing -> "No solution found."
Just b -> showBoard size b ""
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe
