module Exercise_10 where
import Data.List
import Test.QuickCheck
import Data.Ord (comparing)

{-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 xss = concat (map ((++ "\n") . concat . (\xs -> map fieldString xs)) xss)
  where fieldString E = "+"
        fieldString (P x) = show x

{-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 [] _) (r,c) = False
isValidMove (Game xss V) (r,c) = (fieldIsEmpty xss (r,c)) && (fieldIsEmpty xss (r+1,c))
isValidMove (Game xss H) (r,c) = (fieldIsEmpty xss (r,c)) && (fieldIsEmpty xss (r,c+1))

getField :: Board -> Pos -> Field 
getField xss (r,c) = (xss !! r) !! c

fieldIsEmpty :: Board -> Pos -> Bool
fieldIsEmpty xss (r,c) = if width xss > c && height xss > r && 0 <= c && 0 <= r then getField xss (r,c) == E else False

{-H10.1.3-}
canMove :: Game -> Bool
canMove (Game xss V) = or [isValidMove (Game xss V) (r,c) | r <- [0..(height xss - 2)], c <- [0..(width xss - 1)]] 
canMove (Game xss H) = or [isValidMove (Game xss H) (r,c) | r <- [0..(height xss - 1)], c <- [0..(width xss - 2)]] 

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard xss (r,c) fld = lft ++ [inLft ++ [fld] ++ inRht] ++ rht
  where lft = fst( splitAt r xss)
        mdl = head( snd( splitAt r xss)) 
        rht = snd( splitAt (r+1) xss)
        inLft = fst( splitAt c mdl) 
        inRht = snd( splitAt (c+1) mdl)

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

randomMove :: Strategy
randomMove rss game = moves !! randomInt 
  where randomInt = floor(head rss * fromIntegral(length moves)) 
        moves = allMoves game

bestMove :: Strategy 
bestMove rss game = minmax 0 game 

minmax :: Int -> Game -> Pos 
minmax 0 (Game brd H) = maximumBy (comparing (rating game)) (allMoves game) 
  where game = (Game brd H)
minmax 0 (Game brd V) = minimumBy (comparing (rating game)) (allMoves game) 
  where game = (Game brd V)
minmax d (Game brd H) = maximumBy (comparing (rating game)) (map (\m -> minmax (d-1) (game' m)) (allMoves game))
  where game    = (Game brd H)
        game' m = playMove game m 
minmax d (Game brd V) = minimumBy (comparing (rating game)) (map (\m -> minmax (d-1) (game' m)) (allMoves game)) 
  where game    = (Game brd V)
        game' m = playMove game m

-- Returns the rating of a Game. If positive H has more moves left 
rating :: Game -> Pos -> Int
rating game pos = length (allMoves (Game brd' H)) - length (allMoves (Game brd' V)) 
  where (Game brd' p) = playMove game pos

allMoves :: Game -> [Pos]
allMoves (Game bss V) = [(r,c) | r <- [0..10], c <- [0..11], isValidMove (Game bss V) (r,c)]
allMoves (Game bss H) = [(r,c) | r <- [0..11], c <- [0..10], isValidMove (Game bss H) (r,c)]

{-TTEW-}

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss 0 sv sh = ([],H)
play rss dim sv sh   
  | rounds == [] = ([],H)
  | otherwise = (boards,winner)
  where rounds = (playRec rss (Game [[E | j <- [1..dim]] | i <- [1..dim]] V) sv sh)
        boards = tail [brd | (Game brd plyr) <- rounds] 
        (Game lastBoard lastPlayer) = last rounds
        winner = if lastPlayer == V then H else V

playRec :: [[Double]] -> Game -> Strategy -> Strategy -> [Game]
playRec (r:rss) (Game brd player) sv sh
  | canMove (Game brd player) && (isValidMove (Game brd player) pos) = [Game brd player] ++ (playRec rss game' sv sh)
  | otherwise = [Game brd player] 
  where game' = playMove (Game brd player) pos 
        pos = (strat r (Game brd player))
        strat = if player == V then sv else sh

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