module Exercise_10 where
import Data.List
import Test.QuickCheck
--import Debug.Trace
{-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)


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

-- get a given field of a board
field :: Board -> Pos -> Field
field b (x,y) = b !! x !! y
fields :: Board -> [Pos] -> [Field]
fields b [] = []
fields b (p:xs) = (field b p) : fields b xs
-- 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


showBoards b = map prettyShowBoard b |> unlines |> putStr

{-H10.1.1-}
prettyShowBoard :: Board -> String
prettyShowBoard b = intercalate "" $ map rowtoString b 

rowtoString r = intercalate "" $ (map printfield r)++["\n"]

printfield E = "+"
printfield (P H) = "H"
printfield (P V) = "V"

{-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 g pos@(x,y) = 
    case getPlayer g of
    V -> cov pos g && cov (x +1, y ) g
    H -> cov pos g && cov (x , y +1) g

inrange (Game b _) (x,y) = let l = length b in x >= 0 && y >= 0 && x < l && y < l

cov pos@(x,y) g@(Game b p) = inrange g pos &&  ({-trace (show [(row b x)!!y] ++ show x ++ show y) $-} (row b x)!!y == E)

getPlayer (Game b p) = p
{-trace (show [(row b y)!!x] ++ show x ++ show y) $ -}

{-H10.1.3-}
canMove :: Game -> Bool
canMove g@(Game b p) = let l = length b - 1 in
                     let positions = [ (a,b) | a <- [0..l], b <- [0..l]] in
                     map (\x -> isValidMove g x) positions |> foldl (||) False

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard b pos@(x,y) field = let l = length b - 1 in
                                let (front, r:rs) = splitAt x b in
                                let (aa,_:as) = splitAt y r in
                                let newl = aa ++ [field] ++ as in
                                front ++ [newl] ++ rs
                                


{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove g@(Game b p) pos@(x,y) =  case p of
    V -> Game (up2 b pos (x +1, y ) (P V)) (H)
    H -> Game (up2 b pos (x , y+1 ) (P H)) (V)
    
up2 b1 p1 p2 pl = let b2 = updateBoard b1 p1 pl in updateBoard b2 p2 pl
{-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

{-WETT-}
{- Erklärung der Strategie:
Es werden die vier Felder neben dem zu spielenden Dominostein überprüft ob diese Leer sind. Wenn dass der Fall ist wird an eine dieser Positionen gespielt. Sobald es keine dieser Positionen mehr gibt, wird herausgefunden welche der noch übrigen moeglichen Positionen die meisten noch freien Stellen des Gegners blockieren. Dann wird an dieser Stelle ein Block gesetzt.


-}

--christmasAI :: Strategy
christmasAI dl g@(Game b p) = let l = length b -1 in
                         let posmap = filter (isValidMove g) [(a,b) | a <-  [0..l], b <- [0..l]] in 
                         let countmap = map (\x -> (countEs x g, x)) posmap in
                         sort countmap  |> subr1 g

subr1 :: Game ->  [(Int, (Int, Int))] -> Pos
subr1 g@(Game b p) poslist = case p of
        H -> last poslist |> snd -- |> subr g
        V -> let t = (filter (\x -> 4 == fst x) poslist, filter (\x -> 4 /= fst x) poslist)  in if (fst t) == [] then subr g (last poslist) else subr g (getbestY $ fst t)


--bekommt Liste mit positionen mit 4 freine Nachbarn, sucht das aus das Vertikal zu den anderen ist
getbestY list = map (\(x,(y,z))-> (y,z) ) list |> sort |> gethighestx |>  head |> (\x -> (4,x))


gethighestx input = let l = findhighest (-1) input in filter (\x -> fst x == l) input

findhighest c []= c
findhighest c ((x,y):xs) = if x > c then findhighest x xs else findhighest c xs

swap (x,y) = (y,x)

subr  g@(Game b p) (x,y) = if x == 4 then y else let l = length b - 1 in
                                                 let posmap = filter (isValidMove g) [(a,b) | a <-  [0..l], b <- [0..l]] in 
                                                 let gamemap = map (\pos -> (playMove g pos, pos)) posmap in
                                                 let mvcount = map (\(g,x) -> (countMoves l g, x)) gamemap in
                                                 sort mvcount |> head |> snd


countMoves l g@(Game b p) = length $ filter (isValidMove g) [(a,b) | a <-  [0..l], b <- [0..l]]


countEs (x,y) (Game b p) = case p of H -> fields b (filter (inrange (Game b p)) [(x+1,y),(x-1,y),(x+1,y+1),(x-1,y+1)])  |> filter (==E) |> length
                                     V -> fields b (filter (inrange (Game b p)) [(x,y+1),(x,y-1),(x+1,y+1),(x+1,y-1)])  |> filter (==E) |> length



inv H = V
inv V = H


{-TTEW-}

{-H10.1.7-}

(*#) 0 y = [y]
(*#) x y = [y] ++ ((x-1) *# y)
(##) x y = x *# (x *# y)
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play dll dim s1 s2 = let board = (dim-1) ## E in if length board == 0 || length board == 1 then ([board], H) else
                     let newGame = (Game board V) in zug dll (Game board V) s1 s2 [] |> (\(x,y) -> (tail x, y))


zug :: [[Double]] -> Game -> Strategy -> Strategy -> [Board] -> ([Board], Player)
zug (d:dl) game@(Game b p) s1 s2 bacc = if canMove game then  fun2 dl (s1 d game) game s1 s2 bacc else (bacc++[b],inv p )

fun2 dl pos game@(Game b p) s1 s2 bacc = if (isValidMove game pos) then zug (dl) (playMove game pos) s2 s1 (bacc++[b]) else (bacc++[b], inv p)






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