(* ::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["matcher`"]


ComputeRGEModeltoEFT::usage="ComputeRGEModeltoEFT[modelnameF,modelnameE] computes the beta functions of a UV light model with name modelnameF onto an EFT with name modelnameE";
CheckLinearDependence::usage="CheckLinearDependence[modelname] checks the whether the operators defining an EFT model with name modelname are (off-shell) linearly independent, returning the relationships between the different Wilson coefficients if they are linearly dependent.";
MatchModeltoEFT::usage="MatchModeltoEFT[modelnameF,modelnameE] computes the tree level and one-loop matching of a UV model with name modelnameF onto an EFT with name modelnameE";
CompareTwoMatches::usage="CompareTwoMatches[list1_,list2_] compares two lists of rules and checks if they are equal independently of order and naming of dummy indices";
DummyZeroQ::usage="";
RemoveUnderscore::usage="";




Begin["`Private`"]


(*These can move from here to public for development *)
GetFinalRuleOrdered::usage="";
GenerateSymmetries::usage="";
CheckGreenSol::usage="CheckGreenSol[full,eft,greensol] checks is the solution in the green basis given by greensol solves all amplitudes in the matching of UV model full onto EFT eft";
RenameOneLoopWC::usage="";
PutUnderscore::usage="";
ImposeHermiticity::usage="";
MiGetSpecificAmplitudeNew::usage="";
GenericMatchEFT::usage="";
MatchEFT::usage="";
AlphasInSolQ::usage="";
TensorMultiply::usage="";
SolveMinimalLinearSystem::usage="";
SortByType::usage="";
MyCoefficientList::usage="";
CheckIsZero::usage="";
EliminateRepeated::usage="";
positionDuplicates::usage="";
PrepareAmplitude::usage="";
GetTensorsAndIndicesAndOrdering::usage="";
GetFunctionNameAndArguments::usage="";
powerProductFormToList::usage="";
GetKinematics::usage="";
GetDictionary::usage="GetDictionary[modelname] returns a list of two dictionaries -associations- that return, for a list of input particles, a list of two entries, the simplified amplitude and the definition of the extra symbols to compute it. The first dictionary corresponds to tree level and the second one to one loop. If only tree level results are present then the list is of length one.";
EliminateSelfFromRule::usage="";
PrettyShow::usage="return a nice print of the Wilson coefficients in the warsaw basis";
SimpleShow::usage="";
InitializeModel::usage="";
SumExpandIndicesEfficient::usage="";
miSumExpandIndices::usage="";
Splitter::usage="";
GetAlphas::usage="";
GetAlphasGeneral::usage="";
GetAlphasWithArguments::usage="";
GetAlphasWithArgumentsFromDict::usage="";
GetFunctionsFromRules::usage="";
GiveAllChanges::usage="";
GetRelevantRules::usage="";
ReduceFlavorSymmetry::usage="";
EliminatParenthesisInAlphas::usage="";
PutParenthesisInAlphas::usage="";

CheckOneAmplitude::usage="";
ComputesSSPower::usage="";
ComplexConjugate::usage="";
GetIndices::usage="";
TreatDummyFlavor::usage="";
TreatDummyFlavorGeneral::usage="";


$matchmakerpath="REPLACEPATH"


fli=Table[ToExpression["Global`fl"<>ToString[i]],{i,30}];
miflis=Table[ToExpression["Global`mif"<>ToString[i]],{i,30}];
FLi=Table[ToExpression["Global`FL"<>ToString[i]],{i,30}];
MIFLi=Table[ToExpression["Global`MIFL"<>ToString[i]],{i,30}];
mifl2MIFL=MapThread[Rule,{miflis,MIFLi}];


(* The system of equations has to be such that the equations are equated to 0
For instance for a system {{a1 x + b1 y\[Equal]c1},{a2 x + b2 y\[Equal]c2}}} we have
to call SolveMinimalLinearSystem[{{a1 x + b1 y-c1},{a2 x + b2 y-c2}}},{x,y}] *)
SolveMinimalLinearSystem[eqs_List,vars_List]:=Block[{sys,systmp,indices,i,minimaleqs,sol,check},
If[Length[vars]>0,
sys=Normal[CoefficientArrays[eqs,vars][[2]]];
systmp={sys[[1]]};
indices={1};
Do[
If[MatrixRank[Join[systmp,{sys[[i]]}]]>MatrixRank[systmp],systmp=Join[systmp,{sys[[i]]}];AppendTo[indices,i]]
,{i,2,Length[sys]}];
minimaleqs=Part[eqs,#]==0&/@indices;
Off[Solve::svars];
Off[Solve::trace];
sol=Solve[minimaleqs,vars][[1]];
On[Solve::svars];
On[Solve::trace];
check=DeleteCases[Simplify[eqs/.sol],0];,
sol={};
check=eqs;];
(*If[Length[check]>0,Print["Problems!!!",sol,check,eqs,vars];];*)
{sol,check}
]


(*GetDictionary[modelname] returns a list of two dictionaries -associations- that return, for a list of input particles, a list of two entries, the simplified amplitude and the definition of the extra symbols to compute it. The first dictionary corresponds to tree level and the second one to one loop. If only tree level results are present then the list is of length one *)
GetDictionary[modeldir_,replsym_:{}]:=Block[{lista,listaout,input,amp,res,lista0,lista1,input0,input1,amp0,amp1,res0,res1},
lista={FileNames[modeldir<>"/FORM/proc_0loop/*log.mat"],FileNames[modeldir<>"/FORM/proc_1loop/*log.mat"]};
listaout={FileNames[modeldir<>"/FORM/proc_0loop/*out.mat"],FileNames[modeldir<>"/FORM/proc_1loop/*out.mat"]};
If[Length[lista[[2]]]==0,lista={lista[[1]]}];
input=Table[StringSplit[StringReplace[StringSplit[#,"/"][[-1]],{".log.mat"->""}],"_"]&/@lista[[i]],{i,Length[lista]}];
amp=Table[ToExpression[StringJoin["ampl",#]]&/@StringJoin/@input[[i]],{i,Length[input]}];
res=Table[Association[Table[input[[i,j]]->{amp[[i,j]]/.Get[lista[[i,j]]]/.Global`dd[n_,a_,b_]:>ToExpression["Global`dd"<>ToString[n]][a,b],(If[MemberQ[listaout[[i]],StringReplace[lista[[i,j]],"log.mat"->"out.mat"]],Get[StringReplace[lista[[i,j]],"log.mat"->"out.mat"]],{}])/.Global`G[a_]->a},{j,Length[input[[i]]]}](*/.replsym*)/.{Log[a_]->Log[a/Global`\[Mu]^2]}],{i,Length[input]}];
(*ReduceFlavorSymmetry[#,replsym][[1]]&/@res*)
ReduceFlavorSymmetry[#,replsym]&/@res
];



GetParameters[modeldirx_]:=Block[{varsx,counts},
varsx=Join[Import[modeldirx<>"/QGRAF/model_data/newsymbols","Words"],Import[modeldirx<>"/QGRAF/model_data/newfunctions","Words"]];
counts=Counts[StringReplace[#,"bar"->""]&/@varsx];
{Extract[Keys[counts],Position[Values[counts],1]],Extract[Keys[counts],Position[Values[counts],2]]}];


GetGaugeData[modeldir_]:=StringSplit/@ReadList[modeldir<>"/QGRAF/model_data/gaugedatanew",Record];

GetGaugeIndicesAndRanges[modeldir_]:=Block[{data},
data=GetGaugeData[modeldir];
Drop[#,2]&/@DeleteCases[data,a_/;Length[a]<4]];

GetGaugeIndices[modeldir_]:=Block[{res},
res=GetGaugeIndicesAndRanges[modeldir];If[Length[res]>0,res=Transpose[res][[1]]];
res]


ddeerule[indrx_]:=Module[{res},If[Length[indrx]>0,res=Join[ToExpression["Global`dd"<>#]->SparseArray[IdentityMatrix[ToExpression[#]]]&/@Transpose[indrx][[2]],
ToExpression["Global`ee"<>#]->SparseArray[LeviCivitaTensor[ToExpression[#]]]&/@Transpose[indrx][[2]]],res={}];
res];
ddeenogaugerule[indrx_]:=Module[{res},If[Length[indrx]>0,res=Join[ToExpression["Global`dd"<>#][___]->1&/@Transpose[indrx][[2]],
ToExpression["Global`ee"<>#][___]->1&/@Transpose[indrx][[2]]],res={}];
res];



RenameOneLoopWC[allpars_]:=Block[{},
MapThread[Rule,{ToExpression/@allpars,ToExpression[StringReplace[ToString[#],"alpha"->"WC"]]&/@allpars}]]



InitializeModel[modelname_]:=Block[{symmfile,hermiticityfile,redfile,SMrepfile,repgaugefile,realpars,complexpars,complexify,runogauge,dilist,groupdata,indranges,indi,mireplacegaugedata,mirunogauge,symblist,funclist,vars2one,listareplacesymmetry={},listahermiticity={},finalruleordered={},SMreplacement={},replacegaugedata={}},
symmfile=FileNameJoin[{modelname,"QGRAF","model_data","listareplacesymmetry"}];
If[FileExistsQ[symmfile],Get[symmfile];listareplacesymmetry=Global`listareplacesymmetry;];
hermiticityfile=FileNameJoin[{modelname,"QGRAF","model_data","listahermiticity"}];
If[FileExistsQ[hermiticityfile],Get[hermiticityfile];listahermiticity=Global`listahermiticity;];
redfile=FileNameJoin[{modelname,"QGRAF","model_data","redundancies.dat"}];
If[FileExistsQ[redfile],Get[redfile];finalruleordered=Global`finalruleordered;];
SMrepfile=FileNameJoin[{modelname,"QGRAF","model_data","SMreplacements.dat"}];
If[FileExistsQ[SMrepfile],Get[SMrepfile];SMreplacement=Global`SMreplacement;];
repgaugefile=FileNameJoin[{modelname,"QGRAF","model_data","replacegaugedata"}];
If[FileExistsQ[repgaugefile],Get[repgaugefile];replacegaugedata=Global`replacegaugedata;];
realpars=Union[GetParameters[modelname][[1]]];
complexpars=Union[GetParameters[modelname][[2]]];complexify=Join[Table[ToExpression[complexpars[[i]]]->ToExpression[complexpars[[i]]<>"bar"],{i,Length[complexpars]}],Table[ToExpression[complexpars[[i]]<>"bar"]->ToExpression[complexpars[[i]]],{i,Length[complexpars]}]];
dilist=GetDictionary[modelname,listareplacesymmetry];
groupdata=GetGaugeData[modelname];
indranges=GetGaugeIndicesAndRanges[modelname];
indi=GetGaugeIndices[modelname];mireplacegaugedata=Join[Table[Rule[(Global`replacegaugedata[[i,1]]),(Global`replacegaugedata[[i,2]])],{i,Length[Global`replacegaugedata]}],ddeerule[indranges]];mirunogauge=Join[Table[mireplacegaugedata[[i,1]][___]->1,{i,Length[mireplacegaugedata]}],ddeenogaugerule[indranges]];
symblist=Flatten[{Import[FileNameJoin[{modelname,"QGRAF","model_data","newsymbols"}]]}];
If[Length[symblist]>0,symblist=Rule[#,1]&/@ToExpression/@symblist];
funclist=Import[FileNameJoin[{modelname,"QGRAF","model_data","newfunctions"}]];
If[Length[funclist]>0,funclist=Rule[#,1]&/@(ToExpression/@(StringJoin[#,"[a__]"]&/@Flatten[{funclist}])),funclist={}];
(*If[Length[funclist]>0,funclist=Rule[#,1]&/@ToExpression/@Flatten[{funclist}],funclist={}];*)
vars2one=Join[symblist,funclist,ddeenogaugerule[indranges],{Global`ddF[___]->1,Global`invepsilonbar->1}];
{realpars,complexpars,complexify,dilist,groupdata,indranges,indi,mireplacegaugedata,mirunogauge,vars2one,{listahermiticity,finalruleordered,replacegaugedata,listareplacesymmetry}}]


CheckLinearDependence[modelname_]:=Block[{result},
MatchEFT[modelname];
result=DeleteCases[Global`EFTMatching[[2]]/.Global`Coeff[a___]->0,Rule[a_,0]];
If[Length[result]==0,Print["The operators in EFT ",modelname," are linearly independent."];,
Print["The operators in EFT ",modelname," are not linearly dependent."]; Print["Here are the relations between their coefficients: ",result]]]


MatchEFT[modelname_]:=Block[{EFTMatchingfile,EFTMatching},
EFTMatchingfile=FileNameJoin[{modelname,"QGRAF","model_data","EFTMatching.dat"}];
If[FileExistsQ[EFTMatchingfile],Get[EFTMatchingfile],Print["Model ",modelname," has not been matched yet, recreating the matching"];Global`EFTMatching=GenericMatchEFT[modelname];Save[EFTMatchingfile,Global`EFTMatching]];
Global`EFTMatching]


GenericMatchEFT[eft_]:=Block[{realpars,complexpars,complexify,dilist,groupdata,indranges,indi,mireplacegaugedata,mirunogauge,vars2one,hermiticitylist,finalruleordered,replacegaugedata,diE0,pars,system,sols0,sols,eamp0,eamp,newsys,newvars,ferms,kineticrule={},listareplacesymmetry},{realpars,complexpars,complexify,dilist,groupdata,indranges,indi,mireplacegaugedata,mirunogauge,vars2one,{hermiticitylist,finalruleordered,replacegaugedata,listareplacesymmetry}}=InitializeModel[eft];
ferms=Import[FileNameJoin[{eft,"QGRAF","model_data","listlightfermions"}],"CSV"][[1]];
diE0=dilist[[1,1]];
pars=Keys[diE0];
system={};
sols0={};
Do[
(*Print[pars[[cual]]];*)
eamp0=MyCoefficientList[PrepareAmplitude[dilist[[1,1]][pars[[cual]]],indranges,mirunogauge,mireplacegaugedata,False],Global`sSS];
eamp=Table[Flatten[{eamp0[[i]]}],{i,Length[eamp0]}];
If[Length[pars[[cual]]]==2,
AppendTo[kineticrule,pars[[cual]]->GetAlphasWithArguments[eamp[[(3-Boole[MemberQ[ferms,pars[[cual,1]]]])]],ToString/@Flatten[GetAlphas[eamp[[(3-Boole[MemberQ[ferms,pars[[cual,1]]]])]]]]]]];
kins=Table[GetKinematics[eamp[[i]],vars2one],{i,Length[eamp]}];
Do[(*Print["icual=",icual];*)
If[Length[eamp[[icual]]]>0,
AppendTo[system,EliminatParenthesisInAlphas/@Flatten[Table[Table[res=If[NumericQ[kins[[icual,j]]],eamp[[icual,i]],Coefficient[eamp[[icual,i]],kins[[icual,j]]]];
If[res===0, res,res-Global`Coeff[pars[[cual]],icual,i,kins[[icual,j]]]],{i,Length[eamp[[icual]]]}],{j,Length[kins[[icual]]]}]]];
AppendTo[sols0,SolveMinimalLinearSystem[system[[-1]],Union[Flatten[GetAlphas/@system[[-1]]]]][[1]]];],{icual,Length[eamp]}];
,{cual,Length[pars]}];
If[AlphasInSolQ[Flatten[sols0]],
Print["Not al WCs were matched, trying harder"];
newsys=Flatten[sols0]/.Rule[a_,b_]:>a-b;
newvars=Union[Flatten[GetAlphas/@newsys]];
sols0=SolveMinimalLinearSystem[newsys,newvars][[1]];
];
If[AlphasInSolQ[Flatten[sols0]],Print["Not all Wilson Coefficients can be computed, consider adding more amplitudes to the EFT"],Print["All WCs have been matched"]];
Global`kineticrule=kineticrule;
Save[FileNameJoin[{eft,"QGRAF","model_data","kineticrule"}],Global`kineticrule];
{system,Flatten[Union[sols0]]/.Rule[a_,b_]:>Rule[PutParenthesisInAlphas[a],b]}
]


MiGetSpecificAmplitudeNew[dic_,indrangesF_,mirunogaugeF_,mireplacegaugedataF_,repl_,parx_,ppow_,in_,kix_]:=Block[{temp,res,mimanitobarescaldo},
temp=(Flatten[{#}]&/@(MyCoefficientList[PrepareAmplitude[dic[parx],indrangesF,mirunogaugeF,mireplacegaugedataF,True,kix]/.repl,Global`sSS]));
If[temp==={{0}}||Length[temp]<ppow,temp=0,temp=temp[[ppow,in]]];
res=Coefficient[mimanitobarescaldo temp,mimanitobarescaldo kix];
res
]


GetKinematics[amplitude_,vars2onelist_]:=Block[{amplist,varlistrule},
amplist=DeleteCases[Flatten[{Expand[amplitude]/.Plus->List}/.vars2onelist]/.Log[_]->1,0];
varlistrule=Rule[#,1]&/@Variables[amplist];
Union[amplist/(amplist/.varlistrule)]
]


GetAlphas[exp_]:=Union[ToExpression/@DeleteCases[StringSplit[StringReplace[ToString[exp],{"["->" ","("->" ","]"->" ",")"->" ","-"->" "}]],a_/;StringFreeQ[ToString[a],"alpha"]]];

GetAlphasGeneral[exp_,listofalphas_:"alpha"]:=Union[ToExpression/@DeleteCases[StringSplit[StringReplace[ToString[exp],{"["->" ","("->" ","]"->" ",")"->" ","-"->" "}]],a_/;StringFreeQ[ToString[a],listofalphas]]];

GetFunctionsFromRules[rulelist_]:=Module[{res={}},If[Length[rulelist]>0,res=ToString/@Union[Transpose[GetFunctionNameAndArguments/@DeleteCases[Flatten[(rulelist/.{-1->1}/.Rule->List)],0]][[1]]]];
res];

GetAlphasWithArguments[exp_,listofalphas_]:=Union[ToExpression/@DeleteCases[StringSplit[StringReplace[ToString[exp],{"("->" ",", "->",",")"->" ","-"->" ","*"->" "}]],a_/;StringFreeQ[ToString[a],listofalphas]]];

GetAlphasWithArgumentsFromDict[di_,symlist_]:=Block[{vals,listofalphas},
vals=Values[di];
If[Length[symlist]>0,listofalphas=ToString/@GetFunctionsFromRules[symlist],listofalphas="alpha"];
Union[Flatten[Table[GetAlphasWithArguments[vals[[i]][[1]]//.vals[[i]][[2]],listofalphas],{i,Length[vals]}]]]
]


GiveAllChanges[exp_,sy_]:=Block[{yea,re,allre,allrefinal},
yea=sy[[#]]&/@Flatten[Table[Tuples[Range[Length[sy]],n],{n,6}],1];
(*Print[yea];*)
allre={};
Do[
re=exp;
Do[re=re/.yea[[j,i]];,{i,Length[yea[[j]]]}];
AppendTo[allre,exp->re];
,{j,Length[yea]}];
Union[allre]
];

GetRelevantRules[listofalphas_,listofsymmetries_]:=Block[{sol,redrules,changes,result,listofalphasfromsymmetries},
sol={};
listofalphasfromsymmetries=ToString/@GetFunctionsFromRules[listofsymmetries];
Do[
redrules=Select[listofsymmetries,MemberQ[GetAlphasGeneral[listofalphas[[i]],listofalphasfromsymmetries],GetAlphasGeneral[#[[1]],listofalphasfromsymmetries][[1]]]&];
changes=GiveAllChanges[listofalphas[[i]],redrules];
(*Print["i=",i,"  ",listofalphas[[i]],"  ",redrules,"  ",changes];*)
result={};
If[Length[changes]>0,result=Transpose[changes/.Rule->List][[2]]/.{-1->1}];
AppendTo[sol,{listofalphas[[i]],changes,result}];
,{i,Length[listofalphas]}];
sol];

ReduceFlavorSymmetry[diEFT_,listofsymmetries_]:=Block[{listofalphas,indlist={},redlist={},rulesi},
listofalphas=GetAlphasWithArgumentsFromDict[diEFT,listofsymmetries];
If[Length[listofalphas]>0,AppendTo[indlist,listofalphas[[1]]]];
rulesi=GetRelevantRules[listofalphas,listofsymmetries];
Do[
If[Or@@(MemberQ[indlist,#]&/@(rulesi[[i,3]])),AppendTo[redlist,listofalphas[[i]]->(listofalphas[[i]]/.rulesi[[i,2]])],AppendTo[indlist,listofalphas[[i]]]],{i,2,Length[listofalphas]}];
{indlist,redlist};
{diEFT/.redlist,redlist}];


(* SortByType takes a list of rules of the form alphaXxxx \[Rule] ... and a list of "types of operators" of the form {"S","O", ...}, where these correspond to the possible values of X in the order we want the listrules to be returned *)
SortByType[listrules_,typeordering_]:=Block[{replace,pad},
pad=Length[IntegerDigits[Length[typeordering]]];
replace=Join[{"["->"0"},MapThread[Rule,{typeordering,StringPadLeft[#,pad,"0"]&/@ToString/@Range[Length[typeordering]]}]];
SortBy[listrules,StringReplace[ToString[#[[1]]],replace]&]
]


(* EliminateRepeated[sollist] takes as an input a dimension 1 list of the form {alphaxxx \[Rule] xxx,...},
checks if there are repeated entries, including non-trivial index swapping, and eliminates the repeated
ones

positionDuplicates[list] gives the position of repeated entries in a list
*) 

positionDuplicates[list_]:=GatherBy[Range@Length[list],list[[#]]&];

EliminateRepeated[sollist_,replacementlist_:{}]:=Module[{rep,listtodrop,differ},
listtodrop={};
rep=DeleteCases[positionDuplicates[Flatten[GetAlphas/@(sollist/.Rule[a_,b_]:>a)]],{_}];
Do[Do[
differ=Simplify[(sollist[[rep[[i,1]]]][[2]])-(ToExpression[StringReplace[ToString[sollist[[rep[[i,1]]]][[1]]],"_"->""]]/.sollist[[rep[[i,j]]]](*/.replacementlist*))];If[DummyZeroQ[differ,replacementlist]===0,AppendTo[listtodrop,{rep[[i,j]]}](*,Print["Huston we have a problem ",sollist[[rep[[i,1]]]][[1]],"eo",{differ,replacementlist,DummyZeroQ[differ,replacementlist]},"oe"]*)]
,{j,2,Length[rep[[i]]]}];
,{i,Length[rep]}];
Delete[sollist,listtodrop]
]




(* CheckIsZero[exp] takes exp, sums over internal indices up to 3 and checks if the result is 0
this is useful to check if two expressions are the same but they don't seem to be because of a
different naming in dummy indices *)
CheckIsZero[exp_]:=Block[{sexp,ind,check,max,res},
max=3;
res=False;
sexp=Splitter[exp];
check=0;
Do[
ind=ToExpression[GetIndices[sexp[[j]]][[1]]];
If[Length[ind]>0,
check=check+Apply[Sum[sexp[[j]],##]&,Transpose[Join[{ind},{Table[max,{i,Length[ind]}]}]]];,
check=check+sexp[[j]]]
,{j,Length[sexp]}];
If[check==0,res=True];
res
]


(*
GenerateNumericalSymmetries[symlist_,maxx_] generates a list to 
reduce the WC appearing in the symmetry list symlist with 
numerical values of the indices up to maxx to a minimal set
*)
GenerateNumericalSymmetries[symlist_,maxx_]:=Block[{expr,ind,li,res={}},
Do[
expr=RemoveUnderscore[symlist[[iiGNS,1]]];
ind=ToExpression/@GetIndices[expr][[2]];
li=Flatten[Apply[Table[expr,##]&,Transpose[Join[{ind},{Table[maxx,{i,Length[ind]}]}]]]];
Do[If[FreeQ[Values[res],li[[iii]]],AppendTo[res,Rule[li[[iii]],li[[iii]]/.symlist]]],{iii,Length[li]}];
,{iiGNS,Length[symlist]}];
res/.Rule[a_,-a_]:>Rule[a,0]];


(*
GenerateSymmetries[exp,replsym] takes an expression exp and a list of replacement rules replsym
and generates a list of replacement rules to reduce the functions appearing in exp to a minimal set
*)
GenerateSymmetries[exp_,replsym_:{}]:=Block[{funclist,res={}},
funclist=GetAlphasWithArguments[exp,GetFunctionsFromRules[replsym]];
Do[
If[FreeQ[Values[res],funclist[[iiGS]]],AppendTo[res,Rule[funclist[[iiGS]],funclist[[iiGS]]/.replsym]]]
,{iiGS,Length[funclist]}];
res
]


(* DummyZeroQ[exp] takes exp, sums over internal indices up to 3 and checks if the result is 0, if it's zero it returns 0 otherwise it retuns exp. This is useful to check if two expressions are the same but they don't seem to be because of a different naming in dummy indices *)
DummyZeroQ[exp_,replsym_:{}]:=Block[{sexp,ind,check,max=3,res,symrules,symrulesanalytic},
If[TreatDummyFlavorGeneral[exp]===0,res=0,
(*Print["notzero=",exp];*)
symrules=GenerateNumericalSymmetries[replsym,max];
res=exp;
(*Print["replsym=",replsym];*)
symrulesanalytic=GenerateSymmetries[exp,replsym];
sexp=Splitter[exp];
check=0;
Do[
ind=ToExpression[GetIndices[sexp[[jjj]]][[1]]];
If[Length[ind]>0,
check=check+Apply[Sum[sexp[[jjj]],##]&,Transpose[Join[{ind},{Table[max,{iii,Length[ind]}]}]]];,
check=check+sexp[[jjj]]]
,{jjj,Length[sexp]}];
(*Print["check/.symrules=",check/.symrules];
Print["symrulesanalytic=",symrulesanalytic];*)
check=check/.symrules/.symrulesanalytic;
If[check==0,res=0];];
res
]




EliminatParenthesisInAlphas[exp_]:=Block[{exp2,allist},
allist=GetAlphas[exp];
exp2=exp;
Do[
exp2=exp2/.ToExpression[allist[[i]]][a_,b_]:>ToExpression[StringReplace[ToString[allist[[i]][a,b]],{"["->"","]"->"",","->""," "->""}]];
exp2=exp2/.ToExpression[allist[[i]]][a_,b_,c_,d_]:>ToExpression[StringReplace[ToString[allist[[i]][a,b,c,d]],{"["->"","]"->"",","->""," "->""}]];
,{i,Length[allist]}];
exp2
];



PutParenthesisInAlphas[exp_]:=Block[{exp0,wherefs,res},
If[StringQ[exp],exp0=exp,exp0=ToString[exp]];
wherefs=StringPosition[exp0,"fl"];
res=exp0;
If[Length[wherefs]>0,
res=StringInsert[res,"[",wherefs[[1,1]]];
res=StringInsert[res,",",wherefs[[2,1]]+1];
If[Length[wherefs]==4,
res=StringInsert[res,",",wherefs[[3,1]]+2];
res=StringInsert[res,",",wherefs[[4,1]]+3];
];
res=res<>"]"];
ToExpression[StringReplace[res,{"fl99"->"fl99_","fl98"->"fl98_","fl97"->"fl97_","fl96"->"fl96_","fl95"->"fl95_","fl94"->"fl94_","fl93"->"fl93_","fl92"->"fl92_","fl91"->"fl91_"}]]
];


(* 
AddToListOfRules[listofrules,extralist] takes a list of rules listofrules={a\[Rule]a1,b\[Rule]b1, ...} and a list extrlist={a2,b2, ...} and returns
{a\[Rule]a1+a2,b\[Rule]b1+b2, ...}
*)
AddToListOfRules[listofrules_,extralist_]:=Table[listofrules[[i,1]]->listofrules[[i,2]]+extralist[[i]],{i,Length[listofrules]}]


(* 
EliminateSelfFromRule[rulex] takes a rule of the form alXYY\[Rule]alphaXYY+... and returns the RHS of the rule with alphaXYY removed 
*)
EliminateSelfFromRule[rulex_]:=rulex[[2]]/.{ToExpression[StringInsert[ToString[rulex[[1]]],"pha",3]]->0}


(* Splitter *)
Splitter[exp_]:=Block[{res},
res=DeleteCases[Level[Expand[exp]+"REMOVETHIS",1],"REMOVETHIS"];
res];



(* GetFunctionNameAndArguments[f[a,b,c,...] returns the following list {f,{a,b,c,...}}*) 

GetFunctionNameAndArguments[ff_[x__]]:={ff,x//List};






(* GetTensorsAndIndicesAndOrdering[expi] returns a list with three entries 
{{list of tensor names},{list of pairs of repeated indices},{permutation needed to put the external indices in alphabetical order}}*)
(* IMPORTANT NOTES: For this function to work it needs expi to be a product of tensors with indices (no sum, no extra non-tensorial structures)
Also the permutation given by the third entry of the output is the one needed in Transpose[tensor,permutation] to put the tensor with the external
indices in alphabetical order (so that for instance Transpose[T[k,j,i],permutation]=T[i,j,k])
*)

powerProductForm[expr_]:=With[{expanded=Inactivate[expr/.Power[u_,n_Integer?Positive]:>Inactive[Times]@@ConstantArray[u,n],Times]/.prod:Inactive[Times][__]:>Flatten[prod]},Activate@HoldForm[expanded]];
powerProductFormToList[expr_]:=With[{expanded=Inactivate[expr/.Power[u_,n_Integer?Positive]:>Inactive[Times]@@ConstantArray[u,n],Times]/.prod:Inactive[Times][__]:>Flatten[prod]},ReleaseHold[(Activate@HoldForm[expanded])/.Times->List]];

GetTensorsAndIndicesAndOrdering[expi_]:=Module[{expii,inter,Tnames,indexlist,internals,externals},
(*If[ToString[Head[expi]]=="Times",expii=(expi/.head_[arg__]:>List[arg]),expii=Flatten[List[expi]]];
Print["expiinGetTensor1=",expii];*)
expii=Flatten[{powerProductFormToList[expi]}];
(*Print["expiinGetTensor2=",expii];*)
inter=Transpose[DeleteCases[GetFunctionNameAndArguments/@expii,GetFunctionNameAndArguments[_]]];
Tnames=inter[[1]];
indexlist=Flatten[inter[[2]]];
externals=Select[GatherBy[Range@Length[indexlist],indexlist[[#]]&],Length[#]==1&];
internals=Select[GatherBy[Range@Length[indexlist],indexlist[[#]]&],Length[#]>1&];
Join[Tnames,{internals},{InversePermutation[Ordering[Part[indexlist,#]&/@Flatten[externals]]]}]
]


(* TensorMultiply[A,B,C, ...,pairs,rearr] returns with tensor product of A B C ... with the indices in
pairs contracted and the external indices ordered according to the permutation rearr. When rearr is the
permutation computed in GetTensorsAndIndicesAndOrdering the external indices are ordered according to
alphabetical order *)
TensorMultiply[A__,pairs_,rearr_]:=Module[{temp0,res},
temp0=Activate@TensorContract[Inactive[TensorProduct][A],pairs];
If[Length[rearr]>0,res=Transpose[temp0,rearr],res=temp0];
res]
(*TensorMultiply[A__,pairs_,rearr_]:=Transpose[Activate@TensorContract[Inactive[TensorProduct][A],pairs],rearr];*)
(* GetRangeFromIndex[index,indrx] returns the dimension of the corresponding index *)
GetRangeFromIndex[index_,indrx_]:=indrx[[Position[indrx,{ToString[IndexType[index]],_}][[1,1]],2]];



miSumExpandIndices[exp0_,indr0_,runogaugex_,replacelistgauge_]:=Module[{expi0(*,ru0*),ru1,exp(*,resp*)},
expi0=(exp0/.runogaugex);
ru1={expi0->1};
exp=(exp0/.ru1);
(*expi0=TreatDummyFlavorGeneral[expi0];*)If[ToString[exp]!="1",expi0=expi0(TensorMultiply@@(GetTensorsAndIndicesAndOrdering[exp]/.replacelistgauge));];Remove[ru1];
expi0
]


(* IndexType *)

IndexType[in_]:=Block[{res,tostring,tostringnonumbers},
tostring=StringPartition[ToString[in],1];
tostringnonumbers=DeleteCases[tostring,a_/;DigitQ[a]];
ToExpression[StringDelete[StringJoin[tostringnonumbers],"minus"]]
];



SumExpandIndicesEfficient[exp_,indr_,runogaugex_,replacelistgauge_]:=Module[{expi,expi0,iii,res,ru0,ru1},
Off[Part::partd];
expi=Splitter[exp/.Global`samb[a___]->0];
If[Length[expi]>100000,
With[{expii=expi},
DistributeDefinitions[SumExpandIndices];
res=ParallelSum[
SumExpandIndices[expii[[iii]],indr,runogaugex],{iii,Length[expii]}]],
res=Sum[
If[Mod[iii,20000000]==0,Print[DateString[],"  ",iii," Maxmemory= ",MaxMemoryUsed[]/1024.^2,"  memorynow=",MemoryInUse[]/1024.^2]];
miSumExpandIndices[expi[[iii]],indr,runogaugex,replacelistgauge]
(*miSumExpandIndices[TreatDeltaEps[expi[[iii]],indr],indr,runogaugex,replacelistgauge]*),{iii,Length[expi]}]];
On[Part::partd];
(*Print["res=",res];*)
(*Print[DateString[],"  Ending SumExpand"];*)
If[ListQ[res],
Union[Simplify[Flatten[res]]],res]
];


CompareTwoMatches[list1_,list2_]:=Module[{ke1,ke2,res},
ke1=ToExpression[StringReplace[ToString[list1/.Rule[a_,b_]->a],"_"->""]];
ke2=ToExpression[StringReplace[ToString[list2/.Rule[a_,b_]->a],"_"->""]];
If[Sort[ke1]==Sort[ke2],
res=Union[CheckIsZero/@Simplify[((ke1/.list1)-(ke1/.list2))]],
res={False}];
And@@res
]


PutUnderscore[exp_]:=Block[{ind},
ind=ToString/@GetIndices[exp][[2]];
ToExpression[StringReplace[ToString[InputForm[exp]],Table[ind[[i]]->ind[[i]]<>"_",{i,Length[ind]}]]]];


RemoveUnderscore[exp_]:=Block[{ind},
ind=GetIndices[exp];
ToExpression[StringReplace[ToString[InputForm[exp]],Table[ind[[2]][[i]]->StringReplace[ind[[2]][[i]],"_"->""],{i,Length[ind[[2]]]}]]]];

MultiplyLeftRight[term_,ind_,mul_]:=Block[{multi,dummy},
dummy=Global`MIF1;
If[mul[[2]]==1,multi=mul[[1]][ind,dummy],multi=mul[[1]][dummy,ind]];
((term/.{ToExpression[ind]->dummy})multi)];

wc2fieldsdic[modelnameE_]:=Association[((StringSplit[#,"  "]&/@StringSplit[Import[FileNameJoin[{modelnameE,"QGRAF","model_data","wc2fields.txt"}]],"\n"])/.{a_,b_}:>{Rule[ToExpression[a],GatherBy[ToExpression[StringSplit[b," "]],NumberQ]]})];

(* GetKineticWCdic returns a dictionary with the fields present in the EFT as keys 
and a list with {K,in,HasIndices}, where K in the WC corresponding to the kinetic term, in is the order it appears in the kinetic term (1 for real or for complex bar, 2 for complex without conjugation) and HasIndices is True if the field has flavour indices and False if it doesnt *)

GetKineticWCdic[modelnameE_]:=Block[{hasin,isreal,li,lile,al,res,kineticrulex},
Get[FileNameJoin[{modelnameE,"QGRAF","model_data","kineticrule"}]];
kineticrulex=Global`kineticrule;
res=Table[
hasin=If[Length[GetIndices[kineticrulex[[cualx,2]][[1]]][[2]]]>0,True,False];
isreal=If[Length[Union[kineticrulex[[cualx,1]]]]==1,True,False];
li=ToExpression/@kineticrulex[[cualx,1]];
If[isreal,li=Union[li]];
lile=Length[li];
al=GetAlphas[kineticrulex[[cualx,2,1]]][[1]];
Transpose[{li,Table[al,lile],Range[lile],Table[hasin,lile]}]
,{cualx,Length[kineticrulex]}];
res=Flatten[res,1];
Association[Table[res[[ii,1]]->Drop[res[[ii]],1],{ii,Length[res]}]]];


CanonicalNormalization[modelnameE_,wc_]:=Block[{nwc,in,kidi,listKs,wc2fieldsdicx,particles,indexorder,particleswithindices,particleswithoutindices,repl,correctrepl,res},
kidi=GetKineticWCdic[modelnameE];
listKs=Union[Transpose[Values[kidi]][[1]]];
wc2fieldsdicx=wc2fieldsdic[modelnameE];
nwc=RemoveUnderscore[wc];
If[MemberQ[listKs,GetAlphas[nwc][[1]]],
res=2nwc,
in=ToExpression/@GetIndices[nwc][[2]];
particles=wc2fieldsdicx[GetAlphas[nwc][[1]]][[1]];
If[Length[wc2fieldsdicx[GetAlphas[nwc][[1]]]]==1,indexorder={},indexorder=wc2fieldsdicx[GetAlphas[nwc][[1]]][[2]]];
particleswithindices=DeleteCases[wc2fieldsdicx[GetAlphas[nwc][[1]]][[1]](Boole/@(kidi[#][[3]]&/@(wc2fieldsdicx[GetAlphas[nwc][[1]]][[1]]))),0];
particleswithoutindices=DeleteCases[wc2fieldsdicx[GetAlphas[nwc][[1]]][[1]](1-Boole/@(kidi[#][[3]]&/@wc2fieldsdicx[GetAlphas[nwc][[1]]][[1]])),0];
repl=Take[#,2]&/@(kidi/@particleswithindices);
correctrepl=Permute[repl,indexorder];
res=Sum[
MultiplyLeftRight[nwc,in[[ii]],correctrepl[[ii]]]
,{ii,Length[correctrepl]}];
repl=Take[#,1]&/@(kidi/@particleswithoutindices);
(*Print["particles=",particles];
Print["particlesind=",particleswithindices];
Print["particlesnoind=",particleswithoutindices];*)
res=res+Sum[nwc repl[[ii]][[1]],{ii,Length[repl]}];
(*ToExpression["delta"<>ToString[wc]]\[Rule]-1/2res*)
];
wc->-1/2res
];

GenerateNormalizationList[modelnameE_,complexifyx_]:=Block[{CanonicalNormalizationfile,listaalphas,listanor,listanorbar,listanorfinal},
CanonicalNormalizationfile=FileNameJoin[{modelnameE,"QGRAF","model_data","canonicalnormalization.dat"}];
If[FileExistsQ[CanonicalNormalizationfile],Print["Getting information on canonical normalization for model ",modelnameE];Get[CanonicalNormalizationfile];,
Print["Canonical normalization for model ",modelnameE," has not been computed yet, recreating it"];
Get[FileNameJoin[{modelnameE,"QGRAF","model_data","EFTMatching.dat"}]];
listaalphas=ToExpression/@Select[ToString/@(Union[Global`EFTMatching[[2]]/.Rule[a_,b_]:>a]),!StringContainsQ[#,"bar"]&];
listanor=Table[CanonicalNormalization[modelnameE,listaalphas[[i]]],{i,Length[listaalphas]}];
listanorbar=listanor/.complexifyx;
listanorfinal=Union[Join[listanor,listanorbar]]/.Rule[a_,b_]:>Rule[ToExpression["delta"<>ToString[a]],b];
Global`alldeltalist0=listanorfinal;
Save[CanonicalNormalizationfile,Global`alldeltalist0]];
Global`alldeltalist0
];

GenerateClassicalDimension[modelnameE_]:=Block[{wc2fieldsdicx,ClassicalDimensionfile,classicalandims},
wc2fieldsdicx=wc2fieldsdic[modelnameE];
ClassicalDimensionfile=FileNameJoin[{modelnameE,"QGRAF","model_data","classicaldimension.dat"}];
If[FileExistsQ[ClassicalDimensionfile],Print["Getting information on the classical anomalous dimension of the couplings for model ",modelnameE];Get[ClassicalDimensionfile],
Print["Classical anomalous dimensions for model ",modelnameE," have not been computed yet, recreating them"];
classicalandims=Join[(Rule@@@Import[FileNameJoin[{modelnameE,"QGRAF","model_data","gaugecouplingsandbosons.dat"}]])/.Rule[a_,b_]:>Rule[ToExpression[a],1],Normal[wc2fieldsdicx]/.{Rule[a_,b_]:>Rule[a,Length[b[[1]]]-2]}];
Global`classicalandims=classicalandims;
Save[ClassicalDimensionfile,Global`classicalandims]];
]




(* Gets the maximum sSS power of the EFT amplitude *)
ComputesSSPower[eftamplitude_]:=Exponent[eftamplitude[[1]]//.eftamplitude[[2]],Global`sSS];

(* GetsSSOrder[exp,x] gets the coefficient of the term of order sSS^x of exp. For x\[LessEqual]0 we give the result of operators of dimension four or less *)
GetsSSOrder[exp_,x_]:=If[x<=0,exp/.Global`sSS->0,Coefficient[exp,Global`sSS^x]];




RecursiveRuleList[t_List]:=Block[{a,b},t//.Rule[a_,b_]:>Rule[a,b/.t]]


PrepareAmplitude[amp_,indranges_,runogauge_,mireplacegaugedata_,UVPoles_,kix_:1]:=Block[{res0,res,reamp2,reamp2kin},
reamp2=RecursiveRuleList[amp[[2]]];
If[kix===1,reamp2kin=reamp2,reamp2kin=reamp2/.Rule[a_,b_]:>Rule[a,Coefficient[(b/.Dot[aa_,Power[bb_,n_]]->Power[Dot[aa,bb],n]),kix]kix]];
res0=Normal[SumExpandIndicesEfficient[amp[[1]],indranges,runogauge,mireplacegaugedata]]//.reamp2kin/.Global`DEN[a_,b_]->1/(a^2-b^2)/.Global`FourPi->4Pi/.Dot[a_,Power[b_,n_]]->Power[Dot[a,b],n]/.Global`ddF[a_,b_,c_]->KroneckerDelta[b,c];
(*
If[UVPoles,
res=Coefficient[res0,Global`invepsilonbar],
res=res0/.{Global`invepsilonbar\[Rule]0}
];
we now give the full answer, pole and finite*)
res0
]


MyCoefficientList[mat_,var_]:=Block[{maxpow,res},
maxpow=Max[Exponent[mat,var]];
res={mat/.var->0};
If[maxpow>0,res=Join[res,Table[Coefficient[mat,var^iix],{iix,maxpow}]]];
res
]


AlphasInSolQ[sols_]:=Length[Flatten[GetAlphas/@Transpose[sols/.Rule[a_,b_]:>{a,b}][[2]]]]>0


Options[CheckOneAmplitude]={Verbose->False};

CheckOneAmplitude[WC_,ampE_,ampF_,indranges_,runogauge_,mireplacegaugedata_,particles_,opts:OptionsPattern[]]:=Module[{system0,system,kins,sols,sols0,res,check},
If[OptionValue[Verbose],Print[DateString[],": computing system0"]];
system0=GetsSSOrder[#,ComputesSSPower[ampE]]&/@(DeleteCases[Union[Flatten[{Normal[SumExpandIndicesEfficient[ampE[[1]]-ampF[[1]],indranges,runogauge,mireplacegaugedata]]}]],0]//.ampE[[2]]//.ampF[[2]]/.Global`DEN[a_,b_]->1/(a^2-b^2)/.Global`FourPi->4Pi/.Global`listareplacesymmetry/.Dot[a_,Power[b_,n_]]->Power[Dot[a,b],n](*/.Global`ddF[a_,b_,c_]\[Rule]KroneckerDelta[b,c]*));
Union[Simplify[TreatDummyFlavorGeneral/@(system0/.Global`ddF[a_,b_,c_]->KroneckerDelta[b,c]/.WC)]]
]


GetIndices[exp_,indref_:{}]:=Block[{mons,int,ext,monshere,iii,allindices,counts},
mons=Splitter[exp];
int={};
ext={};
Do[
allindices=StringSplit[StringReplace[StringRiffle[StringCases[ToString[InputForm[mons[[iii]]/.Power[a_[c___],2]:>Dot@@Table[a[c],2]]],"["~~s:Except["["|"]"]...~~"]":>s],","]," "->""],","];
(*Print["allinds=",allindices];*)
counts=Counts[allindices];
AppendTo[ext,Keys[Select[counts,#==1&]]];
AppendTo[int,Keys[Select[counts,#>1&]]];
(*If[MemberQ[Values[counts],1],AppendTo[ext,PositionIndex[counts][1]],AppendTo[int,PositionIndex[counts][2]]];*)
(*If[MemberQ[Values[counts],2],AppendTo[int,PositionIndex[counts][2]]];*)
,{iii,Length[mons]}];
{DeleteDuplicates[Flatten[int]],DeleteDuplicates[Flatten[ext]]}];


TreatDummyFlavor[exp_]:=Module[{sys,dummyindices,flindices},
sys=Splitter[exp];
Sum[
dummyindices=ToExpression/@(GetIndices[sys[[j]]][[1]]);
flindices=Select[dummyindices,MemberQ[fli,#]&];
sys[[j]]/.MapThread[Rule,{flindices,Take[FLi,Length[flindices]]}]/.MapThread[Rule,{FLi,fli}],{j,Length[sys]}]]


ComplexConjugate[exp_,complexifyx_]:=Conjugate[exp/.complexifyx]//.{Conjugate[a_+b_]->Conjugate[a]+Conjugate[b],Conjugate[a_*b_]->Conjugate[a]Conjugate[b]}/.Conjugate[a_]->a;



ImposeHermiticity[wclist_,complexifyx_,complexifyFx_]:=Module[{ke,prob,newrules,newruleske},
ke=wclist/.Rule[a_,b_]:>a;
prob=DeleteCases[Tally[ke],{_,1}];
If[Length[prob]>0,prob=Transpose[prob][[1]]];
newrules=EliminateRepeated[Table[Rule[prob[[i]],ComplexConjugate[(ComplexConjugate[RemoveUnderscore[prob[[i]]]/.wclist,complexifyFx]+ComplexConjugate[RemoveUnderscore[prob[[i]]],complexifyx]/.wclist)/2//Simplify,complexifyFx]],{i,Length[prob]}]];
newruleske=newrules/.Rule[a_,b_]:>a;
{Join[Select[wclist,!MemberQ[newruleske,Keys[#]]&],newrules],Select[wclist,MemberQ[newruleske,Keys[#]]&]}
]


TurnToGlobal[exp_]:=ToExpression[StringReplace[ToString[exp,InputForm],{"matcher`Private"->"Global"}]];



TreatDummyFlavorGeneral[exp_,lis_:{"fl"}]:=Block[{listexp,res,internalflavor,externalflavor,miflisnoexternal,numf},
listexp=Splitter[exp];
res=0;
Do[
internalflavor=ToExpression/@GetIndices[listexp[[i]],lis][[1]];
externalflavor=ToExpression/@GetIndices[listexp[[i]],lis][[2]];
miflisnoexternal=Select[miflis,!MemberQ[externalflavor,#]&];
numf=Length[internalflavor];
If[numf>0,
res=res+(listexp[[i]]/.Table[internalflavor[[jj]]->miflisnoexternal[[jj]],{jj,numf}]);,
res=res+listexp[[i]];
];
,{i,Length[listexp]}];
(*Simplify[res]*)
res
];


CanonicallyNormalize[wclist_,modelnameE_,complexifyx_]:=Block[{canorfile,kinrule,kindic,gaugecouplingsandbosonsdic,gaugecouplingrenormalization,alphakin,alphakinbar,alphakinlist,wctreenokin,canorlist,gaugecouplingsandbosonsfile,gaugecouplingsandbosonsdata},
canorfile=FileNameJoin[{modelnameE,"QGRAF","model_data","canonicalnormalization.dat"}];
Get[canorfile];
kinrule=Get[FileNameJoin[{modelnameE,"QGRAF","model_data","kineticrule"}]];
kindic=Association[kinrule/.Rule[a_,b_]:>Rule[a[[1]],b]];
gaugecouplingsandbosonsfile=FileNameJoin[{modelnameE,"QGRAF","model_data","gaugecouplingsandbosons.dat"}];
If[FileExistsQ[gaugecouplingsandbosonsfile],gaugecouplingsandbosonsdata=Import[gaugecouplingsandbosonsfile],
gaugecouplingsandbosonsdata={};
];
If[Length[gaugecouplingsandbosonsdata]>0,
gaugecouplingsandbosonsdic=MapThread[Rule,Transpose[gaugecouplingsandbosonsdata]]/.Rule[a_,b_]:>Rule[ToExpression[a],b];,
gaugecouplingsandbosonsdic={};];
gaugecouplingrenormalization=(gaugecouplingsandbosonsdic/.Rule[a_,b_]:>Rule[a,a(1+Global`onelooporder kindic[b][[1]]/2)])/.wclist[[2,1]];
alphakin=Flatten[kinrule/.Rule[a_,b_]:>b];
alphakinbar=alphakin/.complexifyx;
alphakinlist=Union[Join[alphakin,alphakinbar]];
wctreenokin=Normal[Complement[Association[wclist[[1,1]]],KeySelect[wclist[[1,1]],MemberQ[alphakinlist,#]&]]];
canorlist=Global`alldeltalist0/.wctreenokin/.wclist[[2,1]];
{{wclist[[1]],{wclist[[2,1]]/.Rule[a_,b_]:>Rule[a,b+(ToExpression[StringReplace["delta"<>ToString[a],"_"->""]]/.canorlist)],wclist[[2,2]]}},gaugecouplingrenormalization}
]


UnifyTreeandLoop[wclist_]:=Block[{dit,dil,ket,kel,res},
dit=Association[wclist[[1,1]]];
dil=Association[wclist[[2,1]]];
ket=Keys[dit];
kel=Keys[dil];
If[Sort[ket]===Sort[kel],
res=Table[Rule[ket[[i]],dit[ket[[i]]]+Global`onelooporder dil[ket[[i]]]],{i,Length[ket]}],
Print["Keys in tree level and one-loop matching are not the same"];res="Problems"];
res
]


GetFinalRuleOrdered[wclist_,modelnameE_]:=Block[{redfile=FileNameJoin[{modelnameE,"QGRAF","model_data","redundancies.dat"}],res},
If[FileExistsQ[redfile],Get[redfile]];
If[ListQ[Global`finalruleordered]&&Length[Global`finalruleordered]>0,
res=Global`finalruleordered;,
res=wclist[[1,1]]/.Rule[a_,b_]:>Rule[a,RemoveUnderscore[a]];];
res]



GoToPhysicalBasis[wclist_,modelnameE_]:=Block[{redfile=FileNameJoin[{modelnameE,"QGRAF","model_data","redundancies.dat"}],result=UnifyTreeandLoop[wclist]},
If[FileExistsQ[redfile],Get[redfile]];
If[ListQ[Global`finalruleordered]&&Length[Global`finalruleordered]>0,
result=(Global`finalruleordered/.Rule[a_,b_]:>Rule[a,Normal[Series[Expand[b/.UnifyTreeandLoop[wclist]],{Global`onelooporder,0,1}]]]);];
result]



Options[ComputeRGEModeltoEFT]={Verbose->True};


ComputeRGEModeltoEFT[modelnameF_,modelnameE_,opts:OptionsPattern[]]:=Block[{allwilson,wcphysical,wc0,wc1uv,lwc0,lwc1uv,wctreelist,rescalinglist,x,putindices,realpars,complexpars,complexify,dilist,groupdata,indranges,indi,mireplacegaugedata,mirunogauge,vars2one,listhermiticity,finalruleordered,replacegaugedata,allpars,repl,gaugecouplingrenormalization,listareplacesymmetry,classicalandimswithindices,classicalandimsphysical,goodrescalinglist},
If[FileExistsQ[FileNameJoin[{modelnameF,"RGEResult.dat"}]],Print["RGEs for EFT UV model ",modelnameF, " onto EFT ",modelnameE," already computed and stored in file ",FileNameJoin[{modelnameF,"RGEResult.dat"}]];Print["If you want to recreate the calculation please remove that file and run the command again."];Return[]];
Print["Computing the RGEs for EFT UV model ",modelnameF," onto EFT ",modelnameE];
If[!FileExistsQ[FileNameJoin[{modelnameF,"MatchingResult.dat"}]],
MatchModeltoEFT[modelnameF,modelnameE,Evaluate[FilterRules[{opts},Options[MatchModeltoEFT]]]]];
Get[FileNameJoin[{modelnameE,"QGRAF","model_data","classicaldimension.dat"}]];
Get[FileNameJoin[{modelnameF,"MatchingResult.dat"}]];
allwilson=Global`MatchingResult;
Print["Initializing model ",modelnameE];
{realpars,complexpars,complexify,dilist,groupdata,indranges,indi,mireplacegaugedata,mirunogauge,vars2one,{listhermiticity,finalruleordered,replacegaugedata,listareplacesymmetry}}=InitializeModel[modelnameE];
(* we do this to get finalruleordered even if empty*)
finalruleordered=GetFinalRuleOrdered[allwilson[[2]],modelnameE];
allpars=Join[ToExpression/@realpars,ToExpression/@complexpars,(ToExpression/@complexpars)/.complexify];
repl=RenameOneLoopWC[allpars];
wcphysical=allwilson[[3]];
gaugecouplingrenormalization=allwilson[[4]];
wc0=wcphysical/.Global`onelooporder->0/.Global`epsilonbar->0;
wc1uv=wcphysical/.Global`epsilonbar->0/.Rule[a_,b_]:>Rule[a,Coefficient[b,Global`invepsilonbar Global`onelooporder]];
lwc0=wc0/.Rule->List;
lwc1uv=wc1uv/.Rule->List;
wctreelist=Table[
If[(lwc1uv[[i,1]]/.wc0)===0,Rule[lwc1uv[[i,1]],RemoveUnderscore[lwc1uv[[i,1]]/.repl]],Rule[lwc1uv[[i,1]],RemoveUnderscore[lwc1uv[[i,1]]/.wc0]]]
,{i,Length[lwc1uv]}];
putindices=Table[Rule[ToExpression[StringSplit[ToString[wctreelist[[i,1]]],"["][[1]]],wctreelist[[i,1]]],{i,Length[wctreelist]}];
rescalinglist=(Global`classicalandims/.Rule[a_,b_]:>Rule[(a/.putindices)/.wctreelist,b])/.Rule[a_,b_]:>Rule[a,RemoveUnderscore[a] x^b];
classicalandimswithindices=Join[Global`classicalandims/.Rule[a_,b_]:>Rule[a[c__],a[c] x^b],Global`classicalandims/.Rule[a_,b_]:>Rule[a,a x^b]];
classicalandimsphysical=finalruleordered/.Rule[a_,b_]:>Rule[a,Exponent[Collect[b/.classicalandimswithindices,x],x]];
goodrescalinglist=Join[(Rule@@@Import[FileNameJoin[{modelnameE,"QGRAF","model_data","gaugecouplingsandbosons.dat"}]])/.Rule[a_,b_]:>Rule[ToExpression[a],x ToExpression[a]],wcphysical/.{Global`epsilonbar->0,Global`onelooporder->0}/.Rule[a_,b_]:>Rule[PutUnderscore[b],b x^(a/.classicalandimsphysical)]//Union];
(*Print["wctreelist=",wctreelist];
Print["putindices=",putindices];
Print["rescalinglist=",rescalinglist];
Print["goodrescalinglist=",goodrescalinglist];
Print["lwc1uv=",lwc1uv];*)
Print["Computing the beta functions for model " ,modelnameF," onto ",modelnameE];
Global`RGEResult=gaugecouplingrenormalization/.Rule[a_,b_]:>Rule[Global`\[Beta][a],ToExpression[a] D[(Coefficient[b,Global`onelooporder Global`invepsilonbar]/ToExpression[a])/.goodrescalinglist,x]/.x->1];
Do[
AppendTo[Global`RGEResult,Rule[Global`\[Beta][lwc1uv[[cual,1]]],-Expand[RemoveUnderscore[lwc1uv[[cual,1]]/.wctreelist](D[(lwc1uv[[cual,2]]/RemoveUnderscore[(lwc1uv[[cual,1]]/.wctreelist)])/.goodrescalinglist,x]/.x->1)]]];
,{cual,Length[lwc1uv]}];
(*
Global`RGEResult=Join[gaugecouplingrenormalization/.Rule[a_,b_]\[RuleDelayed]Rule[Global`\[Beta][a],ToExpression[a] D[(Coefficient[b,Global`onelooporder Global`invepsilonbar]/ToExpression[a])/.rescalinglist,x]/.x\[Rule]1],Table[Rule[Global`\[Beta][lwc1uv[[cual,1]]],-Expand[RemoveUnderscore[lwc1uv[[cual,1]]/.wctreelist](D[(lwc1uv[[cual,2]]/RemoveUnderscore[(lwc1uv[[cual,1]]/.wctreelist)])/.rescalinglist,x]/.x\[Rule]1)]],{cual,Length[lwc1uv]}]];

*)
Print["Saving it on file"];
Save[FileNameJoin[{modelnameF,"RGEResult.dat"}],Global`RGEResult];
Print["RGEs computed, result written in ",FileNameJoin[{modelnameF,"RGEResult.dat"}]];
]


Options[MatchModeltoEFT]={Verbose->True};

MatchModeltoEFT[modelnameF_,modelnameE_,opts:OptionsPattern[]]:=Block[{EFTMatching,alldeltalist0,realpars,complexpars,complexify,dilist,groupdata,indranges,indi,mireplacegaugedata,mirunogauge,vars2one,listhermiticity,finalruleordered,replacegaugedata,listhermiticityF,realparsF,complexparsF,complexifyF,dilistF,groupdataF,indrangesF,indiF,mireplacegaugedataF,mirunogaugeF,vars2oneF,finalruleorderedF,replacegaugedataF,diE,diF0,diF1,pars,allsols,dini,dfin,dfinfin,soltemp,sol,newsolbar,newsol,fullsol,allparsF,replF,soltemp2,finalfullsol,finalfullsolcannor,gaugecouplingrenorm,finalfullphys,listareplacesymmetry,listareplacesymmetryF},
If[FileExistsQ[FileNameJoin[{modelnameF,"MatchingResult.dat"}]],
Print["The matching has already been performed and it is stored in ",FileNameJoin[{modelnameF,"MatchingResult.dat"}],". If you want to recreate it please delete the file and run the command again."];
Return[]];
Print["Initializing EFT"];
{realpars,complexpars,complexify,dilist,groupdata,indranges,indi,mireplacegaugedata,mirunogauge,vars2one,{listhermiticity,finalruleordered,replacegaugedata,listareplacesymmetry}}=InitializeModel[modelnameE];
EFTMatching=MatchEFT[modelnameE];
alldeltalist0=GenerateNormalizationList[modelnameE,complexify];
GenerateClassicalDimension[modelnameE];
Print["Initializing Full Theory"];
{realparsF,complexparsF,complexifyF,dilistF,groupdataF,indrangesF,indiF,mireplacegaugedataF,mirunogaugeF,vars2oneF,{listhermiticityF,finalruleorderedF,replacegaugedataF,listareplacesymmetryF}}=InitializeModel[modelnameF];
allparsF=Join[ToExpression/@realparsF,ToExpression/@complexparsF,(ToExpression/@complexparsF)/.complexifyF];
replF=RenameOneLoopWC[allparsF];
diF0=dilistF[[1,1]];
If[Length[dilistF]==1,AppendTo[dilistF,
{Association[Normal[diF0]/.Rule[a_,b_List]:>Rule[a,{0,{}}]],{}}]];
diF1=dilistF[[2,1]];
dini=DateString[];
Print["Beginning of matching calculation. ",dini];
sol={EFTMatching[[-1]]/.Global`Coeff[a_,b_,c_,d_]:>MiGetSpecificAmplitudeNew[diF0,indrangesF,mirunogaugeF,mireplacegaugedataF,replF,a,b,c,d],EFTMatching[[-1]]/.Global`Coeff[a_,b_,c_,d_]:>MiGetSpecificAmplitudeNew[diF1,indrangesF,mirunogaugeF,mireplacegaugedataF,replF,a,b,c,d]};
dfin=DateString[];
Print["End of matching calculation. ",dfin];
Print["Matching calculation finished. It took "<>ToString[DateDifference[dini,dfin,{"Hour","Minute","Second"}]]];
Print["Now tidying up the result"];
sol=Expand[sol]/.(Global`invepsilonbar*Global`epsilonbar)-> 1/.Global`epsilonbar-> 0/.(1/Global`invepsilonbar)-> 0;
(*Print[sol];*)
newsolbar=Table[Table[(sol[[j,i,1]]/.Union[Join[complexify,complexifyF/.replF]])->TreatDummyFlavor[ComplexConjugate[sol[[j,i,2]],Union[Join[complexify,complexifyF/.replF]]]]/.(listhermiticityF/.replF),{i,Length[sol[[j]]]}],{j,Length[sol]}];newsol=Table[Table[(sol[[j,i,1]])->TreatDummyFlavor[sol[[j,i,2]]],{i,Length[sol[[j]]]}],{j,Length[sol]}]/.(listhermiticityF/.replF);
(*Print["newsol=",newsol];
Print["newsolbar=",newsolbar];*)
fullsol=Table[EliminateRepeated[Union[Join[newsol[[j]],newsolbar[[j]]]],listareplacesymmetryF/.replF(*Join[dilist[[1,2]],dilistF[[j,2]],listareplacesymmetryF]*)],{j,Length[newsol]}];
Print["Full solution found, now imposing hermiticity. ",DateString[]];
finalfullsol=ImposeHermiticity[#,complexify,complexifyF/.replF]&/@fullsol;
dfinfin=DateString[];
Print["End of the calculation. ",dfinfin];
Print["Complete matching calculation finished. It took "<>ToString[DateDifference[dini,dfinfin,{"Hour","Minute","Second"}]]];
Print["Now canonically normalizing the result"];
{finalfullsolcannor,gaugecouplingrenorm}=CanonicallyNormalize[finalfullsol,modelnameE,complexify];
Print["Now going to the physical basis"];
finalfullphys=GoToPhysicalBasis[finalfullsolcannor,modelnameE];
Global`MatchingResult={finalfullsol,finalfullsolcannor,finalfullphys,gaugecouplingrenorm};
Save[FileNameJoin[{modelnameF,"MatchingResult.dat"}],Global`MatchingResult];
Print["Now checking the results"];
CheckGreenSol[modelnameF,modelnameE,Evaluate[FilterRules[{opts},Options[CheckGreenSol]]]]
]


Options[CheckGreenSol]={Verbose->True};

CheckGreenSol[full_,eft_,opts:OptionsPattern[]]:=Block[{realpars,complexpars,complexify,dilist,groupdata,indranges,indi,mireplacegaugedata,mirunogauge,vars2one,hermiticitylist,finalruleordered,replacegaugedata,realparsF,complexparsF,complexifyF,dilistF,groupdataF,indrangesF,indiF,mireplacegaugedataF,mirunogaugeF,vars2oneF,hermiticitylistF,finalruleorderedF,replacegaugedataF,diE0,diF0,diF1,pars,problist,messloop,messamp,allparsF,replF,teoe,teof,ampdiff,diff,solgreen,listareplacesymmetry,listareplacesymmetryF},
If[!FileExistsQ[FileNameJoin[{full,"MatchingResult.dat"}]],
MatchModeltoEFT[full,eft]];
Get[FileNameJoin[{full,"MatchingResult.dat"}]];
solgreen=Global`MatchingResult[[1]];
{realpars,complexpars,complexify,dilist,groupdata,indranges,indi,mireplacegaugedata,mirunogauge,vars2one,{hermiticitylist,finalruleordered,replacegaugedata,listareplacesymmetry}}=InitializeModel[eft];
{realparsF,complexparsF,complexifyF,dilistF,groupdataF,indrangesF,indiF,mireplacegaugedataF,mirunogaugeF,vars2oneF,{hermiticitylistF,finalruleorderedF,replacegaugedataF,listareplacesymmetryF}}=InitializeModel[full];
allparsF=Join[ToExpression/@realparsF,ToExpression/@complexparsF,(ToExpression/@complexparsF)/.complexifyF];
replF=RenameOneLoopWC[allparsF];
listareplacesymmetryF=listareplacesymmetryF/.replF;
diE0=dilist[[1,1]];
diF0=dilistF[[1,1]];
If[Length[dilistF]==1,AppendTo[dilistF,
{Association[Normal[diF0]/.Rule[a_,b_List]:>Rule[a,{0,{}}]],{}}]];
diF1=dilistF[[2,1]];
pars=Keys[diE0];
problist={};
messloop="";
messamp="";
If[OptionValue[Verbose],
Print[Style[Dynamic[messloop],Large,Blue]];
Print[Style[Dynamic[messamp]]];
];
Do[
messloop=StringJoin@@{"Checking solution at ",ToString[iloop-1]," loops."};
Do[
messamp=StringJoin@@{"Checking amplitude ",StringRiffle[ToString/@pars[[cual]]]," (number ",ToString[cual]," out of ",ToString[Length[pars]],")"};
teoe=PrepareAmplitude[dilist[[1,1]][pars[[cual]]],indranges,mirunogauge,mireplacegaugedata,False];
teof=PrepareAmplitude[dilistF[[iloop,1]][pars[[cual]]],indrangesF,mirunogaugeF,mireplacegaugedataF,True]/.replF;
ampdiff=DummyZeroQ[#,listareplacesymmetryF]&/@(Expand[Flatten[{teoe-teof}]/.solgreen[[iloop,1]]]/.(1/Global`invepsilonbar)-> 0);
diff=DeleteCases[ampdiff,0];
If[Length[diff]>0,AppendTo[problist,{iloop,pars[[cual]],ampdiff}];Print["problems"];];
(*If[Length[diff]>0,res={Style["bad",Red],ampdiff},res=Style["good",Blue]];*)
,{cual,Length[pars]}],
{iloop,2}];
If[Length[problist]==0,If[OptionValue[Verbose],Print[Style["All cross-checks are OK!",Blue]];,Print["All cross-checks are OK!"];],If[OptionValue[Verbose],Print[Style["Some cross-checks failed!",Red]," Check ",FileNameJoin[{full,"MatchingProblems.dat"}]," for details."];,Print["Some cross-checks failed! Check ",FileNameJoin[{full,"MatchingProblems.dat"}]," for details."];]];
Global`problist=problist;
Save[FileNameJoin[{full,"MatchingProblems.dat"}],Global`problist];
]


SimpleShow[x_]:=Block[{i,j,a},
Table[Select[DeleteCases[x[[i,j]],a_->0],!StringContainsQ[ToString[#[[1]]],"bar"]&],{i,Length[x]},{j,Length[x[[1]]]}]];



End[]


EndPackage[]
