module Exercise_10 where
import Data.List
import Test.QuickCheck
import Data.Ord
import Data.Maybe
import Data.Function

{-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-}
prettyShowBoard :: Board -> String
prettyShowBoard [] = ""
prettyShowBoard (r:rs)= concat(map showField r) ++ "\n" ++ (prettyShowBoard rs)

showField :: Field -> String
showField E = "+"
showField (P V)= "V"
showField (P H)= "H"

{-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 board player) pos
 |player == H = validPos && c+1 < width board && (row board r) !! c == E && (row board r)!! (c+1) ==E
 |player == V = validPos && r+1 < height board && (column board c) !! r == E && (column board c)!! (r+1) ==E
 where r= fst pos
       c= snd pos
       validPos= r < height board && c < width board && r>=0 && c>=0

{-H10.1.3-}
canMove :: Game -> Bool
canMove g@(Game board player) = or [isValidMove g (x,y)|x<-[0..h-1], y<-[0..w-1]]
 where h= height board
       w= width board

{-H10.1.4-}
updateBoard :: Board -> Pos -> Field -> Board
updateBoard board (x, y) field= [if r/= x then board !! r else [if f/= y then (row board r)!! f else field|f<-[0..width board-1]]|r<-[0.. height board-1]] 

{-H10.1.5-}
playMove :: Game -> Pos -> Game
playMove (Game board H) p@(x,y)= Game (updateBoard (updateBoard board (x, y+1) (P H)) p (P H)) V
playMove (Game board V) p@(x,y)= Game (updateBoard (updateBoard board (x + 1, y) (P V)) p (P V)) 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

{-WETT-}
christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI rs = versuch
--christmasAI rs g@(Game board player)= go board player 1

versuch :: Game -> Pos
versuch g@(Game board player)
--check for empty board
 |and[and[f==E|f<-r]|r<-board]= if player == H then (1, 0) else (0, 1)
 |n<= 6 =snd ( maximumBy (comparing fst)[(let newG= playMove g pos in minimax (getBoard newG) player 4 maxValue minValue True,pos)|pos<- allMoves])
 |n<= 30 =snd ( maximumBy (comparing fst)[(let newG= playMove g pos in minimax (getBoard newG) player 1 maxValue minValue True,pos)|pos<- allMoves])
 |otherwise=snd ( maximumBy (comparing fst)[(let newG= playMove g pos in minimax (getBoard newG) player 0 maxValue minValue True,pos)|pos<- allMoves])
 where op= opponent player
       h= height board
       w= width board
       maxValue= (h*w) +1
       minValue= -(h*w) -1
       allMoves= availableMoves board player
       n= length allMoves


versuch2 :: Game -> Pos
versuch2 g@(Game board player)
--check for empty board
 |and[and[f==E|f<-r]|r<-board]= if player == H then (1, 0) else (0, 1)
 |n<= 6 =snd ( maximumBy (comparing fst)[(let newG= playMove g pos in minimax (getBoard newG) player 2 maxValue minValue True,pos)|pos<- considerMoves])
 |n<= 30 =snd ( maximumBy (comparing fst)[(let newG= playMove g pos in minimax (getBoard newG) player 1 maxValue minValue True,pos)|pos<- considerMoves])
 |otherwise=snd ( maximumBy (comparing fst)[(let newG= playMove g pos in minimax (getBoard newG) player 0 maxValue minValue True,pos)|pos<- considerMoves])
 where op= opponent player
       h= height board
       w= width board
       maxValue= (h*w) +1
       minValue= -(h*w) -1
       allMoves= availableMoves board player
--idea: consider in case of positions next to each other
       preprocess= groupMoves allMoves [] player 
       considerMoves= if all ((==1).length) preprocess then concat preprocess else concat (filter ((/=1).length) preprocess)
       n= length considerMoves



--analysing the game after a move (of player)
minimax :: Board -> Player -> Int -> Int-> Int -> Bool -> Int
minimax board player depth alpha beta isMaximizingPlayer
 |depth== 0= let x= heuristic board player in if isMaximizingPlayer then x else -x
 |isMaximizingPlayer && length allMoves==0 = maxValue
 |isMaximizingPlayer && length allMoves==0 = minValue
 |isMaximizingPlayer= moveAnalysis1 board op allMoves maxValue depth alpha beta
 |not isMaximizingPlayer=moveAnalysis2 board op allMoves minValue depth alpha beta
 where op= opponent player
       h= height board
       w= width board
       maxValue= (h*w) +1
       minValue= -(h*w) -1
       allMoves= availableMoves board op

