i’ve been learning haskell, and it’s been going pretty well. i went to implement a version of the ‘knights tour’ problem, wherein a path traced by a ‘chess knight’, on a NxN checkerboard, is determined. in an effort to copy the fastest imperative implementations i tried to perform ‘in-place’ operations on a fixed board. the resulting code \works\ and looks very much like my imperative implementations, but is surprisingly slow. any help would be much appreciated, as i think i’m becoming comfortable working within monadic contexts, and now i’d like to learn how to write performant haskell.
for my mutable board i used
STArray, and i wrapped it in
State so i could do the graph traversal.
thank you in advance.
import Control.Monad.State (execStateT, StateT, get, put, lift) import Control.Monad.Loops (whileM) import Control.Monad (unless) import Control.Monad.ST (runST, ST) import Data.STRef (newSTRef, STRef, modifySTRef, readSTRef) import Data.Array.ST (newArray, readArray, writeArray, STArray, getBounds) -- unless, but with a monadic context unlessM :: Monad m => m Bool -> m () -> m () unlessM mbool statement = mbool >>= (\bool -> unless bool statement) -- search over these relative points rd :: [Int] rd = [2,1,-1,-2,-2,-1,1,2] cd :: [Int] cd = [1,2,2,1,-1,-2,-2,-1] -- `False` if any element of the board is `-1` isSolved :: STArray s (Int, Int) Int -> ST s Bool isSolved arr = do ((r0,c0),(r1,c1)) <- getBounds arr fmap (\x -> (not.(any (\y -> y == -1))) x) $ mapM (\i -> readArray arr i) [(idx, jdx) | idx <- [r0..r1], jdx <- [c0..c1]] -- given the board and a location, find the locations to where the knight can travel getNextPoints :: STArray s (Int, Int) Int -> (Int, Int) -> ST s [(Int, Int)] getNextPoints board (idx, jdx) = do ((r0,c0),(r1,c1)) <- getBounds board let size = 1 + r1 - r0 reachable = filter (\(i,j) -> (0<=i) && (i<size) && (0<=j) && (j<size)) [(idx+r, jdx+c) | (r, c) <- zip rd cd] values <- mapM (\i -> readArray board i) reachable return [p | (p, v) <- zip reachable values, v == -1] -- find a tour if the knight starts at `(idx,jdx)` traversing the board held in state -- `step` is the enumerated knight that is being placed knightFrom :: (Int, Int) -> Int -> StateT (STArray s (Int, Int) Int) (ST s) () knightFrom (idx, jdx) step = do -- get the board from the state boards <- get -- get the size of the board ((r0,c0),(r1,c1)) <- lift $ getBounds boards let size = 1 + r1 - r0 -- update the board to place knight `idx` at location `(idx, jdx)` lift $ writeArray boards (idx, jdx) step -- if the board is solved, return solved <- lift $ isSolved boards if solved then do return () else do -- get the available points next_points <- lift $ getNextPoints boards (idx, jdx) -- act on the available points until (?) the board is solved mapM (\p -> unlessM (lift $ isSolved boards) (knightFrom p (step+1))) next_points -- backtrack if the board is not solved solved <- lift $ isSolved boards if solved then do return () else do lift $ writeArray boards (idx, jdx) (-1) return () readInto2DList :: ST s (STArray s (Int, Int) a) -> ST s [[a]] readInto2DList st_arr = do arr <- st_arr ((x0, y0), (x1, y1)) <- getBounds arr mapM (\j -> mapM (\i -> readArray arr (i, j)) [x0..x1]) [y0..y1] findTour :: Int -> [[Int]] findTour size = runST $ do brd <- newArray ((0, 0), (size-1, size-1)) (-1) :: ST s (STArray s (Int, Int) Int) readInto2DList $ execStateT (knightFrom (0,0) 0) brd