module Exercise_10 where

import Data.List
import Data.Map (fromListWith, toList)
import Test.QuickCheck

b3 = [[E,P V,E],[E,P V,E],[E,P H,E]]
b31 = [[P V,P V,P V],[E,P V,E],[E,E,E]]
b32 = [[E,E,E],[P V,E,P V],[P V,P V,P V]]
b33 = [[E,E,E],[E,P V,E],[P V,P V,E]]
b41 = [[E,E,E,E],[E,P V,P V,P V],[P V,P V,P V,E],[P V,P V,P V,E]]
b81 = [[E,E,P V,E,E,P V,E,E],[E,P V,P V,E,P V,P V,P V,P V],[E,P V,P V,E,P V,P V,P V,P V]]
b82 = [[P V,P V,P V,E,E,P V,E,E],[E,P V,P V,E,P V,P V,P V,P V],[E,P V,P V,E,P V,P V,P V,P V]]
b83 = [[P V,E,P V,E,E,P V,E,E],[P V,P V,P V,E,P V,P V,P V,P V],[E,P V,P V,E,P V,P V,P V,P V]]

b12 = [[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E],[E,E,E,E,E,E,E,E,E,E,E,E]]

{-H10.1-}
data Player = V | H -- vertical or horizontal player
  deriving (Eq,Show)
data Field = P Player | E -- a field is occupied by a player or empty
  deriving (Eq,Show)
type Row = [Field]
type Column = [Field]
type Board = [Row] -- we assume that boards are squares and encode a board row by row
data Game = Game Board Player -- stores the currenty board and player
  deriving (Eq,Show)

-- get a given row of a board
row :: Board -> Int -> Row
row = (!!)

-- get a given column of a board
column :: Board -> Int -> Column
column = row . transpose

-- width of a board
width :: Board -> Int
width [] = 0
width (x:xs) = length x

-- height of a board
height :: Board -> Int
height = length

{-H10.1.1-}
prettyShowPlayer :: Player -> String
prettyShowPlayer H = "H"
prettyShowPlayer V = "V"

prettyShowField :: Field -> String
prettyShowField (P p) = prettyShowPlayer p
prettyShowField E = "+"

prettyShowRow :: Row -> String
prettyShowRow fs = concat (map prettyShowField fs) ++ "\n"

prettyShowBoard :: Board -> String
prettyShowBoard rs = concat $ map prettyShowRow rs

{-H10.1.2-}
-- position on a board (row, column)
-- (0,0) corresponds to the top left corner
type Pos = (Int, Int)

isValidMove :: Game -> Pos -> Bool
isValidMove (Game b p) (r,c)
  | r < 0 = False
  | c < 0 = False
  | r >= phb && p == V = False
  | c >= phb && p == H = False
  | b !! r !! c /= E = False
  | p == H = b !! r !! succ c == E
  | p == V = b !! succ r !! c == E
  where phb = pred $ height b

{-H10.1.3-}
canMove :: Game -> Bool
canMove (Game b p)
  | height b == 0 = False
  | otherwise = canMove2 (Game b p) 0

canMove2 :: Game -> Int -> Bool
canMove2 (Game b _) n | n >= (height b)^2 = False
canMove2 (Game b p) n = isValidMove (Game b p) (r,c) || canMove2 (Game b p) m
  where h = height b
        m = succ n
        r = div n h
        c = mod n h

{-H10.1.4-}
updateList :: [a] -> Int -> a -> [a]
updateList xs i v = ys ++ (v : zs)
  where (ys,(_:zs)) = splitAt i xs

updateBoard :: Board -> Pos -> Field -> Board
updateBoard b (r,c) f = updateList b r $ updateList (b !! r) c f

{-H10.1.5-}
dirMove :: Board -> Pos -> Player -> Board
dirMove b (r,c) H = updateBoard b (r,c+1) (P H)
dirMove b (r,c) V = updateBoard b (r+1,c) (P V)

playMove :: Game -> Pos -> Game
playMove (Game b p) (r,c) = Game (dirMove (updateBoard b (r,c) (P p)) (r,c) p) o
  where o = if p == H then V else H

{-H10.1.6-}
-- the first paramter of a strategy is an infite list of
-- random values between (0,1) (in case you wanna go wild with
-- probabilistic methods)
type Strategy = [Double] -> Game -> Pos

naive :: Strategy -- receives a game and plays a move for the next player
naive (r:rs) (Game b p) = head [ move | move <- moves (Game b p), isValidMove (Game b p) move ]

