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 xss = showRow (head xss) ++ prettyShowBoard (tail xss)
  where showRow [] = "\n"
        showRow (x:xs)
          | x == E = "+" ++ showRow xs
          | x == P H = "H" ++ showRow xs
          | otherwise = "V" ++ showRow 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 zss p) (r,c)
  | null zss = False
  | r < 0 || c < 0 = False
  | r >= length zss || c >= length (head zss) = False
  | p == H = checkHorizontal zss p (r,c)
  | otherwise = checkVertical zss p (r,c)
    where checkHorizontal zss p (r,c)
            | c+1 >= length row = False
            | (row !! c) /= E || (row !! (c+1)) /= E = False
            | otherwise = True
              where row = zss !! r
          checkVertical zss p (r,c)
            | r+1 >= length col = False
            | (col !! r) /= E || (col !! (r+1)) /= E = False
            | otherwise = True
              where col = column zss c

{-H10.1.3-}
canMove :: Game -> Bool
canMove (Game zss p)
  | null zss = False
  | p == H = moveHorizontal zss (0,0)
  | otherwise = moveVertical zss (0,0)
    where moveHorizontal zss (r,c)
            | isValidMove (Game zss H) (r,c) = True
            | c < length (head zss) = moveHorizontal zss (r, c+1)
            | r < length zss = moveHorizontal zss (r+1, 0)
            | otherwise = False
          moveVertical zss (r,c)
            | isValidMove (Game zss V) (r,c) = True
            | r < length zss = moveVertical zss (r+1, c)
            | c < length (head zss) = moveVertical zss (0, c+1)
            | otherwise = False

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard zss (r,c) f = copyUntilRow zss r 0 ++ [changeField (zss !! r) c 0 f] ++ copyAfterRow zss (r+1)
  where copyUntilRow zss r index
          | index < r = [(zss !! index)] ++ copyUntilRow zss r (index+1)
          | otherwise = []
        changeField row c index f
          | index < c = [row !! index] ++ changeField row c (index+1) f
          | index == c = [f] ++ changeField row c (index+1) f
          | index < length row = [row !! index] ++ changeField row c (index+1) f
          | otherwise = []
        copyAfterRow zss index
          | index < length zss = [(zss !! index)] ++ copyAfterRow zss (index+1)
          | otherwise = []

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove game@(Game zss p) (r,c)
  | p == H = playHorizontal
  | otherwise = playVertical
    where playHorizontal = Game (updateBoard (updateBoard zss (r,c) (P p)) (r,c+1) (P p)) V
          playVertical = Game (updateBoard (updateBoard zss (r,c) (P p)) (r+1,c) (P p)) 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 xs g@(Game zss p)
  | p == V = playVertical zss (0,1)
  | otherwise = playHorizontal zss (10,10)
    where playVertical zss (r,c)
            | isValidMove g (r,c) = (r,c)




            | r + 3 < 12 = playVertical zss (r+4, c)
            | c < 12 = playVertical zss (2-(((c+1) `mod` 2)*2), c+1)
            {-}
            | c < 9 = playVertical zss (r,c+2)
            | r < 12 = playVertical zss (r+1, 1)
            -}
            {-}
            | isValidMove g (0,1) = (0,1)
            | isValidMove g (0,3) = (0,3)
            | isValidMove g (2,1) = (2,1)
            | isValidMove g (0,5) = (0,5)
            | isValidMove g (0,7) = (0,7)
            | isValidMove g (0,9) = (0,9)
            | isValidMove g (2,3) = (2,3)
            | isValidMove g (2,5) = (2,5)
            | isValidMove g (4,10) = (4,10)
            | isValidMove g (2,7) = (2,7)
            | isValidMove g (2,10) = (2,10)
            | isValidMove g (4,1) = (4,1)
            | isValidMove g (4,5) = (4,5)
            | isValidMove g (4,7) = (4,7)
            | isValidMove g (5,8) = (5,8)
            | isValidMove g (6,1) = (6,1)
            | isValidMove g (6,3) = (6,3)
            | isValidMove g (2,8) = (2,8)
            | isValidMove g (6,9) = (6,9)
            -}
            {-}
            | isValidMove g (0,1) = (0,1)
            | isValidMove g (8,10) = (8,10)
            | isValidMove g (2,1) = (2,1)
            | isValidMove g (6,10) = (6,10)
            | isValidMove g (4,1) = (4,1)
            | isValidMove g (7,8) = (7,8)
            | isValidMove g (7,3) = (7,3)
            | isValidMove g (7,6) = (7,6)
            | isValidMove g (7,5) = (7,5)
            | isValidMove g (0,3) = (0,3)
            | isValidMove g (0,8) = (0,8)
            | isValidMove g (2,3) = (2,3)
            | isValidMove g (2,8) = (2,8)

            | isValidMove g (0,5) = (0,5)
            | isValidMove g (0,6) = (0,6)
            | isValidMove g (2,5) = (2,5)
            | isValidMove g (2,6) = (2,6)    
            -}    

            | find_square g /= (-1,-1) = find_square g
            | ruinNext g /= (-1,-1) = ruinNext g
            | otherwise = find_single_step g
          playHorizontal zss (r,c)
            | isValidMove g (r,c) = (r,c)
            | c >= 0 = playHorizontal zss (r, c-1)
            | r == 10 = playHorizontal zss (1, 10)
            | r == 1 = playHorizontal zss (8, 10)
            | r == 8 = playHorizontal zss (3, 10)
            | r == 3 = playHorizontal zss (6, 10)
            | r == 6 = playHorizontal zss (4, 10)
            | find_square g /= (-1,-1) = find_square g
            -- ruinNext g /= (-1,-1) = ruinNext g
            | otherwise = find_single_step g

find_square :: Game -> Pos
find_square (Game zss p) = helpFindSquare zss (0,0)
  where helpFindSquare zss (r,c)
          | isValidMove (Game zss H) (r,c) && isValidMove (Game zss H) (r+1,c) = (r,c)
          | r < length zss = helpFindSquare zss (r+1, c)
          | c < length (head zss) = helpFindSquare zss (0, c+1)
          | otherwise = (-1,-1)

ruinNext :: Game -> Pos
ruinNext (Game zss p)
  | p == V = ruinHorizontalStep (find_possible_steps (Game zss H))
  | otherwise = ruinVerticalStep (find_possible_steps (Game zss V))
    where ruinHorizontalStep xs
            -- xs == [] && ruinStep (Game zss V) (r,c) /= (-1,-1) = ruinStep (Game zss V) (r,c)
            | xs == [] = (-1,-1)
            | ruinStep (Game zss V) (r,c) /= (-1,-1) = ruinStep (Game zss V) (r,c)
            | otherwise = ruinHorizontalStep (tail xs)
              where (r,c) = head xs
          ruinVerticalStep ((r,c):xs)
            | xs == [] && ruinStep (Game zss H) (r,c) /= (-1,-1) = ruinStep (Game zss H) (r,c)
            | xs == [] = (-1,-1)
            | ruinStep (Game zss H) (r,c) /= (-1,-1) = ruinStep (Game zss H) (r,c)
            | otherwise = ruinVerticalStep xs

ruinStep :: Game -> Pos -> Pos
ruinStep (Game zss p) (r,c)
  | p == V = ruinHorizontal
  | otherwise = ruinVertical
    where ruinHorizontal
            | r == -1 = (-1,-1)
            | isValidMove (Game zss V) (r,c) = (r,c)
            | isValidMove (Game zss V) (r,c+1) = (r,c+1)
            | isValidMove (Game zss V) (r-1,c) = (r-1,c)
            | isValidMove (Game zss V) (r-1,c+1) = (r-1,c+1)
            | otherwise = (-1,-1)
          ruinVertical
            | r == -1 = (-1,-1)
            | isValidMove (Game zss V) (r,c-1) = (r,c-1)
            | isValidMove (Game zss V) (r+1,c-1) = (r+1,c-1)
            | isValidMove (Game zss V) (r,c) = (r,c)
            | isValidMove (Game zss V) (r+1,c) = (r+1,c)
            | otherwise = (-1,-1)            

find_single_step :: Game -> Pos
find_single_step (Game zss p)
  | p == H = moveHorizontal zss (0,0)
  | otherwise = moveVertical zss (0,0)
    where moveHorizontal zss (r,c)
            | isValidMove (Game zss H) (r,c) = (r,c)
            | c < length (head zss) = moveHorizontal zss (r, c+1)
            | r < length zss = moveHorizontal zss (r+1, 0)
            | otherwise = (-1,-1)
          moveVertical zss (r,c)
            | isValidMove (Game zss V) (r,c) = (r,c)
            | r < length zss = moveVertical zss (r+1, c)
            | c < length (head zss) = moveVertical zss (0, c+1)
            | otherwise = (-1,-1)

find_possible_steps :: Game -> [Pos]
find_possible_steps (Game zss p)
  | p == H = moveHorizontal zss (0,0)
  | otherwise = moveVertical zss (0,0)
    where moveHorizontal zss (r,c)
            | isValidMove (Game zss H) (r,c) = [(r,c)] ++ moveHorizontal zss (r, c+1)
            | c < length (head zss) = moveHorizontal zss (r, c+1)
            | r < length zss = moveHorizontal zss (r+1, 0)
            | otherwise = []
          moveVertical zss (r,c)
            | isValidMove (Game zss V) (r,c) = [(r,c)] ++ moveVertical zss (r+1, c)
            | r < length zss = moveVertical zss (r+1, c)
            | c < length (head zss) = moveVertical zss (0, c+1)
            | otherwise = []
{-TTEW-}

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss dim sv sh = playGame rss sv sh (Game (buildBoard dim) V) []
{-}
  where playGame (r:rs) sv sh g@(Game zss p) b@[boards]
          | canMove g == False && p == V = (b, H)
          | canMove g == False && p == H = (b, V)
          | p == V = playGame rs sv sh (playMove g (sv r g)) ([boards] ++ zss)
          | otherwise = playGame rs sv sh (playMove g (sh r g)) ([boards] ++ zss)
          -}

