module Exercise_10 where

import Data.List
import Test.QuickCheck

{-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)
data Compass = N | O | S | W
  deriving (Eq,Show)
data Orientation = F | L | B | R
  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

-- width of a game
widthg :: Game -> Int
widthg (Game board player) = height board

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

-- height of a game
heightg :: Game -> Int
heightg (Game board player) = height board

{-H10.1.1-}
prettyShowGame :: Game -> String
prettyShowGame (Game brd p) = foldl (\a b ->a ++ prettyShowRow b ++ "\n") [] brd

prettyShowBoard :: Board -> String
prettyShowBoard = foldl (\a b ->a ++ prettyShowRow b ++ "\n") []

prettyShowRow :: Row -> String
prettyShowRow = foldl (\a b ->a ++ case b of
  (P V) -> "V"
  (P H) -> "H"
  E -> "+") []

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

isValidPosition :: Board -> Pos -> Bool
isValidPosition board (row, column) = 0 <= row && row < height board && 0 <= column && column < width board

getField :: Board -> Pos -> Field
getField board (row,column) = (board !! row) !! column

isFree :: Board -> Pos -> Bool
isFree board position = isValidPosition board position && getField board position == E




isValidMove :: Game -> Pos -> Bool
isValidMove (Game board player) position = isFree board position && isFree board (moveO F player position)

{-H10.1.3-}

flatmap _ [] = []  
flatmap f (x:xs) = f x ++ flatmap f xs

cross a b = flatmap (\elma -> map (\elmb -> (elma,elmb)) b) a

getAllPossibleMoves :: Game -> [Pos]
getAllPossibleMoves game = filter (isValidMove game) (cross [0..(heightg game -1)] [0..(widthg game -1)])

getAllPossibleMovesOne :: Game -> [Pos]
getAllPossibleMovesOne game = if isValidMove game (1,1) && getPlayer game == V then [(1,1)] else getAllPossibleMoves game

canMove :: Game -> Bool
canMove game = getAllPossibleMoves game /= []

{-H10.1.4-}
replaceElement :: [a] -> Int ->a -> [a]
replaceElement arr i x = take i arr ++ [x] ++ drop (i+1) arr

updateBoard :: Board -> Pos -> Field -> Board
updateBoard board (row,column) field = replaceElement board row (replaceElement (board!!row) column field)

updateGame :: Game -> Pos -> Field -> Game
updateGame (Game board player) pos field =   Game (updateBoard board pos field) player

{-H10.1.5-}
nextPlayer :: Player -> Player
nextPlayer H = V
nextPlayer V = H

updateBoardP :: Board -> Pos -> Player -> Board
updateBoardP board pos player = updateBoard (updateBoard board pos (P player)) (moveO F player pos) (P player)

playMove :: Game -> Pos -> Game
playMove (Game board player) pos  = Game (updateBoardP board pos player) (nextPlayer player)

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

chooseRandomElement :: Double -> [a] -> a
chooseRandomElement rand list = list !! floor (rand * fromIntegral (length list))
--chooseRandomElement list rand = head list

christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI = nextMoveSmart

ordAI :: [Double] -> Game -> Pos
ordAI rand game = head (getAllPossibleMoves game)

randAI :: [Double] -> Game -> Pos
randAI rand game = chooseRandomElement (head rand) (getAllPossibleMoves game) 

{-TTEW-}

{-H10.1.7-}

switchStrategyOnPlayer :: (Strategy, Strategy) -> Player -> Strategy
switchStrategyOnPlayer (sv,sh) player =
  case player of
  V -> sv 
  H -> sh

getNextMoveOfActualPlayer :: Game -> (Strategy, Strategy) -> [Double] -> Pos
getNextMoveOfActualPlayer game strategies rand =  switchStrategyOnPlayer strategies (getPlayer game) rand game

nextRound :: Game -> (Strategy, Strategy) -> [Double] -> Maybe Game
nextRound game strategies rand = if canMove game
  then let move = getNextMoveOfActualPlayer game strategies rand in
    if isValidMove game move
    then Just (playMove game move)
    else Nothing
  else Nothing

