module Sim where


import Char
import Graphics.UI.WX	
import Graphics.UI.WXCORE
import HXML
import MyParserSpec


qsort []     = []
qsort (x:xs) =(qsort elts_lt_x ++ qsort elts_eq_lt_x ++ [x] ++ qsort elts_eq_gr_x ++ qsort elts_greq_x)
                 where
                   elts_lt_x   = [y | y <- xs, (fst y) < (fst x)]
                   elts_eq_lt_x = [y | y <- xs,(fst y) == (fst x)&&(snd y) < (snd x)]
		   elts_eq_gr_x = [y | y <- xs,(fst y) == (fst x)&&(snd y) >=(snd x)]
		   elts_greq_x = [y | y <- xs, (fst y) >(fst x)]


--mergeSort :: Ord a => [a] -> [a]
mergeSort []  = []
mergeSort [z] = [z]
mergeSort zs  = mische (mergeSort us) (mergeSort vs)
        where n  = length zs
              us = take (div n 2) zs
              vs = drop (div n 2) zs

--mische :: Ord a => [a] -> [a] -> [a]
mische [] ys = ys
mische xs [] = xs
mische (x:xs) (y:ys) | (snd x)<=(snd y) = x:(mische xs (y:ys))
                     | otherwise = y:(mische (x:xs) ys)

--mergeSort2 :: Ord a => [a] -> [a]
mergeSort2 []  = []
mergeSort2 [z] = [z]
mergeSort2 zs  = mische2 (mergeSort2 us) (mergeSort2 vs)
        where n  = length zs
              us = take (div n 2) zs
              vs = drop (div n 2) zs

--mische2 :: Ord a => [a] -> [a] -> [a]
mische2 [] ys = ys
mische2 xs [] = xs
mische2 (x:xs) (y:ys) | (fst x)>=(fst y) = x:(mische2 xs (y:ys))
                     | otherwise = y:(mische2 (x:xs) ys)



previsitAux [] _ _ _ = do return []
previsitAux (x:xs) pos adjlist nextpos = do {
					     adjaux<-varGet adjlist;
					     next<-varGet nextpos;
					     adjaux<-return ((pos,next):adjaux);
					     varSet adjlist adjaux;	
					     singprev<-previsit x next adjlist nextpos;	
					     restprev<-previsitAux xs pos adjlist nextpos;
					     return (singprev++restprev)
					    }	

previsit tree pos adjlist nextpos = case tree of

		Tree (ELNode x args) [] -> do {
					       next<-varGet nextpos;
			   		       varSet nextpos (next+1);
					       adjaux<-varGet adjlist;
					       adjaux<-return ((pos,-1):adjaux);
					       varSet adjlist adjaux;
					       return (x:[])}		

		Tree (ELNode x args) treelist -> do{ next<-varGet nextpos;
						     varSet nextpos (next+1);
						     rest<-(previsitAux treelist pos adjlist nextpos);
					             return (x:rest)}
		
		Tree (TXNode x) [] ->do {
					 next<-varGet nextpos;
			        	 varSet nextpos (next+1);
					 adjaux<-varGet adjlist;
					 adjaux<-return ((pos,-1):adjaux);
					 varSet adjlist adjaux;
					 return (x:[])}

groupList [] = []
groupList (l:ls) = [l:(belong (fst l) ls)]:(groupList (notbelong (fst l) ls))

createParents [] = [(0,0)]					
createParents (x:xs) = if ((snd x) /= -1)
		       then ((snd x),(fst x)):(createParents xs)
		       else (createParents xs)	 


createVec []=[]
createVec ((x,y):ls) = y:(createVec ls) 

makeAdjList tree = do{  adjlist<-varCreate [];
			nextpos<-varCreate 0;
			labels<-previsit tree 0 adjlist nextpos;
			adjlistaux<-varGet adjlist;
			auxlist<-return (qsort adjlistaux);
			parents<-return (createParents auxlist);
			return ((labels,((createVec.qsort)parents)),(concat(groupList auxlist)))}


unMark[]=[]
unMark ('#':xs)=xs
unMark (x:xs) = (x:xs)

strEq [] [] = True
strEq [] _ = False
strEq _ [] = False
strEq (x:xs) (y:ys) = (x==y)&&(strEq xs ys)

selElem _ [] = error ("Error in selElem!: index out of bounds")
selElem 0 (x:xs) = x
selElem index (x:xs) = selElem (index-1) xs

