The Knight's Tour: solutions please

It seems the following pure functional (except for the final printout) version of the search has almost the same performance as the Dan Doel's latest version with the unboxed arrays and callCC. For the board of size 40, Dan Doel's version takes 0.047s on my computer; the version below takes 0.048s. For smaller boards, the difference is imperceptible. Interestingly, the file sizes of the compiled executables (ghc -O2, ghc 6.8.2) are similar too: 606093 bytes for Dan Doel's version, and 605938 bytes for the version below. The version below is essentially Dan Doel's earlier version. Since the problem involves only pure search (rather than committed choice), I took the liberty of substituting FBackTrack (efficient MonadPlus) for LogicT. FBackTrack can too be made the instance of LogicT; there has not been any demand for that though. import Data.List import Data.Ord import qualified Data.IntMap as Map import System.Environment import FBackTrack import Control.Monad -- Emulate the 2-dimensional map as a nested 1-dimensional map initmap n = Map.fromList $ (1,Map.singleton 1 1):[ (k,Map.empty) | k <- [2..n] ] notMember (i,j) m = Map.notMember j $ Map.findWithDefault undefined i m insrt (i,j) v m = Map.update (Just . Map.insert j v) i m lkup (i,j) m = Map.findWithDefault undefined j $ Map.findWithDefault undefined i m successors n b = sortWith (length . succs) . succs where sortWith f = map fst . sortBy (comparing snd) . map (\x -> (x, f x)) succs (i,j) = [ (i', j') | (dx,dy) <- [(1,2),(2,1)] , i' <- [i+dx,i-dx] , j' <- [j+dy, j-dy] , i' >= 1, j' >= 1, i' <= n, j' <= n , notMember (i',j') b ] tour n k s b | k > n*n = return b | otherwise = do next <- foldl1 mplus.map return $ successors n b s tour n (k+1) next $ insrt next k b showBoard n b = unlines . map (\i -> unwords . map (\j -> pad $ lkup (i,j) b) $ [1..n]) $ [1..n] where k = length . show $ n*n + 1 pad i = let s = show i in replicate (k-length s) ' ' ++ s main = do (n:_) <- map read `fmap` getArgs let (b:_) = runM Nothing . tour n 2 (1,1) $ initmap n putStrLn $ showBoard n b
participants (1)
-
oleg@okmij.org