module Exercise_10 where
import Data.List
import Test.QuickCheck
import Control.Monad
import System.IO
--import System.IO.Unsafe

{-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)
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 current board and player
  deriving (Eq,Show)

instance Show Field where
  show E = "+"
  show (P p) = show p

-- 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 b = concat [(concat $ map show row) ++ "\n" | row <- b] 

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

data State = Filled | Empty
  deriving (Eq, Show)
toState E = Empty
toState (P _) = Filled

count x = length . filter (==x)

field' (y, x) b = toState ((b!!y)!!x)

field (y, x) b = if y >= height b || x >= width b || y < 0 || x < 0 then Filled else field' (y, x) b

nextPlayer :: Board -> Player
nextPlayer b = if vc > hc then H else V
  where vc = sum [count (P V) row | row <- b]
        hc = sum [count (P H) row | row <- b]

field2 (y, x) p = if p == H then (y, x + 1) else (y + 1, x)

isValidMove :: Game -> Pos -> Bool
isValidMove (Game b p) pos = field pos b == Empty && field (field2 pos p) b == Empty

{-H10.1.3-}
canMove :: Game -> Bool
canMove g@(Game b _) = or [isValidMove g (y, x) | x <- [0..width b], y <- [0..height b]]

{-H10.1.4-}
replace' (l, _:r) x = l ++ [x] ++ r

replace i xs x = replace' (splitAt i xs) x

updateBoard :: Board -> Pos -> Field -> Board
updateBoard b (y, x) f = replace y b (replace x (b!!y) f)

{-H10.1.5-}
flipP H = V
flipP V = H

playMove :: Game -> Pos -> Game
playMove (Game b p) pos = Game b' (flipP p)
  where b' = updateBoard (updateBoard b pos (P p)) (field2 pos p) (P p)

{-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-}
data Pattern = Any | Exactly State
  deriving (Eq, Show)

a = Any
f = Exactly Filled
e = Exactly Empty

mirrorH = map reverse
mirrorV = reverse

type Scheme = ([[Pattern]], Pos, Int)

    {-
    ([
        [a, f, f, a],
        [f, e, e, f],
        [a, e, e, a]
      ],
      (2, 1),
      15
    ),
    
    ([
        [f, f],
        [e, e],
        [e, e],
        [e, e],
        [e, e]
      ],
      (2, 0),
      12
    ),

    ([
        [f, f, f],
        [f, e, e],
        [f, e, e],
        [f, e, e],
        [f, e, e]
      ],
      (2, 1),
      13
    ),
    ([
        [e, e],
        [e, f]
      ],
      (0, 0),
      3
    ),
    -}

patterns = [
    -- double saver, never occurs
    ([
        [f, f],
        [e, e],
        [e, e],
        [e, e],
        [f, f]
      ],
      (2, 0),
      100000
    ),
    -- Leibbrand
    ([
        [f, e, f, e, e],
        [f, e, f, e, e],
        [f, e, e, e, e],
        [f, e, e, e, e],
        [f, e, f, e, e],
        [f, e, f, e, e],
        [f, e, e, e, e],
        [f, e, e, e, e]
      ],
      (2, 3),
      90000
    ),
    -- shifted saving
    ([
        [e, e, f, a],
        [a, e, e, f],
        [a, f, f, a]
      ],
      (0, 0),
      80000
    ),
    -- normal saving
    ([
        [f, f],
        [e, e],
        [e, e]
      ],
      (2, 0),
      60000
    ),
    -- simple filling
    ([
        [e, e]
      ],
      (0, 0),
      10000
    ),
    -- Modifiers
    ([
        [e, e],
        [e, e],
        [e, e]
      ],
      (0, 0),
      1000
    ),
    -- spoiling opportunities
    ([
        [a, f, e, e],
        [e, f, e, e]
      ],
      (0, 2),
      100
    ),
    ([
        [e, e],
        [e, f],
        [f, a]
      ],
      (0, 0),
      80
    ),
    ([
        [f, e, e],
        [a, e, f]
      ],
      (0, 1),
      70
    ),
    ([
        [e, e],
        [e, e]
      ],
      (0, 0),
      60
    ),
    ([
        [f, e, e],
        [f, e, e]
      ],
      (0, 1),
      50
    ),
    ([
        [e, e],
        [e, f]
      ],
      (0, 0),
      50
    ),
    ([
        [e, e, f]
      ],
      (0, 0),
      50
    )
  ]

flipH :: Int -> Pos -> Pos
flipH width (y, x) = (y, width - x - 2)
flipV :: Int -> Pos -> Pos
flipV height (y, x) = (height - y - 1, x) 

mirrorPatternH :: Scheme -> Scheme
mirrorPatternH (p, offset, score) = (mirrorH p, flipH (length (p!!0)) offset, score)
mirrorPatternV :: Scheme -> Scheme
mirrorPatternV (p, offset, score) = (mirrorV p, flipV (length p) offset, score)
rotatePattern = mirrorPatternH . mirrorPatternV

patterns' = nub $ concat [[p, mirrorPatternH p, mirrorPatternV p, rotatePattern p] | p <- patterns]

matchPos Any _ _ = True
matchPos (Exactly s) b pos = field pos b == s

match b (py, px) (p, (yo, xo), _) = and [matchPos ((p!!y)!!x) b (py - yo + y, px - xo + x) | y <- [0..length p - 1], x <- [0..length (p!!0) - 1]]

argmax :: Ord b => (a -> b) -> [a] -> a
argmax f [x] = x
argmax f (x:xs) = if (f x) >= (f r) then x else r where r = argmax f xs

scorePos :: Board -> Pos -> Int
scorePos b pos = sum [if match b pos s then score else 0 | s@(_,_,score) <- patterns']

christmasAI :: Strategy -- receives a game and plays a move for the next player
christmasAI _ (Game b p) = if p == V then (x, y) else (y, x)
  where (y, x) = argmax (scorePos b') [(y, x) | y <- [0..height b' - 1], x <- [0..width b' - 1]]
        b' = if p == V then transpose b else b
{-TTEW-}

{-H10.1.7-}
play' (rs:rss) g@(Game _ p) sv sh =
  if not (canMove g) || not (isValidMove g choice) then
    []
  else
    (let ng = playMove g choice in (ng:play' rss ng sv sh))
  where choice = cs rs g
        cs = if p == V then sv else sh

maybeLast [] d = d
maybeLast xs _ = last xs

emptyBoard dim = (replicate dim (replicate dim E))

play :: [[Double]] -> Int -> Strategy -> Strategy -> ([Board],Player)
play rss dim sv sh = 
  let gameList = play' rss (Game (emptyBoard dim) V) sv sh
      boardList = map (\(Game b _) -> b) gameList
      (Game _ loser) = maybeLast gameList (Game [] V)
      winner = flipP loser in
    (boardList, winner)

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

toField s = if s == '+' then E else P V

{-b = unsafePerformIO readBoard
readBoard = do
        contents <- readFile "board.txt"
        let ls = lines contents
            board = map (map toField) ls
        return board-}