module Exercise_10 where
import Data.List
import Test.QuickCheck
import Data.Function

{-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 (b:bs) = aux b ++ "\n" ++ prettyShowBoard bs where
   aux []     = ""
   aux [f]    = if f == E then "+" else
                     if f == P V then "V" else "H"
   aux (f:fs) = aux [f] ++ aux fs

{-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 b p) (r,c) 
   | (if p == V then (r+1)>= height b else (c+1)>=width b) || (r<0) || (c<0) = False
   | otherwise                                                               =(p1 == '+') && (p2 == '+') where 
       z             = filter (/='\n') (prettyShowBoard b)
       p1            = z!!(r*(width b) + c)
       p2            = if p == V then
                           z!!((r+1)*(width b) + c) else
                           z!!(r*(width b) + c+1)

{-H10.1.3-}
canMove :: Game -> Bool
canMove g = aux g (0,0) where
   aux (Game b p) (r,c) 
      | r == height b                = False
      | c == width b                 = aux (Game b p) (r+1,0)
      | isValidMove (Game b p) (r,c) = True
      | otherwise                    = aux (Game b p) (r,c+1)

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board 
updateBoard b (row,col) f 
   | (row<0) || (col<0) || (row>=height b) || (col>=width b) = b
   | otherwise                                               = aux b (row,col) f 0 (height b) where
      aux (r:rs) (row,col) f n h
        | n < row   = [r] ++ (aux rs (row,col) f (n+1) h) 
        | otherwise = [aux2 r (row, col) f 0 (length r)] ++ rs where
           aux2 (c:cs) (row,col) f m w
              | m < col   = [c] ++ (aux2 cs (row, col) f (m+1) w)
              | otherwise = [f] ++ cs

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove  (Game b p) (r,c) 
   | p == V    = Game (updateBoard (updateBoard b (r,c) (P p)) (r+1,c) (P p)) H
   | otherwise = Game (updateBoard (updateBoard b (r,c) (P p)) (r,c+1) (P p)) 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-}
--choses the move that lets the opposite player make the least possible moves during his turn
christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI rs g = fst $ head $ sortBy (compare `on` snd) [(p, length (playAllPossibleMoves f)) | (p,f)<-playAllPossibleMoves g]

--returns all possible Moves with the accoriding updated Game
playAllPossibleMoves :: Game -> [(Pos,Game)]
playAllPossibleMoves (Game b p) = [((i,j),playMove (Game b p) (i,j))| i<-[0..((height b) - 1)], j<-[0..((width b) - 1)], isValidMove (Game b p) (i,j)]

{-TTEW-}

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss n sv sh = aux (Game (replicate n (replicate n E)) V) sv sh rss ([],H) where
   aux (Game b p) sv sh (r:rs) (bs,q)
      | not $ canMove (Game b p) = (bs,q)
      | p == V                   = if isValidMove (Game b p) (sv r (Game b p)) 
                                       then aux z sv sh rs ((bs ++ [f | (Game f r)<-[z]]),V) 
                                       else (bs,q)
      | otherwise                = if isValidMove (Game b p) (sh r (Game b p)) 
                                       then aux y sv sh rs ((bs ++ [f | (Game f r)<-[y]]),H) 
                                       else (bs, q) where
         z = playMove (Game b p) (sv r (Game b p))
         y = playMove (Game b p) (sh r (Game b p))


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