praxis

Various programming exercises.
git clone git://git.jtobin.io/praxis.git
Log | Files | Refs

knight.hs (2523B)

      1 {-# OPTIONS_GHC -Wall #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 
      4 module Main where
      5 
      6 import Prelude hiding (Monad, return, (>>=))
      7 import qualified Data.HashSet as HashSet
      8 import Data.HashSet  (HashSet, fromList, empty, singleton)
      9 import Data.Hashable (Hashable)
     10 
     11 -- | Standard monad class with Hashable/Eq constraints on parameters.
     12 class HashableMonad m where
     13     return :: Hashable a                     => a -> m a
     14     (>>=)  :: (Hashable a, Hashable b, Eq b) => m a -> (a -> m b) -> m b
     15 
     16 instance HashableMonad HashSet where
     17     return  = singleton
     18     m >>= f = HashSet.foldr (HashSet.union . f) empty m
     19 
     20 -- | Possible destinations of a move originaing from (c, r).
     21 possibleMoves :: (Num a, Ord a, Hashable a) => (a, a) -> HashSet (a, a)
     22 possibleMoves (c, r) = 
     23     if   (c < 0 || c > 7) || (r < 0 || r > 7)
     24     then error "possibleMoves: invalid origin"
     25     else let inBounds (x, y) = (x >= 0 && y >= 0) && (x <= 7 && y <= 7)
     26          in  fromList $ filter inBounds [ (c - 1, r - 2), (c - 1, r + 2) 
     27                                         , (c - 2, r - 1), (c - 2, r + 1)
     28                                         , (c + 1, r - 2), (c + 1, r + 2)
     29                                         , (c + 2, r - 1), (c + 2, r + 1) ]
     30 {-# INLINE possibleMoves #-}
     31  
     32 -- | The reachability of the destination from the origin in n steps.
     33 canReachInN :: (Num a, Ord a, Hashable a) => (a, a) -> (a, a) -> a -> Bool
     34 canReachInN (c0, r0) (c1, r1) = go (possibleMoves (c0, r0))
     35     where go !h !n | n <= 0    = False
     36                    | otherwise =  HashSet.member (c1, r1) h 
     37                                || go (h >>= possibleMoves) (n - 1)
     38 {-# INLINE canReachInN #-}
     39 
     40 -- | The number of moves required to reach the destination from the origin.
     41 movesToReach :: (Num a, Ord a, Hashable a) => (a, a) -> (a, a) -> Integer
     42 movesToReach a@(c0, r0) b@(c1, r1) 
     43     | (c1 < 0 || c1 > 7) || (r1 < 0 || r1 > 7) = 
     44       error "countMovesToReach: invalid destination"
     45     | a == b    = 0
     46     | otherwise = go (possibleMoves (c0, r0)) 1
     47   where go !h !n | HashSet.member b h = n
     48                  | otherwise          = go (h >>= possibleMoves) (n + 1)
     49 {-# INLINE movesToReach #-}
     50 
     51 -- | Print the number of moves required to move from (0, 0) to (7, 7).
     52 printNumMovesToOppositeCorner :: IO ()
     53 printNumMovesToOppositeCorner = print $ movesToReach (0 :: Int, 0 :: Int) 
     54                                                      (7 :: Int, 7 :: Int)
     55 
     56 main :: IO ()
     57 main = do putStrLn "Number of moves from (0, 0) to (7, 7)"
     58           printNumMovesToOppositeCorner
     59