module Exercise08 where

import Data.Bits
import Data.List
import System.Random (mkStdGen, randoms, randomIO, Random)
import Data.Maybe ( fromJust )

-- Player is either 1 or -1
type Player = Int

-- A field is just an Int value where the absolute gives the number of pieces on the field
-- and the sign corresponds to the player
-- e.g. -3 would mean there are three blobs in this field of player -1
type Field = Int

type Row = [Field]
type Column = [Field]
-- boards are rectangles represented as a list of rows
type Board = [Row]

-- A position on the board is represented as (row, column)
-- (0,0) is the top left corner, coordinate values increase towards the bottom right
type Pos = (Int, Int)

-- A size represented as (height,width)
type Size = (Int, Int)

-- A strategy takes the player who's move it is, optionally takes a list of double values
-- to allow for probabilistic strategies, takes the current board and gives back the position
-- of the move the player should do
type Strategy = [Double] -> Player -> Board -> Pos
-- A stateful strategy can additionally pass some object between invocations
type StatefulStrategyFunc a = a -> [Double] -> Player -> Board -> (Pos, a)
-- first value is the state object to pass to the first invocation of each game
type StatefulStrategy a = (a, StatefulStrategyFunc a)

defaultSize :: (Int, Int)
defaultSize = (9,6)

-- Some useful helper functions
row :: Board -> Int -> Row
row = (!!)

column :: Board -> Int -> Column
column = row . transpose

width :: Board -> Int
width (x : _) = length x
width _       = 0

height :: Board -> Int
height = length

size :: Board -> Size
size b = (height b, width b)

getCell :: Pos -> Board -> Field
getCell (y, x) b = b !! y !! x

-- pretty print a single cell
showCell :: Field -> String
showCell c = "- +" !! succ (signum c) : show (abs c)

-- pretty print the given board
showBoard :: Board -> String
showBoard = unlines . map (unwords . map showCell)

-- print a board to the console
printBoard :: Board -> IO ()
printBoard = putStr . showBoard

-- check if a position is one a board of the given size
isValidPos :: Size -> Pos -> Bool
isValidPos (r, c) (y, x) = y >= 0 && y < r && x >= 0 && x < c

{- x.1 -}
b :: Board
b = [[1,2,3],[4,5,6],[7,8,9]]

getBoardSize :: Board -> Size
getBoardSize b = (length b, length $ head b)

-- Check if the given player can put an orb on the given position
canPlaceOrb :: Player -> Pos -> Board -> Bool
canPlaceOrb p (y, x) b = (row b y !! x) * p >= 0

-- Check if the given player has won the game,
-- you can assume that the opponent has made at least one move before
hasWon :: Player -> Board -> Bool
hasWon p = not . any (if p == 1 then (< 0) else (> 0)) . concat

-- the list of neighbors of a cell
neighbors :: Size -> Pos -> [Pos]
neighbors (r, c) (y, x) = filter (\(y, x) -> y < r && x < c && y >= 0 && x >= 0)
      [(y-1,x),(y,x-1),(y,x+1),(y+1,x)]

-- update a single position on the board
-- f: function that modifies the number of orbs in the cell
-- p: player to whom the updated cell should belong
updatePos :: (Int -> Int) -> Player -> Pos -> Board -> Board
updatePos f p (y, x) b = setValue b (y,x) (p * f (abs (getCell (y, x) b)))

setValue :: Board -> Pos -> Int -> Board
setValue b (y, x) v = fh ++ [newRow] ++ tail sh
    where {
      (fh, sh) = splitAt y b;
      (rfh, rsh) = splitAt x (head sh);
      newRow = rfh ++ [v] ++ tail rsh
    }

{- x.2 -}

emptyBoard :: Size -> Board
emptyBoard (h,w) = [[0 | x <- [1..w]] | h <- [1..h]]

-- place an orb for the given player in the given cell
putOrb :: Player -> Pos -> Board -> Board
putOrb p (y, x) b = overflow (updatePos (+1) p (y, x) b) [(y, x)]

-- uncurry (*) (getBoardSize b)

ofb :: Board
ofb = [[1,2,-1],[2,0,0],[0,-1,1]]

overflow :: Board -> [Pos] -> Board
overflow b [] = b
overflow b ((y, x) : ps)
    | hasWon p b = b
    | newAbsValue >= 0 = let newBoard = attackNeighbors b thisNeighbors p 
      in overflow (setValue newBoard (y, x) (p * newAbsValue)) (ps ++ thisNeighbors)
    | otherwise = overflow b ps
  where {
    thisValue = getCell (y, x) b;
    thisNeighbors = neighbors (getBoardSize b) (y, x);
    p = signum thisValue;
    newAbsValue = abs thisValue - length thisNeighbors;
  }

attackNeighbors :: Board -> [Pos] -> Player -> Board
attackNeighbors b [] _ = b
attackNeighbors b ((y, x) : ps) p = attackNeighbors (updatePos (+1) p (y, x) b) ps p

{- x.3 -}

{-WETT-}
-- Your strategy
inf :: Int
inf = 20000000

