module Exercise_10 where
import Data.List
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 (r:rs) = showRow r ++ "\n" ++ prettyShowBoard rs
  where
    showRow [] = "";
    showRow ((E):fs) = "+" ++ showRow fs
    showRow ((P V):fs) = "V" ++ showRow fs
    showRow ((P H):fs) = "H" ++ showRow fs

{-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 (Game b p) (r,c)
  | p == V = r >= 0 && c >= 0 && height b > (r+1) && width b > c && ((row b r) !! c) == E && ((row b (r+1)) !! c) == E
  | p == H = r >= 0 && c >= 0 && width b > (c+1) && height b > r  && ((row b r) !! c) == E && ((row b r !! (c+1))) == E

{-H10.1.3-}
canMove :: Game -> Bool
canMove (Game b p) = or [isValidMove (Game b p) (r,c) | r <- [0..(height b)], c <- [0..(width b)]]

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard ((f:fs):rs) (0,c) new = (updateRow (f:fs) c new):rs
  where
    updateRow (f:fs) 0 new = new:fs
    updateRow (f:fs) c new = f:(updateRow fs (c-1) new)
updateBoard ((f:fs):rs) (r,c) new = (f:fs):(updateBoard rs (r-1,c) new)


{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game b p) (r,c) 
  | p == V = (Game (updateBoard (updateBoard b (r+1,c) (P V)) (r,c) (P V)) H)
  | p == H = (Game (updateBoard (updateBoard b (r,c+1) (P H)) (r,c) (P H)) 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

{-WETT-}
christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI rand game = snd (bestMove (possibleMoves game) game 2)

bestMove [] game 0 = (150,(-1,-1))
bestMove ms game 0 = argMin (\(x,_) -> x) (evalMoves ms game)
bestMove ms game 1 = argMin (\(x,_) -> x) contEval
  where contEval = [(-fst (bestMove (possibleMoves (playMove game m)) (playMove game m) 0),m) | m <- (contenders ms game 2)]
bestMove ms game n = argMin (\(x,_) -> x) contEval
  where contEval = [(-fst (bestMove (possibleMoves (playMove game m)) (playMove game m) (n-1)),m) | m <- (contenders ms game 3)]

argMin f [] = (150,(-1,-1))
argMin f [a] = a
argMin f (a:as) = if (f a) <= (f recMin) then a else recMin where recMin = argMin f as

-- Evaluation = (# valid moves opponent could make) - (# valid moves I could make) -- goal = minimize this value 
evalMoves [] _ = []
evalMoves (m:ms) game = (length (possibleMoves newGame) - length (possibleMoves $ switch newGame), m):(evalMoves ms game)
  where newGame = playMove game m

contenders ms game n = map snd (take n (sortBy (\(a,_) (b,_) -> compare a b) (evalMoves ms game)))
possibleMoves game = [(r,c) | r<-[0..11], c<-[0..11], isValidMove game (r,c)]

switch (Game b V) = Game b H
switch (Game b H) = Game b V
{-TTEW-}

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play = undefined 

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