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 ""

Here's a clean-up of my code (it even fits within the line-length limit of my mail client :)). Note that it's pretty much exactly the Python algorithm. When the Python program finds a solution, it prints the board and exits. Since that's evil IO type stuff, we noble functional folk instead set up an exit continuation using callCC, and call it when we find a solution. :) I haven't bothered testing it against the Python version, but the backtracking solution I wrote with the Logic monad (and Data.Map) took around 50% more time than this. -- Dan ---- snip ---- module Main where import Control.Monad.Cont import Control.Monad.ST import Data.Array.ST import Data.List import Data.Ord import Data.Ix import System.Environment type Square = (Int, Int) type Board s = STUArray s (Int,Int) Int type ChessM r s = ContT r (ST s) type ChessK r s = String -> ChessM r s () successors :: Int -> Board s -> Square -> ChessM r s [Square] successors n b = sortWith (fmap length . succs) <=< succs where sortWith f l = map fst `fmap` sortBy (comparing snd) `fmap` mapM (\x -> (,) x `fmap` f x) l succs (i,j) = filterM (empty b) [ (i', j') | (dx,dy) <- [(1,2),(2,1)] , i' <- [i+dx,i-dx] , j' <- [j+dy, j-dy] , inRange ((1,1),(n,n)) (i',j') ] empty :: Board s -> Square -> ChessM r s Bool empty b s = fmap (<1) . lift $ readArray b s mark :: Square -> Int -> Board s -> ChessM r s () mark s k b = lift $ writeArray b s k tour :: Int -> Int -> ChessK r s -> Square -> Board s -> ChessM r s () tour n k exit s b | k > n*n = showBoard n b >>= exit | otherwise = successors n b s >>= mapM_ (\x -> do mark x k b tour n (k+1) exit x b -- failed, rollback mark x 0 b) showBoard :: Int -> Board s -> ChessM r s String showBoard n b = fmap unlines . forM [1..n] $ \i -> fmap unwords . forM [1..n] $ \j -> pad `fmap` lift (readArray b (i,j)) where k = floor . log . fromIntegral $ n*n pad i = let s = show i in replicate (k-length s) ' ' ++ s main = do (n:_) <- map read `fmap` getArgs s <- stToIO . flip runContT return $ (do b <- lift $ newArray ((1,1),(n,n)) 0 mark (1,1) 1 b callCC $ \k -> tour n 2 k (1,1) b >> fail "No solution!") putStrLn s

Don Stewart wrote:

Lee Pike forwarded the following:

"Solving the Knight's Tour Puzzle In 60 Lines of Python"

http://developers.slashdot.org/article.pl?sid=08/11/30/1722203

Seems that perhaps (someone expert in) Haskell could do even better? Maybe even parallelize the problem? :)

As one of the posters there points out, for n=100 the program doesn't actually backtrack if the 'loneliest neighbour' heuristic is used. Do any of our programs finish quickly for n=99? The Python one doesn't. Bertram