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

{-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 (b:bs) = f b ++ "\n" ++ prettyShowBoard bs
    where f (x:xs) = case x of (E) -> if xs == [] then "+" else "+" ++ f xs
                               (P H) -> if xs == [] then "H" else "H" ++ f xs
                               (P V) -> if xs == [] then "V" else "V" ++ f xs

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

checkPosInBoard :: Board -> Pos -> Pos -> Bool
checkPosInBoard board (r1, c1) (r2, _) = if r1==r2 then f (row board r1) c1 0 else f (column board c1) r1 0
    where f [] _ _ = False
          f [_] _ _ = False
          f (x1:x2:xs) pos acc | pos /= acc = if xs == [] then False else f (x2:xs) pos (acc+1)
                               | pos == acc = if x1 == E && x2 == E then True else False

isValidMove :: Game -> Pos -> Bool
isValidMove (Game board player) (r, c) = case player of (V) -> if (r+1) >= width board || r < 0 || c >= height board || c < 0 then False else checkPosInBoard board (r, c) (r+1, c)
                                                        (H) -> if r >= width board || r < 0 || (c+1) >= height board || c < 0 then False else checkPosInBoard board (r, c) (r, c+1)


{-H10.1.3-}
canMove :: Game -> Bool
canMove (Game board player) = any (isValidMove (Game board player)) [(x,y)|x<- [0..width board], y<- [0..height board]]

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard board (r, c) field = f board (r, c) field 0
    where f board (r, c) field acc | acc == width board = []
                                   | acc /= r = [row board acc] ++ f board (r, c) field (acc+1)
                                   | acc == r = [take c (row board acc) ++ [field] ++ drop (c + 1) (row board acc)] ++ f board (r, c) field (acc+1)

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game board player) (r, c) = 
    let newboard = updateBoard board (r, c) (P player) in
      case player of (V) -> (Game (updateBoard newboard (r+1, c) (P player)) H)
                     (H) -> (Game (updateBoard newboard (r, c+1) (P player)) V)


{-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

simulate_opponent :: Game -> Int
simulate_opponent (Game board player) = length (filter (isValidMove (Game board player)) [(x,y)|x<- [0..width board], y<- [0..height board]])

minmax_simple :: Game -> [(Int, Int)] -> [((Int, Int), Int)]
minmax_simple _ [] = []
minmax_simple (Game board player) ((r, c):xs) = [((r, c), simulate_opponent $ playMove (Game board player) (r, c))] ++ minmax_simple (Game board player) xs
{-WETT-}
christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI _  (Game board player) =
    let possible_moves = filter (isValidMove (Game board player)) [(x,y)|x<- [0..width board], y<- [0..height board]] in
      fst $ head $ sortBy (compare `on` snd) (minmax_simple (Game board player) possible_moves)
{-TTEW-} 

{-H10.1.7-}
start_play :: [[Double]] -> Strategy -> Strategy -> Game -> Pos -> [Board]
start_play (r:rss) sv sh (Game board player) (x, y) = 
    let (Game new_board new_player) = playMove (Game board player) (x, y) in
      case new_player of (V) -> if canMove (Game new_board V) && isValidMove (Game new_board V) (sv r (Game new_board V)) then [new_board] ++ start_play rss sv sh (Game new_board V) (sv r (Game new_board V)) else [new_board]
                         (H) -> if canMove (Game new_board H) && isValidMove (Game new_board H) (sh r (Game new_board H)) then [new_board] ++ start_play rss sv sh (Game new_board H) (sh r (Game new_board H)) else [new_board]

get_winner :: [[Double]] -> Strategy -> Strategy -> Game -> Pos -> Player
get_winner (r:rss) sv sh (Game board player) (x, y) = 
    let (Game new_board new_player) = playMove (Game board player) (x, y) in
      case new_player of (V) -> if canMove (Game new_board V) && isValidMove (Game new_board V) (sv r (Game new_board V)) then get_winner rss sv sh (Game new_board V) (sv r (Game new_board V)) else H
                         (H) -> if canMove (Game new_board H) && isValidMove (Game new_board H) (sh r (Game new_board H)) then get_winner rss sv sh (Game new_board H) (sh r (Game new_board H)) else V

play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play (r:rss) dim sv sh =
  let init_game = (Game [[ E | j <- [1..dim] ] | i <- [1..dim]] V) in 
    if isValidMove init_game (sv r init_game) then (start_play rss sv sh init_game (sv r init_game), get_winner rss sv sh init_game (sv r init_game)) else ([], H)

-- 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"