module Exercise08 where

import Data.Bits (Bits (shiftL, shiftR, (.&.), (.|.)))
import Data.Function (on)
import Data.List
import Data.Maybe (fromJust, isJust)
import Data.Ord (comparing)
--import Debug.Trace (trace)
import System.Random (Random, mkStdGen, randomIO, randoms)

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

-- Check if the given player can put an orb on the given position
canPlaceOrb :: Player -> Pos -> Board -> Bool
canPlaceOrb p (y, x) b = isValidPos (size b) (y, x) && (getCell (y, x) b * 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 b = not (any (\x -> signum x == (- p)) (concat b)) && any (\x -> signum x == p) (concat b)

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

-- 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 = take y b ++ (take x r ++ (p * f (abs (getCell (y, x) b))) : drop (x + 1) r) : drop (y + 1) b
  where
    r = row b y

{- x.2 -}

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

updateField :: Player -> [Pos] -> Board -> Board
updateField p [] b = b
updateField p (x : xs) b
  | hasWon p b && any (any (/= 0)) b = b
  | length n == abs (getCell x b) + 1 = updateField p (xs ++ n) (updatePos (* 0) p x b)
  | otherwise = updateField p xs (updatePos (1 +) p x b)
  where
    n = neighbors (size b) x

{- x.3 -}

{-WETT-}

-- MinMaxTree Version Two:
strategy :: Strategy
strategy d p b = {-trace ("Player: " ++ show p ++ ": " ++ show pos)-} snd pos
  where
    pos = maximizer (-1000000) 1000000 3 b b p

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

neighborsAmount :: Board
neighborsAmount = [[2, 3, 3, 3, 3, 2], [3, 4, 4, 4, 4, 3], [3, 4, 4, 4, 4, 3], [3, 4, 4, 4, 4, 3], [3, 4, 4, 4, 4, 3], [3, 4, 4, 4, 4, 3], [3, 4, 4, 4, 4, 3], [3, 4, 4, 4, 4, 3], [2, 3, 3, 3, 3, 2]]

valueBoard :: Board
valueBoard = [[3, 2, 2, 2, 2, 3], [2, 1, 1, 1, 1, 2], [2, 1, 1, 1, 1, 2], [2, 1, 1, 1, 1, 2], [2, 1, 1, 1, 1, 2], [2, 1, 1, 1, 1, 2], [2, 1, 1, 1, 1, 2], [2, 1, 1, 1, 1, 2], [3, 2, 2, 2, 2, 3]]

-- Evaluate if the game is won or lost
heuristicGameState :: Board -> Player -> Int
heuristicGameState b p
  | hasWon p b = 10000
  | hasWon (- p) b = -10000
  | otherwise = 0

-- Penalty for enemy stacking points
penaltyStackPoints :: Board -> [Int] -> Int
penaltyStackPoints b p' = - sum ([v * v | v <- p'])

-- Penalty for other players fields
panaltyAmountOfFields :: Board -> [Int] -> Int
panaltyAmountOfFields b = length

-- Bonus for amount of owned fields
bonusAmountOfFields :: Board -> [Int] -> Int
bonusAmountOfFields b = length

-- Bonus amount of fields wich can overflow
bonusAmountOfActiveFields :: Board -> Player -> Int
bonusAmountOfActiveFields b p = sum [1 | y <- [0 .. fst s - 1], x <- [0 .. snd s -1], c <- [getCell (y, x) b * p], c > 0, c + 1 == getCell (y, x) neighborsAmount]
  where
    s = size b

-- Amount of orbs
sumPlayers :: Board -> [Int] -> [Int] -> Int
sumPlayers b p p' = sum p - sum p'

-- calculateField
calculateField :: Board -> Player -> Int
calculateField b p = sum [c * c + getCell (y, x) valueBoard | y <- [0 .. fst s - 1], x <- [0 .. snd s -1], c <- [getCell (y, x) b * p], c > 0]
  where
    s = size b