accumulateJusts :: (a -> Int -> Maybe a) -> [a] -> [a]
accumulateJusts f acc = case f (last acc) (length acc) of
    Just x -> accumulateJusts f (acc++[x])
    Nothing -> acc

getPlayer :: Game -> Player
getPlayer (Game board player) = player
getBoard :: Game -> Board
getBoard (Game board player) = board

generateEmptyBoard :: Int -> Board
generateEmptyBoard dim = replicate dim (replicate dim E)

play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rand dim sv sh =
  let startstate = Game (generateEmptyBoard dim) V in
  let games = drop 1 $ accumulateJusts (\game round -> nextRound game (sv,sh) (rand!!round)) [startstate] in
    (map getBoard games, nextPlayer (if null games then V else getPlayer (last games)))

-- 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 :: Strategy -> Strategy -> IO ()
playAndPrint sh sv = do 
  rss <- generate $ mapM (const genRandomZeroOne) [1..]
  let (bs, w) = play rss 12 sh sv
  putStr $ unlines ( map prettyShowBoard bs) ++ "\nWinner: " ++ show w ++ "\n"

playOnDef :: [[Double]] -> Int -> Strategy -> Strategy -> IO ()
playOnDef rand dim sh sv =
  let (bs, w) = play rand dim sh sv in
    putStr $ unlines ( map prettyShowBoard bs) ++ "\nWinner: " ++ show w ++ "\n"

moveC :: Compass -> Pos -> Pos
moveC N (a,b) = (a-1,b)
moveC O (a,b) = (a,b+1)
moveC S (a,b) = (a+1,b)
moveC W (a,b) = (a,b-1)

translateOrientationToCompass :: Orientation -> Player -> Compass
translateOrientationToCompass B V = N 
translateOrientationToCompass L V = O
translateOrientationToCompass F V = S
translateOrientationToCompass R V = W
translateOrientationToCompass L H = N 
translateOrientationToCompass F H = O
translateOrientationToCompass R H = S
translateOrientationToCompass B H = W

invert :: Compass -> Compass
invert S = N
invert N = S
invert W = O
invert O = W


moveO :: Orientation -> Player -> Pos -> Pos
moveO orientation player = moveC (translateOrientationToCompass orientation player)


countUntilOccupied :: Board -> Compass -> Pos -> Int
countUntilOccupied brd com pos
    | isFree brd pos = 1 + countUntilOccupied brd com (moveC com pos)
    | otherwise = 0


getMovesWithArgMax :: Valuation -> [Pos] -> [Pos] -> Game -> [Pos]
getMovesWithArgMax f [] best game = best
getMovesWithArgMax f poss [] game = getMovesWithArgMax f (drop 1 poss) [head poss] game
getMovesWithArgMax f poss best game
    | f game (head poss) > f game (head best) = getMovesWithArgMax f (drop 1 poss) [head poss] game
    | f game (head poss) == f game (head best) = getMovesWithArgMax f (drop 1 poss) (head poss:best) game
    | f game (head poss) < f game (head best) = getMovesWithArgMax f (drop 1 poss) best game
    
filterMovesWithArgMax :: Valuation -> Game -> [Pos] -> [Pos]
filterMovesWithArgMax f game pos = getMovesWithArgMax f pos [] game

type Valuation = Game -> Pos -> Int

buildStrategy :: [Valuation] -> Strategy
buildStrategy vals rand game = chooseRandomElement (head rand) $  foldl (\poss valuation -> filterMovesWithArgMax valuation game poss ) (getAllPossibleMoves game) vals

buildEndgameStrategy :: [Valuation] -> Strategy
buildEndgameStrategy vals rand g = let game = occultPitHoles g in chooseRandomElement (head rand) $  foldl (\poss valuation -> filterMovesWithArgMax valuation game poss ) (generateEndMoves game) vals

buildOneStrategy :: [Valuation] -> Strategy
buildOneStrategy vals rand game = chooseRandomElement (head rand) $  foldl (\poss valuation -> filterMovesWithArgMax valuation game poss ) (getAllPossibleMovesOne game) vals

