module Exercise_10 where

import Data.Function (on)
import Data.List
import Data.Maybe
import Data.Tuple (swap)
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 = unlines . map (concatMap showField)
  where
    showField (P player) = show player
    showField 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 board player) pos =
    isFree board pos && isFree board (secondaryPos player pos)

isFree :: Board -> Pos -> Bool
isFree board (r, c) =
    r >= 0 &&
    c >= 0 && r < rows board && c < cols board && isFieldEmpty (board !! r !! c)

isFieldEmpty :: Field -> Bool
isFieldEmpty E = True
isFieldEmpty _ = False

secondaryPos :: Player -> Pos -> Pos
secondaryPos V (r, c) = (succ r, c)
secondaryPos H (r, c) = (r, succ c)

rows :: Board -> Int
rows = length

cols :: Board -> Int
cols = length . concat . take 1

{-H10.1.3-}
canMove :: Game -> Bool
canMove g@(Game board player) =
    let (rs, cs) = getBounds player
     in any (isValidMove g) [(r, c) | r <- rs, c <- cs]
  where
    getBounds V = ([0 .. pred . rows $ board], [0 .. cols board])
    getBounds H = ([0 .. rows board], [0 .. pred . cols $ board])

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard board pos field =
    [ [ if (r', c') == pos
        then field
        else board !! r' !! c'
    | c' <- [0 .. cols board - 1]
    ]
    | r' <- [0 .. rows board - 1]
    ]

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game board player) pos =
    Game
        (updateBoard
             (updateBoard board pos field)
             (secondaryPos player pos)
             field)
        (otherPlayer player)
  where
    field = P player

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

otherPlayer :: Player -> Player
otherPlayer V = H
otherPlayer H = V

{-WETT-}
-- here we see the remains of a Monte carlo tree search algorithm, which was sadly too slow :(
-- too many hours have been wasted here
--data MCTree
--    = Leaf Player
--    | Node [MCTree] Player Pos Int Int
--    deriving (Eq, Show)
--getPlayer :: Game -> Player
--getPlayer (Game _ player) = player
--visits :: MCTree -> Int
--visits (Node _ _ _ _ n) = n
--visits (Leaf _) = 1
--wins :: MCTree -> Int
--wins (Node _ _ _ q _) = q
--wins (Leaf _) = 0
--cParam :: Double
--cParam = 1.4
--uct :: MCTree -> MCTree -> Double
--uct _ (Leaf _) = 0.0
--uct node child =
--    (fromIntegral . wins $ child) / (fromIntegral . visits $ child) +
--    cParam *
--    sqrt ((fromIntegral . visits $ node) / (fromIntegral . visits $ child))
--bestChild :: MCTree -> MCTree
--bestChild node@(Node children _ _ _ _)
--    -- trace "findBestChild" (maximumBy (compare `on` uct node) children)
-- = (head children)
possibleMoves :: Game -> [Pos]
possibleMoves game@(Game board player) =
    [ (r, c)
          -- (updateBoard board (r, c) (P player)) (otherPlayer player))
    | c <- [0 .. cols board - 1]
    , r <- [0 .. rows board - 1]
    , isValidMove game (r, c)
    ]

--buildTree :: Game -> MCTree
--buildTree = buildTree' (-1, -1)
--  where
--    buildTree' pos game@(Game board player) =
--        case possibleMoves game of
--            [] -> Leaf player
--            moves ->
--                Node
--                    (map (\move ->
--                              buildTree'
--                                  move
--                                  (Game
--                                       (updateBoard board move (P player))
--                                       player))
--                         moves)
--                    player
--                    pos
--                    0
--                    0
--fullyExpanded :: MCTree -> Bool
--fullyExpanded (Leaf _) = True
--fullyExpanded n@(Node children _ _ _ _) =
--    not . any (isInfinite . uct n) $ children
--
--chooseChild :: Double -> MCTree -> MCTree
--chooseChild _ l@(Leaf _) = l
--chooseChild rand n@(Node children _ _ _ _)
--    | fullyExpanded n = maximumBy (compare `on` uct n) children
--    | otherwise =
--        filter (isInfinite . uct n) children !!
--        floor (fromIntegral (length children) * rand)
--
--traverseTree :: [Double] -> Game -> MCTree -> ([Double], MCTree, Int)
--traverseTree randoms (Game _ player) l@(Leaf currentPlayer) =
--    (randoms, l, fromEnum $ player == currentPlayer)
--traverseTree (rand:randoms) game node@(Node children player pos q n) =
--    let (randoms', child', win) = traverseTree randoms game child
--     in (randoms', Node (newChildren child') player pos (q + win) (succ n), win)
--  where
---    child = chooseChild rand node
--    newChildren child' =
--        map
--            (\c ->
--                 if c == child
--                     then child'
--                     else c)
--            children
--
--mctIterations :: Int
--mctIterations = 10
--
--mct :: [Double] -> Int -> Game -> MCTree -> Pos
--mct randoms n game tree
--    | n <= mctIterations =
--        let (randoms', tree', _) = traverseTree randoms game tree
--         in (mct randoms' (succ n) game tree')
--    | otherwise = getPos $ bestChild tree
--  where
--    getPos (Node _ _ pos _ _) = pos
--christmasAI :: Strategy -- receives a game and plays a move for the next player
--christmasAI randoms game = mct randoms 0 game tree
--  where
--    tree = buildTree game
-- we always play as H
--
validMoves :: Board -> [Pos]
validMoves board =
    [ (r, c)
    | c <- [0 .. cols board - 1]
    , r <- [0 .. rows board - 1]
    , isValidMove (Game board H) (r, c)
    ]