moveAnalysis1 :: Board -> Player -> [Pos]-> Int -> Int -> Int -> Int -> Int
moveAnalysis1 board player [] value depth alpha beta= value
moveAnalysis1 board player (p:ps) value depth alpha beta
 |not (canMove (Game (getBoard newG) op))= minValue
 |value' == minValue= minValue
 |beta>= alpha' = alpha'
 |otherwise= moveAnalysis1 board player ps value' depth alpha' beta
 where op= opponent player
       h= height board
       w= width board
       maxValue= (h*w) +1
       minValue= -(h*w) -1
       newG =playMove (Game board player) p       
       value'= min value (minimax (getBoard newG) player (depth -1) beta alpha False)
       alpha'= min value' alpha

moveAnalysis2 :: Board -> Player -> [Pos]-> Int -> Int -> Int -> Int-> Int
moveAnalysis2 board player [] value depth alpha beta= value
moveAnalysis2 board player (p:ps) value depth alpha beta
 |not (canMove (Game (getBoard newG) op))= maxValue
 |value' == maxValue= maxValue
 |beta <= alpha' = alpha'
 |otherwise= moveAnalysis2 board player ps value' depth alpha' beta
 where op= opponent player
       h= height board
       w= width board
       maxValue= (h*w) +1
       minValue= -(h*w) -1
       newG =playMove (Game board player) p
       value'= max value (minimax (getBoard newG) player (depth -1) beta alpha True)
       alpha'= max value' alpha

availableMoves :: Board -> Player -> [Pos]
availableMoves board V = [(x, y)|x<-[0..height board], y<- [0.. width board], isValidMove (Game board V) (x,y)]
availableMoves board H = [(x, y)|y<-[0.. width board], x<- [0..height board], isValidMove (Game board H) (x,y)]

-- seperate in groups of neighbor moves
groupMoves :: [Pos] -> [Pos] -> Player -> [[Pos]]
groupMoves [] ls _= [ls]
groupMoves (m:ms) [] player= groupMoves ms [m] player
groupMoves (m:ms) (l:ls) H
 |snd l == snd m && fst l== fst m -1= groupMoves ms (m:l:ls) H
 |otherwise= (l:ls):(groupMoves ms [m] H)
groupMoves (m:ms) (l:ls) V
 |fst m== fst l && snd m -1== snd l= groupMoves ms (m:l:ls) V
 |otherwise= (l:ls) : (groupMoves ms [m] V)