singleScoreDir :: Board -> Compass -> Pos -> Int
singleScoreDir board cmp pos = if isFree board (moveC cmp pos) then if isFree board (moveC cmp (moveC cmp pos)) then 2 else 3 else 0

scoreDir :: Game -> Orientation -> Pos -> Int
scoreDir g or pos  = let player = getPlayer g in let board = getBoard g in
  let dir = translateOrientationToCompass or player in
  singleScoreDir board dir pos + singleScoreDir board dir (moveO F player pos)

scoreLR :: Game -> Pos -> Int
scoreLR g pos = combine (scoreDir g L pos) (scoreDir g R pos) 4

singleScoreMultDir :: Board -> Compass -> Pos -> Int
singleScoreMultDir board cmp pos = translateDistToScore $ countUntilOccupied board cmp pos

scoreMultDir :: Game -> Orientation -> Pos -> Int
scoreMultDir g or pos  = let player = getPlayer g in let board = getBoard g in
  let dir = translateOrientationToCompass or player in
  singleScoreMultDir board dir pos * singleScoreMultDir board dir (moveO F player pos)


scoreMultLR :: Game -> Pos -> Int
scoreMultLR g pos = combine (scoreMultDir g L pos) (scoreMultDir g R pos) (14*14)

scoreDir2 :: Game -> Orientation -> Pos -> Int
scoreDir2 g or pos  = let player = getPlayer g in let board = getBoard g in
  let dir = translateOrientationToCompass or player in
  let sc1 = singleScoreMultDir board dir pos in let sc2 = singleScoreMultDir board dir (moveO F player pos) in
  sc1 + sc2 + if sc1 == sc2 then 2 else 0


scoreLR2 :: Game -> Pos -> Int
scoreLR2 g pos = combine (scoreDir2 g L pos *3) (scoreDir2 g R pos *3) 14

translateDistToScore :: Int -> Int
translateDistToScore 0 = 2
translateDistToScore 1 = 1
translateDistToScore 2 = 14
translateDistToScore 3 = 3
translateDistToScore 4 = 13
translateDistToScore 5 = 4
translateDistToScore 6 = 12
translateDistToScore 7 = 5
translateDistToScore 8 = 11
translateDistToScore 9 = 6
translateDistToScore 10 = 10
translateDistToScore 11 = 7
translateDistToScore 12 = 9
translateDistToScore 13 = 8


scoreForward :: Game -> Pos -> Int
scoreForward game pos = let player = getPlayer game in let board = getBoard game in
  let distF = countUntilOccupied board (translateOrientationToCompass F player) pos  in
  let distB = countUntilOccupied board (translateOrientationToCompass B player) pos +1 in
    combine (translateDistToScore distF) (translateDistToScore distB) 2





combine :: Int -> Int -> Int -> Int
combine left right fact = if left > right
                then left * fact + right
                else right * fact + left

ocultingMoves :: Game -> Pos -> [Pos]
ocultingMoves game pos = filter (isValidMove game)  [pos,
  moveO B (getPlayer game) pos,
  moveO F (nextPlayer (getPlayer game)) pos,
  moveO B (getPlayer game) (moveO F (nextPlayer (getPlayer game)) pos)]

enemyScore :: Valuation -> Valuation
enemyScore val g pos = let game = Game (getBoard g) (nextPlayer (getPlayer g)) in 
  sum $ map (val g) (ocultingMoves g pos)

scoreDocking :: Valuation
scoreDocking game pos = let player = getPlayer game in let board = getBoard game in
  let distF = countUntilOccupied board (translateOrientationToCompass F player) pos - 1 in
  let distB = countUntilOccupied board (translateOrientationToCompass B player) pos in
    (if distF ==0 then 1 else 0) + (if distF ==0 then 1 else 0)

scoreEven :: Valuation
scoreEven game (row,column) = (if even row then if getPlayer game == V then 2 else 1 else 0) + (if even column then if getPlayer game == H then 2 else 1 else 0)

scoreMixed :: Valuation
scoreMixed game pos = scoreMultLR game pos + scoreForward game pos

scoreMixed2 :: Valuation
scoreMixed2 game pos = scoreLR2 game pos + (2*scoreForward game pos)

