module Exercise_10 where
import Data.List
import Data.Ord
--import Debug.Trace
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 ++ "\n" ++ prettyShowBoard rs where
  prettyShowRow [] = ""
  prettyShowRow (e:es) = prettyShowEl e ++ prettyShowRow es
  prettyShowEl (P p) = show p
  prettyShowEl 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 [] p) (r,c) = False
isValidMove (Game board p) (r,c)
  | r < 0 || c < 0 = False
  | r > length(board) = False
  | length(board) > 0 && c > length(board !! 0) = False
  | otherwise = validCheck (Game board p) (r,c) where
    validCheck (Game board H) (r,c)
      | r >= length(board) || length (board !! r) <= c + 1 = False
      | otherwise = (board !! r) !! c == E && (board !! r) !! (c + 1) == E 
    validCheck (Game board V) (r,c)
      | length board <= r + 1 || c >= length (board !! r) = False
      | otherwise = (board !! r) !! c == E && (board !! (r + 1)) !! c == E 

{-H10.1.3-}
canMove :: Game -> Bool
canMove (Game [] p) = False
canMove game = length (getValidMoves game) > 0

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard board (r, c) field = [if rIndex /= r then row else updateRow row c | (row, rIndex) <- zip board [0..]] where
  updateRow row c = [if cIndex /= c then column else field | (column, cIndex) <- zip row [0..]]

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game board H) (r, c) = Game updatedBoard V where
  updatedBoard = updateBoard (updateBoard board (r, c+1) (P H)) (r, c) (P H)
