(**
	         Compare.m 

(utility for CreateTopologies + InsertFields)
**)

BeginPackage["Compare`","FeynArts`"]

Compare::usage="
Compare[ t , mod ] is the `pure' compare function to eliminate \n
equivalent topologies of a TopologyList t. The argument mod is \n
optional and denotes the model for comparing inserted topologies. "

Begin["`Private`"]
                                     (** construct the vertices **)

Vs[3][t_]:= Union[ Flatten[ List@@(Cases[ #1 , v3[n_] -> n ]& /@ t) ]]

Vs[4][t_]:= Union[ Flatten[ List@@(Cases[ #1 , v4[n_] -> n ]& /@ t) ]]

Vsn[type_Integer?Positive][t_] :=  Select[ Vs[type][t] , (#1<0)& ]

                                          (** for permutations **)

SwapV[ x_ , old_List , new_List ] :=           
        ( x /. Thread[ v3 /@ old -> v3 /@ new ] 
            )/.Thread[ v4 /@ old -> v4 /@ new ] 

                                          (** comparable form **)

PrSort[ pr_[f_,t_] ] := Sort[ pr[f,t] ]
PrSort[ pr_[f_,t_, p_],mod_List ] :=
   If[ !OrderedQ[{f,t}],
        Propagator[ t ,f ,AntiParticle[mod][p] ],
        If[  f===t,
	     Propagator[ f,f,Sort[{p,AntiParticle[mod][p]}][[1]] ],
             Propagator[ f,t,p]
          ]                           
      ]

CompForm[ t:Topology[___][__],mod___List ] := 
	  Topology@@Sort[ PrSort[Propagator@@#1,mod]& /@ t]  

                          (** compare Topology with TopologyList **)

Complist[ t:Topology[___][__] , tt_TopologyList , mod___ ] :=
          ( CompForm[t,mod]===#1 
	   )& /@ Apply[ List , Function[y,CompForm[y,mod]] /@ tt ]

              (** compare `permutable' Topology with TopologyList **)

DoPerComplist[ t:Topology[___][__],
	     tt_TopologyList,per_List,mod___List ] :=
Function[ z ,( z===#1 
	      )& /@ Apply[ List , 
			   Function[y,CompForm[y,mod]] /@ tt ] 
	] /@ ( CompForm[ SwapV[t,per,#1],mod]& /@ Permutations[per] )

                                    (** two groups of permutables **)

PerComplist[ t:Topology[___][__],tt_TopologyList,a_List,{},mod___List ] :=
        DoPerComplist[ t , tt , a,mod ]
PerComplist[ t:Topology[___][__],tt_TopologyList,a_List,{_},mod___List] :=
        DoPerComplist[ t , tt , a,mod] 
PerComplist[t:Topology[___][__],tt_TopologyList,a_List,{pp__},mod___List] :=
        Flatten[ List@@ ( DoPerComplist[ #1 , tt , a,mod ]& /@
                   ( SwapV[ t , {pp} , #1 ]& /@ Permutations[{pp}]) 
                         ) ]

                               (** putting these things together **)

compare[ t:Topology[___][__] , tt_TopologyList,mod___ ]:=
           If[ Length[ Vsn[3][t] ] < 2 && Length[ Vsn[4][t] ] < 2 ,  
              Complist[t,tt,mod],
              MemberQ[#1 , True]& /@ 
             Transpose[ PerComplist[ t,tt,Vsn[3][t],Vsn[4][t],mod ] ]
             ]

                              (** for extracting the information **)

comp[ True, t:Topology[s_][x__] ] := trash

comp[ False , t:Topology[s_][x__] ] := t  

comp[ n_Integer , t:Topology[s_][x__] ] := Module[{new=Head[t][[1]]},
                 new=If[Length[new]>1,
                        Select[ new , (Head[#]===Integer)& ],
                        new ];
                 new=new/n;
                 Topology[new]@@t  
                ]

truesum[{a___,True,b___}]:= {a, Length[ Cases[ {a,True,b},True ] ] ,b}

                                  (** apply the "comp"-function **)

compmap[ t:Topology[___][__] , tt_TopologyList , m_Integer,mod___] :=
	(comp@@ #1)& /@ 
            Transpose[ { Join[ Table[False,{m-1} ] ,
                               truesum[compare[t,Drop[tt,m-1],mod]]] , 
                         List@@tt } ] 


                                      (** main compare-routine **)

Compare[ TopologyList[],mod___ ] := TopologyList[]

Compare[ tt:TopologyList[__],mod___ ] := 
   Module[{nn=1,topol},
	 topol = tt ;
         While[ nn < Length[ topol ] ,
                topol=Select[ TopologyList@@(compmap[ topol[[nn]],
                                    topol,nn,mod ]),  !#===trash&];
                nn++
               ];
         topol ]

End[]
EndPackage[]

