tic-tac-toe-0.1: MyTree.hs

module MyTree 
  where
  
import DataTypes
import Data.Tree
import Data.Maybe
import Data.List
import Data.Ord

-- this is an implementation without monads:
myTreeMap :: (a -> b) -> Tree a -> Tree b
myTreeMap f (Node node subTree)  = Node (f node) (myTreeMap' f subTree)
			where myTreeMap' f []           = []
			      myTreeMap' f (first:rest) = (myTreeMap f first) : (myTreeMap' f rest)

-- this is an implementation with monads:
--myTreeMap :: (a -> b) -> Tree a -> Tree b
--myTreeMap f tree = do
--		    move <- tree
--		    return (f move)

-- regular zipper, except that during execution, if a node finds that it has won or lost,
-- further generation of the tree stops. We need this so that we dont get weird results when
-- we use minimax.
myCustomTreeZip :: Tree Float -> Tree TableMove -> Tree (Float,TableMove)
myCustomTreeZip (Node n1 s1) (Node n2 s2) = if n1 == 1/0 || n1 == -1/0 then Node (n1,n2) [] else Node (n1,n2) (myTreeZip' s1 s2)
			where myTreeZip' [] _ = []
			      myTreeZip' _ [] = []
			      myTreeZip' (f1:r1) (f2:r2) = (myCustomTreeZip f1 f2) : (myTreeZip' r1 r2)

gameTree :: Tree TableMove -> Tree TableMove
gameTree p = reptree moves p 

-- initialize a non-empty board
makeTableTree :: Board -> CurrentMove -> Tree TableMove
makeTableTree board currentMove = Node (toTableMove board (findHistory board) currentMove) []

-- given a board, returns the history of moves already taken
findHistory :: Board -> [Integer]
findHistory board = foldr (\(p,n) xL -> if p == (Just O) || p == (Just X) then n:xL else xL) [] (zip (concat board) [0..]) 

reptree :: (TableMove -> [Tree TableMove]) -> Tree TableMove -> Tree TableMove
reptree f (Node node []) =
				Node node (map (reptree f) (f node))

-- function responsible for generating a tree and making the input the parent 
-- of all the other subtrees. It does this by getting each possibility of the input
-- excluding the ones in the history that have already been processed. It then proceeds 
-- to remove the symmetries from the generated possibilities, after which it it converts 
-- the TableMove to a Tree of TableMove. For each input, it generates all the possible moves 
-- that the node can make in a list.
moves :: TableMove -> [Tree TableMove]
moves thisNode = map (makeLeafs) (removeSymmetries (map (possibilities thisNode) ([0..8] \\ (accessHistory thisNode))))

-- makes a TableMove into a Tree of TableMove with empty leafs
makeLeafs :: TableMove -> Tree TableMove
makeLeafs (xs) = Node xs [] 

-- a container that interfaces with the possibly function, converting
-- the data into its appropriate type. The Integer is the move placeholder 
-- that we want to place a X or O.
possibilities :: TableMove -> Integer -> TableMove
possibilities node n = toTableMove (possibly (accessMaybeMove node) n (accessCurrentMove node)) (n : (accessHistory node)) (getOtherMove (accessCurrentMove node))

-- breaks down the current TableMove into three rows,
-- with x being the first, y being the second, and z being the third.
-- xs is an empty list. Note: I could probably simplify this to a lot 
-- less code using the chop function.
possibly :: [[Maybe Move]] -> Integer -> Maybe Move -> [[Maybe Move]]
possibly (x:y:z:xs) n currentMove 
		  | n >= 0 && n <= 2 = possibly' x (n `mod` 3) : y : z : xs
		  | n >= 3 && n <= 5 = x : possibly' y (n `mod` 3) : z : xs
		  | n >= 6 && n <= 8 = x : y : possibly' z (n `mod` 3) : xs
		  | otherwise        = x : y : z : xs
                where trulyNothing elem  = if isNothing elem then (getOtherMove currentMove) else elem
		      possibly' (x:y:z:xs) m
		        | m == 0 = trulyNothing x : y : z : xs
		        | m == 1 = x : trulyNothing y : z : xs
		        | m == 2 = x : y : trulyNothing z : xs
		        | otherwise = x : y : z : xs

removeSymmetries :: [TableMove] -> [TableMove]
removeSymmetries []     = []
removeSymmetries (x:xL) = x : removeSymmetries (filter (/= x) xL)