strategy :: Strategy
strategy _ p b = fromJust $ snd (minmax b 4 p (-inf) inf)

-- board, startPos, 
minmax :: Board -> Int -> Player -> Int -> Int -> (Int, Maybe Pos)
minmax b depth p alpha beta
  | depth == 0 = (boardState b, Nothing)
  | otherwise = getBestMove b depth (generatePossibleMoves b p) p alpha beta

getBestMove :: Board -> Int -> [Pos] -> Player -> Int -> Int -> (Int, Maybe Pos)
getBestMove b _ [] p _ _ = (- p * inf , Nothing)
getBestMove b depth ((y, x) : psblMvs) p alpha beta
  | beta <= alpha = (fst thisMove, Just (y, x))
  | fst thisMove > fst othersBestMove =
    if p == 1 then (fst thisMove, Just (y, x))
    else othersBestMove
  | otherwise = 
    if p == 1 then othersBestMove
    else (fst thisMove, Just (y, x))
  where {
    thisMove = minmax (putOrb p (y, x) b) (depth - 1) (-p) alpha beta;
    newAlpha = if p == 1 then max alpha $ fst thisMove else alpha;
    newBeta = if p == -1 then min beta $ fst thisMove else beta;
    othersBestMove = getBestMove b depth psblMvs p newAlpha newBeta;
  }

generatePossibleMoves :: Board -> Player -> [Pos]
-- TODO: Pruning the search
generatePossibleMoves b p = filter (isGoodMove b p) [(y, x) | y <- [0..height-1], x <- [0..width-1]]
  where {
    size = getBoardSize b;
    width = snd size;
    height = fst size;
  }

isGoodMove :: Board -> Player -> Pos -> Bool
isGoodMove b p (y, x) = thisValue * p >= 0 &&
  not (any (\nbr -> length thisNbrs - abs thisValue > length (neighbors (getBoardSize b) nbr) - getCell nbr b) thisNbrs)
  where {
    thisValue = getCell (y, x) b;
    thisNbrs = neighbors (getBoardSize b) (y, x)
  }

boardState :: Board -> Int
boardState b = sum (concat b)

-- adds state to a strategy that doesn't use it
wrapStrategy :: Strategy -> StatefulStrategy Int
wrapStrategy strat = (0, \s r p b -> (strat r p b, succ s))

-- the actual strategy submissions
-- if you want to use state modify this instead of strategy
-- additionally you may change the Int in this type declaration to any type that is usefully for your strategy
strategyState :: StatefulStrategy Int
strategyState = wrapStrategy strategy
{-TTEW-}

-- Simulate a game between two strategies on a board of the given size and
-- returns the state of the board before each move together with the player that won the game
play :: [Int] -> Size -> StatefulStrategy a -> StatefulStrategy b -> [(Board, Pos)]
play rss (r, c) (isa, sa) (isb, sb) = go rss isa sa isb sb 1 0 (replicate r (replicate c 0))
  where
    -- type signature is necessary, inferred type is wrong!
    go :: [Int] -> a -> StatefulStrategyFunc a -> b -> StatefulStrategyFunc b -> Player -> Int -> Board -> [(Board, Pos)]
    go (rs:rss) stc sc stn sn p n b
      | won       = []
      | valid     = (b, m) : go rss stn sn st' sc (-p) (succ n) (putOrb p m b)
      | otherwise = []
      where
        won      = n > 1 && hasWon (-p) b
        (m, st') = sc stc (mkRandoms rs) p b
        valid    = isValidPos (size b) m && canPlaceOrb p m b

-- Play a game and print it to the console
playAndPrint :: Size -> StatefulStrategy a -> StatefulStrategy b -> IO ()
playAndPrint size sa sb = do
  seed <- randomIO
  -- let seed = 42
  let moves = play (mkRandoms seed) size sa sb
  putStr $
    unlines (zipWith showState moves $ cycle ['+', '-']) ++ "\n" ++
    (case length moves `mod` 2 of { 1 -> "Winner: +"; 0 -> "Winner: -" }) ++ "\n" ++
    "View at https://vmnipkow16.in.tum.de/christmas2020/embed.html#i" ++ base64 (1 : t size ++ concatMap (t . snd) moves) ++ "\n"
  where
    showState (b, pos) p = showBoard b ++ p : " places at " ++ show pos ++ "\n"
    t (a, b) = [a, b]

mkRandoms :: Random a => Int -> [a]
mkRandoms = randoms . mkStdGen

base64 :: [Int] -> String
base64 xs = case xs of
  []            -> ""
  [a]           -> f1 a : f2 a 0 : "=="
  [a, b]        -> f1 a : f2 a b : f3 b 0 : "="
  a : b : c : d -> f1 a : f2 a b : f3 b c : f4 c : base64 d
  where
    alphabet = (!!) "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    f1 a     = alphabet $ shiftR a 2
    f2 a b   = alphabet $ shiftL (a .&. 3 ) 4 .|. shiftR b 4
    f3 b c   = alphabet $ shiftL (b .&. 15) 2 .|. shiftR c 6
    f4 c     = alphabet $ c .&. 63