scoreOneOne :: Valuation
scoreOneOne game pos = if getPlayer game == V && pos == (3,1) then 1 else 0

--good approach but occults himself with odd/even problems
fstAI :: Strategy
fstAI = buildStrategy [scoreLR] 

--was good but docking to naive
sndAI :: Strategy
sndAI = buildStrategy [scoreLR,scoreDocking,enemyScore scoreLR]  

--won second place with this but newers beat it
thrdAI :: Strategy
thrdAI = buildStrategy [scoreLR,scoreForward,enemyScore scoreLR]

--slightly better but slower
fthAI :: Strategy
fthAI = buildStrategy [scoreMultLR,scoreForward]

--good and straight forward
sixAI :: Strategy
sixAI = buildOneStrategy [scoreMultLR,scoreForward]

--may time ount, enemyscore does not change a lot
sevAI :: Strategy
sevAI = buildStrategy [scoreMultLR,scoreForward,
  enemyScore scoreMultLR]

--times out
eigAI :: Strategy
eigAI = buildEndgameStrategy [scoreMultLR,scoreForward,
  enemyScore scoreMultLR]

-- strongest and fastest until now
ninAI :: Strategy
ninAI = buildOneStrategy [scoreMultLR,scoreForward,
  enemyScore $ enemyScore $ enemyScore scoreLR]

--no added value and likely to time out because of fold
tenAI :: Strategy
tenAI = buildOneStrategy [scoreMixed2,enemyScore scoreMixed2]

--no added value and likely to time out because of fold
elvAI :: Strategy
elvAI = buildEndgameStrategy [scoreMixed2,enemyScore scoreMixed2]

switchAttakDefense :: Strategy -> Strategy -> Strategy
switchAttakDefense sv sh rand (Game board player) = if player ==V
  then sv rand (Game board player)
  else sh rand (Game board player)

nextMoveSmart :: [Double] -> Game -> Pos
nextMoveSmart = eigAI


isPithole :: Board -> Player -> Pos -> Bool
isPithole b p pos =isFree b (moveO F p pos) && isFree b pos
  && not (
  isFree b (moveO L p pos) ||
  isFree b (moveO R p pos) ||
  isFree b (moveO L p (moveO F p pos)) ||
  isFree b (moveO R p (moveO F p pos))) &&
  not ((isFree b (moveO B p pos) || isFree b (moveO L p (moveO F p (moveO F p pos))) || isFree b (moveO R p (moveO F p (moveO F p pos))))
  &&
  (isFree b (moveO F p (moveO F p pos)) || isFree b (moveO L p (moveO B p pos)) || isFree b (moveO R p (moveO B p pos))))

getAllMovesUpDownUp :: Board -> [Pos]
getAllMovesUpDownUp brd = cross [0..(height brd -1)] [0..(width brd -1)] ++ cross (reverse [0..(height brd -1)]) (reverse [0..(width brd -1)])


checkAndReplaceBothPithole :: Game -> Pos -> Game  
checkAndReplaceBothPithole (Game board player) pos =
  let first = if isPithole board player pos then updateBoardP board pos player else board in
    Game (if isPithole first (nextPlayer player) pos then updateBoardP first pos (nextPlayer player) else first) player

occultPitHoles :: Game -> Game
occultPitHoles (Game board player) = let occulted = foldl checkAndReplaceBothPithole (Game board player) (getAllMovesUpDownUp board) in
  if canMove occulted then occulted else Game board player

generateEndMoves :: Game -> [Pos]
generateEndMoves game =  let moves = getAllPossibleMovesOne game in
    if length moves <=10 && length moves >1
      then
        case bruteForce moves game of 
          Nothing -> moves
          Just pos -> [pos]
    else 
      moves

findWinning :: Game -> Maybe Pos
findWinning game = bruteForce (getAllPossibleMoves game) game

bruteForce :: [Pos] -> Game -> Maybe Pos
bruteForce [] g = Nothing
bruteForce poss g = case findWinning (playMove g (head poss)) of
  Just pos -> bruteForce (tail poss) g
  Nothing -> Just (head poss)