labelRelationAux2 i elemi parenti j elemj parentj = if (isVar elemi)
							  then if (i == 0)
							       then [(i,j)]
							       else if (j /= 0)
								    then if (strEq (unMark parenti) (unMark parentj))
								         then [(i,j)]
									 else []
								    else []
						    else if (strEq (unMark elemi) (unMark elemj))
							 then [(i,j)]
							 else []	


labelRelationAux1 _ _ _ _ _ [] = []
labelRelationAux1 pos1 elemi parenti pos2 nodes2 (py:pys) = (labelRelationAux2 pos1 elemi parenti pos2 (selElem pos2 nodes2) (selElem py nodes2)):(labelRelationAux1 pos1 elemi parenti (pos2+1) nodes2 pys)

labelRelation _ _ [] _ _ _ = []
labelRelation pos1 nodes1 (px:pxs) pos2 nodes2 (py:pys) = (labelRelationAux1 pos1 (selElem pos1 nodes1) (selElem px nodes1) pos2 nodes2 (py:pys)):(labelRelation (pos1+1) nodes1 pxs pos2 nodes2 (py:pys)) 

belong x list =[ y | y<-list, (fst y) == x]

notbelong x list =[ y | y<-list, (fst y) /= x]




selElems [] _ = []
selElems (x:xs) nodes = if (x/= -1)
			then (selElem x nodes):(selElems xs nodes)
			else "null":(selElems xs nodes)


labelTestSingle node adjs2
	|(isVar node) = if ((head adjs2) =="null")
			then False	
			else True
	|otherwise = if (elem (unMark node) (map unMark adjs2)) 
		     then True
		     else False

labelTestAux2 [] _ = True
labelTestAux2 (a:as) adj2 = (labelTestSingle a adj2)&&(labelTestAux2 as adj2) 


labelTestAux1 _ [] _ _ = error ("Empty adjlist2!")
labelTestAux1 [] _ _ _ = error ("Empty adjlist1!")
labelTestAux1 list1 list2 nodes1 nodes2 = if (head list1)==(-1) 
					  then True
					  else labelTestAux2 (selElems list1 nodes1) (selElems list2 nodes2) 


labelTest [] _ _ = []
labelTest (x:xs) info1 info2 =if (labelTestAux1 (map snd (selElem (fst x)(snd info1))) (map snd (selElem (snd x) (snd info2))) ((fst.fst)info1) ((fst.fst)(info2)))
			      then x:(labelTest xs info1 info2)
			      else (labelTest xs info1 info2) 

removeCouple [] _ _ = []
removeCouple (l:lsim) info1 info2 = (labelTest l info1 info2):(removeCouple lsim info1 info2)

makeList [] = []
makeList (x:xs) = [x]:(makeList xs)

mult [] _ = []
mult x [] = [x]
mult (x:xs) cls =if (tail cls) == []
		 then (x:(head cls)):(mult xs cls)
		 else ((map (x:) cls)++(mult xs cls))

injective [] = []
injective (l:ls) = mult l (injective ls)

filterSingle [] _ _ _= []
filterSingle (p:restp) aux parent1 parent2 = if ((fst p) == 0)
					then p:(filterSingle restp aux parent1 parent2) 
					else if (elem ((selElem (fst p) parent1),(selElem (snd p) parent2)) aux)
					     then p:(filterSingle restp aux parent1 parent2)
					     else (filterSingle restp aux parent1 parent2)

filterAll [] _ _ = []
filterAll injlist parent1 parent2 = if (length (filterSingle (head injlist) (head injlist) parent1 parent2))<(length parent1)
				    then (filterAll (tail injlist) parent1 parent2)
				    else (filterSingle (head injlist) (head injlist) parent1 parent2):(filterAll (tail injlist) parent1 parent2)


filterInjectiveAux [] _ = []
filterInjectiveAux (x:xs) labels1 
	|(null xs) = (x:xs)
	|otherwise = if ((snd x)==((snd.head) xs))
		     then if (isVar (selElem (fst x) labels1))
			  then (filterInjectiveAux xs labels1)
			  else if (isVar (selElem ((fst.head) xs) labels1))
			       then (filterInjectiveAux (x:(tail xs)) labels1)
			       else [] --error("Invalid case!")
		     else (x:(filterInjectiveAux xs labels1))


filterInjective [] _ = []
filterInjective simlist labels1 = (mergeSort2 (filterInjectiveAux (mergeSort (head simlist)) labels1)):(filterInjective (tail simlist) labels1) 

