knight.hs

import Data.Map (Map)
import qualified Data.Map as Map
import Data.List (nub, maximumBy)
import Data.Function (on)
import Control.Concurrent

type Loc = (Int, Int)

size :: Int
size = 8 

inbounds :: Loc -> Bool
inbounds (x, y) | 1 <= x && x <= size &&
                  1 <= y && y <= size  = True
                | otherwise            = False

moves :: Loc -> [Loc]
moves (x, y) = filter inbounds 
  ([(x + i, y + j) | i <- [-2, 2], j <- [-1, 1]] ++
   [(x + i, y + j) | i <- [-1, 1], j <- [-2, 2]])

distances :: Loc -> Map Loc Int
distances z = distances' 0 [z] (Map.fromList [(z, 0)])

distances' :: Int -> [Loc] -> Map Loc Int -> Map Loc Int
distances' n open dist 
  | dist == dist' = dist
  | otherwise     = distances' (n + 1) open' dist' 
  where open' = nub [y | x <- open, y <- moves x]
        dist' = foldr (\y r -> Map.insertWith min y (n + 1) r) dist open'

--

argMax :: (Ord b) => (a -> b) -> [a] -> a
argMax f xs = maximumBy (compare `on` f) xs

boards :: [Map Loc Int]
boards = [distances (i, j) | i <- [1..size], j <- [1..size]]

best :: Map Loc Int
best = argMax (maximum . Map.elems) boards

showBoard :: [Loc] -> IO ()
showBoard xs = putStr (unlines [[marker (i, j) | j <- [1..size]] | i <- [1..size]])
  where marker (i, j) = if (i, j) `elem` xs then 'x' else '_'

pad n s = replicate (n - length s) ' ' ++ s

showBoardDist :: Map Loc Int -> IO ()
showBoardDist m = 
  putStrLn (unlines [concat $ map ((pad 3) . show)
    [Map.findWithDefault (-1) (i, j) m | j <- [1..size]] | i <- [1..size]])

main = mapM_ (\x -> showBoardDist x >> threadDelay 30000)
  [distances (i, if i `mod` 2 == 0 then size - j + 1 else j) | i <- [1..size], j <- [1..size]]