(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



BeginPackage["FR2MM`"]



WriteMM::usage="WriteMM[lag] is a function that given a FeynRules Lagrangian it creates the MM model";

FR2Text::usage="";
TreatMetric::usage="";
TreatIndices::usage="";
TreatFunctions::usage="";



Begin["`Private`"]


Needs["FeynRules`"];


miTranspose[x_]:=If[Length[x]>0,Transpose[x],{}];


(* Note that we need to have the model loaded for this to work *)


tiro=Complement[Flatten[Table[MR$GaugeGroups[[i,2]],{i,Length[MR$GaugeGroups]}]],DeleteCases[Flatten[Table[MR$GaugeGroups[[i,2]],{i,Length[MR$GaugeGroups]}]],Definitions:>a__]];
turo=Table[(Definitions/.tiro[[i]])[[1,1,0]],{i,Length[tiro]}];
turoo=Flatten[Table[{ToExpression[ToString[turo[[i]]]<>"[a__]:>b__"],ToExpression[ToString[turo[[i]]]<>"[a__]->b__"]},{i,Length[turo]}]];


RemoveUnphysical[x_]:=KeyDrop[x,Keys[KeySelect[x,UnphysicalQ]]];

GetIndexInfo=Block[{indices,representations0,representations},
indices=Flatten[Apply[List,DeleteCases[Union[Flatten[(Indices/.MR$ClassesRules[#])&/@MR$ClassesList]],Indices],2]];
representations0=Flatten[DeleteCases[(Representations/.MR$GaugeGroupRules[#])&/@MR$GaugeGroupList,Representations],1];
If[Length[representations]>0,representations=miTranspose[representations0][[2]],representations={}];
Union[Join[indices,representations]]];


SymbolicRangesAssoc=Association[DeleteCases[MapThread[Rule,{(BlockName/.MR$ParameterRules[#])&/@MR$ParameterList,MR$ParameterList}],Rule[BlockName,_]]]

IndexForm=Join[miTranspose[{GetIndexInfo,
MR$IndForm/@GetIndexInfo,ToString/@Length/@IndexRange/@Index/@GetIndexInfo}],{{Spin,y,"Dy"},{Lorentz,mu,"D"}}];

Do[
If[KeyExistsQ[SymbolicRangesAssoc,IndexForm[[iin,1]]],IndexForm[[iin,3]]=StringReplace[ToString[SymbolicRangesAssoc[IndexForm[[iin,1]]]],"Global`"->""]];
,{iin,Length[IndexForm]}];

IndexAssoc=AssociationThread@@Transpose@Transpose[Take[Transpose[IndexForm],2]];
Particle2IndexAssoc=AssociationThread@@{(ClassName/.MR$ClassesRules[#])&/@MR$ClassesList
,(Indices/.MR$ClassesRules[#])&/@MR$ClassesList/.Indices->{}};
Particle2IndexAssoc=RemoveUnphysical[Particle2IndexAssoc];

Particle2TypeAssoc=AssociationThread@@{(ClassName/.MR$ClassesRules[#])&/@MR$ClassesList
,Head/@MR$ClassesList};
Particle2TypeAssoc=RemoveUnphysical[Particle2TypeAssoc];

PhysicalParticleList=DeleteCases[Keys[Particle2IndexAssoc],x_/;UnphysicalQ[x]];
Particle2MassAssoc=AssociationThread@@{(ClassName/.MR$ClassesRules[#])&/@MR$ClassesList
,(Mass/.MR$ClassesRules[#])&/@MR$ClassesList/.Mass->{}};
Particle2MassAssoc=RemoveUnphysical[Particle2MassAssoc];

Particle2LightHeavyAssoc=AssociationThread@@{(ClassName/.MR$ClassesRules[#])&/@MR$ClassesList
,(FullName/.MR$ClassesRules[#])&/@MR$ClassesList/.FullName->"heavy"};
Particle2LightHeavyAssoc=RemoveUnphysical[Particle2LightHeavyAssoc];

Particle2YAssoc=AssociationThread@@{(ClassName/.MR$ClassesRules[#])&/@MR$ClassesList,((Y/.(((QuantumNumbers/.MR$ClassesRules[#])&/@MR$ClassesList)/.QuantumNumbers->{Y->0}))/.{Y->0})};
Particle2YAssoc=RemoveUnphysical[Particle2YAssoc];

Particle2FlavorIndexAssoc=AssociationThread@@{(ClassName/.MR$ClassesRules[#])&/@MR$ClassesList
,(FlavorIndex/.MR$ClassesRules[#])&/@MR$ClassesList/.FlavorIndex->{}};
Particle2FlavorIndexAssoc=RemoveUnphysical[Particle2FlavorIndexAssoc];
HeavyFlavorList=Select[IndexForm,MemberQ[Particle2FlavorIndexAssoc/@Select[PhysicalParticleList,Particle2LightHeavyAssoc[#]=="heavy"&],#[[1]]]&];


TreatMetric[exp_]:=exp/.IndexDelta[Index[Spin,a_],Index[Spin,b_]]->gam[Index[Spin,a],Index[Spin,b]]/.{ME[a___]:>gi[a],IndexDelta[a___]:>deltaF[a],Eps[a___]:>eps[a],ProjM:>SEVEN/2,ProjM[a___]:>SEVEN[a]/2,ProjP->SIX/2,ProjP[a___]->SIX[a]/2};

TreatIndices[exp_]:=exp/.{Ext[a_]:>a}/.{Index[b_,c_]:>ToExpression[ToString[IndexAssoc[b]]<>ToString[IndexAssoc[b]]<>ToString[c]]};

TreatFunctions[exp_]:=Block[{res},
res=exp//.{TensDot[a___,Ga[b_],c___]:>TensDot[a,b,c],TensDot[a___,SlashedP[b_],c___]:>TensDot[a,ToExpression["pp"<>ToString[b]],c]};
res/.{IndexDelta[a_,b_]:>deltaF[a,b],
SlashedP[a_]:>ToExpression["pp"<>ToString[a]],
SlashedP[a_,b_,c_]:>gam[b,ToExpression["pp"<>ToString[a]],c],
SIX[a_,b_]:>gam[a,SIX,b],
SEVEN[a_,b_]:>gam[a,SEVEN,b],
TensDot[a_,b___][i_,j_]:>gam[i,a,b,j],
Ga[a_,b_,c_]:>gam[b,a,c],
SP[a_,b_]:>ToExpression["dotp[pp"<>ToString[a]<>",pp"<>ToString[b]<>"]"],
FV[a_,b_]:>ToExpression["Mom[pp"<>ToString[a]<>","<>ToString[b]<>"]"],Conjugate[a_[b__]]:>ToExpression[ToString[a]<>"bar["<>StringRiffle[List[b],","]<>"]"],Conjugate[a_]:>ToExpression[ToString[a]<>"bar"],
Ga[a_]:>a}];

FR2Text[x_]:=StringReplace[StringReplace[StringReplace[ToString[ToString[(InputForm[x]//TreatMetric//TreatIndices//TreatFunctions)/.Power[m_,xx_]/;Element[xx,PositiveIntegers]:>ToString[Row[ConstantArray[m,xx],"*"]]]],"\""->""],Join[Table[ToString[Values[IndexAssoc][[i]]]<>"$"->"minus",{i,Length[Values[IndexAssoc]]}],Table[ToString[GetIndexInfo[[i]]]<>"$"->"minus",{i,Length[GetIndexInfo]}]]],Join[{" "->"","FR2MM`Private`"->"","$"->"minus"},greekrule={"\[Alpha]"->"alpha","\[Beta]"->"beta","\[Gamma]"->"gamma","\[Delta]"->"delta","\[CurlyEpsilon]"->"curlyepsilon","\[Zeta]"->"zeta","\[Eta]"->"eta","\[Theta]"->"theta","\[Iota]"->"iota","\[Kappa]"->"kappa","\[Lambda]"->"lambda","\[Mu]"->"mu","\[Nu]"->"nu","\[Xi]"->"xi","\[Omicron]"->"omicron","\[Pi]"->"pi","\[Rho]"->"rho","\[FinalSigma]"->"finalsigma","\[Sigma]"->"sigma","\[Tau]"->"tau","\[Upsilon]"->"upsilon","\[CurlyPhi]"->"curlyphi","\[Chi]"->"chi","\[Psi]"->"psi","\[Omega]"->"omega","\[CapitalAlpha]"->"Alpha","\[CapitalBeta]"->"Beta","\[CapitalGamma]"->"Gamma","\[CapitalDelta]"->"Delta","\[CapitalEpsilon]"->"CurlyEpsilon","\[CapitalZeta]"->"Zeta","\[CapitalEta]"->"Eta","\[CapitalTheta]"->"Theta","\[CapitalIota]"->"Iota","\[CapitalKappa]"->"Kappa","\[CapitalLambda]"->"Lambda","\[CapitalMu]"->"Mu","\[CapitalNu]"->"Nu","\[CapitalXi]"->"Xi","\[CapitalOmicron]"->"Omicron","\[CapitalPi]"->"Pi","\[CapitalRho]"->"Rho","\[CapitalSigma]"->"Sigma","\[CapitalTau]"->"Tau","\[CapitalUpsilon]"->"Upsilon","\[CapitalPhi]"->"CurlyPhi","\[CapitalChi]"->"Chi","\[CapitalPsi]"->"Psi","\[CapitalOmega]"->"Omega"}]];


GroupData=Block[{grouprepresentations,structureconstants},
grouprepresentations=miTranspose[{MR$GaugeGroupList,((Representations/.MR$GaugeGroupRules[#])&/@MR$GaugeGroupList)/.Representations->{}}];
structureconstants=((StructureConstant/.MR$GaugeGroupRules[#])&/@MR$GaugeGroupList)/.StructureConstant->{};
Table[If[Length[grouprepresentations[[i,2]]]==0,grouprepresentations[[i]],{grouprepresentations[[i,1]],structureconstants[[i]],Join[miTranspose[grouprepresentations[[i,2]]],{MR$IndForm[#]&/@miTranspose[grouprepresentations[[i,2]]][[2]]},{Length[IndexRange[Index[#]]]&/@miTranspose[grouprepresentations[[i,2]]][[2]]}]//miTranspose}],{i,Length[grouprepresentations]}]];




Options[GuessNonAbelianGroup]={Interactive->True};


GuessNonAbelianGroup[x_,opts:OptionsPattern[]]:=Block[{possiblegroups,res},
possiblegroups=Join[Table["su"<>ToString[n],{n,50}],Table["so"<>ToString[n],{n,50}]];
res=0;
Do[If[res==0&&StringContainsQ[x,possiblegroups[[ii]],IgnoreCase->True],res=possiblegroups[[ii]];],{ii,Length[possiblegroups],1,-1}];
If[res!=0&&OptionValue[Interactive],res=DialogInput[{name=res},Column[{"Which group is "<>x<>"? Type it in lower case and with no parenthesis, for instance su2, so3, ...",InputField[Dynamic[name],String],Button["Proceed",DialogReturn[name],ImageSize->Automatic]}]]];
res
]


Options[WriteSymbolsFunctions]={Interactive->True};


WriteSymbolsFunctions[params_,modelname_,opts:OptionsPattern[]]:=Module[{listmass,listmassbar,gaugefunctions,flavorfunctions,flavormassfunctions,gaugefunctionsbar,flavorfunctionsbar,flavormassfunctionsbar,newsymbols,newsymbolsbar,newfunctions,newfunctionsbar,groupgenerators,str,modeldataname,structureconstants,gaugeindices,gaugeindexranges,indiceswithdimensions,groupdata,heavyflavorindiceswithdimensions},
modeldataname=FileNameJoin[{modelname,"model_data"}];
newsymbols=Extract[MR$ParameterList,Position[Indices/.MR$ParameterRules[#]&/@ MR$ParameterList,Indices]];
listmass=Union[DeleteCases[Mass/.MR$ClassesRules[#]&/@MR$ClassesList,Mass]];
listmassbar=Extract[listmass,Position[ComplexParameter/.MR$ParameterRules[#]&/@Intersection[MR$ParameterList,listmass],True]];
newfunctions=Complement[MR$ParameterList,Extract[MR$ParameterList,Position[Indices/.MR$ParameterRules[#]&/@ MR$ParameterList,Indices]]];
newsymbolsbar=ToExpression[ToString[#]<>"bar"]&/@Extract[newsymbols,Position[ComplexParameter/.MR$ParameterRules[#]&/@newsymbols,True]];
newfunctionsbar=ToExpression[ToString[#]<>"bar"]&/@Extract[newfunctions,Position[ComplexParameter/.MR$ParameterRules[#]&/@newfunctions,True||ComplexParameter]];
groupgenerators=Flatten[DeleteCases[((Representations/.MR$GaugeGroupRules[#])&/@MR$GaugeGroupList),Representations],1];
If[Length[groupgenerators]>0,groupgenerators=miTranspose[groupgenerators][[1]],groupgenerators={}];
structureconstants=Flatten[DeleteCases[((StructureConstant/.MR$GaugeGroupRules[#])&/@MR$GaugeGroupList),StructureConstant]];
gaugeindices=Flatten[DeleteCases[(Representations/.MR$GaugeGroupRules[#])&/@MR$GaugeGroupList,Representations],1];
If[Length[gaugeindices]>0,gaugeindices=miTranspose[gaugeindices][[2]];, gaugeindices={}];
gaugefunctions=Union[Flatten[Table[Extract[MR$ParameterList,Position[Indices/.MR$ParameterRules[#]&/@ MR$ParameterList,{Index[gaugeindices[[i]]],___}]],{i,Length[gaugeindices]}]]];
gaugefunctionsbar=ToExpression[ToString[#]<>"bar"]&/@Extract[gaugefunctions,Position[ComplexParameter/.MR$ParameterRules[#]&/@gaugefunctions,True||ComplexParameter]];
flavorfunctions=Complement[newfunctions,gaugefunctions];
flavormassfunctions=Intersection[flavorfunctions,listmass];
flavorfunctionsbar=Complement[newfunctionsbar,gaugefunctionsbar];
flavormassfunctionsbar=Intersection[flavorfunctionsbar,listmassbar];
gaugeindexranges=Length/@IndexRange/@Index/@gaugeindices;
indiceswithdimensions=Table[ToString[IndexForm[[jiji,2]]]<>"="<>IndexForm[[jiji,3]],{jiji,Length[IndexForm]}];
heavyflavorindiceswithdimensions=Table[ToString[HeavyFlavorList[[jiji,2]]]<>"="<>HeavyFlavorList[[jiji,3]],{jiji,Length[HeavyFlavorList]}];
str=OpenWrite[FileNameJoin[{modeldataname,"gaugedata"}],FormatType->OutputForm];
Do[
Write[str,StringRiffle[ToString/@Drop[GroupData[[i]],-1]]];
Do[
Write[str,StringRiffle[ToString/@GroupData[[i]][[-1,j]]]];
,{j,Length[GroupData[[i,-1]]]}]
,{i,Length[GroupData]}];
Close[str];
str=OpenWrite[FileNameJoin[{modeldataname,"gaugedatanew"}],FormatType->OutputForm];
Do[
If[Length[GroupData[[i]]]==2,
Write[str,StringRiffle[ToString/@Drop[GroupData[[i]],-1]]<>" u1"];,
Write[str,StringRiffle[ToString/@Drop[GroupData[[i]],-1]]<>" "<>GuessNonAbelianGroup[ToString[GroupData[[i,1]]],Sequence@@FilterRules[{opts},Options[GuessNonAbelianGroup]]]];];
Do[
Write[str,StringRiffle[ToString/@GroupData[[i]][[-1,j]]]];
,{j,Length[GroupData[[i,-1]]]}]
,{i,Length[GroupData]}]
Close[str];
Export[FileNameJoin[{modeldataname,"newgaugeindices"}],miTranspose[Join[{MR$IndForm/@gaugeindices,Length/@IndexRange/@Index/@gaugeindices}]],"Table"];
str=OpenWrite[FileNameJoin[{modeldataname,"newsymbols"}],FormatType->OutputForm];
Do[Write[str,ToString[newsymbols[[ii]]]];,{ii,Length[newsymbols]}];
Do[Write[str,ToString[newsymbolsbar[[ii]]]];,{ii,Length[newsymbolsbar]}];
Close[str];
str=OpenWrite[FileNameJoin[{modeldataname,"newfunctions"}],FormatType->OutputForm];
Do[Write[str,ToString[newfunctions[[ii]]]];,{ii,Length[newfunctions]}];
Do[Write[str,ToString[newfunctionsbar[[ii]]]];,{ii,Length[newfunctionsbar]}];
Do[Write[str,ToString[groupgenerators[[ii]]]];,{ii,Length[groupgenerators]}];
Do[Write[str,ToString[structureconstants[[ii]]]];,{ii,Length[structureconstants]}];
Close[str];
str=OpenWrite[FileNameJoin[{modeldataname,"newgaugefunctions"}],FormatType->OutputForm];
Do[Write[str,ToString[gaugefunctions[[ii]]]];,{ii,Length[gaugefunctions]}];
Do[Write[str,ToString[gaugefunctionsbar[[ii]]]];,{ii,Length[gaugefunctionsbar]}];
Do[Write[str,ToString[groupgenerators[[ii]]]];,{ii,Length[groupgenerators]}];
Do[Write[str,ToString[structureconstants[[ii]]]];,{ii,Length[structureconstants]}];
Close[str];
Print["Writing New flavor functions"];
str=OpenWrite[FileNameJoin[{modeldataname,"newflavorfunctions"}],FormatType->OutputForm];
Do[Write[str,ToString[flavorfunctions[[ii]]]];,{ii,Length[flavorfunctions]}];
Do[Write[str,ToString[flavorfunctionsbar[[ii]]]];,{ii,Length[flavorfunctionsbar]}];
Close[str];
Print["Writing New flavor mass functions"];
str=OpenWrite[FileNameJoin[{modeldataname,"newflavormassfunctions"}],FormatType->OutputForm];
Do[Write[str,ToString[flavormassfunctions[[ii]]]];,{ii,Length[flavormassfunctions]}];
Do[Write[str,ToString[flavormassfunctionsbar[[ii]]]];,{ii,Length[flavormassfunctionsbar]}];
Close[str];
str=OpenWrite[FileNameJoin[{modeldataname,"newindices"}],FormatType->OutputForm];
Do[Write[str,indiceswithdimensions[[ii]]];,{ii,Length[indiceswithdimensions]}];
Close[str];
str=OpenWrite[FileNameJoin[{modeldataname,"newheavyflavorindices"}],FormatType->OutputForm];
Do[Write[str,heavyflavorindiceswithdimensions[[ii]]];,{ii,Length[heavyflavorindiceswithdimensions]}];
Close[str];
(* We now write a file called "gaugecouplingsandbosons.dat" with a list of the gauge couplings and gauge bosons *)
Export[FileNameJoin[{modeldataname,"gaugecouplingsandbosons.dat"}],MatrixForm[{CouplingConstant,GaugeBoson}/.MR$GaugeGroupRules[#]&/@MR$GaugeGroupList]];
];


WriteQGRAFModel[classes_,feynrules_,modelname_]:=Block[{lightmasslist,heavymasslist,partsandmass,str,sta,ta,partis,tas,res,lightlist,lightliststring,heavylist,heavyliststring,massless,massive,masslesslist,massivelist,lightmasslist0,lightdatamasslist,heavymasslist0,heavydatamasslist,modeldataname},
lightmasslist={};
heavymasslist={};
modeldataname=FileNameJoin[{modelname,"model_data"}];
partsandmass={};
Print["Let's write the Qgraf model"];
str=OpenWrite[FileNameJoin[{modelname,"model"}],FormatType->OutputForm];
Write[str,"* propagators"];
Write[str,""];
Do[If[MemberQ[{F,U},classes[[i,1,0]]],sta="-",sta="+"];
ta=ClassName/.classes[[i,2]];
If[!UnphysicalQ[ta],partis=ClassMemberList[ta];
Do[If[Particle2LightHeavyAssoc[ta]=="light",AppendTo[lightmasslist,Mass/.classes[[i,2]]],AppendTo[heavymasslist,Mass/.classes[[i,2]]]];
tas=ToString[partis[[j]]];
AppendTo[partsandmass,{tas,Mass/.classes[[i,2]]}];
If[SelfConjugateQ[ta],res="  ["<>tas<>", "<>tas<>", "<>sta<>"]",res="  ["<>tas<>", "<>tas<>"bar, "<>sta<>"]";];
Write[str,res];,{j,Length[partis]}]];,{i,Length[classes]}];
Write[str,""];
Write[str,"* vertices"];
Do[res=StringReplace[ToString[Transpose[feynrules[[i,1]]][[1]]],{"{"->"[","}"->"]"," "->""}];
If[Length[feynrules[[i,1]]]>2,Write[str,res];],{i,Length[feynrules]}];
Close[str];
lightlist=Intersection[PhysicalParticleList,Keys[Select[Particle2LightHeavyAssoc,#=="light"&]]];
If[Length[lightlist]>0,lightliststring=ToString[lightlist[[1]]];
Do[lightliststring=lightliststring<>", "<>ToString[lightlist[[i]]],{i,2,Length[lightlist]}],lightliststring=""];
heavylist=Intersection[PhysicalParticleList,Keys[Select[Particle2LightHeavyAssoc,#=="heavy"&]]];
If[Length[heavylist]>0,heavyliststring=ToString[heavylist[[1]]];
Do[heavyliststring=heavyliststring<>", "<>ToString[heavylist[[i]]],{i,2,Length[heavylist]}],heavyliststring=""];
Export[FileNameJoin[{modeldataname,"listlight"}],lightliststring,"Text"];
Export[FileNameJoin[{modeldataname,"listheavy"}],heavyliststring,"Text"];
(*We don\.b4t include 0 as a light mass, it is taken into account by default *)
lightmasslist0=Complement[Union[lightmasslist],{0}];
lightdatamasslist="";
Do[lightdatamasslist=lightdatamasslist<>ToString[lightmasslist0[[i]]]<>"  ",{i,Length[lightmasslist0]}];
heavymasslist0=Union[heavymasslist];
heavydatamasslist="";
Do[heavydatamasslist=heavydatamasslist<>ToString[heavymasslist0[[i]]]<>"  ",{i,Length[heavymasslist0]}];
Export[FileNameJoin[{modeldataname,"listlightmass"}],lightdatamasslist,"Text"];
Export[FileNameJoin[{modeldataname,"listheavymass"}],heavydatamasslist,"Text"];];



GetMassWithIndex[part_]:=Block[{flavind,resp},
resp=ToString[Particle2MassAssoc[part]];
flavind=Particle2FlavorIndexAssoc[part];
If[!ListQ[flavind],resp=resp<>"("<>ToString[IndexAssoc[flavind]]<>ToString[IndexAssoc[flavind]]<>"1)"];
resp]


ComputePropagator[a_]:=Block[{indexlist,indexfactors,den,num,parts},
parts=ToString[a]<>" "<>ToString[a];
If[!SelfConjugateQ[a],parts=parts<>"bar"];
indexlist=ToString/@IndexAssoc/@Flatten[Apply[List,Particle2IndexAssoc[a],2]];
indexfactors=StringJoin@@Table["*deltaF("<>indexlist[[i]]<>indexlist[[i]]<>"1,"<>indexlist[[i]]<>indexlist[[i]]<>"2)"
,{i,Length[indexlist]}];
den="*prop(pp1,"<>GetMassWithIndex[a]<>")";
num=" I"<>Switch[Particle2TypeAssoc[a],V,"*(-1)*deltaF("<>ToString[IndexAssoc[Lorentz]]<>ToString[IndexAssoc[Lorentz]]<>"1,"<>ToString[IndexAssoc[Lorentz]]<>ToString[IndexAssoc[Lorentz]]<>"2)",F,"*(gam("<>ToString[IndexAssoc[Spin]]<>ToString[IndexAssoc[Spin]]<>"1,pp1,"<>ToString[IndexAssoc[Spin]]<>ToString[IndexAssoc[Spin]]<>"2)+"<>GetMassWithIndex[a]<>"*gam("<>ToString[IndexAssoc[Spin]]<>ToString[IndexAssoc[Spin]]<>"1,"<>ToString[IndexAssoc[Spin]]<>ToString[IndexAssoc[Spin]]<>"2))",_,""];
parts<>num<>den<>indexfactors
]



WritePropagators[classes_,modelname_]:=Module[{strprop,ta,partis,colorfactor,flavorfactor,su2factor,den,num,tas,res,modeldataname},
modeldataname=FileNameJoin[{modelname,"model_data"}];
strprop=OpenWrite[FileNameJoin[{modeldataname,"proplist"}],FormatType->OutputForm];
Do[
WriteString[strprop,ComputePropagator[PhysicalParticleList[[i]]]<>"\n"]
,{i,Length[PhysicalParticleList]}];
Close[strprop];];


WritePropagatorsold[classes_,modelname_]:=Module[{strprop,sta,ta,partis,colorfactor,flavorfactor,su2factor,den,num,tas,res,modeldataname},
modeldataname=FileNameJoin[{modelname,"model_data"}];
strprop=OpenWrite[FileNameJoin[{modeldataname,"proplist"}],FormatType->OutputForm];
Do[If[MemberQ[{F,U},classes[[i,1,0]]],sta="-",sta="+"];
ta=ClassName/.classes[[i,2]];
If[!UnphysicalQ[ta],
partis=ClassMemberList[ta];
colorfactor="";
If[Length[StringCases[ToString[Indices/.classes[[i,2]]],"Colour"]]>0,colorfactor="*deltaF(ii1,ii2)"];
If[Length[StringCases[ToString[Indices/.classes[[i,2]]],"Gluon"]]>0,colorfactor="*deltaF(aa1,aa2)"];
flavorfactor="";
If[Length[StringCases[ToString[Indices/.classes[[i,2]]],"Generation"]]>0,flavorfactor="*deltaF(ff1,ff2)"];
su2factor="";
If[Length[StringCases[ToString[Indices/.classes[[i,2]]],"SU2W"]]>0,su2factor="*deltaF(jj1,jj2)"];
If[Length[StringCases[ToString[Indices/.classes[[i,2]]],"SU2D"]]>0,su2factor="*deltaF(kk1,kk2)"];
den="*prop(pp1,"<>ToString[Mass/.classes[[i,2]]]<>")";
num="";
If[MemberQ[{S},classes[[i,1,0]]],num="I"];
If[MemberQ[{U},classes[[i,1,0]]],num="I"];
If[MemberQ[{V},classes[[i,1,0]]],num="(-I)*deltaF(mumu1,mumu2)"];
If[MemberQ[{F},classes[[i,1,0]]],num="I*(gam(yy1,pp1,yy2)+"<>ToString[Mass/.classes[[i,2]]]<>"*gi(yy1,yy2))"];
Do[tas=ToString[partis[[j]]];
If[SelfConjugateQ[ta],res=tas<>" "<>tas,res=tas<>" "<>tas<>"bar"];
WriteString[strprop,res<>" "<>num<>den<>colorfactor<>flavorfactor<>su2factor<>"\n"];,{j,Length[partis]}];];,{i,Length[classes]}];
Close[strprop];];


WriteListParticles[classes_,modelname_]:=Module[{strcpol,ta,tata,partis,tas,res,strpol,listlightfermions,listlightquarks,listlightvectors,listlightscalars,allvectornames,listbackgroundvectors,modeldataname,listexternal},
modeldataname=FileNameJoin[{modelname,"model_data"}];
listlightfermions={};
listlightquarks={};
listlightvectors={};
listlightscalars={};
listbackgroundvectors={};
allvectornames={};
listexternal={};
Do[If[MemberQ[{V},classes[[i,1,0]]],AppendTo[allvectornames,ToString[ClassName/.classes[[i,2]]]]],{i,Length[classes]}];
(*cpol is for incoming momenta*)
Do[
ta=ClassName/.classes[[i,2]];
If[!UnphysicalQ[ta]&&Particle2LightHeavyAssoc[ta]=="light"(*ToString[Mass/.classes[[i,2]]]\[Equal]"0"*),
If[(!MemberQ[{U},classes[[i,1,0]]])&&(!StringContainsQ[ToString[ta],"Quantum"]),AppendTo[listexternal,ta];If[!SelfConjugateQ[ta],AppendTo[listexternal,ToString[ta]<>"bar"]]];
Which[MemberQ[{S},classes[[i,1,0]]],AppendTo[listlightscalars,ta];If[!SelfConjugateQ[ta],AppendTo[listlightscalars,ToString[ta]<>"bar"]],MemberQ[{V},classes[[i,1,0]]],AppendTo[listlightvectors,ta];If[!SelfConjugateQ[ta],AppendTo[listlightvectors,ToString[ta]<>"bar"]],MemberQ[{F},classes[[i,1,0]]],AppendTo[listlightfermions,ta];If[!SelfConjugateQ[ta],AppendTo[listlightfermions,ToString[ta]<>"bar"]]]];
If[MemberQ[{V},classes[[i,1,0]]]&&MemberQ[allvectornames,ToString[ta]<>"Quantum"],AppendTo[listbackgroundvectors,ta];If[!SelfConjugateQ[ta],AppendTo[listbackgroundvectors,ToString[ta]<>"bar"]]];
,{i,Length[classes]}];
strcpol=OpenWrite[FileNameJoin[{modeldataname,"listlightscalars"}],FormatType->OutputForm];
Write[strcpol,StringReplace[ToString[listlightscalars],{"{"->"","}"->"",","->", "}]];
Close[strcpol];
strcpol=OpenWrite[FileNameJoin[{modeldataname,"listlightfermions"}],FormatType->OutputForm];
Write[strcpol,StringReplace[ToString[listlightfermions],{"{"->"","}"->"",","->", "}]];
Close[strcpol];
strcpol=OpenWrite[FileNameJoin[{modeldataname,"listlightvectors"}],FormatType->OutputForm];
Write[strcpol,StringReplace[ToString[listlightvectors],{"{"->"","}"->"",","->", "}]];
Close[strcpol];
strcpol=OpenWrite[FileNameJoin[{modeldataname,"listbackgroundvectors"}],FormatType->OutputForm];
Write[strcpol,StringReplace[ToString[listbackgroundvectors],{"{"->"","}"->"",","->", "}]];
Close[strcpol];
Print[listexternal];
strcpol=OpenWrite[FileNameJoin[{modeldataname,"listexternal"}],FormatType->OutputForm];
WriteString[strcpol,StringReplace[ToString[listexternal],{"{"->"","}"->"",","->", "}]];
Close[strcpol];
]



WritePolarizations[classes_,modelname_]:=Module[{strcpol,ta,tata,partis,tas,res,strpol,listlightfermions,listlightquarks,listlightvectors,listlightscalars,modeldataname},
modeldataname=FileNameJoin[{modelname,"model_data"}];
(*cpol is for incoming momenta*)
strcpol=OpenWrite[FileNameJoin[{modeldataname,"cpollist"}],FormatType->OutputForm];
Do[
ta=ClassName/.classes[[i,2]];
If[!UnphysicalQ[ta],
partis=ClassMemberList[ta];
Do[tas=ToString[partis[[j]]];
If[MemberQ[{S,U},classes[[i,1,0]]],res={tas<>"  1"};
If[!SelfConjugateQ[ta],AppendTo[res,tas<>"bar 1"]]];
If[MemberQ[{V},classes[[i,1,0]]],res={tas<>" Evect(pp1,mumu1)"};
If[!SelfConjugateQ[ta],AppendTo[res,tas<>"bar Evect(pp1,mumu1)"]]];
If[MemberQ[{F},classes[[i,1,0]]],res={tas<>" uspin(pp1,yy1)"};
If[!SelfConjugateQ[ta],AppendTo[res,tas<>"bar vbspin(pp1,yy1)"];]];
Do[Write[strcpol,res[[jj]]];,{jj,Length[res]}],{j,Length[partis]}]];,{i,Length[classes]}];
Close[strcpol];
(*pol is for outgoing momenta*)
strpol=OpenWrite[FileNameJoin[{modeldataname,"pollist"}],FormatType->OutputForm];
Do[ta=ClassName/.classes[[i,2]];
If[!UnphysicalQ[ta],partis=ClassMemberList[ta];
Do[tas=ToString[partis[[j]]];
If[MemberQ[{S,U},classes[[i,1,0]]],res={tas<>"  1"};
If[!SelfConjugateQ[ta],AppendTo[res,tas<>"bar 1"]]];
If[MemberQ[{V},classes[[i,1,0]]],res={tas<>" Evectbar(pp1,mumu1)"};
If[!SelfConjugateQ[ta],AppendTo[res,tas<>"bar Evectbar(pp1,mumu1)"]]];
If[MemberQ[{F},classes[[i,1,0]]],res={tas<>" ubspin(pp1,yy1)"};
If[!SelfConjugateQ[ta],AppendTo[res,tas<>"bar vspin(pp1,yy1)"];]];
Do[Write[strpol,res[[jj]]];,{jj,Length[res]}];,{j,Length[partis]}];];,{i,Length[classes]}];
Close[strpol];];



FixSign4Fermion[Frule_]:=Block[{Frulei,spinindices},
Frulei=Flatten[{Frule/.Plus->List}];
spinindices=ToExpression/@StringReplace[StringCases[ToString[#],Shortest["Index[Spin, Ext["~~a__~~"]"]],{"Index[Spin, Ext["->"","]"->""}]&/@Frulei;
(Frulei*(Signature/@spinindices))/.List->Plus
]


WriteVertices[feynrules_,modelname_]:=Module[{vertexnumber,str,parts,tala,re,modeldataname,frtext,FR4Fermion},
modeldataname=FileNameJoin[{modelname,"model_data"}];
vertexnumber=Union[Table[Length[feynrules[[i,1]]],{i,Length[feynrules]}]];
str=Table[OpenWrite[FileNameJoin[{modeldataname,"v"<>ToString[vertexnumber[[i]]]<>"list"}],FormatType->OutputForm],{i,Length[vertexnumber]}];
Do[
parts=Transpose[feynrules[[i,1]]][[1]];
(* This is done to put the correct sign for the four fermion interactions *)
If[Length[parts]==4&&AllTrue[parts,FermionQ]===True,frtext=FR2Text[FixSign4Fermion[feynrules[[i,2]]]],frtext=FR2Text[feynrules[[i,2]]]];
(*frtext=FR2Text[feynrules[[i,2]]];*)
(* This is done to put the correct sign for the four fermion interactions *)
re=StringReplace[ToString[parts],{"{"->"","}"->"",","->" "}]<>"  "<>StringReplace[frtext,{" "->""}];
WriteString[str[[Position[vertexnumber,Length[parts]][[1,1]]]],re<>"\n"];,{i,Length[feynrules]}];
Do[Close[str[[i]]],{i,Length[str]}];]


WriteQGRAFskeleton[modeldirQGRAF_]:=Module[{masslessparticles,massiveparticles,backgroundparticles,str,skeleton0stringnomassive,skeleton0stringmassive,skeleton1stringnomassive,skeleton1stringmassive,bgtext},
masslessparticles=InsertLinebreaks[StringRiffle[ReadList[FileNameJoin[{modeldirQGRAF,"model_data","listlight"}],Record]],50];
massiveparticles=InsertLinebreaks[StringRiffle[ReadList[FileNameJoin[{modeldirQGRAF,"model_data","listheavy"}],Record]],50];
backgroundparticles=ReadList[FileNameJoin[{modeldirQGRAF,"model_data","listbackgroundvectors"}],Record];
If[Length[backgroundparticles]>0,bgtext="\n\n true = chord["<>InsertLinebreaks[StringRiffle[backgroundparticles],50]<>", 0,  0];",bgtext=""];
skeleton0stringnomassive="\n output= 'OUTPUTFILE' ;\n\n style= 'my.sty' ;\n\n model= 'THEMODEL';\n\n in= LISTOFPARTICLES;\n\n out=;\n\n loops= 0;\n\n loop_momentum= k;\n\n options= ;\n\n true = bridge["<>masslessparticles<>", 0 , 0];";
skeleton0stringmassive="\n output= 'OUTPUTFILE' ;\n\n style= 'my.sty' ;\n\n model= 'THEMODEL';\n\n in= LISTOFPARTICLES;\n\n out=;\n\n loops= 0;\n\n loop_momentum= k;\n\n options= ;\n\n true = bridge["<>masslessparticles<>", 0 , 0];\n\n false = iprop["<>massiveparticles<>", 1000 , 1000];";
skeleton1stringnomassive="\n output= 'OUTPUTFILE' ;\n\n style= 'my.sty' ;\n\n model= 'THEMODEL';\n\n in= LISTOFPARTICLES;\n\n out=;\n\n loops= 1;\n\n loop_momentum= k;\n\n options= ;\n\n true = bridge["<>masslessparticles<>", 0 , 0];"<>bgtext;
skeleton1stringmassive="\n output= 'OUTPUTFILE' ;\n\n style= 'my.sty' ;\n\n model= 'THEMODEL';\n\n in= LISTOFPARTICLES;\n\n out=;\n\n loops= 1;\n\n loop_momentum= k;\n\n options= ;\n\n true = bridge["<>masslessparticles<>", 0 , 0];\n\n false = chord["<>massiveparticles<>", 0,  0];"<>bgtext;
str=OpenWrite[FileNameJoin[{modeldirQGRAF,"qgraf.skeleton.0loop.dat"}],FormatType->OutputForm];
If[massiveparticles=="",WriteString[str,skeleton0stringnomassive],WriteString[str,skeleton0stringmassive]];
Close[str];
CreateDirectory[FileNameJoin[{modeldirQGRAF,"proc_0loop"}]];
str=OpenWrite[FileNameJoin[{modeldirQGRAF,"qgraf.skeleton.1loop.dat"}],FormatType->OutputForm];
If[massiveparticles=="",WriteString[str,skeleton1stringnomassive],WriteString[str,skeleton1stringmassive]];
Close[str];
CreateDirectory[FileNameJoin[{modeldirQGRAF,"proc_1loop"}]];]


WriteParticleIrreps[modelname_]:=Module[{modeldataname,gaugedatanewx,Index2GroupIrrepAssoc,group,i,nonabeliangroups,particlelist,resp,indi,singlets,realorcomplex},
modeldataname=FileNameJoin[{modelname,"model_data"}];
gaugedatanewx=Import[FileNameJoin[{modeldataname,"gaugedatanew"}],"Table"];
Index2GroupIrrepAssoc=<||>;
Do[
If[Length[gaugedatanewx[[i]]]==3,
group=gaugedatanewx[[i,-1]];,
If[Length[gaugedatanewx[[i]]]==4,AssociateTo[Index2GroupIrrepAssoc,ToExpression[gaugedatanewx[[i,2]]]->{group,ToExpression[gaugedatanewx[[i,4]]]}]]];
,{i,Length[gaugedatanewx]}];
nonabeliangroups=Union[miTranspose[Values[Index2GroupIrrepAssoc]][[1]]];
particlelist=(ClassName/.MR$ClassesRules[#])&/@MR$ClassesList;
resp={};
Do[
indi=Particle2IndexAssoc[particlelist[[i]]]/.{Index[a_]:>a};
Off[Transpose::nmtx];
singlets=Join[{#},{1}]&/@Select[nonabeliangroups,!SubsetQ[miTranspose[DeleteCases[Index2GroupIrrepAssoc/@indi,Missing[a___]]][[1]],{#}]&];
On[Transpose::nmtx];
If[SelfConjugateQ[particlelist[[i]]],realorcomplex="R",realorcomplex="C"];
AppendTo[resp,Flatten[{particlelist[[i]],Particle2TypeAssoc[particlelist[[i]]],realorcomplex,Join[DeleteCases[Index2GroupIrrepAssoc/@indi,Missing[a___]],singlets,{{"u1",Particle2YAssoc[particlelist[[i]]]}}]}]];
,{i,Length[particlelist]}];
Export[FileNameJoin[{modeldataname,"particleirreps.dat"}],resp,"Table"];
]


GetLagTerm[co_,Lag_]:=Module[{opi,coe},
opi=Coefficient[Lag/.{ToExpression[ToString[co]<>"[a___]:>"<>ToString[co]]},co];
coe=Coefficient[Lag,opi];
StringReplace[ToString[InputForm[coe*opi]]," "->""]];

GetGaugeTensors[lag_,modelname_]:=Module[{modeldataname,gaugeindices,tensors,resp,lagterms},
modeldataname=FileNameJoin[{modelname,"model_data"}];
gaugeindices=miTranspose[Flatten[DeleteCases[(Representations/.MR$GaugeGroupRules[#])&/@MR$GaugeGroupList,Representations],1]][[2]];
tensors=DeleteCases[miTranspose[Join[{MR$ParameterList},{Indices/.MR$ParameterRules[#]&/@MR$ParameterList}]],{a_,Indices}];
resp=Select[tensors,SubsetQ[gaugeindices,(#[[2]]/.Index[a_]:>a)]&];
lagterms=GetLagTerm[#,lag]&/@miTranspose[resp][[1]];
Export[FileNameJoin[{modeldataname,"gaugetensorcoeffs.dat"}],miTranspose[Append[{miTranspose[resp][[1]]},lagterms]],"Table"];
]


Options[WriteMM]={Interactive->True};


WriteMM[lag_,modelnamex_String:"",opts:OptionsPattern[]]:=Block[{feynrules,classes,params,modelname,modeldataname,modeldirFORM,modeldirQGRAF,fi,notfullnamedlist},
notfullnamedlist=DeleteCases[DeleteCases[DeleteCases[({Unphysical,FullName}/.MR$ClassesRules[#])&/@MR$ClassesList,{True,_}][[All,2]],"light"],"heavy"];
If[Length[notfullnamedlist]>0,Print["There is a problem with the model, not all particles are defined as light or heavy using FullName->\"light\" or FullName->\"heavy\"."];
Print["Please make sure you define all particles properly and then create the model."];
Return["1"];]; 
feynrules=FeynmanRules[lag];
classes=M$ClassesDescription;
params=M$Parameters;
If[modelnamex=="",modelname=M$ModelName<>"_MM",modelname=modelnamex];
modeldirFORM=FileNameJoin[{modelname,"FORM"}];
modeldirQGRAF=FileNameJoin[{modelname,"QGRAF"}];
modeldataname=FileNameJoin[{modeldirQGRAF,"model_data"}];
If[DirectoryQ[modelname],DeleteDirectory[modelname,DeleteContents->True]];
CreateDirectory[modelname];
CreateDirectory[modeldirQGRAF];
CreateDirectory[modeldataname];
(*CreateDirectory[FileNameJoin[{modelname,"WI"}]];*)
Print["Writing new symbols and functions"];
WriteSymbolsFunctions[params,modeldirQGRAF,Sequence@@FilterRules[{opts},Options[WriteSymbolsFunctions]](*Interactive\[Rule]FalseOptionValue[Interactive]*)];
Print["done"];
Print["Writing QGRAF model"];
WriteQGRAFModel[classes,feynrules,modeldirQGRAF];
Print["done"];
Print["Writing propagators"];
WritePropagators[classes,modeldirQGRAF];
Print["done"];
Print["Writing Polarizations"];
WritePolarizations[classes,modeldirQGRAF];
Print["done"];
Print["Writing Particle Lists"];
WriteListParticles[classes,modeldirQGRAF];
Print["done"];
Print["Writing vertices"];
WriteVertices[feynrules,modeldirQGRAF];
Print["done"];
Print["Writing QGRAF files"];
WriteQGRAFskeleton[modeldirQGRAF];
Print["done"];
Print["Writing FORM files"];
CreateDirectory[modeldirFORM];
CreateDirectory[FileNameJoin[{modeldirFORM,"proc_0loop"}]];
CreateDirectory[FileNameJoin[{modeldirFORM,"proc_1loop"}]];
fi=CreateFile[FileNameJoin[{modeldirFORM,"proc_0loop",".gitignore"}]];
WriteString[fi,"!.gitignore"];
fi=CreateFile[FileNameJoin[{modeldirFORM,"proc_1loop",".gitignore"}]];
WriteString[fi,"!.gitignore"];
Print["Model done"];
]


End[]


EndPackage[]
