



#File to compute comprehensive Groebner basis for parametric poly system.
####################################################################################################################
#计算两个集合的乘法 
#输入： List1, List2 都是表格
#输出： List1 和 List2 中两两相乘的元素集合。
ListProduct:=proc(List1, List2)
local i,j, res;
  res:={};
  for i in List1 do
     for j in List2 do
        res:={op(res), i*j};
     od;
  od;
return res;
end proc:


#将一个向量组中的每一个向量都转化为多项式形式。
#输入： Bases:=[B1,B2,...,Bm], 长度是n的向量。 其中B1,...,Bm多项式多项式向量
#      PositionVector:=[e1,e2,...,en]， 一组基向量
# 输出： 多项式 [b11*e1+b12*e2+...+b1n*en, ...., bn1*e1+bn2*e2+...+bmn*en]，输出是一个多项式集合。
ModuleBasis2PolList:=proc(Bases, PositionVector)
map(ListTools[DotProduct], Bases, [op(PositionVector)])
end:


#将一组参数约束的GB的多项式部分转化为向量。
#输入：G 是参数GB 的多项式形式： G:={[{eqn1, diseqn1,GB1}],...,[{eqn_n, diseqn_n,GB1n}] } 
#     Position_set:=[e1,e2,...,en]
#输出：将输入中的GB1,...,GBn从多项式形式转化为向量形式。
#特别标注：输入中含有的位置的非一次的多项式形式，直接忽略掉。比如e1^2, e1*e2,这种位置多项式，直接扔掉。
PolList2ModuleBasis:=proc(G,Position_set)
local List, res;
res:={}; 
for List in G do 
    res:=res union {[List[1],List[2],Onedegree_polys(List[3], Position_set)]}; 
od; 
return res;
end:
  

#####This if a new version of CGS for modules#########
#####ModOrder: 模的序，这儿包括了位置的序和变量的序。
#####NewVar_set：这儿既包含了位置变量，也包含了多项式的变量。不包含参数。
### 2. ModuleCGS: compute CGS for modules by call the CGS algorithm for parametric polynomials ###
## Input: Equ_set --- a set of polynomials in parameters (equality constraints) ##
##        DisEqu_set --- a set of polynomials in parameters (inequality constraints) ##
##        Vectors_set ---  a set of vectors in a module on normal variables and parameters ##
##        Position_set---   a set of position variables  (or called the placeholder variables ) ##
##        NewVar_set ---  a set of normal variables and position variables  ##
##        Para_set --- a set of parameters  ##
##        ModOrder --- a module order w.r.t. normal variables and positions variables  ##
##        ParaOrder --- a monomial order w.r.t.parameters ## 
## Output: a finite set of 3-tuples (Ei, Ni, Gi) such that {(V(Ei)\V(Ni), Gi)} constitutes a minimal comprehensive Groebner system of "Vectors_set" on " V(Equ_set) \ V(DisEqu_set) " ## 






ModuleCGS:=proc(Equ_set, DisEqu_set, Vectors_set, Position_set, NewVar_set, Para_set, ModOrder, ParaOrder) 
local Poly_set,G,k,MCGS;

#将输入的模的生成元从向量形式转化为多项式形式，输出是多项式集合
Poly_set:=ModuleBasis2PolList(Vectors_set, Position_set);

## regard the position variables as normal variables, then convert vectors to polynomials in a set of variables and position variables (i.e., f:=a*x*e[1]+b*x*y*e[2], e[1],e[2] are the position variables)##

#将多项式集合添加所有的2次位置多项式ei*ej, i=1,...,n, j=1...,n. n 是Position_set的长度
Poly_set:={op(Poly_set), op(ListProduct(Position_set,Position_set))};

#计算出多项式形式的CGS
G:=CGS_main(Equ_set, DisEqu_set, Poly_set, NewVar_set, Para_set, ModOrder, ParaOrder);


#将输出的CGS中的多项式形式部分，转化为向量形式。其中参数约束部分不作任何改变，特别注意G中关于位置变量2次的多项式将被直接忽略。因为它们只做辅助用途。
MCGS:=PolList2ModuleBasis(G,Position_set);

return MCGS;
end proc:


####在计算出来的Groebner基中， 要挑出Dickson基， 首先要排除只含参数的以及位置变元的多项式集合。排除p1*e1+p2*e2, 其中,p1,p2只含有参数U.
#####################还要排除那些不含e1这个位置变元的多项式。 即要排除 p(X,U)*e2 这种类型的多项式。 这种类型的多项式只是赋值作用。
#输入 G是一组多项式集合, Position_set=[e1] / 或 [e1,...,en]
# 输出：G中不含有位置变元e1/ [e1,...,en] 的多项式集合。 
FindAuxVector:=proc(G,Position_set)  
 local res,p; 
 res:={};

 for p in G do
     if degree(p,Position_set)=0 then
        res:=res union {p};
    fi;  
 od; 
  return res;
 end proc:

## Part 1: CGB algorithm for parametric polynomials (1-8) ##

#### 1. CGB_main: compute the comprehensive Groebner Bases of  an ideal genrated by parametric polynomials ###
## Input: Equ_set --- a set of polynomials in parameters (equality constraints) ##
##            DisEqu_set --- a set of polynomials in parameters (inequality constraints) ##
##            poly_set ---  a set of  polynomials  in variables and parameters ##
##            Var_set ---  a set of  variables   ##
##            Para_set --- a set of parameters  ##
##            ModuleOrder --- a monomial order w.r.t.  variables  + position variables e1,e2 ##
##            ParaOrder --- a monomial order w.r.t.  parameters ## 
##             Position_set=[e1,e2]

##Output: comprehensive Groebner Bases of  an ideal

CGB_main:=proc(Equ_set,DisEqu_set,poly_set,Position_set, Var_set, Para_set,ModuleOrder,ParaOrder)
 local Order1,Order2,Ord,E,N,F,X,U,G0, G,Gr,GrxN,CGS,NewG,Gm,h,Lc,NewDisEqu_set,H,i, GrVectors, AuxPositionSet,AVectors;
 
 Order1:=ModuleOrder;
 Order2:=ParaOrder;
 Ord:=prod(Order1,Order2);
 ######## AuxPositionSet:=[e1];
 AuxPositionSet:=[Position_set[1]];
 E:=Polysqr(Equ_set);
 N:=Polysqr(DisEqu_set);
 F:=poly_set;
 X:=Var_set;
 U:=Para_set; 
 if (not consistent(E,N)) then return {} end if;
 CGS:={};

    G0:=Groebner[Basis](F, Ord); 
#   去掉GB中的常数因子
    G:=map(primpart,G0, [op(Position_set),op(Var_set),op(Para_set)]);

#GrVectors: the polys has the form p*e1+q*e2, where p, q is a nonzero poly with parameters only.
####the polynomials does NOT have varaible X.
   GrVectors:=PolyOnlyPara(G,X );
#AVectors:  the polys has the form p*e2, where p is a nonzero poly with parameters U and variables X.
########### i.e. polys have NOT position varible e1. 
   AVectors:=FindAuxVector(G,AuxPositionSet);

   Gr:=map(coeff, GrVectors, Position_set[1]) minus {0};
#   if N={1} then GrxN:=Polysqr(SetMulti(Gr,N)) else GrxN：=Gr end if;
   GrxN:=Polysqr(SetMulti(Gr,N));

   if (not consistent(E,GrxN)) then
          CGS:={};
   else
          if nops(Gr)=0 then
             CGS:={};
 　　　　  else
            CGS:={[E,GrxN,GrVectors]};
 #            CGS:={[E,GrxN,{1}]};
          fi;
   fi;
       
 #NewG: the polynomials with varaiables X, which must be appeared. 
   NewG:={op(G)} minus GrVectors minus AVectors;

   if nops(NewG)=0 then
     CGS:=CGS union {[Polysqr(Gr),N,{0}]};
     return CGS;
   fi;

           Gm:={op(MDBasis(NewG,Order1))};
           h:=MDBasisLc(Gm,Order1)[1];
           Lc:=MDBasisLc(Gm,Order1)[2];
           if consistent(Gr,SetMulti(N,{h})) then 
              CGS:=CGS union {[Polysqr(Gr),Polysqr(SetMulti(N,{h})),Gm]};
           fi;
           NewDisEqu_set:=N;
           H:=1;
           for i from 1 to nops(Lc) do
               CGS:=CGS union CGB_main(Gr union {Lc[i]}, NewDisEqu_set, {op(G)} union GeneratePositionPoly(Lc[i], Position_set), Position_set, Var_set, Para_set,ModuleOrder,ParaOrder);
               H:=H*Lc[i];
               NewDisEqu_set:=SetMulti(N,{H});
           od;
           return CGS;
 
 end proc:

#为CGB作准备，将一个参数约束，生成一个参数约束辅助多项式。
#输入：p 一个等式的参数约束多项式， Positon_set: 辅助向量。 
#输出：一个参数的辅助多项式集合。
####如果Position_set=[e1,e2], 那么输出{p*e1-p*e2}; 如果Position_set:=[e1,...,en, E1,...,En] 则输出{p*e1-p*E1, ..., p*en-p*En}
GeneratePositionPoly:=proc(p, Position_set)
local i, n,res;
res:={};
n:=nops(Position_set)/2;
if not type(n,integer)then print("The length of Position_set must be an even number") end if;
for i to n do
 res:={op(res),p*Position_set[i]-p*Position_set[i+n]};
 od;
res;
end proc:


##输入：p是一个多项式， Position_set=[e1,...,en,E1,...,En]这样的位置变量构成的表格。
###输出：将位置变量表的第一个变量与多项式p的乘积。
TimesUnitPoly:=proc(p, Position_set)
expand(p*Position_set[1]);
end proc:



###输入：带约束的参数多项式系统
###      poly_set: 参数多项式。Position_list=[e1,e2], 位置变量构成的向量。
###输出：参数Groebner基
###

IdealCGB_sub:=proc(Equ_set,DisEqu_set,poly_set, Var_set, Para_set, VarOrder,ParaOrder)
local Position_list, res,L,i,L1,L2,L3,e1,e2;
###map(TimesUnitPoly,poly_set, Position_list)：将一个参数多项式集合{p1,...,pm}，转换成带着位置向量的多项式集合{p1*e1,...,pm*e1}
####这样将一个位置优先的序e1>e2>>X的序，给上述的参数多项式集合来计算CGB.
Position_list:=[e1,e2];
 res:=CGB_main(Equ_set,DisEqu_set, map(TimesUnitPoly,poly_set, Position_list), Position_list,  Var_set, Para_set, prod(plex(op(Position_list)), VarOrder), ParaOrder); 


 ####下面为将所有位置变量赋值。

 ##将结果中的令e1=1,e2=1; 那么输出的结果就是和CGS完全一样。如果需要对比，就将L1前面的注释去掉；
# print(res);			###如果需要，请去掉注释。
# L1:= subs([e1=1,e2=0],res);   ##如果需要，请去掉注释。
## print(L1);			##如果需要，请去掉注释。
L2:= subs([e1=1,e2=1],res);
####这个结果是保留了约束，但是多项式部分一定在原多项式理想中，等于0的部分已经被恢复。
end proc:




#### 1. CGS_main: compute the comprehensive Groebner system of  an ideal genrated by parametric polynomials ###
## Input: Equ_set --- a set of polynomials in parameters (equality constraints) ##
##            DisEqu_set --- a set of polynomials in parameters (inequality constraints) ##
##            poly_set ---  a set of  polynomials  in variables and parameters ##
##            Var_set ---  a set of  variables   ##
##            Para_set --- a set of parameters  ##
##            VarOrder --- a monomial order w.r.t.  variables   ##
##            ParaOrder --- a monomial order w.r.t.  parameters ## 
## Output: the comprehensive Groebner basis for a parametric polynomial set (poly_st) 



IdealCGB:=proc(Equ_set,DisEqu_set,poly_set, Var_set, Para_set, VarOrder,ParaOrder)
local i,L2,L3;
L2:= IdealCGB_sub(Equ_set,DisEqu_set,poly_set, Var_set, Para_set, VarOrder,ParaOrder);

L3:={};
for i in L2 do
   L3:=L3 union i[3];
od:
   if nops(L3) <>0 then L3:=L3 minus {0} fi;
   L3:=[op(L3)];
end proc:






### 2. ModuleCGB: compute CGB for modules by call the CGB algorithm for parametric polynomials ###
## Input: Equ_set --- a set of polynomials in parameters (equality constraints) ##
##        DisEqu_set --- a set of polynomials in parameters (inequality constraints) ##
##        Vectors_set ---  a set of vectors in a module on normal variables and parameters ##
##        Position_set---   a LIST of position variables  (or called the placeholder variables ) ##
##        NewVar_set ---  a set of normal variables and position variables  ##
##        Para_set --- a set of parameters  ##
##        ModOrder --- a module order w.r.t. normal variables and positions variables  ##
##        ParaOrder --- a monomial order w.r.t.parameters ## 
## Output: a finite set of 3-tuples (Ei, Ni, Gi) such that  Gi constitutes a  comprehensive Groebner 
#          basis of  the module genereted by the "Vectors_set" on " V(Equ_set) \ V(DisEqu_set) " 
#	   and every vector in G_i  is in the module generated by the "Vectors_set"## 

ModuleCGB:=proc(Equ_set, DisEqu_set, Vectors_set, Position_set, NewVar_set, Para_set, ModOrder, ParaOrder) 
local n,m,Poly_set,i,j,G,k,MCGS;
n:=nops(Vectors_set); 
m:=nops(Position_set);
Poly_set:={seq(ListTools[DotProduct](Vectors_set[i], [op(1..m,Position_set)]),i=1..n)};
## regard the position variables as normal variables, then convert vectors to polynomials in a set of variables and position variables (i.e., f:=a*x*e[1]+b*x*y*e[2], e[1],e[2] are the position variables)##



Poly_set:=Poly_set union  ListProduct(Position_set, Position_set); 


G:=IdealCGB_sub(Equ_set, DisEqu_set, Poly_set, NewVar_set, Para_set, ModOrder, ParaOrder);
#print("the output of IdealCGB_sub");
#print(G);
MCGS:={}; 
for k to nops(G) do 
    MCGS:=MCGS union {[G[k][1],G[k][2],Onedegree_polys(G[k][3], Position_set)]}; 
od; 
return MCGS;
end proc:










