SetDirectory[NotebookDirectory[]];
<<AdditiveDecomposition.m

AdditiveDecomposition.m is written by Hao Du and Elaine Wong, Austrian Academy of Sciences, RICAM, Version 0.2 (July 8, 2020)
⟶ Type  ?AdditiveDecomposition for help

?AdditiveDecomposition

Part 1: Examples from the Paper

Example 3.1

f=(t2+x)(t3^2-t1 t3+x t2)/(x t2 t3)
genlist={t1,t2,t3};
ProperDecomposition[f, genlist]//Together

Example 4.9

f=(1/(Log[x] LogIntegral[x]))+((-2 x Log[x]+LogIntegral[x])/((Log[x])^2))+Log[Log[x]];
Print["Original function:"];
Print["f = ",f];
Print["Generators and derivatives (user choice):"];
genlog={Log[x],LogIntegral[x],Log[Log[x]]}
derlog=D[#,x]&/@genlog//Together
Print["Renaming generators and substituting into f:"];
{fnew, genlist,derlist}=ToGenNames[f,x,genlog]
Print["f = ",fnew];
Print["Additive decomposition {integrable part, remainder}:"];
adif=AddDecompInField[fnew,x,genlist,derlist]
Print["Remainder in the base field:"];
subt=GenSubstitute[x,genlist,derlist];
r=(adif[[2]])//.subt

Example 5.1

f=((Log[(1+x) Log[x]])/(x Log[x]));
Print["Original function:"];
Print["f = ",f];
Print["Generators and derivatives for Tower (i):"];
genlog={Log[x],Log[(x+1) Log[x]]}
derlog=D[#,x]&/@genlog//Together
Print["Renaming generators and substituting into f:"];
{fnew, genlist,derlist}=ToGenNames[f,x,genlog]
Print["f = ",fnew];
Print["Additive decomposition {integrable part, remainder}:"];
adif=AddDecompInField[fnew,x,genlist,derlist]
Print["Remainder in the base field:"];
subt=GenSubstitute[x,genlist,derlist];
r=(adif[[2]])//.subt

f=((Log[1+x]+Log[Log[x]])/(x Log[x]));
Print["Original function:"];
Print["f = ",f];
Print["Generators and derivatives for Tower (ii):"];
genlog={Log[x],Log[x+1],Log[Log[x]]}
derlog=D[#,x]&/@genlog//Together
Print["Renaming generators and substituting into f:"];
{fnew, genlist,derlist}=ToGenNames[f,x,genlog]
Print["f = ",fnew];
Print["Additive decomposition {integrable part, remainder}:"];
adif=AddDecompInField[fnew,x,genlist,derlist]
Print["Remainder in the base field:"];
subt=GenSubstitute[x,genlist,derlist];
r=(adif[[2]])//.subt

Example 5.7

Print["Generators and derivatives:"];
genlog={Log[x],Log[x Log[x]],Log[(x+1) (Log[x]+1) Log[x Log[x]]]};
derlog=D[#,x]&/@genlog//Together
Print["Renaming generators:"];
{fnew, genlist,derlist}=ToGenNames[1,x,genlog]
Print["Associated matrix with respect to the matryoshka decomposition:"];
AssMat[genlist,derlist]
Print["We embed the previous tower into a well-generated one:"];
wglt=WellGenLogTower[x, genlist,derlist];
newgenlist=wglt[[1]];
newderlist=wglt[[3]];
subsu=Thread[genlist -> newgenlist.wglt[[2]]]
wglt[[4]]//MatrixForm

f1 =(((((1+t1))^2)+t1 t2)/(t1 (1+t1) t2 x)); f2=(t3/x);
Print["f1 = ", f1, " and f2 = ", f2];
phif1=f1/.subsu; phif2=f2/.subsu;
Print["ϕ(f1) = ", phif1, " and ϕ(f2) = ", phif2];
Print["Additive decompositions for all f1, ϕ(f1), f2, ϕ(f2), respectively:"];
adif1=AddDecompInField[f1,x,genlist,derlist]
adwg1=AddDecompInField[phif1,x,newgenlist,newderlist]
adif2=AddDecompInField[f2,x,genlist,derlist]
adwg2=AddDecompInField[phif2,x,newgenlist,newderlist]
Print["Projections of the remainders of f2 and ϕ(f2), respectively:"];
ProperDecomposition[adif2[[2]],genlist]
ProperDecomposition[adwg2[[2]],newgenlist]

Part 2: Illustration of the Main Functions

AddDecompInField

?AddDecompInField

AddDecompInField[t4, x,{t1,t2,t3,t4},{1/x,1/t1,1/t2,1/t3}]

AddDecompInField[t4, x,{t1,t2,t3,t4},{(1/x),(1/(1+x)),(1/t1),((-t1 t2-2 t1 t3+2 x+t1 x-t1 t2 x-2 t1 t3 x+2 (x^2)+2 t3 (x^2)+2 t3 (x^3))/(t1 x (1+x) (t2+2 t3+(t3^2) x)))}]

AddDecompInField[t2+t2 t3+((t2-2 t1 x)/(t1^2)),x, {t1,t2,t3},{(1/x),(1/(t1 x)),(1/(1+x))}]

WellGenLogTower

?WellGenLogTower

(* This is an example of an S-primitive tower satisfying (CLI) and (MI) to be used for input. *)
WellGenLogTower[x,{t1,t2,t3,t4},{(1/x),(1/(1+x)),(1/t1)+(1/x),(1/t1)+(1/t2)+(1/x)}]

(* This is an example of an S-primitive tower not satisfying (CLI) and (MI) to be used for input. *)
(* Note that u4' is u3-simple. *)
WellGenLogTower[x,{t1,t2,t3,t4},{(1/x),(1/(1+x)),(1/t1),((2+t1+t1 (t3^2)+2 x+2 t3 x+t1 (t3^2) x+2 t3 (x^2))/(t1 (1+x) (t2+2 t3+(t3^2) x)))}]

(* This is an example of a S-primitive tower not satisfying (CLI) and (MI) to be used for input. *)
(* Note that u4' is NOT u3-simple. *)
WellGenLogTower[x,{t1,t2,t3,t4},{(1/x),(1/t1),(2/t1)+(1/(1+x)),((2+t1+t1 (t2^2)+2 x+2 t2 x+t1 (t2^2) x+2 t2 (x^2))/(t1 (1+x) (t3+(t2^2) x)))}]

Part 3: Useful Functions

ExtendedEuclidean

?ExtendedEuclidean

Catch[ExtendedEuclidean[((x(1+x)(1+y))/(-1+y)),(((-1+x)(1+y))/(-2+y)),1+(x^2),x]]
(* Check: r a + s b = c *)
Simplify[%[[1]]*((x(1+x)(1+y))/(-1+y))+%[[2]]*(((-1+x)(1+y))/(-2+y))-(1+(x^2))]

HermiteReduceGeneral

?HermiteReduceGeneral

(* A hand made example *)
HermiteReduceGeneral[((t2+x)/(((-t1+t2))^2)),x,{t1,t2},{1/x,1/t1}]

(* Example from Bronstein's book Example 2.2.1 *)
HermiteReduceGeneral[(x^7-24x^4-4x^2+8x-8)/(x^8+6x^6+12x^4+8x^2),x,{},{}]

ProperDecomposition

?ProperDecomposition

ProperDecomposition[(((t1^2) t2+(t2^2)+x+t1 x)/((t1-x) (-t1+t2+x))),{t1,t2}]

ProperDecomposition[((1+t1)/x),{t1}]

ProperDecomposition[(((t2^2)+t1 (t2^2)+t3+t1 t3+2 t2 t3+2 t1 t2 t3+2 (t2^2) t3+t1 (t2^2) t3+(t3^2)+t1 (t3^2)+4 t2 (t3^2)+2 t1 t2 (t3^2)+2 (t3^3)+t1 (t3^3)+(t2^2) x+t1 (t2^2) x+t3 x+t1 t3 x+2 t2 t3 x+2 t1 t2 t3 x+(t2^2) t3 x+(t3^2) x+t1 (t3^2) x+2 t2 (t3^2) x+(t3^3) x)/((1+t1) t3 (((t2+t3))^2) (1+x)))
,{t1,t2,t3}]

Head Term

?HeadTerm

HeadTerm[(t2/t3)+(((t2^2) t3)/t1)+t2 (t3^2),{t1,t2,t3}]
HeadTerm[(1/((-1+t1) (1+t2) t3))(-t2+t1 t2-(t2^2)+t1 (t2^2)-(t1^5) (t3^2)+(t1^6) (t3^2)-2 t2 (t3^2)+2 t1 t2 (t3^2)-(t3^4)+t1 (t3^4)+t1 (t3^5)+t1 t2 (t3^5)-t3 x-t2 t3 x-t1 t2 t3 x+(t1^2) t2 t3 x-t1 (t2^2) t3 x+(t1^2) (t2^2) t3 x),{t1,t2,t3}]

MonomialIndicator

?MonomialIndicator

MonomialIndicator[x,{t1,t2,t3}]
MonomialIndicator[t2^3t3^8,{t1,t2,t3}]
MonomialIndicator[t2^3t3^8,{t3,t2,t1}]
MonomialIndicator[1,{t3,t2,t1}]

AddDecompLogTower

?AddDecompLogTower
?CheckAddDecompLogTower

AddDecompLogTower[t4,x,{t1,t2,t3,t4},{(1/x),(1/t1),(2/t1)+(1/(1+x)),(1/t2)+(1/(1+x))}]
CheckAddDecompLogTower@@Append[{t4,x,{t1,t2,t3,t4}},%]

AddDecompLogTower[t4,x,{t1,t2,t3,t4},{(1/x),(1/t1),(2/t1)+(1/(1+x)),((2+t1+t1 (t2^2)+2 x+2 t2 x+t1 (t2^2) x+2 t2 (x^2))/(t1 (1+x) (t3+(t2^2) x)))}]
CheckAddDecompLogTower@@Append[{t4,x,{t1,t2,t3,t4}},%]

(* The following shows that Mathematica is unable to integrate the integrable part (but we can!). *)
inttemp = Log[x+1]-x+Log[x+1] x+x Integrate[1/LogIntegral[x],x]
ftemp = Log[x+1]+Integrate[1/LogIntegral[x],x]
remtemp=-x/LogIntegral[x]
Simplify[D[inttemp,x]+remtemp-ftemp]
Integrate[Together[ftemp-remtemp],x]

ToGenNames

?ToGenNames

f=((-2*Log[x]*x-Log[x]+x)/((Log[x])^2))*LogIntegral[x];
genlog={Log[x],LogIntegral[x]};
ToGenNames[f,x,genlog]

Part 4: Testsuite

(* This collection of examples were used for timings. Examples provided by Christoph Koutschan. *)
christoph1=Import["decomp_examples_collection1.m"];

(* Testing Christoph's examples that take longer than a second to compute. *)
list={22,52,53,54,57,58,76,81,92,93,94,95,96,98};
Do[Print[{list[[i]],Timing[adwgtemp=AddDecompLogTower@@christoph1[[list[[i]]]];],CheckAddDecompLogTower@@Append[christoph1[[list[[i]]]][[1;;3]],adwgtemp]}],{i,1,Length[list]}]

(* 82 and 90 takes a long time, but at least it finishes! *)

Do[Print[{i,Timing[adwgtemp=AddDecompLogTower@@christoph1[[i]];],CheckAddDecompLogTower@@Append[christoph1[[i]][[1;;3]],adwgtemp]}],{i,82,82}]

Do[Print[{i,Timing[adwgtemp=AddDecompLogTower@@christoph1[[i]];],CheckAddDecompLogTower@@Append[christoph1[[i]][[1;;3]],adwgtemp]}],{i,90,90}]