#####################################################
#the order of d.p f the order of a constant is 0 here
#####################################################
d_order:=proc(f)
local T,i,m;
if type(f,rational) then return 0;fi:
T:=indets(f);
for i from 0 while T<>{} do
    if member(y[i],T) then
       m:=i;
       T:=T minus {y[i]};
    fi:
od:
return m;
end:


#####################################################
#input f;
#output: the minim variable appears in f;
#####################################################
minvariable:=proc(f)
local i;
if type(f,rational) then return(0);fi:
for i from 0 while i<>-1 do 
    if degree(f,y[i])<>0 then return i; 
    fi:
od:
end:

########################################################
#the degree of d.p f, the degree of a constant is 0
########################################################
d_degree:=proc(f)
local d;
d:=d_order(f);
degree(simplify(f),y[d]);
end:


########################################################
#the leading term of d.p f
########################################################
lterm:=proc(f)
local ff,i,gg;
ff:=1;
gg:=f;
for i from 1 while not type(gg,rational) do
    ff:=ff*y[d_order(gg)]^d_degree(gg);
    gg:=d_initial(gg);
od:
return(gg*ff);
end:



 
############################################
#the differential degree  of d.p f
############################################
dd_degree:=proc(f)
local g,T,S,d,mono,e;
g:=expand(f);
if type(g,`+`)  then
   T:=convert(g,set);
else
   T:={g};
fi;
S:={};
d:=d_order(g);
for mono in T do
   e:=add(i*degree(mono,y[i]),i=1..d);
   S:=S union {e};
od;
RETURN(max(op(S)));
end:

######################
#the initial of d.p f
######################
d_initial:=proc(f)
local d,p;
p:=simplify(f);
d:=d_order(p);
lcoeff(p,y[d]);
end:

#######################
#the constant term
#######################
d_const:=proc(f)
subs([seq(y[i]=0,i=0..d_order(f))],f);
end:


###############################################
#the composition of two difference polynomials:
###############################################
composition:=proc(g,h)
local L,ff;
if type(h,rational) then 
   L:=[seq(y[k]=h,k=0..d_order(g))];
else
   L:=[seq(y[k]=subs([seq(y[i]=y[k+i],i=0..d_order(h))],h),k=0..d_order(g))];
fi:
ff:=expand(subs(L,g));
end:


###############################################
#input f and integer k
#output: the partial derivation of f about y[k]
###############################################
partial:=proc(f,k)
local i,d,ff;
d:=degree(f,y[k]);
ff:=0;
for i from 1 to d do
    ff:=ff+coeff(f,y[k],i)*y[k]^(i-1)*i;
od;
return(ff);
end:


###############################################################
#input: d.p f, an integer k.
#output: the sum of the k-total homogeneous terms in f
###############################################################
ksum:=proc(f,k)
local H,i,T,p,mono;
H:=expand(f);
if type(H,`+`) then 
   T:=convert(H,set);
else
   T:={H};
fi;
p:=0;
for mono in T do
    if degree(mono)=k then p:=p+mono fi;
od; 
RETURN(p);
end:



###############################################################
#input: a homogeneous d.p f, an integer k.
#output: the sum of terms with the difference degree k in f
###############################################################
dsum:=proc(f,k)
local H,i,T,p,mono;
H:=expand(f);
if type(H,`+`) then 
   T:=convert(H,set);
else
   T:={H};
fi;
p:=0;
for mono in T do
    if dd_degree(mono)=k then p:=p+mono fi;
od; 
RETURN(p);
end:


#################################################################
#the set of m-th factors of a d.p or an integer f 
##################################################################
Factorlist:=proc(f,m,sigal)
local xx,yy,zz,ww,kk,list1,list2,list3,i,j,ss,S,T,n;
if sigal="int" then
   if f=1 then 
      RETURN({1}) 
   else 
      if f=0 then return("null") fi;
   fi;
   list1:=ifactors(f)[2];
else
   if type(f,rational) or type(f,float) then RETURN({1}) fi;
   list1:=factors(primpart(f))[2];
fi;
n:=nops(list1);
list2:={};
list3:={};
for xx in list1 do list2:=list2 union {xx[1]} od;
    for i from 1 to n do
           kk:=list1[i][2];
           kk:=(kk-(kk mod m))/m;
           ss[i]:={seq(k,k=0..kk)};
    od;
    S:=ss[1];
    for i from 2 to n do
        T:={};
        for xx in S do
               for yy in ss[i] do
                   T:=T union {[xx,yy]};
               od;
        od;
        S:=T;
    od;
    for xx in S do
        for i from n to 2 by -1 do
               zz[i]:=xx[2];
               xx:=xx[1];
        od;
        zz[1]:=xx;
        ww:=1;
        for i from i to n do
               ww:=ww*list1[i][1]^zz[i];
        od;
        list3:=list3 union {ww}; 
    od;
end:

####################################################
#the set {[dh,oh,h_{dh}]}
####################################################
fset:=proc(f)
local T,T1,T2,S,ordf,ddegf,i,k,z1,z2,z3,min,cf,og,dg,sig;
ordf:=d_order(f);
ddegf:=d_degree(f);
T1:={seq(i,i=0..ordf)};
T2:={ddegf};
for i from 1 to floor(ddegf/2+1) do
    if modp(ddegf,i)=0 then
       T2:=T2 union {i};
    fi:
od:
T:={};
for z1 in T1 do
    for z2 in T2 do
        T:=T union {[z2,z1,1]};
        og:=ordf-z1;dg:=ddegf/z2;    
        S:=Factorlist(coeff(f,y[ordf],ddegf),dg,"pol");
        S:=S minus {1};
        for z3 in S do
            sig:=1;
            for i from 1 to dg-1 do
               cf:=coeff(f,y[ordf],ddegf-i);
               cf:=simplify(cf/z3^(dg-i));
               if not type(denom(cf),rational) then
                  sig:=0;break;
               fi:
            od:
            min:=minvariable(z3);
            if sig=1 and min>=og then
               z3:=subs([seq(y[k]=y[k-og],k=min..d_order(z3))],z3);
               T:=T union {[z2,z1,z3]};
            fi:
        od:
    od:
od:
return(T);
end:


####################################################
#compute the left decomposition factor
#input f, h
#output the left factor g such that f=g@h
####################################################
leftfactor:=proc(f,h)
local o_g,degree_g,t,tt,g_1,i_g;
if type(f, rational) then RETURN(f) fi;    
o_g:=d_order(f)-d_order(h);
if o_g<0 then RETURN("null") fi;
if not type(degree(f)/degree(h),integer) then return("null") fi;
degree_g:=d_degree(f)/d_degree(h);
if not type(degree_g,integer) then return("null") fi;
t:=d_initial(f)/composition(y[o_g],d_initial(h))^degree_g;
t:=simplify(t);
if (not type(denom(t),rational)) then RETURN("null") fi;
i_g:=leftfactor(t,h);
if i_g="null" then RETURN("null") fi;
tt:=simplify(f-t*(composition(y[o_g],h)^degree_g));
g_1:=leftfactor(tt,h);   
if g_1="null" then RETURN("null") fi;
i_g*y[o_g]^degree_g+g_1;
end:


#########################################################
#compute the right decomposition factor when g is linear
#input f, g
#output the right factor h such that f=g@h
#########################################################
rightfactor:=proc(f,g)
local og,of,degf,hd,min,barf,aaa;
if f=0 then return 0;fi:
og:=d_order(g);
of:=d_order(f);
if og>of then return("null");fi:
degf:=d_degree(f);
hd:=coeff(f,y[of],degf)/coeff(g,y[og],1);
min:=minvariable(hd);
if not type(hd,rational) then
   if min<og then return("null");fi:
fi:
hd:=subs([seq(y[i]=y[i-og],i=min..d_order(hd))],hd);
barf:=simplify(f-composition(g,hd*y[of-og]^degf));
aaa:=rightfactor(barf,g);
if aaa="null" then return("null");
else
   return(aaa+hd*y[of-og]^degf);
fi:
end:

##################################################################
#input: a homogeneous difference polynomial f;
#output: a set S which contains all the (g,h) such that f=g\circ h
#and g is linear
##################################################################
linearlfactor:=proc(f,n)
local ff,tdegf,ddegf,b,t,H,T,xx,k,mono,cc,G,i,z,TTT,g,h,j; 
if n=0 then return({[y[0],f]});fi:
tdegf:=degree(f);
ddegf:=dd_degree(f);
if tdegf>ddegf then return("null");fi:
b:=modp(ddegf,tdegf);t:=(ddegf-b)/tdegf;
for k from 0 to b do
    ff[k]:=0;
od:
H:=expand(f);
if type(H,`+`) then 
   T:=convert(H,set);
else
   T:={H};
fi;
for k from 0 to b do
    for i from 0 to t do
        xx[i]:=0;
    od:
    for mono in T do
        cc:=dd_degree(mono);
        if modp(cc,tdegf)=b-k
        then 
        cc:=(cc-b+k)/tdegf;
        xx[cc]:=lcoeff(mono)+xx[cc];
        fi;
    od; 
    for i from 0 to t do
        ff[k]:=ff[k]+xx[i]*y^i;
    od:
od:
G:=ff[0];
for k from 1 to b do
    G:=gcd(G,ff[k]);
od:
if G={1} then return "null";fi:
T:=Factorlist(G,1,"pol");
TTT:={};
for z in T do
    if degree(z,y)=n then
       g:=0;
       for j from 0 to n do
           g:=g+coeff(z,y,j)*y[j];
       od:
       h:=rightfactor(f,g);
       if not type(h,string) then
          TTT:=TTT union {[g,h]};
       fi:
    fi:
od:          
RETURN(TTT);
end:


##################################################################
#algorithm 4.3  
#input: total degree homogeneous difference polynomials #f,g,h;
#output: p in algorithm 4.3 or "null" if p doesn't exist.
##################################################################
alg_lemma:=proc(f,g,h)
local p,G,i,j,l,ff,gandh1,gandh2,sig,alpha,min,max,p1,p2,ltermg,ltermh,ltermf,dorderg,dorderh,ltermff,dorderp2,gg;
if f=0 then return(0);fi:
ltermg:=lterm(g);
ltermh:=lterm(h);
dorderh:=d_order(ltermh);
dorderg:=d_order(ltermg);
ltermf:=lterm(f);
sig:=0;
alpha:=0;
p:=0;
ff:=f;
for i from 0 to dorderg do
    G[i]:=partial(g,i);
od:
min:=minvariable(ltermg);
max:=dorderg;
gandh1:=composition(partial(ltermg,min),ltermh);
p1:=simplify(ltermf/gandh1);
if type(denom(p1),rational) and minvariable(p1)>=min 
then 
   p1:=subs([seq(y[i]=y[i-min],i=minvariable(p1)..d_order(p1))],p1);
   for l from 1 while l<>0 do
       p:=p+p1;
       for j from 0 to dorderg do
          ff:=ff-composition(G[j],h)*composition(y[j],p1);
       od:
       ff:=simplify(ff);
       if ff=0 then return p;fi:
       ltermff:=lterm(ff);
       p1:=simplify(ltermff/gandh1);
       if (not type(denom(p1),rational)) or minvariable(p1)<min then break;fi:
       p1:=subs([seq(y[i]=y[i-min],i=minvariable(p1)..d_order(p1))],p1);
   od:
fi:
ff:=f;
gandh2:=composition(partial(ltermg,max),ltermh);
p2:=simplify(ltermf/gandh2);
if not type(denom(p2),rational) or minvariable(p2)<max then return("null");fi:
p2:=subs([seq(y[i]=y[i-max],i=minvariable(p2)..d_order(p2))],p2);
for j from 0 to dorderg do
    ff:=ff-composition(G[j],h)*composition(y[j],p2);
od:
ff:=simplify(ff);
gg:=alg_lemma(ff,g,h);
if not type(gg,string) then
   return(p2+alg_lemma(ff,g,h));
else
   return("null");
fi:
end:

