{- Copyright © 2005 Antti-Juhani Kaijanaho This program is free software; you can redistribute it and/or modify it under the terms of Version 2 of the GNU General Public License as published by the Free Software Foundation. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA -} module Model (Dir (..), opposite, Mark (..), otherMark, Pos, move, Board (), getGoal, emptyBoard, nscore, pscore, getMark, isMark, placeMark, activeRectangle, findWinner) where import Array import Maybe (fromJust) {- Some simple theory: Let x be a position. Let N(x) be the position north of x. NE(x) be the position northeast of x. E(x) be the position east of x. SE(x) be the position southeast of x. S(x) be the position south of x. SW(x) be the position southwest of x. W(x) be the position west of x. NW(x) be the position northwest of x. Let nx+(x) be the number of X marks north of x nex+(x) be the number of X marks northeast of x ex+(x) be the number of X marks east of x sex+(x) be the number of X marks southeast of x sx+(x) be the number of X marks south of x swx+(x) be the number of X marks southwest of x wx+(x) be the number of X marks west of x nwx+(x) be the number of X marks northwest of x in each case, including the X mark in x, if any Let no+(x) be (as above, but for O marks) ETC Let nx-(x) be the number of X marks that can be put consequtively from x northward (incliding the potential X mark on x, if any) ETC Now, the following hold: If there is an X on x: nx+(x) = nx+(N(x)) + 1 nx-(x) = nx-(N(x)) + 1 no+(x) = 0 no-(x) = 0 (similarly for all directions) (similarly for an O mark) If there is no mark on x: nx+(x) = 0 nx-(x) = nx-(N(x)) + 1 no+(x) = 0 no-(x) = no-(N(x)) + 1 THEOREM: If there is a position x such that there is an X mark on it and nx+(x) + sx+(x) >= 6 (or similarly for any of the other 180-degree pairs of directions) then X has won, and vice versa. (Similarly for O.) PROOF. Assume that nx+(x) + sx+(x) >= 6. Without loss of generality, we may assume that ns+(x) = 1, for if this is not the case, just move x southward until it is the case. Now, it holds that nx+(x) >= 5, and the following also hold: nx+(N(x)) >= 4 and there is an X at N(x) nx+(N(N(x))) >= 3 and there is an X at N(N(x)) nx+(N(N(N(x)))) >= 2 and there is an X at N(N(N(x))) nx+(N(N(N(N(x))))) >= 1 and there is an X at N(N(N(N(x)))) Hence, there is a column of at least five Xs northward of x, including x itself, and X has won. To prove the converse, assume that ie. that X has won, that is, there is a column of at least five Xs northward of x, starting with x itself (this simplifying assumption of northwardness creates no loss of generality). Now, the following hold: nx+(x) = nx+(N(x)) + 1 = nx+(N(N(x))) + 2 = nx+(N(N(N(x)))) + 3 = nx+(N(N(N(N(x))))) + 4 and since N(N(N(N(x)))) will hold an X, nx+(N(N(N(N(x))))) >= 1, hence nx+(x) >= 5. But also sx+(x) will be at least 1, hence nx+(x) + sx+(x) >= 6.. -} data Dir = N | NE | E | SE | S | SW | W | NW deriving (Bounded, Enum, Show) opposite :: Dir -> Dir opposite N = S opposite NE = SW opposite E = W opposite SE = NW opposite S = N opposite SW = NE opposite W = E opposite NW = SE data Mark = X | O deriving (Eq,Show) otherMark :: Mark -> Mark otherMark X = O otherMark O = X type Pos = (Integer,Integer) move :: Dir -> Int -> Pos -> Pos move d = f where f 0 p = p f n (x,y) = f (n-1) $ case d of N -> (x+0,y-1) NE -> (x+1,y-1) E -> (x+1,y+0) SE -> (x+1,y+1) S -> (x+0,y+1) SW -> (x-1,y+1) W -> (x-1,y+0) NW -> (x-1,y-1) extendBounds :: Pos -> (Pos,Pos) -> (Pos,Pos) extendBounds (x,y) r@((x1,y1),(x2,y2)) | xc == EQ && yc == EQ = r | xc == EQ && yc == LT = ((x1,y),(x2,y2)) | xc == EQ && yc == GT = ((x1,y1),(x2,y)) | xc == LT && yc == EQ = ((x,y1),(x2,y2)) | xc == LT && yc == LT = ((x,y),(x2,y2)) | xc == LT && yc == GT = ((x,y1),(x2,y)) | xc == GT && yc == EQ = ((x1,y1),(x,y2)) | xc == GT && yc == LT = ((x1,y),(x,y2)) | xc == GT && yc == GT = ((x1,y1),(x,y)) where xc | x < x1 = LT | x > x2 = GT | otherwise = EQ yc | y < y1 = LT | y > y2 = GT | otherwise = EQ data PosData = PosData { mark :: Maybe Mark, ps :: Mark -> Dir -> Int, ns :: Mark -> Dir -> Int } data Board = Board Pos (Array Pos PosData) Int -- last is goal | EmptyBoard Int -- Int is goal emptyBoard goal | goal >= 1 = EmptyBoard goal -- pscore board x X N is nx+(x) -- note: cannot refer to ps (b!p) because it's defined by calling this pscore :: Board -> Pos -> Mark -> Dir -> Int pscore (EmptyBoard _) _ _ _ = 0 pscore brd@(Board _ b _) p m d | isMark m brd p = if inRange (bounds b) p' then ps (b!p') m d + 1 else 1 | otherwise = 0 where p' = move d 1 p -- nscore board x X N is nx-(x); goal+1 is used for anything >= 5 -- note: cannot refer to ns (b!p) because it's defined by calling this nscore :: Board -> Pos -> Mark -> Dir -> Int nscore (EmptyBoard goal) _ _ _ = goal+1 nscore brd@(Board _ b goal) p m d | isMark (otherMark m) brd p = 0 | otherwise = if inRange (bounds b) p' then let r = ns (b!p') m d in (if r >= goal then goal else r) + 1 else goal + 1 where p' = move d 1 p getMark :: Board -> Pos -> Maybe Mark getMark (EmptyBoard _) _ = Nothing getMark (Board _ b _) p | inRange (bounds b) p = mark (b!p) | otherwise = Nothing isMark :: Mark -> Board -> Pos -> Bool isMark m b p = getMark b p == Just m placeMark :: Monad m => Mark -> Pos -> Board -> m Board placeMark m p (EmptyBoard goal) = return $ Board p (array (p,p) [(p,d)]) goal where d = PosData { mark = Just m, ps = \m' _ -> if m == m' then 1 else 0, ns = \m' _ -> if m == m' then goal+1 else 0 } placeMark m p brd@(Board _ b goal) = case getMark brd p of Just m' | m == m' -> fail "You already have a mark there" | otherwise -> fail "Your opponent already has a mark there" Nothing -> return brd' where brd' = Board p b' goal b' = array nb (map (\p -> (p, nd p)) (range nb)) nb = extendBounds p (bounds b) nd p' = PosData { mark = if p == p' then Just m else getMark brd p', ps = pscore brd' p', ns = nscore brd' p' } findWinner :: Board -> [(Mark, Pos, Dir)] findWinner (EmptyBoard _) = [] findWinner brd@(Board p _ goal) = map (\(m,d,_) -> (m, massage brd m p (opposite d), d)) $ filter (\(m,d,sc) -> sc >= goal) $ concatMap (\d -> (map (\m -> (m,d, pscore brd (move d 1 p) m d + pscore brd p m (opposite d))) [X,O])) $ enumFromTo N SE massage :: Board -> Mark -> Pos -> Dir -> Pos massage b m p d | isMark m b p' = massage b m p' d | otherwise = p where p' = move d 1 p activeRectangle :: Board -> [Pos] activeRectangle brd = range ((x1-goal,y1-goal),(x2+goal,y2+goal)) where ((x1,y1),(x2,y2)) = case brd of EmptyBoard _ -> ((0,0),(0,0)) Board _ b _ -> bounds b goal = fromIntegral $ getGoal brd getGoal :: Board -> Int getGoal (EmptyBoard goal) = goal getGoal (Board _ _ goal) = goal