module C8 where

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

instance Show a => Show (NestedList a) where
	show (Atom x) = "<" ++ show x ++ ">"
	show (List l) = "{" ++ (show $ head l) ++ concat (zipWith (++) (repeat ", ") $ map show $ tail l) ++ "}"
instance Show a => Show (Pair a) where
	show (P x y) = "<" ++ show x ++ ", " ++ show y ++ ">"

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] where
	invert = reverse

{-- 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
	contents :: t a -> [a]
instance Container Pair where
	contents (P x y) = [x, y]
instance Container NestedList where
	contents (Atom x)	=	[x]
	contents (List x)	=	concat $ map contents x
instance Container [] where
	contents = id
--}


--
f1 :: Eq a => a -> a -> a -> a
f1 x y z	=	if x == y then x else z

f2 :: (Eq (t a), Container t, Invertible (t a)) => t a -> t a -> [a]
f2 x y		=	if (invert x) == (invert y)
					then contents x
					else contents y

f3 :: Invertible a => [a] -> [a] -> [a]
f3 x y		=	(invert x) ++ (invert y)

f4 :: Ord a => a -> a -> a -> a
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
left Nil = undefined
left (Leaf _) = Nil
left (Node _ (t:_)) = t -- primul copil
right Nil = undefined
right (Leaf _) = Nil
right (Node _ (_:t:_)) = t -- al doilea copil
			
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

{-- bfs pe arbore
bfsT = bfsTR . (flip (:) [])

bfsTR [] = []
bfsTR ((Leaf root):open) = [root] ++ bfsTR open
bfsTR ((Node root children) : open) = 
		root : bfsTR (open ++ children)
--}

-- afișare arbore binar
put value space = spacer ++ show value ++ (drop 2 spacer)
	where spacer = [' ' | _ <- [1..space]]
printTree tree = putStr $ pT [tree, Nil] 32
pT [Nil] _ = "\n"
pT (Nil : open) sp = "\n" ++ pT (open ++ [Nil]) (div sp 2)
pT ((Leaf root) : open) sp = put root sp ++ pT open sp
pT ((Node root children) : open) sp = put root sp ++ pT (open ++ children) sp
-----------------------



-- lucru pe grafuri
-- graful de la laborator 4
graph = [(3, 8), (3, 10), (5, 11), (7, 8), (7, 11),
		(8, 9), (11, 2), (11, 9), (11, 10)]

outgoing x = map snd . (filter $ (== x) . fst)

qs [] = []
qs (h:l) = qs [x | x <- l, x < h] 
			++ [h]
			++ qs [x | x <- l, x > h]

nodes = qs . nodesA

nodesA [] = []
nodesA ((a, b):g) = (filter (not . flip elem rest) [a, b]) ++ rest
	where rest = nodesA g

assoc e = elem e . map fst

-- dfs cu limitarea adâncimii
dfsG1AD depth hAux v g = 
	let dfsGR d v h = 
		if d == 0 then h else
			foldl (\hLocal child -> 
				if assoc child $ hLocal ++ hAux then hLocal else
					dfsGR (d - 1) child $ hLocal ++ [(child, v)]
				) h $ outgoing v g
	in dfsGR depth v [(v, -1)] 

dfsG depth g = foldl (\sol node ->
		if assoc node sol then sol else sol ++ dfsG1AD depth sol node g
		) [] $ nodes g
		

maxV = 10
edges ns = (ns !! 0, ns !! 1) : (edges $ drop 2 ns)

-- graf fix
--dfs (-1) graph

-- orice adâncime, graf mic
--dfs (-1) $ take 10 $ edges $ randomRs (0, maxV) $ mkStdGen 4242

-- orice adâncime, graf mare (se oprește când deja a parcurs toate nodurile)
--dfs 1 $ take 100 $ edges $ randomRs (0, maxV) $ mkStdGen 4242

-- adâncime 1, graf mic
--dfs 1 $ take 10 $ edges $ randomRs (0, maxV) $ mkStdGen 4242

-- adâncime 1, graf mare
--dfs 1 $ take 100 $ edges $ randomRs (0, maxV) $ mkStdGen 4242



class Explorable t where
	-- parcurgere
	paR :: Eq a => ([t a] -> [t a] -> [t a]) -> [t a] -> [a]
	paR _ [] = []
	paR op (x:open)
		| trm x = val x : paR op open
		| otherwise = val x : paR op (open `op` cld x)

	dfs :: Eq a => t a -> [a]
	dfs x = paR (flip (++)) [x]

	bfs :: Eq a => t a -> [a]
	bfs x = paR (++) [x]
{-	bfs = bfsR . (flip (:) [])
		where
			bfsR [] = []
			bfsR (x:open)
				| trm x = val x : bfsR open
				| otherwise = val x : bfsR (open ++ cld x)
-}	
	
	trm :: Eq a => t a -> Bool	-- terminal
	val :: t a -> a				-- value
	cld :: Eq a => t a -> [t a]	-- children

instance Explorable Tree where
	trm (Leaf x) = True
	trm _ = False
	val (Leaf x) = x
	val (Node x _) = x
	cld (Node _ children) = children
	

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

instance Explorable Graph where
	trm (G (n, g)) = outgoing n g == []
	val (G (n, _)) = n
	cld (G (n, g)) = map (G . (flip (,) $ g)) $ outgoing n g