module Exercise_10 where
import Data.List
import Data.Function --added
import Data.Tuple --added
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

--Test Boards
sh :: Board -> IO ()
sh b = putStr $ prettyShowBoard b
shG :: Game -> IO ()
shG (Game board player)
                        | player == V = putStr $ "Player's turn: V\n" ++ prettyShowBoard board
                        | player == H = putStr $ "Player's turn: H\n" ++ prettyShowBoard board

board0 = [] :: Board
board1 = [[E]]
board4 = [[E, E,E,E],[E,E,E,E],[E,E,E,E],[E,E,E,E]]
board5 = [[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]]
board6 = [[P V,P V,E,E,E],[E,E,E,E,E],[E,E,E,E,E],[E,E,E,E,P H],[E,E,E,E,P H]]
gameEV0 = Game board0 V
gameEV5 = Game board5 V
gameEH0 = Game board0 H
gameEH5 = Game board5 H
gameEH6 = Game board6 H
pos0x0 = (0,0) :: Pos
pos3x3 = (3,3) :: Pos
pos4x4 = (4,4) :: Pos
pos0x1 = (0,1) :: Pos


{-H10.1.1-}
{-Player Horizontal, Player Vertical, Empty-}
prettyShowBoard :: Board -> String
prettyShowBoard ( []          ) = ""
prettyShowBoard (( []     ):cs) = "\n" ++ prettyShowBoard (     cs)
prettyShowBoard (((E  ):rs):cs) = "+"  ++ prettyShowBoard ((rs):cs)
prettyShowBoard (((P V):rs):cs) = "V"  ++ prettyShowBoard ((rs):cs)
prettyShowBoard (((P H):rs):cs) = "H"  ++ prettyShowBoard ((rs):cs)

{-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 H) (r,c) = let i = height board in ( r>=0 && c>=0 ) &&  r<i && (c+1)<i && (row board r)!!c == E &&  (row board r)!!(c+1) == E
isValidMove (Game board V) (r,c) = let i = height board in ( r>=0 && c>=0 ) &&  (r+1)<i && c<i && (row board r)!!c == E &&  (row board (r+1))!!c == E

{-H10.1.3-}
canMove :: Game -> Bool
canMove (Game  (       []  )  H) = False
canMove (Game  ((E:E:rs):cs)  H) = True
canMove (Game  ((_:rs):cs  )  H) = canMove (Game  ((  rs):cs      )  H)
canMove (Game  ((   _):cs  )  H) = canMove (Game  (       cs      )  H)
canMove (Game  ( board     )  V) = canMove (Game  (transpose board)  H)

{-H10.1.4-}
--sh $ updateBoard board5 pos0x0 (P H)
--sh [[P H,P H,E],[E,P V,P V],[P V,P H,E]]
--sh $ updateBoard [[P H,P H,E],[E,P V,P V],[P V,P H,E]] ((1,2)::Pos) (P H)

--    Spielfeld -> (c,r) -> (P V|P H|E) -> Spielfeld
updateBoard :: Board -> Pos -> Field -> Board
updateBoard [         ] (rt,ct) f = []
updateBoard ((r:rs):cs) (0 ,ct) f = (updateRow (r:rs) ct f) : cs
  where updateRow (r:rs) 0  f = (f) : rs
        updateRow (r:rs) ct f = r : updateRow (rs) (ct-1) f
updateBoard ((r:rs):cs) (rt,ct) f = (r:rs) : updateBoard (cs) (rt-1,ct) f

{-H10.1.5-}
--shG $ (Game [[E,P H,E],[E,E,E],[E,E,P V]] V)
--shG $ playMove (Game [[E,P H,E],[E,E,E],[E,E,P V]] V) ((0,2)::Pos) 

playMove :: Game -> Pos -> Game
playMove (Game board H) (r,c) = if isValidMove (Game board H) (r,c)
                                then (Game  ( (updateBoard ( updateBoard board (r,c) (P H) ) (r,c+1) (P H)) )  V)
                                else (Game  ( board                                                         )  H)