##################################################################
#the homogeneous decomposition
#input: a homogeneous difference polynomial f;
#output: "null" or homogeneous g and h such that g@h=f
##################################################################
homodec:=proc(f)
local  barf,barf1,dbarf,obarf,T,S,S1,z,dh,oh,hdh,og,dg,i,j,k,Hi,z1,coef,sig,g,h,H,Aa,F;
S:=fset(f);
T:={};
for z in S do
    dh:=z[1];oh:=z[2];hdh:=z[3];
    sig:=0;
    barf:=f;
    for j from 1 while j<>-1 do
        dbarf:=d_degree(barf); 
        obarf:=d_order(barf);
        dg:=dbarf/dh;og:=obarf-oh;
        if not type(dg,integer) or og<0 then 
           sig:=1;break;#########
        fi:
        for i from 1 to dg-1 do
            coef:=coeff(barf,y[obarf],dbarf-i);
            if (not type(denom(simplify(coef/composition(y[og],hdh)^(dg-i))),rational)) then 
               sig:=1;break;##########
            fi:
        od:
        if sig=1 then break;fi:
        coef:=coeff(barf,y[obarf],dbarf);
        barf1:=simplify(coef/composition(y[og],hdh)^dg);
        if type(barf1,rational) then break;fi:
        if not type(denom(barf1),rational)
        then sig:=1;break;
        else barf:=barf1;
        fi:
    od:
    if sig=1 then next;fi:
    if dg=1 then 
       S1:=linearlfactor(barf,og);
       if type(S1,string) then next;fi:
       for z1 in S1 do
           h:=z1[2];
           if type(simplify(h/y[0]),rational) then next;fi:
           g:=leftfactor(f,h);
           if not type(g,string) then
              if type(simplify(g/y[0]),rational) then next;fi:
              T:=T union {[g,h]};
           fi:
       od:
       next;
    fi:
    barf:=barf/barf1;
    H[dh]:=hdh;
    Hi:=hdh*y[oh]^dh;
    for i from dh-1 to 1 by -1 do 
        F:=coeff(barf,y[obarf],dbarf-dh+i);
        if not type(F,rational) then
           if minvariable(F)<og then break;sig:=1;fi:#################
           F:=subs([seq(y[k]=y[k-og],k=minvariable(F)..d_order(F))],F);
        fi:
        H[i]:=simplify((F-coeff((Hi)^dg,y[oh],dbarf-dh+i))/(dg*hdh^(dg-1)));
        Hi:=Hi+H[i]*y[oh]^i;
    od:
    if sig=1 then next;fi:    
    F:=coeff(barf,y[obarf],dbarf-dh);
    Aa:=coeff(Hi^dg,y[oh],dbarf-dh);
    Aa:=simplify((F-composition(y[og],Aa))/composition(y[og],hdh^(dg-1)));
    if (not type(denom(Aa),rational)) then next; fi:
    Aa:=Aa+dg*composition(y[og],Hi);
    S1:=linearlfactor(Aa,og);
    if type(S1,string) then next;fi:
    for z1 in S1 do
           h:=z1[2];
           if type(simplify(h/y[0]),rational) then next;fi:
           g:=leftfactor(f,h);
           if not type(g,string) then
              if type(simplify(g/y[0]),rational) then next;fi:
              T:=T union {[g,h]};
           fi:
    od:
od:
return(T);
end:    



