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

30 Nov 2008


      ajb:
...
G'day all.
Quoting Don Stewart :
...
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