playMove (Game board V) (r, c) = Game updatedBoard H where
  updatedBoard = updateBoard (updateBoard board (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-}
otherPlayer :: Player -> Player
otherPlayer H = V
otherPlayer V = H

-- complex? maybe, but seems faster that [(a,b) | a <- [0..length board], b <- [0..length board], isValidMove (Game board p) (a,b)]
-- I didn't check that, but ¯\_(ツ)_/¯
getValidMoves :: Game -> [Pos]
--getValidMoves (Game board V) = filter () [zip row [0..] | row <- zip board [0..]]
getValidMoves game@(Game board p) = filter (\move -> isValidMove game move) (getValidMovesAux zippedBoard p) where
  zippedBoard = map (\(row, rowIndex) -> [(field, rowIndex, colIndex) | (field, colIndex) <- row]) [(zip row [0..], rowIndex) | (row, rowIndex) <- zip board [0..]]
  getValidMovesAux :: [[(Field, Int, Int)]] -> Player -> [Pos]
  getValidMovesAux [] p = []
  getValidMovesAux [r] V = []
  getValidMovesAux (r1:r2:rows) V = [getPos (r1 !! index) | index <- (getFree r1) `intersect` (getFree r2)] ++ getValidMovesAux (r2:rows) V
  getValidMovesAux rows H = concat [validMoves row | row <- rows]
  getFree :: [(Field, Int, Int)] -> [Int]
  getFree [] = []
  getFree ((E,a,b):fs) = (b):(getFree fs)
  getFree (f:fs) = getFree fs
  validMoves :: [(Field, Int, Int)] -> [Pos]
  validMoves [] = []
  validMoves [_] = []
  validMoves [(E,a,b),(E,_,_)] = [(a,b)]
  validMoves [(f1,_,_),(f2,_,_)] = [] 
  validMoves ((f1,a,b):(f2,c,d):fs) = if f1 == E && f2 == E then ((a,b):(validMoves ((f2,c,d):fs))) else validMoves ((f2,c,d):fs)
  getPos :: (Field, Int, Int) -> Pos
  getPos (_,a,b) = (a,b)

-- wooops, that got ugly fast :O
createsSafeSpot :: Game -> Pos -> Bool
--createsSafeSpot (Game board p) move | trace ("createsSafeSpot\n" ++ show board ++ " p " ++ show p ++ " " ++ show move) False = undefined
createsSafeSpot game@(Game board H) (r,c)
  | r - 2 > 0 = not (isValidMove game (r-2, c)) && (board !! (r-2) !! c /= E) && (board !! (r-2) !! (c+1) /= E)
  | r + 2 < length board = not (isValidMove game (r+2, c)) && (board !! (r+2) !! c /= E) && (board !! (r+2) !! (c+1) /= E)
  | r == 0 && isValidMove game (r+2, c) = False
  | r == (length board) - 1 && isValidMove game (r-2, c) = False
  | otherwise = False
createsSafeSpot game@(Game board V) (r,c)
  | c == 0 && isValidMove game (r, c+2) = False
  | c == 1 && (board !! r !! 0 == E) && (board !! (r + 1) !! 0 == E) = True
  | c == (length board) - 1 && isValidMove game (r, c-2) = False
  | c == (length board) - 2 && (board !! r !! ((length board) - 1) == E) && (board !! (r + 1) !! ((length board) - 1) == E) = True
  | c - 2 > 0 = not (isValidMove game (r, c-2)) && (board !! r !! (c-2) /= E) && (board !! (r + 1) !! (c-2) /= E)
  | c + 2 < length board = not (isValidMove game (r, c+2)) && (board !! r !! (c+2) /= E) && (board !! (r + 1) !! (c+2) /= E)
  | otherwise = False

getFullRow :: Board -> Int -> Int
getFullRow board r = sum $ map (\field -> if field /= E then 1 else 0) (board !! r)
getFullColumn :: Board -> Int -> Int
getFullColumn board c = getFullRow (transpose board) c

fillScore :: Game -> Pos -> Int
fillScore (Game board V) (r,c) = (getFullRow board r) + (getFullRow board (r+1)) + (getFullColumn board c)
fillScore (Game board H) (r,c) = (getFullRow board r) + (getFullColumn board c) + (getFullColumn board (c+1))

{-
Okay so what's going on here?

The basic idea is:
  if we found a move that lets our opponent lose, choose that.
  if we can create a "safe spot", i.e. a spot that cannot be chosen by our opponent,
    choose that
  otherwise check how many valid moves we and our opponent lose if we choose that
    and try to maximize the opponent's loss.
  also: we try to maximize filled up rows / columns
-}
evaluate :: Game -> Pos -> Integer
evaluate game@(Game board p) move@(r,c) =
  if not $ (canMove (playMove (Game board p) move)) then 100000
  else if createsSafeSpot (Game board p) move then 5 * (reductionScoreOther - reductionScoreSelf) * fScore
  else (reductionScoreOther - reductionScoreSelf) * fScore where
    reductionScoreOther = 10 * (
      toInteger (length (getValidMoves (Game board (otherPlayer p))))
      - toInteger (length (getValidMoves (playMove (Game board p) move))))
    reductionScoreSelf = 10 * (
      toInteger (length (getValidMoves (Game board p)))
      - toInteger (length (getValidMoves (Game updatedBoard p))))
    (Game updatedBoard _) = playMove (Game board p) move
    fScore = toInteger $ ((fillScore (Game updatedBoard p) move) - (fillScore game move))

{-
naming is legacy. not actually a real minimax any more...

We first get all valid moves and then choose the first "best one" as specified by our fancy evaluate function.
That's it.

¯\_(ツ)_/¯
-}
minimax :: Game -> (Pos, Integer)
--minimax game@(Game board p) | trace (show board ++ "\nplayer " ++ show p ++ " game:\n" ++ prettyShowBoard board ++ " canMove: " ++ show (canMove game)) False = undefined
minimax game@(Game board p) = head bestMoves where
    validMoves = getValidMoves (Game board p)
    --moves = trace (show board ++ "\nboard: \n" ++ prettyShowBoard board ++ "player " ++ show p ++ " show moves: " ++ show [(move, evaluate game move) | move <- validMoves]) [(move, evaluate game move) | move <- validMoves]
    moves = [(move, evaluate game move) | move <- validMoves]
    bestMoves = last $ groupBy (\a -> \b -> (snd a) == (snd b)) $ sortBy (comparing snd) moves

christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI _ game = fst (minimax game)

-- our test opponent is very lazy..
badAI :: Strategy
badAI _ game = head $ getValidMoves game
{-TTEW-}

{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board], Player)
play rss dim sv sh = (games, winner games) where
  games = unfoldr playAux (rss, initialGame)
  winner :: [Board] -> Player
  winner [] = H
  winner boards | odd $ length boards = V
                | even $ length boards = H
  row = take dim (repeat E)
  board = take dim (repeat row)
  initialGame = (Game board V)
  playAux :: ([[Double]], Game) -> Maybe (Board, ([[Double]], Game))
  playAux (rss, game)
    | not (canMove game) = Nothing
    | not (isValidMove game pos) = Nothing
    | otherwise = Just (updatedBoard, (drop 1 rss, (Game updatedBoard newPlayer))) where
      (Game currentBoard currentPlayer) = game
      strategy = if currentPlayer == V then sv else sh
      pos = strategy (head rss) (Game currentBoard currentPlayer)
      (Game updatedBoard newPlayer) = playMove (Game currentBoard currentPlayer) pos

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