import Data.Bits  -- .&. , .|. , shiftL , shiftR , complementBit
import Data.Ord  -- comparing
import Data.List  -- minimumBy

{- 

A FUNCTIONAL AND MODULAR A.I - TIC TAC TOE EXAMPLE - INSPIRED BY "WHY FP MATTERS" BY JOHN HUGHES

given a position, bestMove returns the best move for the computer to make
best move is computed using the minimax algorithm on a game tree.

-}

bestMove :: Int -> Int  
bestMove = minimumBy (comparing evaluate) . nextPositions

abBestMove = minimumBy (comparing abEvaluate) . nextPositions

evaluate :: Int -> Int -- launch the maximise - minimise co-recursion
evaluate = maximise . mapTree static . prune 5 . buildGTree

abEvaluate :: Int -> Int
abEvaluate = abMaximise . mapTree static . prune 8 . buildGTree

maximise :: GameTree -> Int		
maximise (Node n []) = n
maximise (Node _ ns) = maximum $ map minimise ns

minimise :: GameTree -> Int
minimise (Node n []) = n
minimise (Node _ ns) = minimum $ map maximise ns

abMaximise :: GameTree -> Int
abMaximise = maximum . abMaximise' 
abMaximise' :: GameTree -> [Int]
abMaximise' (Node n []) = [n]
abMaximise' (Node _ subs) = mapMin . map abMinimise' $ subs
mapMin :: [[Int]] -> [Int]
mapMin (nums : rest) = (minimum nums) : (omitIf  (<=) (minimum nums) rest)

abMinimise :: GameTree -> Int
abMinimise = minimum . abMinimise'
abMinimise' :: GameTree -> [Int]
abMinimise' (Node n []) = [n]
abMinimise' (Node _ subs) = mapMax . map abMaximise' $ subs
mapMax :: [[Int]] -> [Int]
mapMax (nums : rest) = (maximum nums) : (omitIf  (>=) (maximum nums) rest)

omitIf p a [] = []
omitIf p a (xs:xss)
	| any (p a) xs = omitIf p a xss
	| otherwise = (minimum xs) : (omitIf p (minimum xs) xss)

static :: Int -> Int -- no look-ahead evaluation of a position: -1 if player wins, 1 if computer wins, 0 otherwise
static = static' . decomp
	where
		static' (_, c, p)
			| p `elem` winners = -1
			| c `elem` winners = 1
			| otherwise = 0

{-  GameTree type and building functions // should have been generalised!! -}

data GameTree = Node Int [GameTree] deriving (Show)

buildGTree :: Int -> GameTree -- build a potentially infinite game tree from a position
buildGTree p = Node p (map buildGTree $ nextPositions  p)

nextPositions :: Int -> [Int] -- all possible positions following the position in argument
nextPositions = nextPositions' . decomp
	where
		nextPositions' (1, c, p) = map (\x -> rebuild 0 x p) . map (.|. c) . filter (\m -> (m .&. (p .|. c)) == 0)  $ allMoves
		nextPositions' (0, c, p) = map (rebuild 1 c) .  map (.|. p) . filter (\m -> (m .&. (p .|. c)) == 0) $ allMoves

prune :: Int -> GameTree -> GameTree -- prune the game tree to keep n levels
prune 0 (Node t _) = Node t []
prune n (Node t rest) = Node t (map (prune (n-1)) rest)

foldTree :: (Int -> b -> c) -> (c -> b -> b) -> b -> GameTree -> c  -- self explanatory 
foldTree f g a (Node l subs) = f l (foldTree' f g a subs)
	where
		foldTree' :: (Int -> b -> c) -> (c -> b -> b) -> b -> [GameTree] -> b
		foldTree' f g a (s : ss) = g (foldTree f g a s) (foldTree' f g a ss);
		foldTree' f g a [] = a

-- mapTree :: (Int -> Int) -> GameTree -> GameTree -- idem
-- mapTree f = foldTree (Node . f) (:) []

mapTree :: (Int -> Int) -> GameTree -> GameTree
mapTree f (Node n []) = Node (f n) []
mapTree f (Node n ns) = Node (f n) (map (mapTree f) ns)


{- 
Board building and analysing utilities
a board is represented by 19 bits:
0-8 : player pos, 9-17 : computer pos, 18: whose turn it is (0 player, 1 computer)
-}

mask9 :: Int -- #111111111b
mask9 = 2^9-1

makeMask :: [Int] -> Int  -- creates a binary mask from the list of 'on' bits
makeMask = foldr ((+) . (2^)) 0

-- all winning positions
winners = map makeMask [[0,1,2], [3,4,5], [6,7,8], -- lines
                        [0,3,6], [1,4,7], [2,5,8], -- columns
                        [0,4,8], [2,4,6]]          -- diagonals
 
turnBit :: Int  -- name of the bit showing whose turn it is
turnBit = 18

allMoves :: [Int]  -- all possible moves on a virgin board
allMoves = [2^x | x <- [0..8]]

rebuild :: Int -> Int -> Int -> Int -- creates a board from t (whose turn), c (computer position), p (player position)
rebuild t c p = p .|. (shiftL c 9) .|. (shiftL t turnBit)

decomp :: Int -> (Int, Int, Int)  -- inverse operation from rebuild
decomp p = (if testBit p 18 then 1 else 0, (shiftR p 9) .&. mask9, p .&. mask9)