heuristicSum :: Board -> Player -> Int
heuristicSum b p = sumPlayers b amountP amountP' + heuristicGameState b p + calculateField b p - panaltyAmountOfFields b amountP'
  where
    amountP = map abs (filter (\x -> x * p > 0) (concat b))
    amountP' = map abs (filter (\x -> x * (- p) > 0) (concat b))

-- Maximize gameboard value
maximizer :: Int -> Int -> Int -> Board -> Board -> Player -> (Int, Pos)
maximizer a b 0 bOld bNew p = {- trace ("Max | Board: " ++ show board ++ " Pos: " ++ show pos ++ " Value: " ++ show (evaluateBoard board p, pos)) -} (heuristicSum bNew p, (-1, -1))
maximizer a b d bOld bNew p
  | hasWon p bNew && sumOld >= 2 = (10000, (-1, -1))
  | otherwise = maximizerHelper a b d bNew p posses
  where
    posses = preferredPlaces p bNew
    sumOld = sum (map abs (concat bOld))

maximizerHelper :: Int -> Int -> Int -> Board -> Player -> [Pos] -> (Int, Pos)
maximizerHelper _ _ _ _ _ [] = (-1000000, (-5, -5))
maximizerHelper a b d board player (p : pos)
  | fst a' >= b = (fst a', p)
  | fst a' > a = maximum [(fst a', p), maximizerHelper (fst a') b d board player pos]
  | otherwise = maximizerHelper a b d board player pos
  where
    a' = {-trace ("d: " ++ show (d -1) ++ " MinTree: a:" ++ show a ++ " b:" ++ show b ++ " Board:" ++ show board ++ " Pos:" ++ show p ++ " Player:" ++ show player)-} minimizer a b (d - 1) board (putOrb player p board) player

-- Minimize gameboard value
minimizer :: Int -> Int -> Int -> Board -> Board -> Player -> (Int, Pos)
minimizer a b 0 bOld bNew p = {- trace ("Max | Board: " ++ show board ++ " Pos: " ++ show pos ++ " Value: " ++ show (evaluateBoard board p, pos)) -} (heuristicSum bNew p, (-1, -1))
minimizer a b d bOld bNew p
  | hasWon (- p) bNew && sumOld >= 2 = (-10000, (-1, -1))
  | otherwise = minimizerHelper a b d bNew p posses
  where
    posses = possiblePlaces (- p) bNew
    sumOld = sum (map abs (concat bOld))

minimizerHelper :: Int -> Int -> Int -> Board -> Player -> [Pos] -> (Int, Pos)
minimizerHelper _ _ _ _ _ [] = (1000000, (-5, -5))
minimizerHelper a b d board player (p : pos)
  | fst b' <= a = (fst b', p)
  | fst b' < b = minimum [(fst b', p), minimizerHelper a (fst b') d board player pos]
  | otherwise = minimizerHelper a (fst b') d board player pos
  where
    b' = {-trace ("d: " ++ show (d -1) ++ " MaxTree: a:" ++ show a ++ " b:" ++ show b ++ " Board:" ++ show board ++ " Pos:" ++ show p ++ " Player:" ++ show (- player))-} maximizer a b (d -1) board (putOrb (- player) p board) player

-- Possible Places
possiblePlaces :: Player -> Board -> [Pos]
possiblePlaces p b = [(y, x) | y <- [0 .. fst s - 1], x <- [0 .. snd s - 1], canPlaceOrb p (y, x) b]
  where
    s = size b

preferredPlaces :: Player -> Board -> [Pos]
preferredPlaces player board = places
  where
    allCells = possiblePlaces player board
    posPlayer = filter (\x -> canPlaceOrb player x board) allCells
    posPlayerNotEmpty = filter (\x -> getCell x board /= 0) posPlayer
    posPlayer' = filter (\x -> canPlaceOrb (- player) x board) allCells
    criticalPlaces = [p | p <- posPlayer', getCell p board * (- player) + 1 == getCell p neighborsAmount]
    s = size board
    places = nub ((posPlayer \\ criticalPlaces) ++ posPlayerNotEmpty)

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