(* This is the Groebner Package for version 2.0 of Mathematica *) (* INSTALLATION To use this package, you should copy this file under a name, such as groebner.m, into the directory from which you start Mathematica. Every time you start a Mathematica session you will need to load this package. This can be done by giving the command << groebner.m at the Mathematica prompt. The first part of this file is the documentation that explains how to use the package. *) (* CONTENTS OF PACKAGE The major commands in the Groebner package are as follows: MonOrder: sets the monomial order. PRemainder: computes the remainder in the division algorithm. PQuotient: computes the quotients in the division algorithm. Buchberger: a naive version of the Buchberger algorithm. BuchbergerSteps: prints out intermediate steps in Buchberger. QuickBuchberger: a more efficient Buchberger algorithm. QuickBuchbergerSteps: gives intermediate steps in QuickBuchberger. The package also includes commands to do the following: SPoly: computes S-polynomials. ReduceGroebner: reduces Groebner basis to a reduced one. GroebnerQ: tests to see if you have a Groebner basis. IdealQ: solves the ideal membership problem. RadicalQ: solves the radical membership problem. FiniteQ: determines if there are finitely many solutions. VSDimension: determines the dimension of a quotient ring. *) (* DESCRIPTIONS OF THE COMMANDS The descriptions of MonOrder and PRemainder should be read carefully. For each of the commands described below, on-line documentation is available through the usual Mathematica help facility. MonOrder: This command is used to set the monomial order used in all other commands in the package. The allowable monomial orders are denoted Lex (lexicographic), Grlex (graded lexicographic) and Grevlex (graded reverse lexicographic). Note the use of capital letters in the names of these orders. Thus, to change the monomial order to Grlex, you would issue the command MonOrder[Grlex] Furthemore, the command MonOrder[] will return the current monomial order. This is useful if you've forgotten what the order is. The default monomial order is Lex. PRemainder: The format for this command is PRemainder[f,{f1,...,fs},(varlist)] where f is the polynomial to be divided and {f1,...,fs} is the list of polynomials to divide by. The output will be the remainder of f on division by f1,...fs. The "varlist" is a list of variables. You should be aware of the following three important aspects of "varlist": 1) The order of the variables is important since it (together with what you specified in MonOrder) determines the monomial order. 2) Note that "varlist" need not include all of the variables in f1,...,fs. Any variables in the polynomials but not in "varlist" are assumed to lie in the coefficient field. Thus you can do the division algorithm over a rational function field. 3) The parentheses around "varlist" indicates that this is an optional argument. If omitted, the algorithm will use all of the variables appearing in {f1,...,fs}, ordered according to the default order in Mathematica. These three comments apply to ALL commands in the package. PQuotient: The format is PQuotient[f,{f1,...,fs},(varlist)] where f is the polynomial to be divided and {f1,...,fs} is the list of polynomials to divide by. The output will be a list of quotients {a1,...,as} of f on division by f1,...fs. The "varlist" is a list of variables that determines the order of the variables in the current monomial order, subject to the above comments. Buchberger: The format is Buchberger[{f1,...,fs},(varlist)] where {f1,...,fs} is a list of polynomials and, if specified, "varlist" determines the order of the variables used in the current monomial order. The output of this command is a Groebner basis for the ideal , and it also prints out the number of times that PRemainder is performed. The algorithm employed is a naive version of the Buchberger algorithm, with the one efficiency that no S-polynomial that has already been checked is checked again. The output need not be a reduced Groebner basis. BuchbergerSteps: The format is BuchbergerSteps[{f1,...,fs},(varlist)] This is a modification of the Buchberger command which prints out the list of polynomials added to the Groebner basis and the number of executions of PRemainder at each step of its execution. QuickBuchberger: The format is QuickBuchberger[{f1,...,fs},(varlist)] This command uses a more efficient version of the Buckberger algorithm to compute a Groebner basis for the ideal . The output need not be a reduced Groebner basis. If specified, "varlist" determines the order of the variables used in the current monomial order. QuickBuchbergerSteps: The format is QuickBuchbergerSteps[{f1,...,fs},(varlist)] This command performs the same algorithm as QuickBuchberger. It also prints out the total number of times that PRemainder is performed, but doesn't give information about each step of the algorithm. SPoly: The format is SPoly[poly1,poly2,(varlist)] This command returns the S-polynomial of poly1 and poly2. If specified, "varlist" determines the order of the variables used in the current monomial order. ReduceGroebner: The format is ReduceGroebner[{f1,...,fs},(varlist)] This command takes a Groebner basis {f1,...,fs} and produces a reduced Groebner basis for the same ideal. Be sure not to change the monomial order or "varlist" from when you produced the Groebner basis. GroebnerQ: The format is GroebnerQ[{f1,...,fs},(varlist)] This command returns either True or False, depending on whether {f1,...,fs} forms a Groebner basis under the current monomial ordering. If specified, "varlist" determines the order of the variables used in the current monomial order. IdealQ: The format is IdealQ[f,{f1,...,fs},(varlist)] This is an implementation of the Ideal Membership Algorithm. The command returns either True or False, depending on whether the polynomial f is in the ideal . If specified, "varlist" determines the order of the variables used in the current monomial order. RadicalQ: The format is RadicalQ[f,{f1,...,fs},(varlist)] This is an implementation of the Radical Membership Algorithm. The command returns either True or False, depending on whether the polynomial f is in the radical of the ideal . If specified, "varlist" determines the order of the variables used in the current monomial order. FiniteQ: The format is FiniteQ[{f1,...,fs},(varlist)] This is an implementation of the Finiteness Algorithm. The command returns True or False, depending on whether the set of equations specified by f1=...=fs=0 has a finite number of solutions over an algebraically closed field. If specified, "varlist" determines which variables are to be solved for (i.e., which variables are not in the coefficient field). VSDimension: The format is VSDimension[{f1,...,fs},(varlist)] This command returns the dimension (as a vector space) of the polynomial ring modulo the ideal . The output is "Infinite" if the quotient is infinite dimensional. If specified, "varlist" determines which variables are in the ring (this variables not in varlist are in the coefficient field). Note that there is also on-line documentation for each of these commands. For example, to find out about the "Buchberger" command, type ?Buchberger at the Mathematica prompt. END OF DOCUMENTATION *) BeginPackage["Buchberger`"] MonOrder::usage = "MonOrder[] returns the current monomial ordering; MonOrder[order] changes the current monomial ordering to order. The valid arguments for MonOrder are Lex, Grlex (graded lex), and Grevlex (graded reverse lex)." Lex::usage = "Lex is an argument of MonOrder which changes the monomial ordering to lex order." LexLT::usage = "LexLT[poly,(varlist)] returns the leading term in lex order of the polynomial poly. If specified, varlist determines the ordering of the variables." Grlex::usage = "Grlex is an argument of MonOrder which changes the monomial ordering to graded lex order." GrlexLT::usage = "GrlexLT[poly,(varlist)] returns the leading term in grlex order of the polynomial poly. If specified, varlist determines the ordering of the variables." Grevlex::usage = "Grevlex is an argument of MonOrder which changes the monomial ordering to graded reverse lex order." GrevlexLT::usage = "GrevlexLT[poly,(varlist)] returns the leading term in grevlex order of the polynomial poly. If specified, varlist determines the ordering of the variables." PQuotient::usage = "PQuotient[f,{f1,...,fs},(varlist)] returns the list of quotient polynomials of f divided by {f1,...,fs}, i.e. {a1,...,as} where a1*f1 +...+ as*fs + r = f. If specified, varlist determines the order of variables used in the current monomial ordering." PRemainder::usage = "PRemainder[f,{f1,...,fs},(varlist)] returns the remainder of f divided by {f1,...,fs}. If specified, varlist determines the order of the variables used in the current monomial ordering." SPoly::usage = "SPoly[poly1,poly2,(varlist)] returns the S-polynomial of poly1 and poly2. If specified, varlist determines the order of the variables used in the current monomial ordering." Buchberger::usage = "Buchberger[{f1,...,fs},(varlist)] returns a Groebner basis for the ideal and prints out the number of times that PRemainder is performed. The algorithm is made as efficient as it can be without major structural changes by assuring that no S-polynomial that has already been checked is checked again. If specified, varlist determines the order of the variables used in the current monomial ordering." BuchbergerSteps::usage = "BuchbergerSteps[{f1,...,fs},(varlist)] is a modification of Buchberger which prints out the list of polynomials added to the Groebner basis and the number of executions of PRemainder at each step of its execution." QuickBuchberger::usage = "QuickBuchberger[{f1,...,fs},(varlist)] uses a highly modified, more efficient version of the Buckberger algorithm to compute a Groebner basis for the ideal . If specified, varlist determined the order of the variables used in the current monomial ordering." QuickBuchbergerSteps::usage = "QuickBuchbergerSteps[{f1,...,fs},(varlist)] performs the same algorithm as QuickBuchberger, printing out the number of times that PRemainder is performed." GroebnerQ::usage = "GroebnerQ[{f1,...,fs},(varlist)] determines whether {f1,...,fs} forms a Groebner basis under the current monomial ordering. If specified, varlist determines the order of the variables used in the current monomial ordering." ReduceGroebner::usage = "ReduceGroebner[basis,(varlist)] takes a Groebner basis and produces a reduced Groebner basis for the same ideal. If specified, varlist determines the order of the variables used in the current monomial ordering." IdealQ::usage = "IdealQ[f,{f1,...,fs},(varlist)] determines whether the polynomial f is in the ideal . If specified, varlist determines the order of the variables used in the current monomial ordering." RadicalQ::usage = "RadicalQ[f,{f1,...,fs},(varlist)] determines whether the polynomial f is in the radical of the ideal . If specified, varlist determines the order of the variables used in the current monomial ordering." FiniteQ::usage = "FiniteQ[{f1,...,fs},(varlist)] determines whether the set of equations specified by f1=...=fs=0 has a finite number of solutions. If specified, varlist determines which variables are to be solved for (i.e., which variables are not in the coefficient field)." VSDimension::usage = "VSDimension[{f1,...,fs},(varlist)] returns the dimension (as a vector space) of the polynomial ring modulo the ideal . If specified, varlist determines which variables are in the ring (this variables not in varlist are in the coefficient field)." Begin["`Private`"] OrderList = {Lex,LexLT} MonOrder[order_:Automatic]:= Block[{change=True}, If [order===Automatic,OrderList[[1]], If [order===Lex, OrderList[[1]] = Lex; OrderList[[2]] = LexLT, If [order===Grlex, OrderList[[1]] = Grlex; OrderList[[2]] = GrlexLT, If [order===Grevlex, OrderList[[1]] = Grevlex; OrderList[[2]] = GrevlexLT, change = False]]]; If [change, order, Print[order," is not a valid monomial order."]; OrderList[[1]] ] ] ] LexLT[polys_List,varlist_:Automatic]:= Map [LexLT[#,varlist]&,polys] LexLT[poly_,varlist_:Automatic]:= Block[{lc=poly,lm=1,vars,var,exp,loop,endloop}, If [poly===0,0, If [varlist===Automatic, vars = Variables[poly], vars = varlist]; endloop = Length[vars]; Do [var = vars[[loop]]; exp = Exponent[lc,var]; lm = lm * var^exp; lc = Collect[lc,var]; lc = Coefficient[lc,var,exp], {loop,1,endloop}]; lc * lm] ] GrlexLT[polys_List,varlist_:Automatic]:= Map [GrlexLT[#,varlist]&,polys] GrlexLT[poly_,varlist_:Automatic]:= Block[{vars,var,lexpoly=poly,loop,endloop,extract}, If [poly===0,0, If [varlist===Automatic, vars = Variables[poly], vars = varlist]; endloop = Length[vars]; Do [var = vars[[loop]]; lexpoly = lexpoly /. var->extract*var, {loop,1,endloop}]; lexpoly = Collect[lexpoly,extract]; lexpoly = Coefficient[ lexpoly,extract,Exponent[ lexpoly,extract]]; LexLT[lexpoly,vars] ] ] GrevlexLT[polys_List,varlist_:Automatic]:= Map [GrevlexLT[#,varlist]&,polys] GrevlexLT[poly_,varlist_:Automatic]:= Block[{vars,var,lt=poly,loop,endloop,exp,least,extract}, If [poly===0,0, If [varlist===Automatic, vars = Variables[poly], vars = varlist]; endloop = Length[vars]; Do [var = vars[[loop]]; lt = lt /. var->extract*var, {loop,1,endloop}]; lt = Collect[lt,extract]; lt = Coefficient[lt,extract,Exponent[lt,extract]]; Do [var = vars[[endloop-loop+1]]; exp = -1; least = 0; lt = Collect[lt,var]; While [least===0, exp++; least = Coefficient[lt,var,exp] ]; lt = least * var^exp, {loop,1,endloop}]; lt] ] FreeCheck[expr_,vars_]:= Block[{}, Apply[ And,Map[FreeQ[expr,#]&,vars] ] ] PRemainder[poly_,polylist_,varlist_:Automatic]:= Block[{ltfunc,vars,varcheck,check,qpoly=poly,temp,rem=0, qlt,leadlist,loop,endloop=Length[polylist], divisionoccured,divterm}, ltfunc = OrderList[[2]]; varcheck = Variables[Append[polylist,poly]]; If [varlist===Automatic, vars = varcheck; check = NumberQ, vars = varlist; If [Apply[ And,Map[MemberQ[vars,#]&,varcheck] ], check = NumberQ, check = FreeCheck[#,vars]&] ]; leadlist = ltfunc[polylist,vars]; While [!(qpoly===0), qlt = ltfunc[qpoly,vars]; divisionoccured = False; loop = 1; While [(loop<=endloop) && !divisionoccured, divterm = qlt/leadlist[[loop]]; divisionoccured = (check[Denominator[divterm]]); If [divisionoccured, qpoly=Simplify[qpoly - divterm*polylist[[loop]]], loop++] ]; If [!divisionoccured, temp = Expand[rem + qlt]; rem = temp; qpoly = Simplify[qpoly - qlt] ] ]; rem ] PQuotient[poly_,polylist_,varlist_:Automatic]:= Block[{ltfunc,vars,varcheck,check,qpoly=poly,temp,rem=0, qlt,leadlist,loop,endloop=Length[polylist], divisionoccured,divterm}, ltfunc = OrderList[[2]]; varcheck = Variables[Append[polylist,poly]]; If [varlist===Automatic, vars = varcheck; check = NumberQ, vars = varlist; If [Apply[ And,Map[MemberQ[vars,#]&,varcheck] ], check = NumberQ, check = FreeCheck[#,vars]&] ]; quotlist = Table[0,{endloop}]; leadlist = ltfunc[polylist,vars]; While [!(qpoly===0), qlt = ltfunc[qpoly,vars]; divisionoccured = False; loop = 1; While [(loop<=endloop) && !divisionoccured, divterm = qlt/leadlist[[loop]]; divisionoccured = (check[Denominator[divterm]]); If [divisionoccured, quotlist[[loop]] = Simplify[quotlist[[loop]]+divterm]; qpoly=Simplify[qpoly - divterm*polylist[[loop]]], loop++] ]; If [!divisionoccured, qpoly = Simplify[qpoly - qlt] ] ]; quotlist ] MonoLCM [mono1_,mono2_,vars_]:= Block[{loop}, Product[ vars[[loop]]^Max[ Exponent[mono1,vars[[loop]]], Exponent[mono2,vars[[loop]]] ], {loop,1,Length[vars]} ] ] SPoly [poly1_,poly2_,varlist_:Automatic]:= Block[{ltfunc,vars,lt1,lt2,lcm}, ltfunc = OrderList[[2]]; If [varlist===Automatic, vars = Union[Variables[poly1],Variables[poly2]], vars = varlist]; lt1 = ltfunc[poly1,vars]; lt2 = ltfunc[poly2,vars]; lcm = MonoLCM[lt1,lt2,vars]; Simplify[(lcm/lt1)*poly1 - (lcm/lt2)*poly2] ] Buchberger [polylist_,varlist_:Automatic]:= Block[{basis=polylist,basisprime,vars,breakloop,divisions=0, length=Length[polylist],oldlength=1, spoly,spolyrem,loop1,loop2}, If [varlist===Automatic, vars = Variables[polylist], vars = varlist]; breakloop = False; While[!breakloop, basisprime = basis; Do [spoly=SPoly[basisprime[[loop1]], basisprime[[loop2]],vars]; spolyrem=PRemainder[spoly,basisprime,vars]; divisions++; If[!(spolyrem===0),AppendTo[basis,spolyrem]], {loop1,1,length}, {loop2,Max[loop1+1,oldlength+1],length}]; oldlength = length; length = Length[basis]; breakloop = (oldlength===length) ]; Print [" ",divisions," divisions total."]; basis ] BuchbergerSteps [polylist_,varlist_:Automatic]:= Block[{basis=polylist,basisprime,vars,breakloop, length=Length[polylist],oldlength=1,spoly,spolyrem, loop1,loop2,step=0,printtable,divloop,divisions=0}, If [varlist===Automatic, vars = Variables[polylist], vars = varlist]; breakloop = False; While[!breakloop, step++; divloop = 0; basisprime = basis; Do [spoly=SPoly[basisprime[[loop1]], basisprime[[loop2]],vars]; spolyrem=PRemainder[spoly,basisprime,vars]; divloop++; If[!(spolyrem===0),AppendTo[basis,spolyrem]], {loop1,1,length}, {loop2,Max[loop1+1,oldlength+1],length}]; oldlength = length; length = Length[basis]; printtable = Table[basis[[loop1]], {loop1,oldlength+1,length}]; If [printtable==={}, Print["Step ",step,": nothing added."], Print["Step ",step,": ",printtable," added."]]; If [divloop===1, Print[" 1 division performed."], Print[" ",divloop," divisions performed."]]; divisions = divisions + divloop; breakloop = (oldlength===length) ]; Print [""]; Print [" ",divisions," divisions total."]; basis ] QuickBuchberger[polylist_,varlist_:Automatic]:= Block[{ltfunc,vars,blist,basis=polylist, length=Length[polylist],indi,indj,indk, lti,ltj,ltk,lcm,criterion, spoly,spolyrem,loop}, ltfunc = OrderList[[2]]; If [varlist===Automatic, vars = Variables[polylist], vars = varlist]; blist = Apply[Union,Table[{indi,indj}, {indi,1,length},{indj,indi+1,length}]]; While [!(blist==={}), indi = blist[[1]][[1]]; indj = blist[[1]][[2]]; lti = ltfunc[basis[[indi]]]; ltj = ltfunc[basis[[indj]]]; lcm = MonoLCM[lti,ltj,vars]; If [!NumberQ[lcm/(lti*ltj)], criterion = False; Do [If[!MemberQ[blist,{indi,indk}] &&!MemberQ[blist,{indk,indi}] &&!MemberQ[blist,{indj,indk}] &&!MemberQ[blist,{indk,indj}], ltk = ltfunc[basis[[indk]]]; criterion = NumberQ[ Denominator[lcm/ltk]] ], {indk,1,length}]; If [!criterion, spoly=SPoly[basis[[indi]],basis[[indj]],vars]; spolyrem=PRemainder[spoly,basis,vars]; If [!(spolyrem===0), length++; AppendTo[basis,spolyrem]; Do [AppendTo[blist,{loop,length}], {loop,length-1}] ] ] ]; blist = Drop[blist,1]; ]; basis ] QuickBuchbergerSteps[polylist_,varlist_:Automatic]:= Block[{ltfunc,vars,blist,basis=polylist, length=Length[polylist],indi,indj,indk, lti,ltj,ltk,lcm,criterion, spoly,spolyrem,loop,divisions=0}, ltfunc = OrderList[[2]]; If [varlist===Automatic, vars = Variables[polylist], vars = varlist]; blist = Apply[Union,Table[{indi,indj}, {indi,1,length},{indj,indi+1,length}]]; While [!(blist==={}), indi = blist[[1]][[1]]; indj = blist[[1]][[2]]; lti = ltfunc[basis[[indi]]]; ltj = ltfunc[basis[[indj]]]; lcm = MonoLCM[lti,ltj,vars]; If [!NumberQ[lcm/(lti*ltj)], criterion = False; Do [If[!MemberQ[blist,{indi,indk}] &&!MemberQ[blist,{indk,indi}] &&!MemberQ[blist,{indj,indk}] &&!MemberQ[blist,{indk,indj}], ltk = ltfunc[basis[[indk]]]; criterion = NumberQ[ Denominator[lcm/ltk]] ], {indk,1,length}]; If [!criterion, spoly=SPoly[basis[[indi]],basis[[indj]],vars]; spolyrem=PRemainder[spoly,basis,vars]; divisions++; If [!(spolyrem===0), length++; AppendTo[basis,spolyrem]; Do [AppendTo[blist,{loop,length}], {loop,length-1}] ] ] ]; blist = Drop[blist,1]; ]; Print[" ",divisions," divisions total."]; basis ] GroebnerQ[polylist_,varlist_:Automatic]:= Block[{vars,length=Length[polylist],spoly,spolyrem, loop1,loop2,groeb=True}, If [varlist===Automatic, vars = Variables[polylist], vars = varlist]; Do [spoly = SPoly[polylist[[loop1]],polylist[[loop2]],vars]; spolyrem = PRemainder[spoly,polylist,vars]; If[!(spolyrem===0),groeb=False;Break[] ], {loop1,1,length},{loop2,loop1+1,length}]; groeb ] ReduceGroebner[basis_,varlist_:Automatic]:= Block [{ltfunc,vars,length=Length[basis],basisprime=basis, divlist,loop=1,loop2,rem,lt,temp}, If [varlist===Automatic, vars = Variables[basis], vars = varlist]; While [(length>1)&&(loop<=length), divlist = Drop[basisprime,{loop,loop}]; rem = PRemainder[basisprime[[loop]],divlist,vars]; If [rem===0, basisprime = divlist; length--, basisprime[[loop]] = rem;loop++]; ]; ltfunc = OrderList[[2]]; Do [lt = ltfunc[basisprime[[loop2]],vars]; basisprime[[loop2]] = Simplify[basisprime[[loop2]]* (MonoLCM[lt,1,vars]/lt)], {loop2,1,length}]; basisprime ] IdealQ[poly_,polylist_,varlist_:Automatic]:= Block [{order,vars,rem,basis}, If [varlist===Automatic, vars = Variables[Append[polylist,poly]], vars = varlist]; order = OrderList[[1]]; MonOrder[Grevlex]; rem = PRemainder[poly,polylist,vars]; If [!(rem===0), basis = QuickBuchberger[polylist,vars]; rem = PRemainder[poly,basis,vars] ]; MonOrder[order]; rem===0 ] RadicalQ[poly_,polylist_,varlist_:Automatic]:= Block [{order,vars,extra,listprime,basis}, If [varlist===Automatic, vars = Variables[Append[polylist,poly]], vars = varlist]; order = OrderList[[1]]; MonOrder[Grevlex]; listprime = Append[polylist,1 - extra*poly]; basis = QuickBuchberger[listprime,Append[vars,extra]]; MonOrder[order]; Apply[Or,Map[FreeCheck[#,vars]&,basis]] ] FiniteQ[polylist_,varlist_:Automatic]:= Block [{order,ltfunc,vars,basis,ltbasis, finite,loop,endloop,varprime}, If [varlist===Automatic, vars = Variables[polylist], vars = varlist]; endloop = Length[vars]; order = OrderList[[1]]; MonOrder[Grevlex]; ltfunc = OrderList[[2]]; basis = QuickBuchberger[polylist,vars]; ltbasis = ltfunc[basis]; finite = True; Do [varprime = Drop[vars,{loop,loop}]; finite = finite && Apply[Or,Map[FreeCheck[#,varprime]&,ltbasis]], {loop,1,endloop}]; MonOrder[order]; finite ] VSDimension[polylist_,varlist_:Automatic]:= Block [{order,ltfunc,vars,basis,ltbasis, boundlist,freelist,poslist,monlist, monlength,length1,length2, loop,loop2,endloop,var,varprime,dim=0}, If [varlist===Automatic, vars = Variables[polylist], vars = varlist]; endloop = Length[vars]; order = OrderList[[1]]; MonOrder[Grevlex]; ltfunc = OrderList[[2]]; basis = QuickBuchberger[polylist,vars]; ltbasis = ltfunc[basis]; boundlist = Table[Infinity,{endloop}]; Do [var = vars[[loop]]; varprime = Drop[vars,{loop,loop}]; freelist = Map[FreeCheck[#,varprime]&,ltbasis]; poslist = Flatten[Position[freelist,True]]; If [!(poslist==={}), boundlist[[loop]] = Exponent[ltbasis[[poslist[[1]]]],var] ], {loop,1,endloop}]; MonOrder[order]; If [Apply[Or,Map[(#===Infinity)&,boundlist]], Infinity, monlength = Apply[Times,boundlist]; monlist = Table[1,{monlength}]; Do [var = vars[[loop]]; length1 = Apply[Times,Drop[boundlist,loop]]; length2 = monlength/length1; Do [monlist[[(loop2-1)*length1+loop1]] = monlist[[(loop2-1)*length1+loop1]] * var^Mod[loop2-1,boundlist[[loop]]], {loop1,1,length1},{loop2,1,length2}], {loop,1,endloop}]; Do [If [! Apply[ Or,Map[NumberQ[Denominator [monlist[[loop]]/#]]&,ltbasis]], dim = dim+1], {loop,1,monlength}]; dim] ] End[] Protect [OrderList,MonOrder,Lex,LexLT,Grlex,GrlexLT, Grevlex,GrevlexLT,PQuotient,PRemainder,SPoly, Buchberger,BuchbergerSteps,QuickBuchberger, QuickBuchbergerSteps,GroebnerQ,ReduceGroebner, IdealQ,RadicalQ,FiniteQ,VSDimension] EndPackage[]