rankMove :: Board -> Pos -> Int
rankMove board pos =
    sum [ score isDoubleSaveMove 3
        , score isSaveMove 3
        , score isDdestroyingMove 2
        , score isDestroyingMove 2
        , score isNearEdge 1
        ]
  where
    score f s =
        if f board pos
            then s
            else 0

isNearEdge :: Board -> Pos -> Bool
isNearEdge board (r, c) =
    (r == 1 && (c == 0 || c == cols board - 2)) ||
    (r == rows board - 1 && (c == 0 || c == cols board - 2))

isSaveMove :: Board -> Pos -> Bool
isSaveMove board (r, c) =
    ((isFree board (r - 1, c) && isFree board (r - 1, c + 1)) &&
     (not (isFree board (r - 2, c)) && not (isFree board (r - 2, c + 1)))) ||
    ((isFree board (r + 1, c) && isFree board (r + 1, c + 1)) &&
     (not (isFree board (r + 2, c)) && not (isFree board (r + 2, c + 1))))

isDoubleSaveMove :: Board -> Pos -> Bool
isDoubleSaveMove board (r, c) =
    ((isFree board (r - 1, c) && isFree board (r - 1, c + 1)) &&
     (not (isFree board (r - 2, c)) && not (isFree board (r - 2, c + 1)))) &&
    ((isFree board (r + 1, c) && isFree board (r + 1, c + 1)) &&
     (not (isFree board (r + 2, c)) && not (isFree board (r + 2, c + 1))))

isDdestroyingMove :: Board -> Pos -> Bool
isDdestroyingMove board (r, c) =
    (isFree board (r - 1, c) && isFree board (r - 1, c + 1)) ||
    (isFree board (r + 1, c) && isFree board (r + 1, c + 1))

isDestroyingMove :: Board -> Pos -> Bool
isDestroyingMove board (r, c) =
    isFree board (r - 1, c) ||
    isFree board (r - 1, c + 1) ||
    isFree board (r + 1, c) || isFree board (r + 1, c + 1)

christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI rs g@(Game board V) =
    swap $ christmasAI rs (Game (transpose board) H)
christmasAI (r:rs) g@(Game board _) =
    maximumBy (compare `on` (rankMove board)) $ possibleMoves g

randChristmasAI :: Strategy
randChristmasAI (r:rs) g = randomMove r (possibleMoves g)

randomMove :: Double -> [Pos] -> Pos
randomMove r moves = moves !! (floor $ fromIntegral (length moves) * r)

{-TTEW-}
{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board], Player)
play rss dim sv sh = play' rss sv sh (Game (genBoard dim) V)

genBoard :: Int -> Board
genBoard dim = [[E | _ <- [0 .. pred dim]] | _ <- [0 .. pred dim]]

play' :: [[Double]] -> Strategy -> Strategy -> Game -> ([Board], Player)
play' (rs:rss) sv sh g@(Game board player)
    | null (possibleMoves g) || not (isValidMove g (move player)) =
        ([], otherPlayer player)
    | otherwise =
        let g'@(Game board' player') = playMove g (move player)
         in case play' rss sv sh g' of
                (boards, winner) -> (board' : boards, winner)
  where
    move V = sv rs g
    move H = sh rs g

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