{-WETT-}
christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI (r:rs) (Game b p) = head candidates
  where index = floor $ r * (fromIntegral (length candidates))
        mapping = toList $ sortAndGroup $ zipMoves (Game b p)
        hl = if p == V then head else last
        candidates = if null mapping then [(0,0)] else snd $ hl mapping
{-TTEW-}

sortAndGroup assocs = fromListWith (++) [(k, [v]) | (k, v) <- assocs]

boardToPos b n | n >= (height b)^2 = []
boardToPos b n = (if f == E then [(r, c)] else []) ++ boardToPos b (succ n)
  where h = height b
        m = succ n
        r = div n h
        c = mod n h
        f = b !! r !! c

moves :: Game -> [Pos]
moves (Game b p) = [ (r,c) | r <- [0..h-1], c <- [0..h-1], isValidMove (Game b p) (r,c) ]
  where h = height b

boardFromGame :: Game -> Board
boardFromGame (Game b _) = b

zipMoves (Game b p) = zip (map (eval . boardFromGame . snd) bs) (map fst bs)
  where bs = [ ((r,c), playMove (Game b p) (r,c)) | (r,c) <- moves (Game b p) ]

eval :: Board -> Int
eval b = evalIslands b (islands b (boardToPos b 0) [])

evalIslandP :: Game -> [Pos] -> Int
evalIslandP _ [] = 0
evalIslandP (Game b p) ((r,c):rc) = evalIslandP (Game b p) rc + (length $ intersect rc $ neighborsOf2 (Game b p) (r,c))

evalIsland :: Board -> [Pos] -> Int
evalIsland b rc = evalIslandP (Game b H) rc - evalIslandP (Game b V) rc

evalIslands :: Board -> [[Pos]] -> Int
evalIslands b iss = sum [ evalIsland b is | is <- iss ]

islands :: Board -> [Pos] -> [[Pos]] -> [[Pos]]
islands b [] ts = ts
islands b (s:ss) ts = if b !! fst s !! snd s == E then islands b (ss \\ island) (island : ts) else islands b ss ts
  where island = islandOf b [s] []

islandOf :: Board -> [Pos] -> [Pos] -> [Pos]
islandOf _ [] ts = ts
islandOf b (s:ss) ts
  | elem s ts = islandOf b ss ts
  | otherwise = islandOf b (neighborsOf b s ++ ss) (s:ts)

neighborsOf :: Board -> Pos -> [Pos]
neighborsOf b (r,c) = [ (r',c') | (r',c') <- [(r,c-1),(r+1,c),(r,c+1),(r-1,c)], r' >= 0, r' < h, c' >= 0, c' < h, b !! r' !! c' == E ]
  where h = height b

neighborsOf2 :: Game -> Pos -> [Pos]
neighborsOf2 (Game b H) (r,c) = [ (r',c') | (r',c') <- [(r,c-1),(r,c+1)], r' >= 0, r' < h, c' >= 0, c' < h, b !! r' !! c' == E ]
  where h = height b
neighborsOf2 (Game b V) (r,c) = [ (r',c') | (r',c') <- [(r+1,c),(r-1,c)], r' >= 0, r' < h, c' >= 0, c' < h, b !! r' !! c' == E ]
  where h = height b

{-H10.1.7-}
emptyBoard :: Int -> Board
emptyBoard dim = [ [ E | _ <- [1..dim] ] | _ <- [1..dim] ]

play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss dim sv sh = (v,w)
  where v = playRec rss dim sv sh (emptyBoard dim) 0
        w = if mod (length v) 2 == 0 then H else V

playRec :: [[Double]] -> Int -> Strategy -> Strategy -> Board -> Int -> [Board]
playRec (rs:rss) dim sv sh b n = if isValidMove (Game b p) move then step : recursive else []
  where p = if mod n 2 == 0 then V else H
        o = if mod n 2 == 1 then V else H
        ai = if mod n 2 == 0 then sv else sh
        move = ai rs (Game b p)
        step = boardFromGame $ playMove (Game b p) move
        recursive = if canMove (Game step o) then playRec rss dim sv sh step (succ n) else []

-- generates infinite list of values between (0,1)
genRandomZeroOne :: Gen [Double]
genRandomZeroOne = mapM (const $ choose (0::Double,1)) [1..]

-- plays a game and prints it to the console
playAndPrint :: Int -> Strategy -> Strategy -> IO ()
playAndPrint dim sh sv = do
  rss <- generate $ mapM (const $ genRandomZeroOne) [1..]
  let (bs, w) = play rss dim sh sv
  putStr $ (unlines $ map prettyShowBoard bs) ++ "\nWinner: " ++ show w ++ "\n"