module C8 where

import Data.Char
import Debug.Trace
import C7

-- Pair 1 2
-- List [1,2,3]
l = List [Atom 1, Atom 2, List [Atom 3, Atom 4], Atom 5]

data Pair a = P a a
data NestedList a 	=	Atom a |	List [NestedList a]


class Invertible a where
	invert	::	a -> a
	invert	=	id
instance Invertible (Pair a) where
	invert (P x y) = P y x
instance Invertible (NestedList a) where 
	invert a@(Atom x)	= a
	invert (List x)		= List $ reverse $ map invert x
instance Invertible a => Invertible [a] where
	invert = reverse . map invert 
	
	
{-- v1
class Container a where	contents :: a -> [a]

instance Container [x] where
--	contents [x] = [x]
	contents = id
--}

{-- v2
class Container a where	contents :: a -> [b]

instance Container [x] where
	contents = id
--}


--{--v3
class Container t where -- -> t unifică la un constructor de tip
	contents :: t x -> [x]

instance Container [] where
	contents = id
instance Container Pair where
	contents (P x y) = [x, y]
instance Container NestedList where
	contents (Atom x) = [x]
	contents (List l) = concat $ map contents l -- concatMap
--}







--{--
f1 x y z	=	if x == y then x else z

f2 x y		=	if (invert x) == (invert y)
					then contents x
					else contents y

f3 x y		=	(invert x) ++ (invert y)

f4 x y z	=	if x == y then z else 
					if x > y then x else y
--}


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

-- tree = [1, [tree], [tree]] -> tip neuniform al elementelor din listă
-- tree = (1, tree, tree) -> tip infinit pentru ultimele două elemente din pereche

data Tree a = Nil				-- arbore vid
			| Leaf a			-- frunză
			| Node a [Tree a]	-- nod cu un număr oarecare de copii

root Nil = undefined
root (Leaf r) = r
root (Node r _) = r
			
tree1 = Node 1 [tree1, tree1]

-- arbore binar care la BFS dă lista de numere
treeB = Node 1 [(tBL 1), (tBR 1)]
	where
		tBL p = let l=2*p in if l > 7 then Leaf l else Node l [(tBL l), (tBR l)]
		tBR p = let r=2*p+1 in if r > 7 then Leaf r else Node r [(tBL r), (tBR r)]

-- arbore binar infinit care la BFS dă lista de numere
treeIB = Node 1 [(tBL 1), (tBR 1)]
	where
		tBL p = let l=2*p in Node l [(tBL l), (tBR l)]
		tBR p = let r=2*p+1 in Node r [(tBL r), (tBR r)]

preord Nil = []
preord (Leaf root) = [root]
preord (Node root children) = foldl (++) [root] $ map preord children

terminate 0 _ = Nil
terminate at t = case t of
	Node x children -> Node x $ map (terminate (at-1)) children
	otherwise -> t


showTree tree = pt 0 tree where
			pt level tree = case tree of
				Nil -> space level ++ "- \n"
				Leaf val -> space level ++ show val ++ "\n"
				Node val children -> space level ++ show val ++ "\n" ++ 
					if all isNil children then "" else
						concatMap (pt $ level + 1) children
			space sp = [' ' | _ <- [1..sp * 2]]
			isNil Nil = True
			isNil _ = False

instance Show a => Show (Tree a) where
	show = showTree

	
class TreeLike t where
	makeOne :: a -> t a
	toTree :: Eq a => (t a) -> Tree a
	reduce :: Eq a => (a -> b) -> (a -> [b] -> b) -> b -> t a -> b
	reduce redLeaf redNode vNil treelike = red $ toTree treelike where
		red Nil = vNil
		red (Leaf x) = redLeaf x
		red (Node x children) = redNode x $ map red children
			
	
	
instance TreeLike Tree where
	makeOne x = Leaf x
	toTree = id
	
sumTree tree = reduce id (foldl (+)) 0 tree

instance TreeLike Expr where
	makeOne x = Number x
	toTree (Number x) = Leaf x
	toTree (Op e1 op e2) = Node op $ map toTree [e1, e2]
	
fromNumber (Number x) = x

-- toTree $ fromRes $ fst $ exprParser "123+((25+3)*5)"

computeExpr e = reduce fLeaf fNode 0 $ fromRes $ fst $ exprParser "123+((25+3)*5)" where
	fLeaf = read
	fNode "+" = foldl (+) 0
	fNode "*" = foldl (*) 1

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

data Graph a = G [(a, a)]

graph = G [(3, 8), (3, 10), (3, 5), (5, 11), (7, 8), (7, 11),
		(8, 9), (11, 2), (11, 9), (11, 10)]

outgoing x = map snd . (filter $ (== x) . fst)
nodes (G []) = []
nodes (G (e:g)) = eNodes ++ (filter (not . (flip elem $ eNodes)) $ nodes $ G g) where eNodes = [fst e, snd e]

--- varianta 1: dfs întoarce o pereche între arborele rezultat din parcurgere și lista tuturor nodurilor parcurse până în prezent
--- rezultatul lui fold este o pereche între lista subarborilor copiilor și 
---  lista tuturor nodurilor parcurse până în prezent
instance TreeLike Graph where
	makeOne x = G [(x, undefined)]
	toTree g@(G edges) = fst $ dfs first [] where
		first = head $ nodes g -- parcurgem din primul nod din graf
		
		-- node> nodul curent; history: nodurile parcurse deja
		dfs node history = case [n | n <- outgoing node edges, not $ elem n history] of
			[] -> (Leaf node, node : history)	-- dac[ nu mai sunt copii neparcurși -> frunză
			children -> (Node node $ reverse $ fst result, snd result) where
				result = foldl -- result (și acumulatorul) va fi o pereche (listă sub-arbori, totalitatea nodurilor parcurse)
					(\r@(subtrees, historyLocal) child ->
						if elem child historyLocal then r else
							let resDfs = dfs child historyLocal in -- găsim o nouă pereche (sub-arbore, noduri parcurse)
								(fst resDfs : subtrees, snd resDfs) -- asamblăm în rezultat
					)
					([], history) children


--- tipul lui makeOne este:
--- makeOne :: TreeLike t => a -> t a

-- makeOne 5 -- nu știm ce tip trebuie să întoarcă makeOne (este ambiguu)
-- preord $ makeOne 5 -- clar makeOne trebuie să întoarcă un Tree pentru că preord :: Tree a -> [a]
-- fromNumber $ makeOne 5 -- makeOne trebuie să întoarcă un Expr pentru că fromNumber :: Expr t -> t
-- nodes $ makeOne 5 -- excepție (undefined)
-- head $ nodes $ makeOne 5 -- nu dă excepție mulțumită evaluării leneșe