dropNull [] = []
dropNull list = after 
		where (before,after) = (break (==(-1,-1)) list)


simulatedVertices [] = []
simulatedVertices partial = (map snd (map last partial))

selectSub tree pos curpos = do{
				curaux<-varGet curpos;
				varSet curpos (curaux+1);
			        if ((curaux+1) == pos) 
			        then do{return [tree]}
			        else case tree of
				 Tree (TXNode text) [] ->do{return []} 
				 Tree (ELNode name att) [] -> do {return []}
				 Tree (ELNode name att) args -> do{
				 				  sol<-(selectAux args pos curpos);
				 				  return sol}
			      }

selectAux [] _ _ =do {return []}
selectAux (x:xs) pos curpos = do{
				selaux<-selectSub x pos curpos;
				if (not (null selaux))
			        then do{return (selaux)}
			        else do{
					iter<-(selectAux xs pos curpos);
					return iter}
				}

subsigmas [] _ _ _ =do {return []}
subsigmas simlist t1 t2 nodes1 = do {
				    s1<-(singlesigma (head simlist) t1 t2 nodes1);
				    s2<-(subsigmas (tail simlist) t1 t2 nodes1); 
				    return (s1:s2)
				   }

singlesigma [] _ _ _  = do {return []}
singlesigma singsim pattern page nodes1 =do{
					    curpos<-varCreate (-1);
					    if (isVar (selElem ((fst.head) singsim) nodes1))
					    then do {
						    pairx<-return (unMark (selElem ((fst.head) singsim) nodes1));
						    pairyaux<-selectSub page ((snd.head) singsim) curpos;
					            pairy<-return (head pairyaux);
						    rest<-(singlesigma (tail singsim) pattern page nodes1);
						    return ((pairx,pairy):rest)}
					    else do{
						    rest<-(singlesigma (tail singsim) pattern page nodes1);
						    return rest}

					}

filterValidAux [] _ = True
filterValidAux (x:xs) firstslist = if (elem x firstslist)
				  then (filterValidAux xs firstslist)
				  else False    

filterValid _ [] = []
filterValid n (x:xs) = if (filterValidAux [0..n] (map fst x))
		       then (x:(filterValid n xs))
		       else (filterValid n xs)

simulation t1 (Tree RTNode weblist) vertexlist = do{
				tinfo1<-makeAdjList t1;
				tinfo2<-makeAdjList (head weblist);
				nodes1<-return (fst (fst tinfo1));
				nodes2<-return (fst (fst tinfo2));

						

				sim<-return (concat(groupList((concat(concat (labelRelation 0 nodes1 ((snd.fst) tinfo1) 0 nodes2 ((snd.fst) tinfo2))))))) ;
				simaux<-return(removeCouple sim tinfo1 tinfo2);

				
				inj<-return (injective simaux);
				
				fil1<-return (filterAll inj ((snd.fst) tinfo1) ((snd.fst) tinfo2));
				
				if (elem [] simaux) 
				then do{return []}
				else do{
					partial<-return (filterInjective fil1 ((fst.fst) tinfo1));
					varSet vertexlist (simulatedVertices partial);
					vaux<-varGet vertexlist;
					finalpartial<-return (filterValid ((length ((fst.fst) tinfo1))-1) partial );
					subs<-(subsigmas finalpartial t1 (head weblist) nodes1);		
					return subs;
					}


  			}



simulationp t1 req vertexlist = do{
				tinfo1<-makeAdjList t1;
				tinfo2<-makeAdjList req;
				nodes1<-return (fst (fst tinfo1));
				nodes2<-return (fst (fst tinfo2));
		

				sim<-return (concat(groupList((concat(concat (labelRelation 0 nodes1 ((snd.fst) tinfo1) 0 nodes2 ((snd.fst) tinfo2))))))) ;
				simaux<-return(removeCouple sim tinfo1 tinfo2);

				
				inj<-return (injective simaux);
				
				fil1<-return (filterAll inj ((snd.fst) tinfo1) ((snd.fst) tinfo2));
				
				if (elem [] simaux) 
				then do{return []}
				else do{
					partial<-return (filterInjective fil1 ((fst.fst) tinfo1));
					
					varSet vertexlist (simulatedVertices partial);
					vaux<-varGet vertexlist;
					
					subs<-(subsigmas partial t1 req nodes1);		
					
					return subs;
					}


  			}

