(**   
                  FeynGrassman.m  

(utility for CreateFeynAmp)
**)

BeginPackage["FeynGrassman`","FeynArts`"]

TopToGrassman::usage=
" applied to an inserted topology builds SpinorChains of fermions \n
and corrects the combinatorial factor. "

Begin["`Private`"]

         (**  first step : building chains of grassman fields   **)

GrassmanStart = {
 Topology[s_][ pa___, Propagator[ty_][x___, U[in_,gi___], m_], pb___] :>
      Topology[s][ pa , pb , gmC[ Propagator[ty][ x,U[in,gi],m ] ] ],
 Topology[s_][ pa___, Propagator[ty_][x___, F[in_], m_ ], pb___] :>
      Topology[s][ pa , pb , gmC[ Propagator[ty][ x,F[in],m ] ] ]
 }

GrassmanRules = {
         Topology[s_][ pa___ , 
                  Propagator[ty_][ toz_,toy_,fi_[in_,gi___] ,m1_] , 
                  pb___ , 
                  gmC[ qa___ , 
                       Propagator[tz_][ frz_,toz_,fi_[jn_,gj___],m2_] ]
                ] :>
         Topology[s][ pa , pb , 
                 gmC[ qa , 
                      Propagator[tz][frz,toz,fi[jn,gj],m2] , 
                      Propagator[ty][toz,toy,fi[in,gi],m1]  ]
               ]/;MemberQ[{F,U},fi],             
         Topology[s_][ pa___ , 
                  Propagator[ty_][ fry_,toz_,fi_[in_,gi___] ,m1_] , 
                  pb___ , 
                  gmC[ qa___ , 
                       Propagator[tz_][ frz_,toz_,fi_[jn_,gj___],m2_] ]
                ] :>
         Topology[s][ pa , pb , 
                 gmC[ qa , 
                      Propagator[tz][frz,toz,fi[jn,gj],m2] , 
                      Propagator[ty][toz,fry,
			   AntiParticle[CreateFeynAmp`Private`WorkingModel][
			      fi[in,gi]],-m1] ]
               ]/;MemberQ[{F,U},fi],
         Topology[s_][ pa___ , 
                  Propagator[ty_][ fry_,frz_,fi_[in_,gi___] ,m1_] , 
                  pb___ , 
                  gmC[ Propagator[tz_][ frz_,toz_,fi_[jn_,gj___],m2_] ,
                       qa___ ]
                ] :>
         Topology[s][ pa , pb , 
                 gmC[ Propagator[ty][fry,frz,fi[in,gi],m1] , 
                      Propagator[tz][frz,toz,fi[jn,gj],m2] ,
                      qa ]
               ]/;MemberQ[{F,U},fi],             
         Topology[s_][ pa___ , 
                  Propagator[ty_][ frz_,toy_,fi_[in_,gi___] ,m1_] , 
                  pb___ , 
                  gmC[ Propagator[tz_][ frz_,toz_,fi_[jn_,gj___],m2_] ,
                       qa___ ]
                ] :>
         Topology[s][ pa , pb , 
                 gmC[ Propagator[ty][toy,frz,
			   AntiParticle[CreateFeynAmp`Private`WorkingModel][ 
			       fi[in,gi] ],-m1],
                      Propagator[tz][frz,toz,fi[jn,gj],m2] ,
                      qa ] 
               ]/;MemberQ[{F,U},fi]             
       }

Grassman = {
	    Topology[s_][p___] :> 
	    ((Topology[s][p] /. GrassmanStart)//. GrassmanRules)
	   }

       (**  second step : correcting the combinatorial factor (1) **) 
       (**                add -1 for every closed grassman chain  **)

Scorrect[ tt:Topology[s_][args___] ]:= 
     Module[{ttext},
        Topology[ (-1)^(Count[tt,gmC[__]]) s ][args]
     ]

       (**  third step : building correct fermion chains          **)

PropReverse[ Propagator[ty_][ fr_,to_,fi_,mom_ ] ] := 
       Propagator[ty][to, fr, 
		      AntiParticle[CreateFeynAmp`Private`WorkingModel][
		           fi], -mom ]

ToSpinorChain = {
Topology[s_][ 
 pa___, 
 gmC[Propagator[ty_][fr_ ,to_ ,U[in_,gi___], mom_ ],pb___ ], 
 pc___ ] :>
 Topology[s][ Propagator[ty][fr,to,U[in,gi],mom], pb, pa, pc],
Topology[s_][ 
 pa___, 
 gmC[ Propagator[ty_][fr_, to_,F[in_Integer?Negative], mom_], pb___], 
 pc___ ] :>
 Topology[s][pa, pc, SpinorChain[Propagator[ty][fr,to,F[in],mom],pb]] ,
Topology[s_][ 
 pa___, 
 the:gmC[ Propagator[ty_][fr_ ,to_, F[in_Integer?Positive], mom_ ] ,
                           pb___], 
 pc___ ] :>
 Topology[s][ pa , pc , SpinorChain@@ (Reverse[ PropReverse/@ the ])  ],
 Topology[s_][ 
 pa___, 
 gmC[ Propagator[ty_][fr_, to_,F[-I], mom_], pb___], 
 pc___ ] :>
 Topology[s][pa, pc, SpinorChain[Propagator[ty][fr,to,F[-I],mom],pb]] ,
Topology[s_][ 
 pa___, 
 the:gmC[ Propagator[ty_][fr_ ,to_, F[I], mom_ ] ,
                           pb___], 
 pc___ ] :>
 Topology[s][ pa , pc , SpinorChain@@ (Reverse[ PropReverse/@ the ])  ]  
}

         (**  fourth step : extracting the extern fermion numbers **)

ExtractExt[ Propagator[_][___] ] := {}

ExtractExt[ SpinorChain[ Propagator[_][e[a_],__], ___,
			 Propagator[_][_,e[b_],__] ] ] := {a,b}

ExtractExt[ SpinorChain[ ___ ] ] := {}

ExtractPermutables[ tt:Topology[_][__] ] := Join@@ ( ExtractExt/@ tt ) 

        (**  fifth step : check relative sign of extern fermions  **)

PermutationSign[ p_List ] := 
   Module[ {l=p,i,j,h,len,exp=0} ,
          len=Length[ p ] ;
          For[ j=1 , j<=len, j++ , 
          For[ i=1 , i<len , i++ ,
               If[ l[[i]] > l[[i+1]] ,
                   h=l[[i]] ; l[[i]]=l[[i+1]] ; l[[i+1]]=h ; exp++ ]
             ] ] ;
          Return[ (-1)^(exp+len/2) ]
        ]

                 (**  putting everything together   **) 

TopToGrassman[ tt:Topology[ s_ ][ pr__ ] ] :=
    Module[ { fermfac,topol } ,
	   topol = tt //.Grassman;
	   topol = Scorrect[ topol ];
	   topol = topol//.ToSpinorChain;
           fermfac = PermutationSign[ ExtractPermutables[topol] ] ;
           topol = topol/. Topology[ ss_ ]->Topology[ ss fermfac ] ;
           Return[ topol ]
         ]

End[]

EndPackage[]

