module Exercise_10 where
import Data.List
import Test.QuickCheck
import Data.Maybe
import Data.Function

{-H10.1-}
data Player = V | H -- vertical or horizontal player
  deriving (Eq,Show)
data Field = P Player | E -- a field is occupied by a player or empty
  deriving (Eq,Show)
type Row = [Field]
type Column = [Field]
type Board = [Row] -- we assume that boards are squares and encode a board row by row
data Game = Game Board Player -- stores the currenty board and player
  deriving (Eq,Show)

-- get a given row of a board
row :: Board -> Int -> Row
row = (!!)

-- get a given column of a board
column :: Board -> Int -> Column
column = row . transpose

-- width of a board
width :: Board -> Int
width [] = 0
width (x:xs) = length x

-- height of a board
height :: Board -> Int
height = length

{-H10.1.1-}
prettyShowBoard :: Board -> String
prettyShowBoard [] = ""
prettyShowBoard (r:rs) = prettyShowRow r ++ "\n" ++ prettyShowBoard rs
  where
    prettyShowRow [] = ""
    prettyShowRow ((P V):r) = "V" ++ prettyShowRow r
    prettyShowRow ((P H):r) = "H" ++ prettyShowRow r
    prettyShowRow (E:r)     = "+" ++ prettyShowRow r

{-H10.1.2-}
-- position on a board (row, column)
-- (0,0) corresponds to the top left corner
type Pos = (Int, Int)

isValidMove :: Game -> Pos -> Bool
isValidMove g@(Game b p) pos@(r, c)
  | r < 0 || c < 0 || r >= height b || c >= width b = False
  | p == V && r >= (height b - 1)                   = False
  | p == H && c >= (width b - 1)                    = False
  | otherwise                                       = isValidMove' g pos
    where
      isValidMove' (Game b V) (r, c) = (row b r)!!c == E &&
                                   (row b (r+1))!!c == E
      isValidMove' (Game b H) (r, c) = (row b r)!!c == E &&
                                   (row b r)!!(c+1) == E

{-H10.1.3-}
canMove :: Game -> Bool
canMove g@(Game b _) = or [isValidMove g (r, c) | r <- [0..n], c <- [0..n]]
  where
    n = length b

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard b (r, c) f = (take r b) ++ ((take c col) ++ [f] ++ (drop (c+1) col)) : (drop (r+1) b)
  where
    col = b!!r

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game b V) (r, c) = Game playV H
  where
    playV = updateBoard (updateBoard b (r, c) (P V)) (r+1, c) (P V)
playMove (Game b H) (r, c) = Game playH V
  where
    playH = updateBoard (updateBoard b (r, c) (P H)) (r, c+1) (P H)

{-H10.1.6-}
-- the first paramter of a strategy is an infite list of
-- random values between (0,1) (in case you wanna go wild with
-- probabilistic methods)
type Strategy = [Double] -> Game -> Pos
{-WETT-}
christmasAI :: Strategy
christmasAI _ g@(Game _ V)
  | (0,1) `elem` validMoves   = (0,1)
  | (0,10) `elem` validMoves  = (0,10)
  | (10,1) `elem` validMoves  = (10,1)
  | (10,10) `elem` validMoves = (10,10)
  | otherwise                 = christmasAI' g
    where
      validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]
christmasAI _ g@(Game _ H)
  | (10,0) `elem` validMoves  = (10,0)
  | (1,0) `elem` validMoves   = (1,0)
  | (10,10) `elem` validMoves = (10,10)
  | (1,10) `elem` validMoves  = (1,10)
  | otherwise                 = christmasAI' g
    where
      validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]

