[Haskell-cafe] The Knight's Tour: solutions please

[Don Stewart]

ajb:
> G'day all.
> 
> Quoting Don Stewart <dons at galois.com>:
> 
> >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 ""

dolio implemented a cute one based on continuations, that's also about
10x faster than the python version,

    http://hpaste.org/12546#a2 


-- Don