Skip to content

Instantly share code, notes, and snippets.

@sphynx
Last active August 29, 2015 14:24
Show Gist options
  • Save sphynx/a54c6861cb7f713f05d7 to your computer and use it in GitHub Desktop.
Save sphynx/a54c6861cb7f713f05d7 to your computer and use it in GitHub Desktop.
Knight Tour at Haskell Hoodlums
module Main where
import Data.Array
import Data.List
import Data.Ord
import Text.Printf
type Coord = (Int, Int)
type Size = (Int, Int)
data Board = Board (Array Coord Int) Coord Int
instance Show Board where
show (Board arr _ _) = unlines $
map printRow (rows arr)
where rows arr = map (map snd) $
groupBy (\((x, _), _) ((y, _), _) -> x == y) $
assocs arr
printRow = unwords . map (printf "%3d")
newBoard :: Size -> Board
newBoard (x, y) = Board (listArray ((1,1), (x,y)) (repeat 0)) (0,0) 0
visit :: Coord -> Board -> Board
visit c (Board arr _ no) = Board (arr // [(c, no + 1)]) c (no + 1)
isVisited :: Coord -> Board -> Bool
isVisited c (Board arr _ _) = arr ! c /= 0
size :: Board -> Size
size (Board arr _ _) = snd $ bounds arr
b5 :: Board
b5 = newBoard (5, 5)
moves :: Size -> Coord -> [Coord]
moves (m, n) (x, y) =
filter isInside
[ (x-2, y-1)
, (x-2, y+1)
, (x-1, y-2)
, (x-1, y+2)
, (x+1, y-2)
, (x+1, y+2)
, (x+2, y-1)
, (x+2, y+1)
]
where
isInside (x, y) = x >= 1 && x <= m && y >= 1 && y <= n
legalMoves :: Board -> Coord -> [Coord]
legalMoves b c = filter (not . flip isVisited b) $ moves sz c
where sz = size b
start :: Board -> Board
start = visit (1,1)
next :: Board -> [Board]
next b@(Board _ lastMove _) = [visit nextMove b | nextMove <- legalMoves b lastMove]
nextHeur :: Board -> [Board]
nextHeur board = [minimumBy (comparing f) nb]
where f b@(Board _ lastMove _) = length $ legalMoves b lastMove
nb = next board
nextHeur10 :: Board -> [Board]
nextHeur10 board = (sortBy (comparing f) $ take 10 nb) ++ drop 10 nb
where f b@(Board _ lastMove _) = length $ legalMoves b lastMove
nb = next board
tour :: (Board -> [Board]) -> Coord -> Board -> Board
tour nextFunc s0 b = head $ (!!(sz-1)) $
iterate (concatMap nextFunc) [visit s0 b]
where
(m, n) = size b
sz = m * n
main :: IO ()
main = print $ tour nextHeur (1, 1) $ newBoard (20, 20)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment