module Exercise08 where

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

-- 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
  | p == 1 = getCell (y, x) b >= 0
  | otherwise = getCell (y, x) b <= 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 = isNothing $ hasWonHelper p b

hasWonHelper :: Player -> Board -> Maybe Int
hasWonHelper p b =
  let step l index = case l of
            [] -> Nothing
            (x:xs) ->
                if p == 1 && x < 0 || p == -1 && x > 0
                    then Just index
                    else step xs (index + 1)
    in step list 0
    where list = concat b

-- the list of neighbors of a cell
neighbors :: Size -> Pos -> [Pos] -- coulnt write it uglier
neighbors (r, c) (y, x) = (if y == 0 then [] else [(y-1,x)]) ++ (if x == 0 then [] else [(y,x-1)]) ++ (if y == r-1 then [] else [(y+1,x)]) ++ (if x == c-1 then [] else [(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) z ++ p * (f (abs (z !! x))) : drop (x+1) z) : (drop (y+1) b)
  where z = b !! y

{- x.2 -}

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

putOrbHelper :: Player -> [Pos] -> Board -> Board
putOrbHelper p xs b
  | hasWon p (updateAllNb p (fst nextIteration) (snd nextIteration)) = updateAllNb p (fst nextIteration) (snd nextIteration)
  | null $ fst nextIteration = snd nextIteration
  | otherwise = putOrbHelper p (fst nextIteration) (snd nextIteration)
  where nextIteration = putOrbNb p xs [] b

putOrbNb :: Player -> [Pos] -> [Pos] -> Board -> ([Pos],Board) -- get list of neighbors with get a Orb -> output list of neighbors of neighbors which should also get an orb
putOrbNb p [] ys b = (ys, b)
putOrbNb p [(y, x)] ys b
  | abs(getCell (y, x) b) + 1 < length nb = (ys, (updatePos (+1) p (y, x) b))
  | otherwise = ((ys ++ nb), (updatePos (\x-> x - length nb + 1) p (y, x) b))
  where nb = neighbors (size b) (y ,x)
putOrbNb p ((y, x):xs) ys b
  | abs(getCell (y, x) b) + 1 < length nb = putOrbNb p xs ys (updatePos (+1) p (y, x) b)
  | otherwise = putOrbNb p xs (ys ++ nb) (updatePos (\x-> x - length nb + 1) p (y, x) b)
  where nb = neighbors (size b) (y ,x)

updateAllNb :: Player -> [Pos] -> Board -> Board
updateAllNb p [] b = b
updateAllNb p [yx] b = updatePos (+1) p yx b
updateAllNb p (x:xs) b = updateAllNb p xs (updatePos (+1) p x b)

{- x.3 -}

{-WETT-}
-- Your strategy
 -- [Double] -> Player -> Board -> Pos
strategy :: Strategy
strategy values p b = minimaxCaller p b 3

minimaxCaller :: Player -> Board -> Int -> Pos
minimaxCaller p b depth
  | p == 1 = fst (foldr (\move y -> if snd (minimax move (putOrb p move b) (depth - 1) (-1)) > snd y 
                                    then (move, snd (minimax move (putOrb p move b) (depth - 1) (-1))) 
                                    else y) (head moves, -1000000000) moves)
  | otherwise = fst (foldr (\move y -> if snd (minimax move (putOrb p move b) (depth - 1) (1)) < snd y 
                                        then (move, snd (minimax move (putOrb p move b) (depth - 1) (1))) 
                                        else y) (head moves, 1000000000) moves)
  where moves = possibleMoves p b

minimax :: Pos -> Board -> Int -> Player -> (Pos, Int)
minimax (y, x) b 0 p = ((y,x) ,staticEvaluation b)
minimax (y, x) b depth p
  | hasWon 1 b || hasWon (-1) b = ((y,x) ,staticEvaluation b)
  | p == 1 = foldr (\move y -> if snd (minimax move (putOrb p move b) (depth - 1) (-1)) > snd y 
                                then (move, snd (minimax move (putOrb p move b) (depth - 1) (-1))) 
                                else y) 
                                (head moves, -1000000000) moves
  | otherwise = foldr (\move y -> if snd (minimax move (putOrb p move b) (depth - 1) 1) < snd y 
                                then (move, snd (minimax move (putOrb p move b) (depth - 1) 1)) 
                                else y) 
                                (head moves, 1000000000) moves
  where moves = possibleMoves p b

possibleMoves :: Player -> Board -> [Pos]
possibleMoves p b = [(y, x) | y <- [0..height b - 1], x <- [0..width b - 1], canPlaceOrb p (y, x) b]

-- evaluation

staticEvaluation :: Board -> Int
staticEvaluation b
  | hasWon 1 b = 1000000000
  | hasWon (-1) b = -1000000000
  | otherwise = numberOfOrbs b + borders b + getCorners b

numberOfOrbs :: Board -> Int
numberOfOrbs b = foldr (\x y -> if (abs x > 0) then x+y else y) 0 (concat b)

borders :: Board -> Int
borders b = foldr (\x y -> if (x==0&&y==0||x==0&&y==(height b - 1)||x==(width b - 1)&&y==0||x==(width b - 1)&&y==(height b - 1)) 
                            then if (abs x > 0) then (4 * x)+y else y
                            else if (abs x > 0) then x+y else y
                            ) 0 xs
  where xs = [getCell (y, x) b | y <- [0..height b - 1], x <- [0..width b - 1], y == 0 || x == 0 || y == height b - 1 || x == width b - 1]

getCorners :: Board -> Int
getCorners b = getCell (0,0) b + getCell (0,width b - 1) b + getCell (height b - 1,0) b + getCell(height b - 1,width b - 1) b

-- end evaluation

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