module Exercise08 where

import Data.Bits
import Data.List
import Data.Ord
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 = (signum . getCell (y, x)) b /= - p

-- 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 = all (all ((/= - p) . signum)) b && countOrbs p b > 1

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

{- x.2 -}

-- place an orb for the given player in the given cell
putOrb :: Player -> Pos -> Board -> Board
putOrb p (y, x) b = if abs (getCell (y, x) newboard) < length neighb || hasWon p newboard then newboard else foldr1 (.) (map (putOrb p) neighb) (updatePos (\x -> x - length neighb) p (y, x) newboard)
  where
    newboard = updatePos (+ 1) p (y, x) b
    neighb = neighbors (size b) (y, x)

{- x.3 -}

{-WETT-}
-- Your strategy

type Moves = [Pos]

strategy :: Strategy
strategy = undefined

-- 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 Pos
strategyState =
  ( (-1, -1),
    \c ds p b ->
      let safeMoves1 = detectLosing 1 p b
          safeMoves2 = if null safeMoves1 then detectLosing 0 p b else safeMoves1
          moves = if null safeMoves2 then getMoves p b else safeMoves2
          corner = getStartingCorner p b c
       in ((findSomeMove moves corner . findFarest p b moves corner . findSafe p b moves corner . placeOnEdge 2 p b moves corner . placeOnEdge 1 p b moves corner . placeOnEdge 0 p b moves corner . findCorner p b corner . findDefense p b moves . if countOrbs p b + countOrbs (- p) b >= 50 && countOrbs p b + countOrbs (- p) b < 83 && countOrbs p b < 50 then findWinning 2 p b moves else findWinning 1 p b moves) (-1, -1), corner)
  )

--find some move far away from the corner
findSomeMove :: Moves -> Pos -> Pos -> Pos
findSomeMove ms corner pos = if fst pos /= -1 then pos else getFarest corner ms

--tries to find a safe position  away from the starting corner
findSafe :: Player -> Board -> Moves -> Pos -> Pos -> Pos
findSafe p b ms corner pos = if fst pos /= -1 then pos else getFarest corner $ getSafe p b ms

--find the farest spot away from the starting corner
findFarest :: Player -> Board -> Moves -> Pos -> Pos -> Pos
findFarest p b ms corner pos = if fst pos /= -1 then pos else getFarest corner $ filter (isNotFull b) ms

--tries to find a safe spot from the outer to the inner ring of the board, which is closest to the horizontal edge of the starting corner
placeOnEdge :: Int -> Player -> Board -> Moves -> Pos -> Pos -> Pos
placeOnEdge n p b ms (d, c) pos = if fst pos /= -1 then pos else getClosestEdge (d, c) $ filter (\(y, x) -> isNotFull b (y, x) && onEdge n (size b) (y, x)) (getSafe p b ms)

--tries to place in a corner
findCorner :: Player -> Board -> Pos -> Pos -> Pos
findCorner p b corner pos = if fst pos /= -1 then pos else getClosest corner $ filter (\(y, x) -> getCell (y, x) b == 0) (getSafe p b [(0, 0), (h -1, 0), (0, w -1), (h -1, w -1)])
  where
    h = height b
    w = width b

--tries to find the best defense using a minmax algorithm for the next two moves
findDefense :: Player -> Board -> Moves -> Pos -> Pos
findDefense p b ms pos = if fst pos /= -1 || (fst . fst) defense == maximumBy (comparing id) (map (\move -> countOrbs (- p) (putOrb (- p) move b)) (getMoves (- p) b)) then pos else snd defense
  where
    defense = minimumBy (comparing (fst . fst)) (map (\(y, x) -> (maximizer (putOrb p (y, x) b), (y, x))) ms)
    maximizer =maximumBy (comparing fst) . map (\(board, move) -> (countOrbs (- p) board, move)) . (\board -> map (\(d, c) -> (putOrb (- p) (d, c) board, (d, c))) (getMoves (- p) board))