--apply for considering between nodes after a move (player's move)
heuristic :: Board -> Player -> Int
heuristic board player 
 |n2==0 = maxValue
 |n1==0 = minValue
 |otherwise= n1 - n2
 where h= height board
       w= width board
       n1= length (availableMoves board player)
       n2= length (availableMoves board (opponent player))
--infinity (in this case)
       maxValue= (h*w) +1
--minus infinity
       minValue= -(h*w) -1

emptyBoard :: Int -> Board
emptyBoard n= [[E|w<-[0..n-1]]|h<-[0..n-1]]

getBoard (Game board player) = board

opponent H= V
opponent V= H
{-TTEW-}

aiTurn :: Board -> Board
aiTurn board =  getBoard (playMove game move)
 where game= (Game board V)
       move= christmasAI [] game

myTurn :: Board -> Pos -> Board
myTurn board pos= getBoard (playMove (Game board H) pos)

playWithAI board pos= getBoard (playMove game move)
 where b1= getBoard (playMove (Game board H) pos)
       game= (Game b1 V)
       move= christmasAI [] game
{-


--analysing the game after a move (of player)
minimax :: Board -> Player -> Int -> Bool -> Int
minimax board player depth isMaximizingPlayer
 |depth== 0= let x= heuristic board player in if isMaximizingPlayer then x else -x
 |isMaximizingPlayer && length allMoves==0 = maxValue
 |isMaximizingPlayer && length allMoves==0 = minValue
 |isMaximizingPlayer= moveAnalysis1 board op allMoves maxValue depth
 |not isMaximizingPlayer=moveAnalysis2 board op allMoves minValue depth
 where op= opponent player
       h= height board
       w= width board
       maxValue= (h*w) +1
       minValue= -(h*w) -1
       allMoves= availableMoves board op

moveAnalysis1 :: Board -> Player -> [Pos]-> Int -> Int -> Int
moveAnalysis1 board player [] value depth= value
moveAnalysis1 board player (p:ps) value depth
 |not (canMove (Game (getBoard newG) op))= minValue
 |value' == minValue= minValue
 |otherwise=  moveAnalysis1 board player ps value' depth 
 where op= opponent player
       h= height board
       w= width board
       maxValue= (h*w) +1
       minValue= -(h*w) -1
       newG =playMove (Game board player) p
       value'= min value (minimax (getBoard newG) player (depth -1) False)

moveAnalysis2 :: Board -> Player -> [Pos]-> Int -> Int -> Int
moveAnalysis2 board player [] value depth= value
moveAnalysis2 board player (p:ps) value depth
 |not (canMove (Game (getBoard newG) op))= maxValue
 |value' == maxValue= maxValue
 |otherwise = moveAnalysis2 board player ps value' depth 
 where op= opponent player
       h= height board
       w= width board
       maxValue= (h*w) +1
       minValue= -(h*w) -1
       newG =playMove (Game board player) p
       value'= max value (minimax (getBoard newG) player (depth -1) True)

versuch :: Game -> Pos
versuch g@(Game board player)=snd ( maximumBy (comparing fst)[(let newG= playMove g pos in minimax (getBoard newG) player 2 True,pos)|pos<- allMoves])
 where op= opponent player
       h= height board
       w= width board
       allMoves= availableMoves board player

-- --

christmasAI rs g@(Game board player)= go board player 1
go :: Board -> Player -> Int -> Pos
go board player 0 = snd (minimumBy (comparing fst) [(length (availableMoves (getBoard (playMove (Game board player) p)) op), p)|p<- ps])
 where ps= availableMoves board player
       op= opponent player
go board player depth =snd (maximumBy (comparing fst) (moveAna board player ps depth)) -- snd (maximumBy (comparing fst) newBoards )
 where ps= availableMoves board player
       op= opponent player
--     newBoards=  [( let newG= playMove (Game board player) p  in let newG'= playMove newG (go (getBoard newG) op (depth -1)) in length (availableMoves (getBoard newG') player ) ,  p)|p<-ps]

moveAna :: Board -> Player -> [Pos] -> Int -> [(Int,Pos)]
moveAna board player [] _= []
moveAna board player (p:ps) depth
 |not (canMove (Game (getBoard newG) op) )= [(h*w+1, p)]
 |otherwise =  (length (availableMoves (getBoard newG') player), p):(moveAna board player ps depth)
 where op= opponent player
       h= height board
       w= width board
       newG =playMove (Game board player) p
       newG'= playMove newG (go (getBoard newG) op (depth -1))

-}
{-H10.1.7-}
play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss dim sv sh
 |null rss= ([], H)
 |otherwise = playAux rss sv sh (emptyBoard dim) V

playAux :: [[Double]] -> Strategy -> Strategy -> Board -> Player -> ([Board],Player)
playAux (rs:rss) sv sh board player
 |not (canMove (Game board player)) = ([],(opponent player))
 |not (isValidMove (Game board player) move)= ([], opponent player)
 |null rss= (newBoard:[], player)
 |otherwise = (newBoard:bs, p)
 where move= (if player == V then sv else sh) rs (Game board player)
       newBoard=getBoard( playMove (Game board player) move)
       (bs, p)= playAux rss sv sh newBoard (opponent player)

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



out= putStr.prettyShowBoard


b= emptyBoard 6
b1=[[E, E, E, P V, E, P V, E, P V],
 [P V, E, P V, E, P V, E, E, P V],
 [E, E, E, E, E, E, P H, P H],
 [P V, P V, E, E, E, P V, P H, E],
 [E, E, E, P V, E, E, P H, E],
 [P V, E, E, E, E, P V, E, P H],
 [E, P H, E, E, E, E, E, E],
 [E, E, E, E, E, E, E, E]]