playMove (Game board V) (r,c) = if isValidMove (Game board V) (r,c)
                                then (Game  ( (updateBoard ( updateBoard board (r,c) (P V) ) (r+1,c) (P V)) )  H)
                                else (Game  ( board                                                         )  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 ([2.0]::[Double]) gameEH5
christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI = christmasAI2

--AI3------------------
christmasAI3 :: Strategy -- receives a game and plays a move for the next player
christmasAI3 rss game@(Game board V) = let p = christmasAI3 rss (Game (transpose board) H) in (snd p,fst p)
christmasAI3 rss game@(Game board H) = head $ possipleMovesH board
--AI3------------------


--AI2------------------
christmasAI2 :: Strategy -- receives a game and plays a move for the next player
christmasAI2 rss game@(Game board V) = let p = christmasAI2 rss (Game (transpose board) H) in (snd p,fst p)
christmasAI2 rss game@(Game board H) = let possBlocks = possipleBlocks game
                                           possTup    = schemePossible (generateStrategyFlo game) possBlocks
                                        in if fst possTup then snd possTup else fst $ head possBlocks

schemePossible :: [Pos] -> [(Pos,Int)] -> (Bool,Pos)
schemePossible lstStrategy possBlocks = if length lstStrategyMatching >0 then (True,head lstStrategyMatching) else (False,fst $ head possBlocks)
  where ls4 = map fst $ {-filter (\x -> snd x >= 4) $-} possBlocks --(optional) List with only block 4 Positions
        lstStrategyMatching = filter (\x -> x `elem` ls4) lstStrategy

--is onyl calles for Player H; if needed to swap [Pos] use "map swap lst4"
generateStrategyFlo :: Game -> [Pos]
generateStrategyFlo game@(Game board H) = generateStrategyFlo' w 1 0
  where w = width board
        generateStrategyFlo' w r c
                                    | r<(w-1) && (c+1)< w = (r,c) : ( generateStrategyFlo' w r (c+4) )
                                    | r<(w-1) && (c+1)>=w = if mod r 2 ==0 then generateStrategyFlo' w (r+1) 0 else generateStrategyFlo' w (r+1) 2
                                    | otherwise   = []
--AI2------------------


--AImaxBlock------------------
christmasAI1 :: Strategy -- receives a game and plays a move for the next player
christmasAI1 rss (Game board V) = let p = christmasAI1 rss (Game (transpose board) H) in (snd p,fst p)
christmasAI1 rss (Game board H) = fst $ head $ possipleBlocks (Game board H)

--Returns sorted List of possible Movementst
possipleBlocks :: Game -> [(Pos,Int)]
possipleBlocks (Game board H) = possipleBlocks'  (Game board H)  (possipleMovesH board)
  where possipleBlocks' game [] = []
        possipleBlocks' game (x:xs) = sortBy (flip compare `on` snd) $ (x,( blockedStones game x )) : possipleBlocks' game xs
possipleBlocks (Game board V) = possipleBlocks'  (Game board V)  (possipleMovesH $ transpose board)
  where possipleBlocks' game [] = []
        possipleBlocks' game (x:xs) = sortBy (flip compare `on` snd) $ (x,( blockedStones game x )) : possipleBlocks' game xs

blockedStones :: Game -> Pos -> Int
blockedStones (Game board H) (r,c) = length movesVbefore - length movesVafter
  where movesVbefore = possipleMovesH ( transpose (board      )  )
        movesVafter  = possipleMovesH ( transpose (boardAfter )  )
        Game boardAfter p = playMove (Game board H) (r,c)
blockedStones (Game board V) (r,c) = length movesHbefore - length movesHafter
  where movesHbefore = possipleMovesH ( board                    )
        movesHafter  = possipleMovesH ( boardAfter               )
        Game boardAfter p = playMove (Game board V) (r,c)

possipleMovesH :: Board -> [Pos]
possipleMovesH board = possipleMovesH' board (0,0) (height board, ((width board)-1) )
  where possipleMovesH' board (r,c) (rm,cm)
          | r<rm && c<cm  && isValidMove (Game board H) (r,c) = (r,c) : possipleMovesH' board (r  ,c+1) (rm,cm)
          | r<rm && c<cm                                      =         possipleMovesH' board (r  ,c+1) (rm,cm)        
          | r<rm && c<=cm                                     =         possipleMovesH' board (r+1, 0 ) (rm,cm)        
          | otherwise                                         = []
--AImaxBlock------------------

{-TTEW-}


{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
--play (rs:rss) dim sv sh = let result = playHelper (rs:rss) sv sh (Game (generateEmptyBoard dim) V) [generateEmptyBoard dim] in (reverse $ fst result , snd result )
play (rs:rss) dim sv sh = let result = playHelper (rs:rss) sv sh (Game (generateEmptyBoard dim) V) [] in (reverse $ fst result , snd result )

playHelper :: [[Double]] -> Strategy -> Strategy -> Game -> [Board] -> ([Board],Player)
playHelper (rs:rss) sv sh game@(Game board V) boards = let Game boardsNext playerNext = (playMove game (posNext))
                                                           posNext = (sv rs game)
                                                           allowed = isValidMove game posNext
                                                        in if canMove game && allowed then playHelper rss sv sh (Game boardsNext playerNext) (boardsNext:boards) else (boards,H)
playHelper (rs:rss) sv sh game@(Game board H) boards = let Game boardsNext playerNext = (playMove game (posNext))
                                                           posNext = (sh rs game)
                                                           allowed = isValidMove game posNext
                                                        in if canMove game && allowed then playHelper rss sv sh (Game boardsNext playerNext) (boardsNext:boards) else (boards,V)


generateEmptyBoard :: Int -> Board
generateEmptyBoard dim = generateEmptyBoard' dim dim E
  where generateEmptyBoard' dim i field = if i>0 then (generateEmptyRow' dim dim field) : generateEmptyBoard' dim (i-1) field else []
        generateEmptyRow' dim i field = if i>0 then field : generateEmptyRow' dim (i-1) field else []



-- 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
-- Dimension -> Strategy Vertical V (1st Move) -> Strategy Horizontal H
playAndPrint :: Int -> Strategy -> Strategy -> IO ()
playAndPrint dim sv sh = do 
  rss <- generate $ mapM (const $ genRandomZeroOne) [1..]
  let (bs, w) = play rss dim sv sh
  putStr $ (unlines $ map prettyShowBoard bs) ++ "\nWinner: " ++ show w ++ "\n"


-----Show Single Strategy---------------
playSingle :: [[Double]] -> Int -> Strategy -> Player -> ([Board],Player)
playSingle (rs:rss) dim sh  p = let result = playSingleHelper (rs:rss) sh (Game (generateEmptyBoard dim) p) [] in (reverse $ fst result , snd result )

playSingleAndPrint :: Player -> Int -> Strategy -> IO ()
playSingleAndPrint p dim sh = do 
  rss <- generate $ mapM (const $ genRandomZeroOne) [1..]
  let (bs, w) = playSingle rss dim sh p
  putStr $ (unlines $ map prettyShowBoard bs) ++ "\nWinner: " ++ show w ++ "\n"

playSingleHelper :: [[Double]] -> Strategy -> Game -> [Board] -> ([Board],Player)
playSingleHelper (rs:rss) sv game@(Game board V) boards = let Game boardsNext playerNext = (playMove game (posNext))
                                                              posNext = (sv rs game)
                                                              allowed = isValidMove game posNext
                                                           in if canMove game && allowed then playSingleHelper rss sv (Game boardsNext V) (boardsNext:boards) else (boards,H)
playSingleHelper (rs:rss) sh game@(Game board H) boards = let Game boardsNext playerNext = (playMove game (posNext))
                                                              posNext = (sh rs game)
                                                              allowed = isValidMove game posNext
                                                           in if canMove game && allowed then playSingleHelper rss sh (Game boardsNext H) (boardsNext:boards) else (boards,V)
--------------------

{--Games-----------------
playSingleAndPrint H 6 christmasAI2
playAndPrint 6 christmasAI2 christmasAI1
--------------------}