module Solve.FoxHounds
where
import qualified Data.Char as Char
import Data.Set (Set)
import qualified Data.Set as Set
import Solve.Game (Game)
import qualified Solve.Game as Game
import Solve.Util
boardSize :: Int
boardSize = 8
data Coord =
Coord Int Int
deriving (Eq,Ord)
instance Show Coord where
show (Coord x y) = Char.chr (Char.ord 'a' + x) : show (y + 1)
onBoard :: Coord -> Bool
onBoard (Coord x y) =
0 <= x && x < boardSize &&
0 <= y && y < boardSize
rankAdjacent :: Int -> Int -> [Coord]
rankAdjacent x y = filter onBoard [Coord (x - 1) y, Coord (x + 1) y]
foxAdjacent :: Coord -> [Coord]
foxAdjacent (Coord x y) = rankAdjacent x (y - 1) ++ rankAdjacent x (y + 1)
houndAdjacent :: Coord -> [Coord]
houndAdjacent (Coord x y) = rankAdjacent x (y + 1)
data Pos =
Pos
{foxOnMove :: Bool,
fox :: Coord,
hounds :: Set Coord}
deriving (Eq,Ord,Show)
initial :: Pos
initial =
Pos
{foxOnMove = True,
fox = Coord (2 * (n `div` 2)) (boardSize - 1),
hounds = Set.fromList (map (\x -> Coord (2 * x + 1) 0) [0..(n-1)])}
where
n = boardSize `div` 2
occupied :: Pos -> Coord -> Bool
occupied p c = c == fox p || Set.member c (hounds p)
empty :: Pos -> Coord -> Bool
empty p = not . occupied p
foxMove :: Pos -> [Pos]
foxMove p = map mk cl
where
mk c = p {foxOnMove = False, fox = c}
cl = filter (empty p) (foxAdjacent (fox p))
houndsMove :: Pos -> [Pos]
houndsMove p = map mk (updateSet mv (hounds p))
where
mk hs = p {foxOnMove = True, hounds = hs}
mv h = filter (empty p) (houndAdjacent h)
move :: Pos -> [Pos]
move p = if foxOnMove p then foxMove p else houndsMove p
gameOver :: Pos -> Bool
gameOver = null . move
data Eval =
FoxEscape Int
| FoxCapture Int
deriving (Eq,Show)
instance Ord Eval where
compare (FoxEscape n1) (FoxEscape n2) = compare n2 n1
compare (FoxEscape _) (FoxCapture _) = GT
compare (FoxCapture _) (FoxEscape _) = LT
compare (FoxCapture n1) (FoxCapture n2) = compare n1 n2
foxWin :: Eval
foxWin = FoxEscape 0
houndsWin :: Eval
houndsWin = FoxCapture 0
delay :: Eval -> Eval
delay (FoxEscape n) = FoxEscape (n + 1)
delay (FoxCapture n) = FoxCapture (n + 1)
eval :: Pos -> Either Eval ([Eval] -> Bool -> Eval)
eval p = if gameOver p then Left result else Right lift
where
m = foxOnMove p
result = if m then houndsWin else foxWin
lift es _ = delay (if m then maximum es else minimum es)
game :: Game Pos Eval
game = Game.Game {Game.move = move, Game.eval = eval}