<<TeXUtilities`

Get[NotebookDirectory[]<>"dan_procedure.m"];

(*TeX Formatting*)Format[a[i_],TraditionalForm]:=Subscript[a,i]
Format[Inf,TeXForm]:=TeXCommand["infty"]

myFold[f_,l_List]:=Fold[f,l[[1]],l[[2;;All]]]

myTeXList[l_List]:=TeXForm[TeXVerbatim[myFold[#1<>", "<>#2&,ToString[TeXForm[#]]&/@l]]]

Format[cri[l_List],TeXForm]:=TeXVerbatim[myFold[#1<>" "<>#2&,ToString[TeXForm[#]]&/@l]]

Format[IIi[inds_List,args_List],TeXForm]:=TeXVerbatim["I_{"<>ToString[myTeXList[inds]]<>"}("<>ToString[myTeXList[args]]<>")"]

Format[H[a0_,alist_List,x_,alast_],TeXForm]:=TeXVerbatim["H("<>ToString[TeXForm[a0]]<>" \\mid "<>ToString[myTeXList[alist]]<>" \\dblslash "<>ToString[TeXForm[x]]<>" \\mid "<>ToString[TeXForm[alast]]<>")"];

(*manipulate and LaTeX results*)

gatherIntegrals[expr_]:=((If[Head[expr]===Plus,List@@expr,{expr}])//GatherBy[#,indices[#]&]&)//Reverse;
gatherIntegrals[expr_,function_]:=((If[Head[expr]===Plus,List@@expr,{expr}])//GatherBy[#,function]&)//Reverse;

countIntegrals[expr_]:=({Length[#],#}&/@expr)//ColumnForm//Print

texCountIntegrals[expr_]:="Integral & Number in expression"<>Fold[#1<>" \\\\ \n"<>#2&,"",{"$ I_"<>ToString[indices[#[[1]]]]<>" $ & "<>ToString[Length[#]]}&/@expr]<>" \\\\ \nTotal & "<>ToString[Total[Length/@expr]];

texCountIntegrals[expr_,function_]:="Type & Number in expression"<>Fold[#1<>" \\\\ \n"<>#2&,"",{Fold[#1<>" "<>#2&,ToString/@function[#[[1]]]]<>" $ & "<>ToString[Length[#]]}&/@expr]<>" \\\\ \nTotal & "<>ToString[Total[Length/@expr]];

texIntegralsSingleLine[expr_]:="I_{"<>StringCases[#,"I_{"~~index:Shortest[___]~~"}":>index][[1]]<>"}( "<>StringReplace[#,{"I_{"~~Shortest[___]~~"}"->"","("->"[",")"->"]"}]<>" )"&@(StringReplace[expr,{")-"->") \n - ",")+"->") \n + "}]);

texJoinIntegrals[expr_]:=Fold[#1<>" + {} \\\\ \n & {} + "<>#2&,expr]

texIntegralsWithFracGath[expr_]:=texJoinIntegrals[texIntegralsSingleLine/@ToString/@TeXForm/@(expr/.{Rational[a_,b_]:>Sign[a/b] HoldForm[Evaluate[Abs[Divide[a,b]]]]})]
texIntegralsWithFrac[expr_]:=texIntegralsWithFracGath[Total/@gatherIntegrals[expr]];

texIntegralsGath[expr_List]:=texJoinIntegrals[texIntegralsSingleLine/@ToString/@TeXForm/@(expr)]
texIntegralsGath[expr_List,scaling_]:=texJoinIntegrals[(If[#[[2]]≠1,ToString[TeXForm[1/#[[2]]]]<>" ",""]<>#[[1]])&/@MapThread[List,{texIntegralsSingleLine/@ToString/@TeXForm/@(scaling*expr//Expand),scaling}]]

texIntegralsByCoeff[expr_]:=Block[{gath=gatherIntegrals[expr,{indices[#],denominator[#]}&]},texIntegralsGath[Total/@gath,denominator/@gath[[All,1]]]];
texIntegrals[expr_]:=Block[{gath=gatherIntegrals[expr]},texIntegralsGath[Total/@gath]];

(*Using a pattern to make a pattern not a pattern!?*)
lhsRule[RuleDelayed[lhs_,rhs_]]:=lhs/.HoldPattern[w_Pattern]:>w[[1]]
rhsRule[RuleDelayed[lhs_,rhs_]]:=Expand[rhs]

ruleToIdentity[expr_]:=lhsRule[expr]-rhsRule[expr]//Expand;

texRule[expr_]:=Block[{gath=gatherIntegrals[Expand@rhsRule[expr]]},ToString[TeXForm[lhsRule[expr]]]<>" & {} = "<>texIntegralsGath[Total/@gath]];
texRuleWithFrac[expr_]:=Block[{gath=gatherIntegrals[Expand@rhsRule[expr]]},ToString[TeXForm[lhsRule[expr]]]<>" & {} = "<>texIntegralsWithFracGath[Total/@gath]];
texRuleByCoeff[expr_]:=Block[{gath=gatherIntegrals[Expand@rhsRule[expr],{indices[#],denominator[#]}&]},ToString[TeXForm[lhsRule[expr]]]<>" & {} = "<>texIntegralsGath[Total/@gath,denominator/@gath[[All,1]]]];
texRuleByCR[expr_]:=Block[{gath=Reverse@gatherIntegrals[Expand@rhsRule[expr],{indices[#],denominator[#],args[#]//Length,(Union@@(args[#][[All,1]]))//Length}&]},ToString[TeXForm[lhsRule[expr]]]<>" & {} = "<>texIntegralsGath[Total/@gath,denominator/@gath[[All,1]]]];

(* Load precomputed results to check later *)
Get[NotebookDirectory[]<>"wt5_dan_precomputed.m"];

(* ------ *)

wt5VarsToABC = {a[i_]:>{a,b,c,d,e,f,g}[[i+1]], x->Inf};
canonicalCR = {cri[{a_,b_,c_,d_}]:>cri[crOrbit[{a,b,c,d}]]};

in5Dan = Asymb[5,1,2]/.wt5VarsToABC//TeXForm

in5Polylog = iToCcr@hToI@hCrSimp[Asymb[5,1,2]]/.wt5VarsToABC;
%//TeXForm

(* apply the all n reduction first *)

out5AllN = iToCcr@hToI@hCrSimp@Expand@reduceAll[5]/.wt5VarsToABC//Expand;

out5AllNLower = Select[out5AllN, Position[#, a]≠{}&]/.canonicalCR;

out5AllN - (out5AllNLower - (out5AllNLower/.a->g))/.canonicalCR//Expand

wt5DanAllNPrecomputed == (in5Polylog - (out5AllNLower - (out5AllNLower/.a->g))/.{a->0,g->1}/.canonicalCR//Expand)

out5AllNLowerGathered = gatherIntegrals[out5AllNLower];

countIntegrals[out5AllNLowerGathered]

texCountIntegrals[out5AllNLowerGathered]

texIntegrals[2*out5AllNLower//Expand]

texIntegralsWithFrac[out5AllNLower]

texIntegralsByCoeff[out5AllNLower]

(* now apply the odd n reduction *)

out5OddN = iToCcr@hToI@hCrSimp@Expand@reduceOdd[5]/.wt5VarsToABC;

out5OddNLower = Select[out5OddN, Position[#, a]≠{}&]/.canonicalCR;

out5OddN -(out5OddNLower - (out5OddNLower/.a->g))/.canonicalCR//Expand

Length[out5OddNLower]

wt5DanOddNPrecomputed  == (in5Polylog - (out5OddNLower - (out5OddNLower/.a->g))/.{a->0,g->1}/.canonicalCR//Expand)

out5OddNLowerGathered = gatherIntegrals[out5OddNLower];

countIntegrals[out5OddNLowerGathered];

texCountIntegrals[out5OddNLowerGathered]

texIntegrals[out5OddNLower]

(* Now we use some identities to write everything in terms of I311, I32 and I5 *)

Get[NotebookDirectory[]<>"wt5_rules_to_i311_i32_i5.m"];

texRuleByCoeff[rule41to32]

texRuleByCoeff[rule14to32]

texRule[rule23to32]

texRule[rule221to311]

texRule[rule131to311]

texRuleByCoeff[rule113to311]

texRule[rule122to311]

texRule[rule212to311]

(* Apply these rules to write I11111 as I311, I32 and I5 *)

out5OddNLoweras311and32and5 = out5OddNLower/.{rule221to311,rule212to311,rule122to311,rule113to311,rule131to311,rule41to32,rule14to32,rule23to32}/.canonicalCR//Expand;

out5OddNLoweras311and32and5gathered = gatherIntegrals[out5OddNLoweras311and32and5];

Length[out5OddNLoweras311and32and5]

wt5DanOddNas311and32and5Precomputed  == (in5Polylog - (out5OddNLoweras311and32and5 - (out5OddNLoweras311and32and5/.a->g))/.{a->0,g->1}/.canonicalCR//Expand)

countIntegrals[out5OddNLoweras311and32and5gathered]

texCountIntegrals[out5OddNLoweras311and32and5gathered]

texIntegralsByCoeff[out5OddNLoweras311and32and5]

(* Now convert I311 to I32 modulo del, to reduce I11111 to I32 only *)

texRuleByCR[rule311to32]

(* Now apply this rule to write I11111 as I32 mod del *)

out5OddNLoweras32del = out5OddNLoweras311and32and5/.rule311to32/.IIi[{5},_List]:>0/.canonicalCR//Expand;

out5OddNLoweras32del//Length

wt5DanOddNas32delPrecomputed == (in5Polylog - (out5OddNLoweras32del - (out5OddNLoweras32del/.a->g))/.{a->0,g->1}/.canonicalCR//Expand)

out5OddNLoweras32delGathered = gatherIntegrals[out5OddNLoweras32del,{args[#]//Length, (Union@@(args[#][[All,1]]))//Length, Count[Join@@ccrToCr[args[#]][[All,1]],Inf]}&]//SortBy[#, Switch[{args[#[[1]]]//Length,  (Union@@(args[#[[1]]][[All,1]]))//Length, Count[Join@@ccrToCr[args[#[[1]]]][[All,1]],Inf]},
{1,5,0},1,
{1,5,1},2,
{1,5,2},3,
{2,5,0},4,
{2,5,1},5,
{2,5,2},6,
{2,6,0},7,
{2,6,1},8,
{2,6,2},9]&]&;

texCountIntegrals[out5OddNLoweras32delGathered, {Switch[{args[#]//Length,  (Union@@(args[#][[All,1]]))//Length, Count[Join@@ccrToCr[args[#]][[All,1]],Inf]},
{2,6,2},"6-variable & 2",
{2,6,1},"6-variable & 1",
{2,6,0},"6-variable & 0",
{2,5,2},"5-variable & 2",
{2,5,1},"5-variable & 1",
{2,5,0},"5-variable & 0",
{1,5,2},"Coupled & 2",
{1,5,1},"Coupled & 1",
{1,5,0},"Coupled & 0"]}&]

out5OddNLoweras32delGatheredCoeff = gatherIntegrals[out5OddNLoweras32del,{denominator[#], args[#]//Length,(Union@@(args[#][[All,1]]))//Length, Count[Join@@ccrToCr[args[#]][[All,1]],Inf]}&]//SortBy[#, Switch[{args[#[[1]]]//Length,  (Union@@(args[#[[1]]][[All,1]]))//Length, Count[Join@@ccrToCr[args[#[[1]]]][[All,1]],Inf]},
{1,5,0},1,
{1,5,1},2,
{1,5,2},3,
{2,5,0},4,
{2,5,1},5,
{2,5,2},6,
{2,6,0},7,
{2,6,1},8,
{2,6,2},9]&]&;

texWt5As32del = ToString[texIntegralsGath[Total/@out5OddNLoweras32delGatheredCoeff, denominator/@out5OddNLoweras32delGatheredCoeff[[All,1]]]];

texWt5As32del