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-} --alternative: double-foldl?
prettyShowBoard :: Board -> String
prettyShowBoard [] = ""
prettyShowBoard (x:xs) = printRow x ++ prettyShowBoard xs
  where
    printRow [] = "\n"
    printRow (x:xs) = 
      case x of
        E   -> '+':printRow xs
        P H -> 'H':printRow xs
        P V -> 'V':printRow xs

{-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) = let l = width b in
  r >= 0 && c >= 0 && r < l && c < l &&
  (if p == V then
    (r + 1) < l && (b !! r) !! c == E && (b !! (r + 1)) !! c == E
  else
    (c + 1) < l && (b !! r) !! c == E && (b !! r) !! (c + 1) == E)

{-H10.1.3-}
canMove :: Game -> Bool
canMove (Game [] _) = False
canMove (Game b V) = canMove (Game (transpose b) H)
canMove (Game (x:xs) H) = or [x !! i == E && x !! (i+1) == E | i <- [0..(length x - 2)]] || canMove (Game xs H)

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard b (r,c) f = [[ if (r == row && c == column) then f else (b !! row) !! column | column <- [0..(width b - 1)]] | row <- [0..(width b - 1)]]

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game b p) fstPos@(r,c) = let sndPos = if p == V then (r+1,c) else (r, c+1) 
                                       newPlayer = if p == V then H else V in
  Game (updateBoard (updateBoard b fstPos (P p)) sndPos (P p)) newPlayer

{-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 _ game@(Game b p) = minimaxAlphaBeta game 1

lstValidMoves :: Game -> [Pos]
lstValidMoves game@(Game b p) = [(r,c) | r <- [0..(width b - 1)], c <- [0.. (width b - 1)], isValidMove game (r,c)]

minimax :: Game -> Int -> Pos
minimax game depth = let pos = lstValidMoves game
                         values = [minimaxAux (playMove game x) (depth - 1) False | x <- pos] in
                                          case (elemIndex (maximum values) values) of
                                            Just x  -> pos !! x
                                            Nothing -> (-1,-1)

minimaxDebug :: Game -> Int -> [Int]
minimaxDebug game depth = let pos = lstValidMoves game
                              values = [minimaxAux (playMove game x) (depth - 1) False | x <- pos] in
                                values

minimaxAux :: Game -> Int -> Bool -> Int
minimaxAux game depth maximizingPlayer
  | canMove game == False = if maximizingPlayer then -1000 else 1000
  | depth == 0 = (length (lstValidMoves game)) * (if maximizingPlayer then 1 else (-1))
  | maximizingPlayer == True = maximum [minimaxAux (playMove game x) (depth - 1) False | x <- lstValidMoves game]
  | otherwise = minimum [minimaxAux (playMove game x) (depth - 1) True | x <- lstValidMoves game]

minimaxAlphaBeta :: Game -> Int -> Pos
minimaxAlphaBeta game depth = let pos = lstValidMoves game
                                  values = [alphabeta (playMove game x) (depth - 1) (-10000) (10000) False | x <- pos] in
                                          case (elemIndex (maximum values) values) of
                                            Just x  -> pos !! x
                                            Nothing -> (-1,-1)

alphabetaDebug :: Game -> Int -> [Int]
alphabetaDebug game depth = let pos = lstValidMoves game
                                values = [alphabeta (playMove game x) (depth - 1) (-1000) (1000) False | x <- pos] in
                                  values

alphabeta :: Game -> Int -> Int -> Int -> Bool -> Int 
alphabeta game depth alpha beta maximizingPlayer
  | canMove game == False = if maximizingPlayer then -10000 else 10000
  | depth == 0 = (length (lstValidMoves game)) * (if maximizingPlayer then 1 else (-1))
  | maximizingPlayer == True = alphabetaAux game (lstValidMoves game) depth alpha beta maximizingPlayer (-10000)
  | otherwise = alphabetaAux game (lstValidMoves game) depth alpha beta maximizingPlayer (10000)

alphabetaAux :: Game -> [Pos] -> Int -> Int -> Int -> Bool -> Int -> Int
alphabetaAux _ [] _ _ _ _ acc = acc
alphabetaAux game (x:xs) depth alpha beta True acc = 
  let value = alphabeta (playMove game x) (depth - 1) alpha beta False
      newValue = max acc value 
      newAlpha = max alpha newValue in
        if alpha < beta then
          alphabetaAux game xs depth newAlpha beta True newValue
        else
          newValue
alphabetaAux game (x:xs) depth alpha beta False acc = 
  let value = alphabeta (playMove game x) (depth - 1) alpha beta True
      newValue = min acc value 
      newBeta = min beta newValue in
        if alpha < beta then
          alphabetaAux game xs depth alpha newBeta False newValue
        else
          newValue                  

{-TTEW-}

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss dim sv sh = 
  let startingBoard = [[E | _ <- [0..(dim-1)]] | _ <- [0..(dim-1)]] in
    playAcc rss sv sh (Game startingBoard V) []
      where
        playAcc (r:rss) sv sh currGame@(Game cb cp) acc = 
          let nextPos = (if cp == V then (sv r currGame) else (sh r currGame))
              nextGame@(Game nb np) = playMove currGame nextPos in 
            if isValidMove currGame nextPos then 
              (if canMove nextGame then
                playAcc rss sv sh nextGame (acc++[nb])
              else
                (acc++[nb], cp))
            else
              (acc, np)

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