module Exercise_10 where
import Data.List
import Data.Ord
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 (r:rs) = prettyShowRow r ++ prettyShowBoard rs
  where
    prettyShowRow :: Row -> String
    prettyShowRow [] = "\n"
    prettyShowRow (f:fs) = prettyShowField f ++ prettyShowRow fs
      where
        prettyShowField :: Field -> String
        prettyShowField E = "+"
        prettyShowField (P p) = 
          case p of
            V -> "V"
            H -> "H"

{-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 H) (r, c) = isFree b (r, c) && isFree b (r, c+1)
isValidMove (Game b V) (r, c) = isFree b (r, c) && isFree b (r+1, c)

isFree :: Board -> Pos -> Bool
isFree b (r, c) = 
  r >= 0 && c >= 0 && r < height b && c < width b
  && ((b !! r) !! c == E)

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

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard b (r,c) f = umodifiedFrontRows ++ (modifiedRow : unmodifiedBackRows)
  where
    (umodifiedFrontRows, restRows) = splitAt r b
    unmodifiedBackRows = tail restRows
    (umodifiedFrontCells, restCells) = splitAt c (head restRows)
    unmodifiedBackCells = tail restCells
    modifiedCell = [f]
    modifiedRow = umodifiedFrontCells ++ modifiedCell ++ unmodifiedBackCells
      

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game b H) (r, c) = Game updatedBoard V
  where
    updatedBoard = updateBoard (updateBoard b (r, c) (P H)) (r, c+1) (P H)
playMove (Game b V) (r, c) = Game updatedBoard H
  where
    updatedBoard = updateBoard (updateBoard b (r, c) (P V)) (r+1, c) (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-}
-- Note: only works for quadratic fields
christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI _ (Game b V) = verticalStrategy b
christmasAI _ (Game b H) = horizontalStrategy b 
  
-- Finds a good move for the horizontal player based on a given board
horizontalStrategy :: Board -> Pos
horizontalStrategy b = best [(
                              (x, y), 
                              countBlocked (x,y) + countHeldFree (x,y) + evenRowBonus x                                          -- "Quality Points"
                              ) | x <- [0 .. (height b - 1)], y <- [0 .. (width b - 1)], isValidMove (Game b H) (x, y)]
  where
    -- Finds the move with the highest amount of "Quality Points"
    best :: Ord c => [(a, c)] -> a
    best opts = fst (maximumBy (comparing snd) opts)

    -- Hypothetical game board after playing the move p
    hypoBoard p = getBoard (playMove (Game b H) p)

    {- 
      Awards "Quality Points" based on the amount of fields that are blocked for the opponent after placing a stone on (r, c).
      - Only the fields on which the stone is placed and the fields directly above the stone need to be considered 
        as the other fields on the board are not affected by this stone.
      - A field is considered blocked if the opponent could have placed a stone on it but can't anymore after placing a stone on (r, c).
    -}
    countBlocked (r, c) = sum [3 | r2 <- [r, r-1], c2 <- [c, c+1], 
        isValidMove (Game b V) (r2, c2), 
        not (isValidMove (Game (hypoBoard (r,c)) V) (r2, c2))]

    {-
      Awards "Quality Points" based on the amount of fields that are still free for the horizontal player after placing a stone on (r, c)-
      - Only the fields befor and after the placed stone need to be considered 
        as the other fields on the board are not affected by this stone.
      - A field is considered held free if the horizontal player could could still place a stone on it after placing a stone on (r, c).
    -}
    countHeldFree (r, c) = sum [1 | r2 <- [r], c2 <- [c-2, c+2], isValidMove (Game b H) (r2,c2), isValidMove (Game (hypoBoard (r,c)) H) (r2, c2)] 

    {-
      Awards a bonus "Quality Point" as a tie braker, if the row index is even
    -}
    evenRowBonus r
      | r `mod` 2 == 0 = 1
      | otherwise = 0

-- Finds a good move for the vertical player based on a given board
{-
  The strategy for the vertical player is expressed in terms of the strategy for the horizontal player.
  This uses the fact that the board is quadratic (nxn) and that the task for the vertical player
  is just the same as the task for teh horizontal player after transposing the board (due to symmetry)
-}
verticalStrategy :: Board -> Pos
verticalStrategy b = swap (horizontalStrategy (transpose b))
  where 
    swap (r, c) = (c, r)

{-TTEW-}


{-H10.1.7-}
getBoard :: Game -> Board
getBoard (Game b _) = b

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

play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss dim sv sh = helpPlay rss sv sh [] (Game emptyBoard V)
  where
    emptyBoard = replicate dim (replicate dim E)
    helpPlay :: [[Double]] -> Strategy -> Strategy -> [Board] -> Game -> ([Board], Player)
    helpPlay rss sc sn bs g@(Game _ p)
      | not (canMove g) = (reverse bs, otherPlayer p)
      | otherwise = 
        if isValidMove g pos
        then helpPlay (tail rss) sn sc (getBoard (playMove g pos) : bs) (playMove g pos)
        else (reverse bs, otherPlayer p)
        where
          pos = sc (head rss) 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"