module Exercise08 where

import Data.Bits
import Data.List
import Data.Function
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 = (!!)

au :: Int -> Int
au n = 0

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 = if (signum f) * (signum p) < 0 then False else True 
   where f = getCell (y, x) b 

-- 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 [ not ((signum (getCell (y, x) b)) * (signum p) < 0 )| x <- [0 .. (width b - 1)], y <- [0 .. (height b - 1)]]

-- the list of neighbors of a cell
neighbors :: Size -> Pos -> [Pos]
neighbors (r, c) (y, x) = filter (isValidPos (r, c)) [ob, unt, rech, lnks]
   where ob = (y-1, x)
         unt = (y+1, x)
         rech = (y, x+1)
         lnks = (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
   | y == 899 = [zeNew] ++ (drop 1 b)
   |otherwise = (take y b) ++ [zeNew] ++ (drop (y+1) b)
      where zeile = row b y
            fieldNew = p * (f (abs (getCell (y, x) b)))
            zeNew = zeNe zeile (y, x) fieldNew 

zeNe :: Row -> Pos -> Field -> Row
zeNe zeile (y, x) fi 
   | x == 98 = fi:(drop 1 zeile)
   | otherwise = (take x zeile) ++ [fi] ++ (drop (x+1) zeile)

{- x.2 -}
{-}
isFlld :: Board -> Pos -> Bool 
isFlld b p = and [abs (getCell ngb b) <= anzF| ngb <- nghbrs] 
   where nghbrs = neighbors (size b) p 
         anzF = abs (getCell p b)
-}
doOvfl :: Player -> Board -> [Pos] -> Board
doOvfl pl b (ng:nghbrs) = doOvfl pl (updatePos (\x -> 1 + abs x) pl ng b) nghbrs
doOvfl _ b [] = b

filled :: Board -> Pos -> Bool
filled b po = length( neighbors (size b) po) <= (abs (getCell po b))

updOvflw :: Player -> [Pos] -> Board -> Board
updOvflw pl (po:ps) b 
   |filled b po = if isOver b then b else updOvflw pl (ps ++ nghbrs) (doOvfl pl brdOhne nghbrs)
   |otherwise = updOvflw pl ps b 
      where nghbrs = neighbors (size b) po
            brdOhne = updatePos (\x -> abs ( (abs x) - length nghbrs) ) pl po b
updOvflw pl [] b = b
   

isOver :: Board -> Bool 
isOver b = (hasWon 1 b) || hasWon (-1) b 

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



{- x.3 -}

{-WETT-}
-- Your strategy
anzOrbs :: Player -> Board -> Int
anzOrbs pl b = sum [abs $ getCell (y, x) b| y <- [0 .. (hei - 1)], x <- [0 .. (wid - 1)], (pl * (getCell (y, x) b)) > 0]
   where (hei, wid) = size b

validMv :: Player -> Board -> Pos -> Bool 
validMv pl b po = (getCell po b) * pl >= 0 

smlt :: Player -> Pos -> Board -> Int
smlt pl po b = strtOpp (-pl) nwBrd
   where nwBrd = putOrb pl po b 
         
smltOppnt :: Player -> Pos -> Board ->  Int
smltOppnt pl po b = strtScndOpp (-pl) nwBrd
    where nwBrd = putOrb pl po b 

smltSel :: Player -> Pos -> Board -> Int
smltSel pl po b = strtOpp (-pl) nwBrd
   where nwBrd = putOrb pl po b

smltEas :: Player -> Board -> Pos -> Int
smltEas pl b po = anzOrbs pl nwBrd - (anzOrbs (-pl) nwBrd)
    where nwBrd = putOrb pl po b 

bstMv :: Player -> Board -> Int -> [Pos] -> Pos
bstMv pl b bst (mv:mvs) = if (smlt pl mv b) == bst then mv else bstMv pl b bst mvs

bstMvOpp :: Player -> Board -> Int -> [Pos] -> Pos
bstMvOpp pl b bst (mv:mvs) = if (smltOppnt pl mv b) == bst then mv else bstMv pl b bst mvs

strategy :: Strategy --[Double] -> Player -> Board -> Pos
strategy ds pl b = resltMv
   where (hght, wdth) = size b 
         allPos = [(y, x) | y <- [0.. (hght -1)], x <- [0.. (wdth - 1)]]
         vldMvs = filter (validMv pl b) allPos
         smpls = map (\pstn -> oppSmpl pl b pstn) vldMvs
         bstSmpls =  take 30 $ reverse $ sortBy (compare `on` fst) (smpls)
         nmbsMv = map (\(n, pstn) -> smlt pl pstn b) bstSmpls
         bstNmb = maximum nmbsMv
         resltMv = bstMv pl b bstNmb vldMvs

strtOpp :: Player -> Board -> Int
strtOpp pl b = bstNmb
   where (hght, wdth) = size b 
         allPos = [(y, x) | y <- [0.. (hght -1)], x <- [0.. (wdth - 1)]]
         vldMvs = filter (validMv pl b) allPos
         smpls = map (\pstn -> oppSmpl pl b pstn) vldMvs
         bstSmpls =  take 30 $ reverse $ sortBy (compare `on` fst) (smpls)
         nmbsMv = map (\(n, pstn) -> smltOppnt pl pstn b) bstSmpls
         bstNmb = minimum nmbsMv
     --    resltMv = bstMv pl b bstNmb vldMvs

strtSelf :: Player -> Board -> Int
strtSelf pl b = bstNmb
   where (hght, wdth) = size b 
         allPos = [(y, x) | y <- [0.. (hght -1)], x <- [0.. (wdth - 1)]]
         vldMvs = filter (validMv pl b) allPos
         smpls = map (\pstn -> oppSmpl pl b pstn) vldMvs
         bstSmpls =  take 30 $ reverse $ sortBy (compare `on` fst) (smpls)
         nmbsMv = map (\(n, pstn) -> smltOppnt pl pstn b) bstSmpls
         bstNmb = maximum nmbsMv

strtScndOpp :: Player -> Board -> Int
strtScndOpp pl b = bstNmb
   where (hght, wdth) = size b 
         allPos = [(y, x) | y <- [0.. (hght -1)], x <- [0.. (wdth - 1)]]
         vldMvs = filter (validMv pl b) allPos
         nmbsMv = map (\pstn -> smltEas pl b pstn) vldMvs
         bstNmb = minimum nmbsMv

oppSmpl :: Player -> Board -> Pos -> (Int, Pos)
oppSmpl pl b po =  (anzOrbs pl nwBrd - (anzOrbs (-pl) nwBrd), po)
    where nwBrd = putOrb pl po 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