playGame :: [[Double]] -> Strategy -> Strategy -> Game -> [Board] -> ([Board], Player)
playGame (r:rs) sv sh g@(Game zss p) boards
  | canMove g == False && p == V = (tail (boards ++ [zss]), H)
  | canMove g == False && p == H = (tail (boards ++ [zss]), V)
  | p == V && isValidMove g (sv r g) == False = (tail (boards ++ [zss]), H)
  | p == V = playGame rs sv sh (playMove g (sv r g)) (boards ++ [zss])
  | isValidMove g (sh r g) == False = (tail (boards ++ [zss]), V)
  | otherwise = playGame rs sv sh (playMove g (sh r g)) (boards ++ [zss])

{-}
play rss dim sv sh = playGame rss sv sh (Game (buildBoard dim) V) []
  where playGame rss sv sh g@(Game zss p) [boards]
          | canMove g == False && p == V = ([boards] ++ zss, H)
          | canMove g == False && p == H = ([boards] ++ zss, V)
          | p == V = playGame (tail rss) sv sh (playMove g (sv (head rss) g)) ([boards] ++ zss)
          | otherwise = playGame (tail rss) sv sh (playMove g (sh (head rss) g)) ([boards] ++ zss)
          -}
          

buildBoard :: Int -> Board
buildBoard dim = replicate dim (buildRow dim)
  where buildRow x
          | x-1 > 0 = [E] ++ buildRow (x-1)
          | otherwise = [E]

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


simulateVerticalSteps :: Game -> Int -> Game
simulateVerticalSteps g@(Game zss p) steps
  | steps <= 0 = g
  -- otherwise = simulateVerticalSteps (playMove g (christmasAI [] g)) (steps-1)
  | otherwise = simulateVerticalSteps (Game gameboard V) (steps -1)
    where (Game gameboard newPlayer) = playMove g (christmasAI [] g)

simulateSteps :: Game -> Int -> Game
simulateSteps g@(Game zss p) steps
  | steps <= 0 = g
  | otherwise = simulateSteps (playMove g (christmasAI [] g)) (steps-1)

test5 = putStr $ prettyShowBoard zss
  where (Game zss p) = simulateVerticalSteps (Game board_12 V) 17

test6 = putStr $ prettyShowBoard zss
  where (Game zss p) = simulateSteps (Game board_12 V) 71

board_12 = [[E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E],
            [E,E,E,E,E,E,E,E,E,E,E,E]]

test1 =    [[P V,P V,E,E,E,E,E,E,E,E,P V,E],
            [E,P V,E,E,E,E,E,E,E,E,E,E],
            [P V,E,E,E,E,E,E,E,E,E,P V,E],
            [E,P V,E,E,E,E,E,E,E,E,E,E],
            [P V,E,E,E,E,E,E,E,E,E,P V,E],
            [E,P V,E,E,E,E,E,E,E,E,E,E],
            [P V,E,E,E,E,E,E,E,E,E,P V,E],
            [E,P V,E,E,E,E,E,E,E,E,E,E],
            [P V,E,E,E,E,E,E,E,E,E,P V,E],
            [E,P V,E,E,E,E,E,E,E,E,E,E],
            [P V,E,E,E,E,E,E,E,E,E,P V,E],
            [E,P V,E,E,E,E,E,E,E,E,E,E]]

test2    = [[P V,E  ,E],
            [P H,P V,E],
            [P H,E,  E]]

test3 =    [[E,P H,E,P H,E,P H,E,P H,E,P H,E,P H],
            [E,P H,E,P H,E,P H,E,P H,E,P H,E,P H],
            [E,P H,E,P H,E,P H,E,P H,E,P H,E,P H],
            [E,P H,E,P H,E,P H,E,P H,E,P H,E,P H],
            [E,P H,E,P H,E,E,E,P H,E,P H,E,P H],
            [E,P H,E,P H,E,E,E,P H,E,P H,E,P H],
            [E,P H,E,P H,E,P H,E,P H,E,P H,E,P H],
            [E,P H,E,P H,E,P H,E,P H,E,P H,E,P H],
            [E,P H,E,P H,E,P H,E,P H,E,P H,E,P H],
            [E,P H,E,P H,E,P H,E,P H,E,P H,E,P H],
            [E,P H,E,P H,E,P H,E,P H,E,P H,E,E],
            [E,P H,E,P H,E,P H,E,P H,E,P H,E,E]]

test4 = [[P V,E,E,E],
         [E,E,E,E],
         [E,P V,E,E],
         [E,E,E,E]]