module Exercise_10 where
import Data.List
import Data.Ord
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 board = concat [prettyShowRow row | row <- board]
  where
    prettyShowRow row = concat [prettyShowField field | field <- row] ++ "\n"
    prettyShowField (P p) = show p
    prettyShowField E = "+"

{-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 rows player) (r,c)
  | player == H && r >= 0 && c >= 0 && r < length rows && c < length (rows !! 0) - 1 = notOccupied r c && notOccupied r (c + 1)
  | player == V && r >= 0 && c >= 0 && r < length rows - 1 && c < length (rows !! 0) = notOccupied r c && notOccupied (r + 1) c
  | otherwise                                                                        = False
    where
      notOccupied r c = (rows !! r) !! c == E

{-H10.1.3-}
canMove :: Game -> Bool
canMove game = length (validMoves game) > 0

validMoves :: Game -> [Pos]
validMoves (Game board player)
  | player == H = filter ((>=0) . fst) (concat [[if isValidMove (Game board player) (r, c) then (r,c) else (-1,-1) | c <- [0..length (board !! 0) - 2]] | r <- [0..length board - 1]])
  | player == V = filter ((>=0) . fst) (concat [[if isValidMove (Game board player) (r, c) then (r,c) else (-1,-1) | c <- [0..length (board !! 0) - 1]] | r <- [0..length board - 2]])

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard board (r,c) v = [[if i == r && j == c then v else (board !! i) !! j | j <- [0..length (board !! i) - 1]] | i <- [0..length board - 1]]

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game board player) (r,c)
  | player == H = Game (updateBoard (updateBoard board (r,c) (P H)) (r,c + 1) (P H)) V
  | player == V = Game (updateBoard (updateBoard board (r,c) (P V)) (r + 1,c) (P V)) 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 -- receives a game and plays a move for the next player
christmasAI _ game = fst $ minimumBy (comparing snd) (weightedMoves game)

weightedMoves :: Game -> [(Pos, Int)]
weightedMoves game = [(pos, length (validMoves (playMove game pos))) | pos <- validMoves game]

-- christmasAI :: Strategy -- receives a game and plays a move for the next player
-- christmasAI _ game = let wm = weightedMoves game in if length wm > 0 then fst $ maximumBy (comparing snd) wm else (-1,-1)
--
-- christmasAIOpp :: Strategy -- receives a game and plays a move for the next player
-- christmasAIOpp _ game = let wm = weightedMovesOpp game in if length wm > 0 then fst $ minimumBy (comparing snd) wm else (-1,-1)
--
-- weightedMoves :: Game -> [(Pos, Int)]
-- weightedMoves game = [let m1 = playMove game pos
--                           oppPos = christmasAIOpp [] m1 in
--                       if fst oppPos < 0 then (pos, 12*12+1) else (pos, length (validMoves (playMove m1 (oppPos)))) | pos <- validMoves game]
--
-- weightedMovesOpp :: Game -> [(Pos, Int)]
-- weightedMovesOpp game = [(pos, length (validMoves (playMove game pos))) | pos <- validMoves game]
{-TTEW-}

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss dim sv sh =
  let initialBoard     = [[E | j <- [0..dim - 1]] | i <- [0..dim - 1]]
      (history,winner) = (auxV sv sh rss [initialBoard]) in
  ((drop 1 history),winner)
    where
      auxV sv sh (ss:sss) history =
        let prevBoard = last history
            game      = Game prevBoard V in
        if canMove game
        then
          let pos = sv ss game in
          if isValidMove game pos
          then auxH sv sh sss (history ++ [(getBoard (playMove game pos))])
          else (history,H)
        else (history,H)
      auxH sv sh (ss:sss) history =
        let prevBoard = last history
            game      = Game prevBoard H in
        if canMove game
        then
          let pos = sh ss game in
          if isValidMove game pos
          then auxV sv sh sss (history ++ [(getBoard (playMove game pos))])
          else (history,V)
        else (history,V)
      getBoard (Game board _) = board

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