module Exercise08 where

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

-- 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 * 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 = (and (map (and) (map (map (\x -> x * p >= 0)) b)))

-- the list of neighbors of a cell

neighbors :: Size -> Pos -> [Pos]
neighbors (r, c) (y, x) = (if (isValidPos (r,c) (y-1,x)) then [((y-1),x)] else []) ++ (if (isValidPos (r,c) (y+1,x)) then [((y+1),x)] else []) ++ (if (isValidPos (r,c) (y,x-1)) then [(y,(x-1))] else []) ++ (if (isValidPos (r,c) (y,x+1)) then [(y,x+1)] else [])
        
neighbors2 :: Size -> Pos -> [Pos]
neighbors2 (r, c) (y, x) = (if (isValidPos (r,c) (y-2,x)) then [((y-2),x)] else []) ++ (if (isValidPos (r,c) (y+2,x)) then [((y+2),x)] else []) ++ (if (isValidPos (r,c) (y,x-2)) then [(y,(x-2))] else []) ++ (if (isValidPos (r,c) (y,x+2)) then [(y,x+2)] else [])

-- 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) ++ [(f (abs (getCell (y, x) b))) * p ] ++ drop (x+1) (b!!y))]  ++ drop (y+1) b

{- x.2 -}

-- place an orb for the given player in the given cell
putOrb :: Player -> Pos -> Board -> Board
putOrb p (y, x) b
    | hasWon p b && not(hasWon (p * (-1)) b) = b
    | (length (neighbors (size b) (y,x))) - 1 == (abs (getCell (y,x) b)) = putOrbHelper p (neighbors (size b) (y,x)) (updatePos (\x -> 0) p (y, x) b) 
    | otherwise = updatePos (\x -> x + 1) p (y, x) b 

putOrbHelper :: Player -> [Pos] -> Board -> Board
putOrbHelper p (pos:ps) b = putOrbHelper p ps (putOrb p pos b)
putOrbHelper p [] b = b 

{- x.3 -}

cornered :: Board -> Player -> Pos -> Pos
cornered b p (x,y)
    | x == (height b) = cornered b p (0,y+1)
    | y == (width b) = (-1,-1)
    | (getCell (x,y) b) * p > 0 = if (length (neighbors s (x,y)) - abs (getCell (x,y) b) ) == minimum (5:( map (\z -> length (neighbors s z) - (abs (getCell z b))) (filter (\n -> (signum (getCell n b)) == (-p) ) (neighbors s (x,y)))) ) then (x,y) else cornered b p (x+1,y) --  (map (\z -> (  (length (neighbors s z) - (getCell z b) * (-p)) )) (neighbors s (x,y)) ) then (x,y) else cornered b p (x+1,y)
    | otherwise = cornered b p (x+1,y)

      where 
          s = size b

{-WETT-}
-- Your strategy
strategy :: Strategy
strategy = (\l p b ->  winningMove l b p (0,0))

winningMove :: [Double] -> Board -> Player -> Pos -> Pos
winningMove l b p (x,y)
    | x == (height b) = winningMove l b p (0,y+1)
    | y == (width b) = counter l p b
    | (( (length (neighbors s (x,y))) - abs ( getCell (x,y) b) ) == 1) && (getCell (x,y) b) * p > 1 = if (hasWon p (putOrb p (x,y) b)) then (x,y) else winningMove l b p (x+1,y)
    | otherwise = winningMove l b p (x+1,y)

      where 
          s = size b

corneredAll :: Board -> Player -> Pos -> Int -> Pos -> Pos
corneredAll b p (x,y) m pos
    | x == (height b) = corneredAll b p (0,y+1) m pos
    | y == (width b) = pos
    | (length (neighbors s (x,y)) - abs (getCell (x,y) b) ) >= m = corneredAll b p (x+1,y) m pos
    | (getCell (x,y) b) * p > 0 = if (length (neighbors s (x,y)) - abs (getCell (x,y) b) ) == minimum (10:( map (\z -> length (neighbors s z) - (abs (getCell z b))) (filter (\n -> ((getCell n b)) * (-p) >= 0  ) (neighbors s (x,y)))) ) then corneredAll b p (x+1,y) (length (neighbors s (x,y)) - abs (getCell (x,y) b) ) (x,y) else corneredAll b p (x+1,y) m pos --  (map (\z -> (  (length (neighbors s z) - (getCell z b) * (-p)) )) (neighbors s (x,y)) ) then (x,y) else corneredAll b p (x+1,y)
    | otherwise = corneredAll b p (x+1,y) m pos

      where 
          s = size b

exploMiddle :: [Double] -> Player -> Board -> Pos
exploMiddle (ls) p b 
    | pos == (-1,-1) = attack ls b p (0,0)
    | otherwise = pos

      where   
          pos = explosion ls b p (0,0) ((countOrb b p) + 15) (-1,-1)

explosion :: [Double] -> Board -> Player -> Pos -> Int -> Pos -> Pos
explosion ls b p (x,y) best pos
    | x == (height b) = explosion ls b p (0,y+1) best pos
    | y == (width b) = pos  
    | ((length(neighbors s (x,y)) - (getCell (x,y) b) * p) == 1) = if best < (countOrb (putOrb p (x,y) b) p) then explosion ls b p (x+1,y) (countOrb (putOrb p (x,y) b) p  ) (x,y) else explosion ls b p (x+1,y) best pos
    | otherwise = explosion ls b p (x+1,y)   best pos

      where 
          s = size b

countOrb :: Board -> Player -> Int
countOrb b p = (sum (map (sum) (map (map (\x -> if signum x == p then x else 0)) b)))

attack :: [Double] -> Board -> Player -> Pos -> Pos
attack ls b p (x,y)
    | x == (height b) = attack ls b p (0,y+1)
    | y == (width b) = corner ls p b
    | ((getCell (x,y) b) * (-p) > 0) && ((maximum (map (\x -> (getCell x b) * p) (neighbors2 s (x,y)))) == 0) = attackHelper ls (neighbors2 s (x,y)) b p (x,y)
    | otherwise = attack ls b p (x+1,y)

      where 
          s = size b

attackHelper :: [Double] -> [Pos] -> Board -> Player -> Pos -> Pos
attackHelper ls (pos:ps) b p (x,y)
    | (getCell pos b) == 0 && (0 == minimum(map (\z -> (getCell z b) * (-p)) (neighbors (size b) pos))) = pos
    | otherwise = attackHelper ls ps b p (x,y)
attackHelper ls [] b p (x,y) = attack ls b p (x+1,y)

sColumn :: [Double] -> Board -> Player -> Pos -> Pos
sColumn ls  b p (x,y)
      | (x == (height b)) && (y == (width b -1)) =  sRow ls b p (0,1)
      | (x == (height b)) = sColumn ls b p (1,((width b) -1 ))
      | (getCell (x,y) b == 0) && ( (maximum (map (\z -> abs (getCell z b) ) (neighbors (size b) (x,y))) ) == 0) = (x,y)
      | otherwise = sColumn ls b p (x+1,y)

sRow :: [Double] -> Board -> Player -> Pos -> Pos
sRow ls  b p (x,y)
      | (y == (width b)) && (x == (height b -1)) = random1 ls p b 4
      | (y == (width b)) = sRow ls b p ((height b) -1,1)
      | (getCell (x,y) b == 0) && ( (maximum (map (\z -> abs (getCell z b)) (neighbors (size b) (x,y))) ) == 0) = (x,y)
      | otherwise = sRow ls b p (x,y+1)

toGoal :: Int -> Int -> Int
toGoal num neigh = neigh - num

counter :: [Double] -> Player -> Board -> Pos
counter (ls) p b 
    | pos == (-1,-1)  = exploMiddle ls p b
    | otherwise = pos

      where   
          pos = corneredAll b p (0,0) 5 (-1,-1)

random2 :: [Double] -> Player -> Board -> Pos
random2 (x:y:ls) p b 
    | (((getCell pos b)*p) >= 0) = pos
    | otherwise = random2 ls p b

      where  
          pos = (floor (y * (fromIntegral (height b -1 ))),floor (x * ( fromIntegral (width b -1) ))) 

random1 :: [Double] -> Player -> Board -> Int -> Pos
random1 (x:y:ls) p b c
    | c == 0 = random2 ls p b
    | (((getCell pos b)*p) >= 0) && ( (minimum (map (\z -> (getCell z b) * p) (neighbors (size b) (pos))) ) >= 0) && (1 < (length (neighbors (size b) pos) ) - (getCell pos b) * p) = pos
    | otherwise = random1 ls p b (c-1)

      where  
          pos = (floor (y * (fromIntegral (height b -1 ))),floor (x * ( fromIntegral (width b -1) ))) 

corner :: [Double] -> Player -> Board -> Pos
corner ls p b
      | ((getCell (0,0) b) * p == 0) && ( (minimum (map (\z -> (getCell z b) * p) (neighbors (size b) (0,0))) ) >= 0) = (0,0)
      | ((getCell (0,(width b - 1)) b) * p == 0) && ( (minimum (map (\z -> (getCell z b) * p) (neighbors (size b) (0,(width b - 1)))) ) >= 0) = (0,(width b - 1))
      | ((getCell ((height b - 1),0) b) * p == 0) && ( (minimum (map (\z -> (getCell z b) * p) (neighbors (size b) ((height b - 1),0))) ) >= 0) = ((height b - 1),0)
      | ((getCell (height b - 1,width b - 1) b) * p == 0) && ( (minimum (map (\z -> (getCell z b) * p) (neighbors (size b) (height b - 1,width b - 1))) ) >= 0) = (height b - 1,width b - 1)
      | otherwise = sColumn ls b p  (1,0)

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