{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe #-}
module Exercise5 where

import System.Random
import System.IO
import Data.Char


{-

    This exercise will run over several weeks, with three deadlines:

    Part #1. Tuesday 11th November, 23.59.
    Part #2. Friday  21th November, 23.59.
    Part #3. Thursday 4th December, 23.59.

    Testbench releases:

    Part #1. Friday  7th November noon.
    Part #2. Friday 14th November noon.
    Part #3. Friday 21th November, or before.

    This is the last programming exercise for the module.

    For each deadline, submit this file with the solutions completed
    up to the required point (or more) on canvas.

    We will play "peg solitaire"
    https://en.wikipedia.org/wiki/Peg_solitaire

    You might find this website useful for testing:

    http://www.pegu.it/

Before stating the exercise, we will give a few definitions.

-}

data Direction = N | E | S | W
                 deriving (Eq, Show, Read)

-- Cartesian coordinate system
-- (as used in Java 2D API)
-- (x,y) :
-- the x coordinate increases to the right, and
-- the y coordinate increases downward,
-- as shown in the following figure
--
--      a b c d
--      0 1 2 3 ----> x
--  a 0
--  b 1
--  c 2
--    |
--    V
--    y
type Coord = (Int, Int)

-- A move is a coordinate and a direction.
type Move = (Coord, Direction)

-- Exercise (40 points). For deadline #1.
--
-- Define the following function to parse a string and produce a
-- sequence of moves in the above format.
--
--
-- An example of a string of moves is "adENba2EEWS".
--
-- This should produce
-- [((0,3),E),((2,3),N),((1,0),E),((3,0),E),((5,0),E),((7,0),W),((5,0),S)]
--
--   Two consecutive lower case letters are coordinates, as above, to
--   move the current position to.
--
--   The letters N, E, W, S are directions to move to.
--
--   A non-negative number specifies how many times the next
--   move N, E, W, or S should be performed.
--
-- So, in the above example,
-- which contains "2EE", the move E will be performed 2+1 times.
--
-- Ignore all spaces (newline, tab, blank) using the function isSpace
-- from the imported module Data.Char.

parseMoves :: String -> [Move]
parseMoves [] = []
parseMoves (' ':tl) = parseMoves(removeAllSpace tl)
parseMoves (x:y:z:tl) | (isLower x) && (isLower y) && (isUpper z) = (((alphaToCoord x), (alphaToCoord y)), checkDirection z) : parseMoveHelper (makeMove (alphaToCoord x, alphaToCoord y) (checkDirection z), tl)
                      | (isLower x) && (isLower y) && (isDigit z) = if(z/='0') then (((alphaToCoord x), (alphaToCoord y)), checkDirection c) : parseMoveHelper (makeMove (alphaToCoord x, alphaToCoord y) (checkDirection c), (convertChar (z:a) c ++ d)) else (parseMoveHelper ((alphaToCoord x, alphaToCoord y), d))
                      | otherwise = error(x:y:z:"Illegal move")
                      where (a, xs) = span (isDigit) tl
                            c:d = xs

parseMoveHelper :: (Coord, String) -> [Move]
parseMoveHelper (x,[]) = []
parseMoveHelper (q, (x:y:z:tl)) | (isLower x) && (isLower y) && (isUpper z) = (((alphaToCoord x), (alphaToCoord y)), checkDirection z) : parseMoveHelper (makeMove (alphaToCoord x, alphaToCoord y) (checkDirection z), tl)
                            | (isDigit x) && (isDigit y) && (isDigit z) = if(x/='0') then (q, checkDirection c) : parseMoveHelper (makeMove q (checkDirection c), ((convertChar (x:y:z:a) c) ++ tl)) else (parseMoveHelper (q, d))
                            | (isDigit x) && (isDigit y) && (isUpper z) = if(x/='0') then (q, checkDirection z) : parseMoveHelper (makeMove q (checkDirection z), ((convertChar (x:y:[]) z) ++ tl)) else (parseMoveHelper (q, tl))
                            | (isLower x) && (isLower y) && (isDigit z) = if(z/='0') then (((alphaToCoord x), (alphaToCoord y)), checkDirection c) : parseMoveHelper (makeMove (alphaToCoord x, alphaToCoord y) (checkDirection c), (convertChar (z:a) c ++ d)) else (parseMoveHelper ((alphaToCoord x, alphaToCoord y), d))
                            | (isUpper x) = (q, checkDirection x) : parseMoveHelper (makeMove q (checkDirection x), (y:z:tl))
                            | (isDigit x) && (isUpper y) = if(x/='0') then (q, checkDirection y) : parseMoveHelper (makeMove q (checkDirection y), ((convertChar (x:[]) y) ++ z:tl)) else (parseMoveHelper (q, (z:tl)))
                            where (a, xs) = span (isDigit) tl
                                  c:d = xs
parseMoveHelper (q, (x:y:tl))   | (isDigit x) = if(x/='0') then (q, checkDirection y) : parseMoveHelper (makeMove q (checkDirection y), ((convertChar (x:[]) y)) ++ tl) else (parseMoveHelper (q, tl))
                            | (isUpper x) = (q, checkDirection x) : parseMoveHelper (makeMove q (checkDirection x), (y:tl))
parseMoveHelper (q, (x:tl)) = (q, checkDirection x) : parseMoves tl

-- this assigns the upper case alphabets to directions.
checkDirection :: Char -> Direction
checkDirection x          | x=='N' = N
                          | x=='S' = S
                          | x=='E' = E
                          | x=='W' = W

-- this will turns the character to the an coord int.
alphaToCoord :: Char -> Int
alphaToCoord hd = (ord hd) - 97

-- this will make the move according to the direction after the direction has been checked
makeMove :: Coord -> Direction -> Coord
makeMove (x, y) d 	| d==N = (x, y-2)
                    | d==S = (x, y+2)
                    | d==E = (x+2, y)
                    | d==W = (x-2, y)

convertChar :: String -> Char -> String
convertChar a b = if (a/= "0") then (replicate (((read (a)::Int)) - 1) b) else []

removeAllSpace :: String -> String
removeAllSpace [] = []
removeAllSpace (x:xs)
        | (isSpace x) = (removeAllSpace xs)
        | otherwise = x:(removeAllSpace xs)



-- We need the following definition for the next exercise.
--
-- The state of each place in the board is one of the following:
--
--  - illegal
--  - empty
--  - occupied
--
-- So, a legal position is one which is empty or occupied.
--
-- When (i,j) is illegal then no ((i,j),_) is in the list defining the
-- state of the board.
--
-- ((i,j),True)  means (i,j) is occupied by a peg, and
-- ((i,j),False) means (i,j) is empty,
-- where 0 <= i,j <= 25, i.e. the maximum size of a board is 26x26
type BoardSpec = [(Coord, Bool)]

-- Exercise (10 points). For deadline #1.
--
-- Write a function that counts how many pegs
-- are in a given board:
countPeg :: BoardSpec -> Int
countPeg [] = 0
countPeg ((a,b) : xs)
                | b == True = 1 + countPeg xs
                | b == False = 0 + countPeg xs

-- Exercise (40 points). For deadline #1.
--
-- Convert a board to a String.
--
-- An example of a output is
--
--      o o o
--      o o o
--  o o o o o o o
--  o o o - o o o
--  o o o o o o o
--      o o o
--      o o o
--
-- There is a space between each pair of adjacent cells in the same line.
-- An illegal cell is presented by a space if there are legal cells on the right.
-- 'o' means that the cell is occupied by a peg, and
-- '-' means that the cell is empty.
-- Notice that there is NO spaces in the end of each line.
--
-- This will be useful for you to test your program.

highestX :: Int -> Int -> BoardSpec -> Int
highestX i a [] = i
highestX i a (((x, y), b): xs) = if ((i < x) && (a == y)) then highestX x a xs else highestX i a xs


highestY :: Int -> BoardSpec -> Int
highestY i [] = i
highestY i (((x,y),b):xs) = if i < y then highestY y xs else highestY i xs

showBoardHelper1 :: Coord -> BoardSpec -> String
showBoardHelper1 a [] = []
showBoardHelper1 (a, b) xs
        |elem ((a, b), True) xs  = if (a < (highestX (-1) b xs)) then "o " ++ showBoardHelper1 (a + 1, b) xs else "o" ++ showBoardHelper2 (0, b + 1) xs
        |elem ((a, b), False) xs = if (a < (highestX (-1) b xs)) then "- " ++ showBoardHelper1 (a + 1, b) xs else "-" ++ showBoardHelper2 (0, b + 1) xs
        |otherwise               = if (a < highestX (-1) b xs) then "  " ++ showBoardHelper1 (a + 1, b) xs else " " ++ showBoardHelper2 (0, b + 1) xs

showBoardHelper2 :: Coord -> BoardSpec -> String
showBoardHelper2 a [] = []
showBoardHelper2 (a, b) xs
        |b > (highestY (-1) xs) = []
        |elem ((a, b), True) xs  = if (a < highestX (-1) b xs) then "\no " ++ showBoardHelper1 (a + 1, b) xs else "\no" ++ showBoardHelper2 (0, b + 1) xs
        |elem ((a, b), False) xs = if (a < highestX (-1) b xs) then "\n- " ++ showBoardHelper1 (a + 1, b) xs else "\n-" ++ showBoardHelper2 (0, b + 1) xs
        |otherwise               = if (a < highestX (-1) b xs) then "\n  " ++ showBoardHelper1 (a + 1, b) xs else "\n " ++ showBoardHelper2 (0, b + 1) xs

showBoard :: BoardSpec -> String
showBoard all@(x:xs) = showBoardHelper1 (0, 0) (all)

-- This too:
printBoard :: BoardSpec -> IO ()
printBoard = putStrLn . showBoard


-- Exercise (40 points). For deadline #1.
--
-- Given a board specification (of type BoardSpec defined below), and
-- given a list of moves (of type Move defined above), produce either
-- Nothing (when a move in the list is impossible), or Just the
-- resulting board after performing all the moves.
--
-- Using this, and the function countPeg you defined above, also
-- define a function simulateMoves which only gives Just the number of
-- resulting pegs, or Nothing if an illegal move occurs:

runMoves :: BoardSpec -> [Move] -> Maybe BoardSpec
runMoves [] a = Nothing
runMoves xs [] = Just xs
runMoves xs (((a,b), d):tl) = runMoves (firstMove ((a, b), d) xs) tl

firstMove :: Move -> BoardSpec -> BoardSpec
firstMove ((e, f), d) xs = case d of
        N -> if c then secondMove ((e, f - 1), d) (init as ++ ((a, b), False):[] ++ bs) else []
        E -> if c then secondMove ((e + 1, f), d) (init as ++ ((a, b), False):[] ++ bs) else []
        S -> if c then secondMove ((e, f + 1), d) (init as ++ ((a, b), False):[] ++ bs) else []
        W -> if c then secondMove ((e - 1, f), d) (init as ++ ((a, b), False):[] ++ bs) else []
        where (as, bs) = if (findCoord (e, f) xs) > 0 then splitAt (findCoord (e, f) xs) xs else (xs, [])
              ((a, b), c) = last as

secondMove :: Move -> BoardSpec -> BoardSpec
secondMove ((e, f), d) xs = case d of
        N -> if c then thirdMove ((e, f - 1), d) (init as ++ ((a, b), False):[] ++ bs) else []
        E -> if c then thirdMove ((e + 1, f), d) (init as ++ ((a, b), False):[] ++ bs) else []
        S -> if c then thirdMove ((e, f + 1), d) (init as ++ ((a, b), False):[] ++ bs) else []
        W -> if c then thirdMove ((e - 1, f), d) (init as ++ ((a, b), False):[] ++ bs) else []
        where (as, bs) = if (findCoord (e, f) xs) > 0 then splitAt (findCoord (e, f) xs) xs else (xs, [])
              ((a, b), c) = last as

thirdMove :: Move -> BoardSpec -> BoardSpec
thirdMove ((e, f), d) xs = if (not c) then (init as ++ ((a, b), True):[] ++ bs) else []
        where (as, bs) = if (findCoord (e, f) xs) > 0 then splitAt (findCoord (e, f) xs) xs else (xs, [])
              ((a, b), c) = last as

findCoord :: Coord -> BoardSpec -> Int
findCoord (e, f) [] = (-999999999999)
findCoord (e, f) (((x, y), b):xs) = if (e==x) && (f==y) then 1 else 1 + (findCoord (e, f) xs)

maybe2Board :: Maybe BoardSpec -> BoardSpec
maybe2Board Nothing = error("Nothing")
maybe2Board (Just xs) = xs

simulateMoves :: BoardSpec -> [Move] -> Maybe Int
simulateMoves xs ys = if (runOutput == Nothing) then Nothing else (Just count)
                        where
                         runOutput = runMoves xs ys
                         maybeOut = maybe2Board runOutput
                         count = countPeg maybeOut

-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

-- Exercise (40 points). For deadline #2
--
-- Two positions of a board are adjacent if (1) they are next to each
-- other vertically, or (2) they are next to each other
-- horizontally. A board is called connected if every legal position
-- may be reached from any other legal position by travelling via
-- adjacent legal positions.
--
-- Check whether (the legal positions of) a board are connected.

{- >>>>>>>>> DON'T NEED TO USE IT

sortBoardHelper1 :: Coord -> BoardSpec -> BoardSpec
sortBoardHelper1 a [] = []
sortBoardHelper1 (a,b) xs
		|elem ((a, b), True) xs  = if (a < (highestX (-1) b xs)) then [((a,b), True)] ++ sortBoardHelper1 (a + 1, b) xs else [((a,b), True)] ++ sortBoardHelper2 (0, b + 1) xs
        	|elem ((a, b), False) xs = if (a < (highestX (-1) b xs)) then [((a,b), False)] ++ sortBoardHelper1 (a + 1, b) xs else [((a,b), False)] ++ sortBoardHelper2 (0, b + 1) xs
        	|otherwise               = if (a < highestX (-1) b xs) then [] ++ sortBoardHelper1 (a + 1, b) xs else [] ++ sortBoardHelper2 (0, b + 1) xs

sortBoardHelper2 :: Coord -> BoardSpec -> BoardSpec
sortBoardHelper2 a [] = []
sortBoardHelper2 (a, b) xs
        |b > (highestY (-1) xs) = []
        |elem ((a, b), True) xs  = if (a < highestX (-1) b xs) then [((a,b), True)] ++ sortBoardHelper1 (a + 1, b) xs else [((a,b), True)] ++ sortBoardHelper2 (0, b + 1) xs
        |elem ((a, b), False) xs = if (a < highestX (-1) b xs) then [((a,b), False)] ++ sortBoardHelper1 (a + 1, b) xs else [((a,b), False)] ++ sortBoardHelper2 (0, b + 1) xs
        |otherwise 		 = if (a < highestX (-1) b xs) then [] ++ sortBoardHelper1 (a + 1, b) xs else [] ++ sortBoardHelper2 (0, b + 1) xs


sortBoard :: BoardSpec -> BoardSpec
sortBoard all = sortBoardHelper1 (0, 0) (all)

 -}

isConAdj :: Coord -> BoardSpec -> Bool
isConAdj (x,y) [] = False
isConAdj (x,y) (((x',y'),b):xs)
                                | x' == x+1 && y' == y = True
                                | x' == x-1 && y' == y = True
                                | x' == x && y' == y+1 = True
                                | x' == x && y' == y-1 = True
                                | otherwise = False || isConAdj (x,y) xs


isConHelper :: BoardSpec -> BoardSpec -> BoardSpec -> BoardSpec
isConHelper ys [] visited = visited
isConHelper ys (((x,y),b):xs) visited = if isConAdj (x,y) ys then isConHelper ys xs (visited ++ [((x,y),b)]) else isConHelper ys xs visited

isConnected :: BoardSpec -> Bool
isConnected xs
                        | tail(xs) == [] = True
                        | otherwise = xs == isConHelper xs xs []



-- Bonus Exercise (20 points). For deadline #2
--
-- Count how many connected components the legal positions form.
--
-- There is at most one connected component if the board is connected
-- as above.
numConnectedComponents :: BoardSpec -> Int
numConnectedComponents = undefined

-- We define our own Rand monad for random number generation:
newtype Rand a = Rand(StdGen -> (a , StdGen))

instance Monad Rand where
 return x = Rand (\s -> (x,s))
 Rand g >>= f = Rand (\s -> let (x, s')  = g s
                                (Rand h) = f x
                            in h s')

randDouble :: Rand Double
randDouble = Rand random

randInt :: Rand Int
randInt = Rand random

-- Run a Rand with the specified initial seed
runRand :: Int -> Rand a -> a
runRand seed (Rand g) = fst (g (mkStdGen seed))


-- Generates a random element  ---cxx993@cs.bham.ac.uk
uniform :: [a] -> Rand a
uniform l = do
    i <- randInt
    let n = abs i `mod` (length l)
    return $ l !! n

-- Example:
--
-- *Template6 Control.Monad> runRand 1 (replicateM 30 (uniform [1..10]))
-- [5,2,1,1,10,8,5,7,2,8,7,2,6,3,5,7,1,10,3,6,6,1,9,2,7,8,3,10,6,4]
--
-- (This in principle can give different results in different versions of Haskell,
--  if the random generation procedure in the libraries are changed.)

testRand :: Rand (Int, Int, Int)
testRand = do
    x <- uniform [1..10]
    y <- uniform [1..10]
    z <- uniform [1..10]
    return (x, y, z)

-- Exercise (30 points). For deadline #2.
-- Generate a random square board of a certain height and width.

randBool :: Rand Bool
randBool = Rand random




genBool :: IO Bool
genBool = getStdRandom (randomR (True,False))

io2Bool :: IO Bool -> Bool
io2Bool i =



genCoord :: Int -> Int -> Int -> [Coord] -> [Coord]
genCoord 0 x y coords = []
genCoord i x y coords
                | x < i-1 = genCoord i (x+1) y cod
                | y < i-1 = genCoord i 0 (y+1) cod
                | otherwise = cod
                           where cod = coords ++ [(x,y)]


populate :: [Coord] -> BoardSpec -> BoardSpec
populate [] lastfil = lastfil
populate (x:xs) filled = filled ++ [(x,y)] ++ populate xs filled
			where IO y = genBool

genBoardSpec :: Int -> Rand BoardSpec
genBoardSpec = undefined

{-genBoardSpec i  = return (populate (genCoord i) [])

genBoardSpec x = do
        n <- Rand True -- n == True
-}

-- Exercise (30 points). For deadline #2.
--
-- Given a board, randomly play legal moves until no further legal
-- moves are possible.

playRandomly :: BoardSpec -> Rand [Move]
playRandomly = undefined


-- Exercise (100 points). For deadline #3.
--
-- This will be your best try for playing the game intelligently.
--
-- To get any mark at all in this exercise, your solution should (1)
-- take no more than the test bench allows, in a lab machine, in a
-- board size given by the test bench, and (2) be strictly better than
-- a random play.
--
-- The test bench for this part will be given in advance.
--
--
-- Mark allocation, subject to the above restrictions.
--
--     100 for ending up with one peg, and fast (according to the testbench).
--      70 for ending up with one peg, and reasonably fast (according to the testbench).
--   40-69 for ending with few pegs, and reasonably fast (according to the testbench).
--    1-39 see test bench results.
--
-- The test bench will only give you approximate marks, due to the
-- probabilistic nature of our testing. We will test your program
-- several times and take averages.

play :: BoardSpec -> [Move]
play = undefined