--tries to find a winning move within n+1 turns
findWinning :: Int -> Player -> Board -> Moves -> Pos -> Pos
findWinning 0 p b ms pos = if fst pos /= -1 then pos else head $ dropWhile (\(y, x) -> (not . hasWon p) (putOrb p (y, x) b)) ms ++ [(-1, -1)]
findWinning n p b ms pos = if fst pos /= -1 then pos else head $ dropWhile (\(y, x) -> let board = putOrb p (y, x) b in (not . hasWon p) board && (not . all (\(d, c) -> let newBoard = putOrb (- p) (d, c) board in (not . hasWon (- p)) newBoard && findWinning (n -1) p newBoard (getMoves p newBoard) pos /= (-1, -1))) (getMoves (- p) board)) ms ++ [(-1, -1)]

--tries to find a losing move within n+1 turns
detectLosing :: Int -> Player -> Board -> Moves
detectLosing n p b = filter (\(y, x) -> let board = putOrb p (y, x) b in not $ any (\(d, c) -> let newBoard = putOrb (- p) (d, c) board in hasWon (- p) newBoard || countOrbs p newBoard <= 1 || (n /= 0 && null (detectLosing (n -1) p newBoard))) (getMoves (- p) board)) (getMoves p b)

--determines if the move is on the specified ring of the board
onEdge :: Int -> Size -> Pos -> Bool
onEdge n (h, w) (y, x) = y == n || x == n || y == h -1 - n || x == w -1 - n

--find a move that seems safe with no neighboring cell that are controlled by the oponent and are fuller than the cell itself
getSafe :: Player -> Board -> Moves -> Moves
getSafe p b = filter (\(y, x) -> all (\(d, c) -> let cell = getCell (d, c) b in signum cell /= - p || length (neighbors (size b) (d, c)) - abs cell >= length (neighbors (size b) (y, x)) - abs (getCell (y, x) b) || any (\(f, e) -> let neighbor = getCell (f, e) b in signum neighbor /= - p && length (neighbors (size b) (d, c)) - abs cell > length (neighbors (size b) (f, e)) - abs (getCell (f, e) b)) (neighbors (size b) (d, c))) (neighbors (size b) (y, x)))

--get all possible moves on the given board for the player
getMoves :: Player -> Board -> Moves
getMoves p b = [(y, x) | y <- [0 .. height b -1], x <- [0 .. width b -1], canPlaceOrb p (y, x) b]

--gets a starting corner as far away as possible from the starting move of the oponent
getStartingCorner :: Player -> Board -> Pos -> Pos
getStartingCorner p b pos
  | total > 2 = pos
  | total == 0 = (0, width b -1)
  | otherwise = maximumBy (comparing (\(y, x) -> abs (fst oponent - y) + abs (snd oponent - x))) [(0, 0), (0, width b -1), (height b -1, 0), (height b -1, width b -1)]
  where
    oponent = head $ filter (\(y, x) -> getCell (y, x) b /= 0) (getMoves (- p) b)
    total = countOrbs p b + countOrbs (- p) b

--determines if the given cell is already filled
isNotFull :: Board -> Pos -> Bool
isNotFull b (y, x) = abs (getCell (y, x) b) < length (neighbors (size b) (y, x)) -1

--get closest position to the horizontal edge of the starting corner
getClosestEdge :: Pos -> Moves -> Pos
getClosestEdge _ [] = (-1, -1)
getClosestEdge corner ms = (if fst corner == 0 then minimumBy else maximumBy) (comparing fst) ms

--get closest position to the starting corner
getClosest :: Pos -> Moves -> Pos
getClosest _ [] = (-1, -1)
getClosest corner ms = minimumBy (comparing (\(y, x) -> abs (fst corner - y) + abs (snd corner - x))) ms

--get farest position from the starting corner
getFarest :: Pos -> Moves -> Pos
getFarest _ [] = (-1, -1)
getFarest corner ms = maximumBy (comparing (\(y, x) -> abs (fst corner - y) + abs (snd corner - x))) ms

--count all orbs of the player
countOrbs :: Player -> Board -> Int
countOrbs p b = (abs . sum) $ filter ((p ==) . signum) (concat b)

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