##################################################################
#the main procedure.
#input: a difference polynomial f;
#output: no nontrivial decomposition&quot or [g,h] such that g@h=f
##################################################################
differencedec:=proc(f)
local ordf,dconst,ff,degreef,f_max,outputset,T,aint,a,b,g,h,G,H,i,sig,contents;
ordf:=d_order(f);
dconst:=d_const(f);
degreef:=degree(f);
ff:=expand(f-dconst);
f_max:=ksum(ff,degreef);
T:=homodec(f_max);
outputset:={};
for aint in T do
    sig:=0;
    G:=aint[1];
    a:=degree(G); b:=degreef/a;
    H[b]:=aint[2];
    if b=1 then g:=leftfactor(ff,H[1]);
       if not type(g,string) then 
          contents:=icontent(expand(H[1]));
          g:=composition(g,contents*y[0])+dconst;
          outputset:=outputset union {[expand(g),expand(H[1]/contents)]};
       fi:
       next;
    fi:
    H[b-1]:=alg_lemma(ksum(ff,degreef-1),G,H[b]);
    if type(H[b-1],string) then next;fi:
    if b=2 then
       h:=H[1]+H[2];
       g:=leftfactor(ff,h);
       if not type(g,string) then 
          contents:=icontent(expand(h));
          g:=composition(g,contents*y[0])+dconst;
          outputset:=outputset union {[expand(g),expand(h/contents)]};
       fi:
       next;
    fi;
    h:=H[b]+H[b-1];
    for i from 2 to b-1 do
        H[b-i]:=alg_lemma(ksum(ff,degreef-i)-ksum(composition(G,h),degreef-i),G,H[b]);
        if H[b-i]="null" then sig:=1;break;
        else h:=h+H[b-i];
        fi;   
    od;
    if sig=1 then next;fi:
    g:=leftfactor(ff,h);
    if not type(g,string) then 
       contents:=icontent(expand(h));
       g:=composition(g,contents*y[0])+dconst;
       outputset:=outputset union {[expand(g),expand(h/contents)]};
    fi:
od:
return(outputset);
end:


exam1:=proc(of,df)
local ordf,degf,T,i,a,f,nowtime,tt,tl,t1,l1;
ordf:=of:
degf:=df:
tt:=0:
tl:=0;
T:={seq(y[i],i=0..ordf)}:
for i from 1 to 10 do
    printf(`#####################################################################################################\n`);
    printf(`the %d st example:\n`,i);
    print(`the input f is:\n`);
    a:=rand(1..combinat[numbcomb](ordf+degf+1,ordf+1))():
    f:=randpoly(T, coeffs=rand(-10^2..10^2),terms=a,degree=degf):
    nowtime:=time();
    differencedec(f);
    t1:=time()-nowtime:
    l1:=nops(f):
    printf(`The spent time is [%g] seconds\n`,t1);    
    printf(`f has [%d] terms :\n`,l1);
    tt:= tt + t1:
    tl:= tl + nops(f);
od:
    printf(`The average time [%g]; avrage length [%g]\n`,tt/10,tl/10);    
    printf(`#####################################################################################################\n`);
end:

exam2:=proc(og,dg,oh,dh)
local ordg,degg,ordh,degh,T1,T2,i,a,b,g,h,f,nowtime;
ordg:=og:
degg:=dg:
ordh:=oh:
degh:=dh:
T1:={seq(y[i],i=0..ordg)}:
T2:={seq(y[i],i=0..ordh)}:
for i from 1 to 10 do
    printf(`###################################################################################################\n`);
    printf(`the %d st example:\n`,i);
    print(`the input [g,h] is:\n`);
    a:=rand(1..combinat[numbcomb](ordg+degg+1,ordg+1))():
    g:=randpoly(T1, coeffs=rand(-50..50),terms=a,degree=degg):
    b:=rand(1..combinat[numbcomb](ordh+degh,ordh))():
    h:=randpoly(T2, coeffs=rand(-50..50),terms=b,degree=degh):
    print([g,h]);
    f:=expand(composition(g,h)):
    printf(`the decomposition result is :\n`);
    nowtime:=time();
    print(differencedec(f));
    printf(`The spent time is [%g] seconds \n`,time()-nowtime);    
od:
printf(`###################################################################################################\n`);
end:

exam3:=proc()
local i,f,justnow,spenttime,chars;
read("d:/all-soft/dec-chafen//diffgandh.txt"):
printf(`###########################################################################################\n`);
for i from 1 to 20 by 2 do
      f:=expand(composition(P[i],P[i+1])):
      justnow:=time():
      chars:=differencedec(f):
      spenttime:=time()-justnow:
      if chars<>{}
      then 
          print(chars);
      else 
          printf(` f is indecomposable!\n`,i);
      fi;
      printf(`The time of decomposing  the composition of g[%d] and h[%d] is [%g] seconds.\n`,floor(i/2)+1,floor(i/2)+1,spenttime);
      printf(`###########################################################################################\n`);
      print(``);
od:
end:
