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 == 1 = b!!y!!x >= 0
  | otherwise = b!!y!!x <= 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 
  | p == 1 = and[all (>=0) (row b i) | i <-[0 .. length b -1]]
  | otherwise = and[all (<=0) (row b i) | i <-[0 .. length b -1]]

-- the list of neighbors of a cell
neighbors :: Size -> Pos -> [Pos]
neighbors (r, c) (y, x) = [(fst n + y, snd n + x) | n <- pos, fst n + y < r, snd n + x < c, fst n + y >= 0, snd n + x >= 0]
  where pos = [(1, 0), (0, 1), (-1, 0), (0, -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 = [if i == y then [if j==x then p * f (abs((b!!i)!!j)) else (b!!i)!!j| j<-[0..length (b!!i) - 1]] else b!!i | i <-[0..length b - 1]]

{- x.2 -}

-- place an orb for the given player in the given cell
putOrb :: Player -> Pos -> Board -> Board
putOrb p (y, x) b 
  | ln > abs(b'!!y!!x) = b'
  | otherwise = putOrbs p ns b''
  where b' = updatePos (+1) p (y, x) b
        size = (length b, length (head b))
        ns = neighbors size (y, x)
        ln = length ns
        b'' = updatePos (*0) p (y, x) b 

putOrbs :: Player -> [Pos] -> Board -> Board
putOrbs p [] b = b
putOrbs p (x:xs) b 
  | hasWon p b = b
  | otherwise = putOrbs p xs (putOrb p x b)

{- x.3 -}

{-WETT-}
-- Your strategy
-- type Strategy = [Double] -> Player -> Board -> Pos
strategy :: Strategy -- bisher beste
strategy ds p b 
  | not(null wpos) = head wpos
  | not(null def) = thinkAhead def b p
  | not(null tacs) = thinkAhead tacs b p
  | otherwise = thinkAhead [fst po | po <- pos, snd po] b p
  where   size = (length b, length(head b))
          corners = [(0,0), (fst size -1,0), (0,snd size -1), (fst size -1,snd size -1)]
          pos = [((i,j),signum (b!!i!!j)==p || b!!i!!j == 0)|i<-[0..length b - 1], j<-[0..length(head b)-1]]
          pot = [fst po | po <- pos, snd po, fst po `notElem` corners, abs(getCell (fst po) b) + 1==length(neighbors size (fst po))]
          wpos = [fst po | po<-pos, snd po, hasWon p (putOrb p (fst po) b)]
          att = sortBy (\x y -> compare (snd x) (snd y)) [(n, if p < 0 then maximum [ getCell f b |f<-neighbors size n] else minimum [getCell f b |f<-neighbors size n]) | po<-pos, not(snd po), n <- neighbors size (fst po), (n, True) `elem` pos, getCell n b /= 0]
          def = [fst at | at<-att, e<-[minimumBy (\x y -> compare (snd x) (snd y)) [(n,length(neighbors size n)) | n<-neighbors size (fst at), getCell n b==snd at]], length(neighbors size (fst at))-abs(getCell (fst at) b)==length(neighbors size (fst e))-abs(snd at)]
          --tac2 enthaelt alle felder die null sind und deren nachbar nicht dem gegner gehören
          tac2 = [fst po | po <- pos,snd po, getCell (fst po) b==0,and[fst po `notElem` neighbors size (fst po') | po'<-pos, not(snd po')]]
          --tac4 enthaelt alle felder die keine ecken sind und deren anzahl +1 echt kleiner als voll ist
          tac4 = [fst po | po <- pos,snd po, abs(getCell (fst po) b) + 1<length(neighbors size (fst po)), and[fst po `notElem` neighbors size (fst po') | po'<-pos, not(snd po')], fst po `notElem` corners]
          --tac1 enthaelt alles felder aus 2 die am rand liegen
          tac1 = [t | t<-tac2, fst t == 0 || snd t == 0 || fst t == fst size -1 || snd t == snd size -1]
          --tac0 enthaelt alle felder aus tac1 deren nachbar nachbar dem gegner gehoert
          tac0 = [t | t<- tac1, n <- neighbors size t, n1<-neighbors size n, (n1, False) `elem` pos]
          -- tac3 enthaelt alle felder aus tac2 deren nachbar nachbar dem gegner gehoert
          tac3 = [t | t<- tac2, n <- neighbors size t, n1<-neighbors size n, (n1, False) `elem` pos]
          ltc = if head (head b) == 0 &&  abs(head(b!!1))<=1 && abs(head b !! 1)<=1 then (0,0) else (-1, -1)
          rtc = if head (last b) == 0 &&  abs(head(b!!(fst size -2)))<=1 && abs(last b !! 1)<=1 then (fst size -1,0) else (-1, -1)
          lbc = if last (head b) == 0 &&  abs(head b !! (snd size -2))<=1 && abs(last (b !! 1))<=1 then (0,snd size -1) else (-1, -1)
          rbc = if last (last b) == 0 &&  abs(last(b!!(fst size -2)))<=1 && abs(last b !! (snd size -2))<=1 then (fst size -1,snd size -1) else (-1, -1)
          cs = [c | c<-[ltc, rtc, lbc, rbc], fst c /= -1]
          tacs= nub(cs++tac0++tac1++tac3++tac2++tac4++pot)

thinkAheadAhead::[Pos]->Board->Player->Pos
thinkAheadAhead poss b p = fst (if p < 0 then minimumBy (\x y -> compare (snd $ snd x) (snd $ snd y)) val else maximumBy (\x y -> compare (snd $ snd x) (snd $ snd y)) val)
  where   pot b'= [(i,j)|i<-[0..length b' - 1], j<-[0..length(head b')-1],signum (b'!!i!!j)/=p || b'!!i!!j == 0]
          val = [(pos, thinkAhead' (pot (putOrb (-p) posO (putOrb p pos b))) (putOrb (-p) posO (putOrb p pos b)) p) |  pos <- poss, posO<-pot (putOrb p pos b)]

thinkAhead'::[Pos]->Board->Player->(Pos, Int)
thinkAhead' poss b p = if p < 0 then minimumBy (\x y -> compare (snd x) (snd y)) vals else maximumBy (\x y -> compare (snd x) (snd y)) vals
  where   pot b'= [(i,j)|i<-[0..length b' - 1], j<-[0..length(head b')-1],signum (b'!!i!!j)/=p || b'!!i!!j == 0]
          valp pos = maximum [sum (map sum (putOrb (-p) po (putOrb p pos b))) | po<-pot (putOrb p pos b)]
          valn pos = minimum [sum (map sum (putOrb (-p) po (putOrb p pos b))) | po<-pot (putOrb p pos b)]
          vals = [(pos, if p < 0 then valp pos else valn pos) | pos<-poss]

thinkAhead2::[Pos]->Board->Player->Pos
thinkAhead2 poss b p = snd $ fst (if p < 0 then minimumBy (\x y -> compare (snd x) (snd y)) val else maximumBy (\x y -> compare (snd x) (snd y)) val)
  where   pot b'= [(i,j)|i<-[0..length b' - 1], j<-[0..length(head b')-1],signum (b'!!i!!j)/=p || b'!!i!!j == 0]
          val = [((thinkAhead (pot (putOrb p pos b)) (putOrb p pos b) (-p), pos), sum(map sum (putOrb p pos b))) |  pos <- poss]

thinkAhead::[Pos]->Board->Player->Pos
thinkAhead poss b p = fst (if p < 0 then minimumBy (\x y -> compare (snd x) (snd y)) vals else maximumBy (\x y -> compare (snd x) (snd y)) vals)
  where   pot b'= [(i,j)|i<-[0..length b' - 1], j<-[0..length(head b')-1],signum (b'!!i!!j)/=p || b'!!i!!j == 0]
          valp pos = maximum [sum (map sum (putOrb (-p) po (putOrb p pos b))) | po<-pot (putOrb p pos b)]
          valn pos = minimum [sum (map sum (putOrb (-p) po (putOrb p pos b))) | po<-pot (putOrb p pos b)]
          vals = [(pos, if p < 0 then valp pos else valn pos) | pos<-poss]

strategy4 :: Strategy -- bisher beste
strategy4 ds p b 
  | not(null wpos) = head wpos
  | not(null def) = thinkAhead def b p
  | head (head b) == 0 &&  abs(head(b!!1))<=1 && abs(head b !! 1)<=1 = (0,0)
  | head (last b) == 0 &&  abs(head(b!!(fst size -2)))<=1 && abs(last b !! 1)<=1 = (fst size -1,0)
  | last (head b) == 0 &&  abs(head b !! (snd size -2))<=1 && abs(last (b !! 1))<=1 = (0,snd size -1)
  | last (last b) == 0 &&  abs(last(b!!(fst size -2)))<=1 && abs(last b !! (snd size -2))<=1 = (fst size -1,snd size -1)
  | not(null tacs) = thinkAhead tacs b p
  | otherwise = thinkAhead [fst po | po <- pos, snd po] b p
  where   size = (length b, length(head b))
          corners = [(0,0), (fst size -1,0), (0,snd size -1), (fst size -1,snd size -1)]
          pos = [((i,j),signum (b!!i!!j)==p || b!!i!!j == 0)|i<-[0..length b - 1], j<-[0..length(head b)-1]]
          pot = [fst po | po <- pos, snd po, fst po `notElem` corners, abs(getCell (fst po) b) + 1==length(neighbors size (fst po))]
          wpos = [fst po | po<-pos, snd po, hasWon p (putOrb p (fst po) b)]
          att = sortBy (\x y -> compare (snd x) (snd y)) [(n, if p < 0 then maximum [ getCell f b |f<-neighbors size n] else minimum [getCell f b |f<-neighbors size n]) | po<-pos, not(snd po), n <- neighbors size (fst po), (n, True) `elem` pos, getCell n b /= 0]
          def = [fst at | at<-att, e<-[minimumBy (\x y -> compare (snd x) (snd y)) [(n,length(neighbors size n)) | n<-neighbors size (fst at), getCell n b==snd at]], length(neighbors size (fst at))-abs(getCell (fst at) b)==length(neighbors size (fst e))-abs(snd at)]
          --tac2 enthaelt alle felder die null sind und deren nachbar nicht dem gegner gehören
          tac2 = [fst po | po <- pos,snd po, getCell (fst po) b==0,and[fst po `notElem` neighbors size (fst po') | po'<-pos, not(snd po')]]
          --tac4 enthaelt alle felder die keine ecken sind und deren anzahl +1 echt kleiner als voll ist
          tac4 = [fst po | po <- pos,snd po, abs(getCell (fst po) b) + 1<length(neighbors size (fst po)), and[fst po `notElem` neighbors size (fst po') | po'<-pos, not(snd po')], fst po `notElem` corners]
          --tac1 enthaelt alles felder aus 2 die am rand liegen
          tac1 = [t | t<-tac2, fst t == 0 || snd t == 0 || fst t == fst size -1 || snd t == snd size -1]
          --tac0 enthaelt alle felder aus tac1 deren nachbar nachbar dem gegner gehoert
          tac0 = [t | t<- tac1, n <- neighbors size t, n1<-neighbors size n, (n1, False) `elem` pos]
          -- tac3 enthaelt alle felder aus tac2 deren nachbar nachbar dem gegner gehoert
          tac3 = [t | t<- tac2, n <- neighbors size t, n1<-neighbors size n, (n1, False) `elem` pos]
          tacs= tac0++tac1++tac3++tac2++tac4++pot

strategy3 :: Strategy
strategy3 ds p b 
  | not(null wpos) = head wpos
  | head (head b) == 0 &&  abs(head(b!!1))<=1 && abs(head b !! 1)<=1 = (0,0)
  | head (last b) == 0 &&  abs(head(b!!(fst size -2)))<=1 && abs(last b !! 1)<=1 = (fst size -1,0)
  | last (head b) == 0 &&  abs(head b !! (snd size -2))<=1 && abs(last (b !! 1))<=1 = (0,snd size -1)
  | last (last b) == 0 &&  abs(last(b!!(fst size -2)))<=1 && abs(last b !! (snd size -2))<=1 = (fst size -1,snd size -1)
  | not(null def) = head def
  | not(null tac0) = head tac0
  | not(null tac1) = head tac1
  | not(null tac3) = head tac3
  | not(null tac2) = head tac2
  | not(null tac4) = head tac4
  | not(null pot) = head pot
  |otherwise = head [fst po | po <- pos, snd po]
  where   size = (length b, length(head b))
          corners = [(0,0), (fst size -1,0), (0,snd size -1), (fst size -1,snd size -1)]
          pos = [((i,j),signum (b!!i!!j)==p || b!!i!!j == 0)|i<-[0..length b - 1], j<-[0..length(head b)-1]]
          pot = [fst po | po <- pos, snd po, fst po `notElem` corners, abs(getCell (fst po) b) + 1==length(neighbors size (fst po))]
          wpos = [fst po | po<-pos, snd po, hasWon p (putOrb p (fst po) b)]
          att = sortBy (\x y -> compare (snd x) (snd y)) [(n, if p < 0 then maximum [ getCell f b |f<-neighbors size n] else minimum [getCell f b |f<-neighbors size n]) | po<-pos, not(snd po), n <- neighbors size (fst po), (n, True) `elem` pos, getCell n b /= 0]
          def = [fst at | at<-att, e<-[minimumBy (\x y -> compare (snd x) (snd y)) [(n,length(neighbors size n)) | n<-neighbors size (fst at), getCell n b==snd at]], length(neighbors size (fst at))-abs(getCell (fst at) b)==length(neighbors size (fst e))-abs(snd at)]
          --tac2 enthaelt alle felder die null sind und deren nachbar nicht dem gegner gehören
          tac2 = [fst po | po <- pos,snd po, getCell (fst po) b==0,and[fst po `notElem` neighbors size (fst po') | po'<-pos, not(snd po')]]
          --tac4 enthaelt alle felder die keine ecken sind und deren anzahl +1 echt kleiner als voll ist
          tac4 = [fst po | po <- pos,snd po, abs(getCell (fst po) b) + 1<length(neighbors size (fst po)), and[fst po `notElem` neighbors size (fst po') | po'<-pos, not(snd po')], fst po `notElem` corners]
          --tac1 enthaelt alles felder aus 2 die am rand liegen
          tac1 = [t | t<-tac2, fst t == 0 || snd t == 0 || fst t == fst size -1 || snd t == snd size -1]
          --tac0 enthaelt alle felder aus tac1 deren nachbar nachbar dem gegner gehoert
          tac0 = [t | t<- tac1, n <- neighbors size t, n1<-neighbors size n, (n1, False) `elem` pos]
          -- tac3 enthaelt alle felder aus tac2 deren nachbar nachbar dem gegner gehoert
          tac3 = [t | t<- tac2, n <- neighbors size t, n1<-neighbors size n, (n1, False) `elem` pos]

strategy2 :: Strategy
strategy2 ds p b 
  | not(null wpos) = head wpos
  | head (head b) == 0 &&  abs(head(b!!1))<=1 && abs(head b !! 1)<=1 = (0,0)
  | head (last b) == 0 &&  abs(head(b!!(fst size -2)))<=1 && abs(last b !! 1)<=1 = (fst size -1,0)
  | last (head b) == 0 &&  abs(head b !! (snd size -2))<=1 && abs(last (b !! 1))<=1 = (0,snd size -1)
  | last (last b) == 0 &&  abs(last(b!!(fst size -2)))<=1 && abs(last b !! (snd size -2))<=1 = (fst size -1,snd size -1)
  | not(null def) = head def
  | not(null tac0) = head tac0
  | not(null tac1) = head tac1
  | not(null tac3) = head tac3
  | not(null tac2) = head tac2
  | not(null tac4) = head tac4
  | not(null pot) = head pot
  |otherwise = head [fst po | po <- pos, snd po]
  where   size = (length b, length(head b))
          corners = [(0,0), (fst size -1,0), (0,snd size -1), (fst size -1,snd size -1)]
          pos = [((i,j),signum (b!!i!!j)==p || b!!i!!j == 0)|i<-[0..length b - 1], j<-[0..length(head b)-1]]
          pot = [fst po | po <- pos, snd po, fst po `notElem` corners, abs(getCell (fst po) b) + 1<length(neighbors size (fst po))]
          wpos = [fst po | po<-pos, snd po, hasWon p (putOrb p (fst po) b)]
          att = [(n, if p < 0 then maximum [ getCell f b |f<-neighbors size n] else minimum [getCell f b |f<-neighbors size n]) | po<-pos, not(snd po), n <- neighbors size (fst po), (n, True) `elem` pos, getCell n b /= 0]
          def = [fst at | at<-att, e<-[minimumBy (\x y -> compare (snd x) (snd y)) [(n,length(neighbors size n)) | n<-neighbors size (fst at), getCell n b==snd at]], length(neighbors size (fst at))-abs(getCell (fst at) b)==length(neighbors size (fst e))-abs(snd at)]
          --tac2 enthaelt alle felder die null sind und deren nachbar nicht dem gegner gehören
          tac2 = [fst po | po <- pos,snd po, getCell (fst po) b==0,and[fst po `notElem` neighbors size (fst po') | po'<-pos, not(snd po')]]
          --tac4 enthaelt alle felder die keine ecken sind und deren anzahl +1 echt kleiner als voll ist
          tac4 = [fst po | po <- pos,snd po, abs(getCell (fst po) b) + 1<length(neighbors size (fst po)), and[fst po `notElem` neighbors size (fst po') | po'<-pos, not(snd po')], fst po `notElem` corners]
          --tac1 enthaelt alles felder aus 2 die am rand liegen
          tac1 = [t | t<-tac2, fst t == 0 || snd t == 0 || fst t == fst size -1 || snd t == snd size -1]
          --tac0 enthaelt alle felder aus tac1 deren nachbar nachbar dem gegner gehoert
          tac0 = [t | t<- tac1, n <- neighbors size t, n1<-neighbors size n, (n1, False) `elem` pos]
          -- tac3 enthaelt alle felder aus tac2 deren nachbar nachbar dem gegner gehoert
          tac3 = [t | t<- tac2, n <- neighbors size t, n1<-neighbors size n, (n1, False) `elem` pos]
          --if p < 0 then maximum [b!!(fst f)!!(snd f)|f<-neighbors n] else
        

strategy1 :: Strategy
strategy1 ds p b 
  | all(all (==0)) b = (1,1)
  | null l' = fst(head l)
  | otherwise = head l'
  where l = sortBy (\x y-> compare (snd(snd x)) (snd(snd y))) ([((i,j) ,(hasWon p (putOrb p (i, j) b), sum(map sum (putOrb p (i, j) b))))|i<-[0..length b - 1], j<-[0..length(head b)-1], signum (b!!i!!j)==p || b!!i!!j == 0])
        l' = [fst e| e<-l, fst(snd e)]

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