christmasAI' g = fst $ minimumBy (compare `on` snd) (map (\m -> (m, eval (playMove g m))) validMoves)
  where
    validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]
    eval g = sum [evalPos g (r,c) | r <- [0..11], c <- [0..11]]
      where
        validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]
        evalPos g@(Game b V) pos
          | isValidMove (Game b H) pos && isValidMove g pos = 1
          | isValidMove (Game b H) pos                      = -2
          | isValidMove g pos                               = 2
          | otherwise                                       = 0
        evalPos g@(Game b H) pos
          | isValidMove (Game b V) pos && isValidMove g pos = 1
          | isValidMove (Game b V) pos                      = -2
          | isValidMove g pos                               = 2
          | otherwise                                       = 0
{-TTEW-}
christmasAI2 :: Strategy
christmasAI2 _ g = fst $ maximumBy (compare `on` snd) (map (\m -> (m, eval2 (playMove g m))) filteredEvals)
  where
    validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]
    eval g = length [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]
    firstEvals = map (\m -> (m, eval (playMove g m))) validMoves
    minOppSquares = snd $ minimumBy (compare `on` snd) firstEvals
    filteredEvals = map fst $ filter (\m -> snd m == minOppSquares) firstEvals
    eval2 g = sum [evalPos g (r,c) | r <- [0..11], c <- [0..11]]
    evalPos g@(Game b V) pos
      | isValidMove (Game b H) pos && isValidMove g pos = 0
      | isValidMove (Game b H) pos                      = 2
      | isValidMove g pos                               = -2
      | otherwise                                       = 0
    evalPos g@(Game b H) pos
      | isValidMove (Game b V) pos && isValidMove g pos = 0
      | isValidMove (Game b V) pos                      = 2
      | isValidMove g pos                               = -2
      | otherwise                                       = 0

christmasAI3 :: Strategy
christmasAI3 _ g = fst $ minimumBy (compare `on` snd) (map (\m -> (m, eval (playMove g m))) validMoves)
  where
    validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]
    eval g = length [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]

-- christmasAI2 :: Strategy
-- christmasAI2 _ g = fst $ maximumBy (compare `on` snd) (map (\m -> (m, miniMax (playMove g m))) validMoves)
--   where
--     validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]
--     miniMax g
--       | null validMoves = maxBound :: Int
--       | otherwise       = minimum (map (eval . playMove g) validMoves)
--         where
--           eval g = length [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]
--           validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]

christmasAI4:: Strategy -- receives a game and plays a move for the next player
christmasAI4 _ g = case (find (odd . snd) validMoves) of
  Just pos -> pos
  Nothing -> fromJust $ find (even . snd) validMoves
  where
    validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]

christmasAI5 :: Strategy
christmasAI5 _ g = fst $ maximumBy (compare `on` snd) (map (\m -> (m, eval (playMove g m))) validMoves)
  where
    validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]
    eval g = sum [evalPos g (r,c) | r <- [0..11], c <- [0..11]]
      where
        validMoves = [(r, c) | r <- [0..11], c <- [0..11], isValidMove g (r, c)]
    evalPos g@(Game b V) pos
      | isValidMove (Game b H) pos && isValidMove g pos = 1
      | isValidMove (Game b H) pos                      = 2
      | isValidMove g pos                               = -2
      | otherwise                                       = 0
    evalPos g@(Game b H) pos
      | isValidMove (Game b V) pos && isValidMove g pos = 1
      | isValidMove (Game b V) pos                      = 2
      | isValidMove g pos                               = -2
      | otherwise                                       = 0

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss dim sv sh = let b = replicate dim (replicate dim E)
                         g = (playMove (Game b V) (sv (head rss) (Game b V))) in
  if canMove (Game b V) && isValidMove (Game b V) (sv (head rss) g) then
  play' (tail rss) sv sh g [] else ([], H)
    where
      play' (rs:rss) sv sh g@(Game b V) acc
        | not (canMove g)
        || not (isValidMove g (sv rs g)) = (acc ++ [b], H)
        | otherwise                      = play' rss sv sh (playMove g (sv rs g)) (acc ++ [b])
      play' (rs:rss) sv sh g@(Game b H) acc
        | not (canMove g)
        || not (isValidMove g (sh rs g)) = (acc ++ [b], V)
        | otherwise                      = play' rss sv sh (playMove g (sh rs g)) (acc ++ [b])

-- generates infinite list of values between (0,1)
genRandomZeroOne :: Gen [Double]
genRandomZeroOne = mapM (const $ choose (0::Double,1)) [1..]

-- plays a game and prints it to the console
playAndPrint :: Int -> Strategy -> Strategy -> IO ()
playAndPrint dim sh sv = do
  rss <- generate $ mapM (const $ genRandomZeroOne) [1..]
  let (bs, w) = play rss dim sh sv
  putStr $ (unlines $ map prettyShowBoard bs) ++ "\nWinner: " ++ show w ++ "\n"