2
$\begingroup$

I'm working with square polynomial systems and wish to know if a (small) system has a finite number of solutions. That is, if it's zero-dimensional. I'm not aware of any built-in function to do this so attempted to write my own but not that familiar with the concept and was wondering if others might have any comments about my routine below? Some background for the reader:

One way to compute the dimension is to compute a Groebner basis and then check if some element of the basis has a leading monomial (monomial with highest precedence described below) that is a pure power of each variable, i.e., a leading monomial with only one variable. My understanding is one first settles on a monomial ordering. Two of which is lexicographic or graded lexicographic. In lexicographic, the ordering of the variables defined by say $f(x,y,z)$ take precedence: $x$ has a higher precedence than say $y^2$. In the case of say $x^2 y$ and $x^2 y^2$, the ordering is in terms of overall degree so $x^2 y^2>x^2y$ and so forth.

The build-in function CoefficientRules will lexigraphically order the monomial exponent vectors from highest precedence to lowest. So that a Groebner basis is computed and then the list of exponent vectors is computed. The leading terms of each vector set is then checked for a pure power of each variable. In the case of 3 variables, this would be checking for the set $\text{{{0,0,_},{0,_,0},{_,0,0}}}$. If this set is found, the sysem is zero-dimensional.

Here is a 3-variable example using a known zero-dimensional system:

f[{x_, y_, z_}] = {x^2 - 2 x z + 5, x y^2 + y z^3, 3 y^2 - 8 z^3};

isZeroDimensional[f_] := Module[{gBasis, cRules, leadingC, p1, p2, 
   p3},
   
   gBasis = GroebnerBasis[f[{x, y, z}], {x, y, z}];
   (*
    get coefficient rules.  
    This will order the exponent vectors lexicographically from 
    highest precedence to lowest
   *)
   cRules = (CoefficientRules[#, {x, y, z}] & /@ gBasis);
   (*
    get the highest precedent monomial of each basis element
   *)
   leadingC = cRules[[All, 1]][[All, 1]];
   (*
   now check the list of leading monomials for the set {{0,0,_}, 
   {0,_,0},{_,0,0}}.  This represents a set of pure powers of x,y,z
   *)
   If[MemberQ[leadingC, {0, 0, _}] && MemberQ[leadingC, {0, _, 0}] 
     && MemberQ[leadingC, {_, 0, 0}],
    True
    ,
    False
    ]
   ];  

isZeroDimensional[f]

Out[150]= True
$\endgroup$
4
  • 2
    $\begingroup$ There is some (old) code to compute the Krull dimension at the end of this manuscript. Probably substantially the same as the code in this 1999 MathGroup thread $\endgroup$ Mar 31 at 23:47
  • $\begingroup$ Thanks for that Daniel. There are some version issues with the code but it led me to a thread about ideal dimension here: mathematica.stackexchange.com/questions/37015/… which also has a minor version error with MonomialList. I'll post the updated (ver. 12) code here for idealDimension in a few days unless someone does so first. $\endgroup$
    – Dominic
    Apr 1 at 12:07
  • $\begingroup$ Your ability to locate old posts apparently exceeds mine; I did not stumble over that MSE version (nor did I remember it). Please do post an updated version. I'll be sure to upvote it. As for MonomialList, that predated the System context function of the same name. The current approximate equivalent would be GroebnerBasis`DistributedTermsList (maybe you knew that). Or you can use the new MonomialList as someone else kindly updated the code to do. (It's unfortunate this Krull dimension code is something of a moving target. Another reason I'd be happy to upvote an update to version 12.) $\endgroup$ Apr 1 at 14:25
  • $\begingroup$ Thanks. I prefer giving others opportunity to answer the post for the check, but if no one does in a few days I'll post my code. $\endgroup$
    – Dominic
    Apr 1 at 14:30
1
$\begingroup$

I wish to follow up with this post: The reference above: idealDimension

written by Daniel does answer this question in terms of Ideal Dimension and I tested it in ver. 12.0.0. All credit goes to him. I'll re-post the code here to save the interested reader some time:

firstContainsSecond[l1_, l2_] := (Union[l1, l2] === l1);
isIndependentSet[set_, sets_] := 
  Map[! firstContainsSecond[set, #] &, sets];
getMaxIndependentSets[vars_, inset_, heds_, maxlen_, indx_, sets_] := 
  Module[{currentset, vlen = Length[vars], ilen = Length[inset], 
    enlarged = False, newmax = maxlen, maxsets = sets}, 
   Do[If[ilen + vlen - i + 1 <= maxlen, Break[]];
    currentset = Append[inset, vars[[i]]];
    If[And @@ 
      isIndependentSet[currentset, heds], {maxsets, enlarged, 
       newmax} = 
      getMaxIndependentSets[vars, currentset, heds, newmax, i + 1, 
       maxsets];
     If[! enlarged, maxsets = Append[maxsets, currentset];
      newmax = Max[newmax, Length[currentset]];
      enlarged = True;];], {i, indx, vlen}];
   {maxsets, enlarged, newmax}];

idealDimension[ideal_, vars_] := 
  Module[{ord = DegreeReverseLexicographic, gb, pheads, heds, maxsets,
     el, mlen}, gb = GroebnerBasis[ideal, vars, MonomialOrder -> ord];
   pheads = Map[First[MonomialList[#, vars, ord]] &, gb];
   heds = Map[Variables[#] &, pheads];
   {maxsets, el, mlen} = 
    getMaxIndependentSets[vars, {}, heds, 0, 1, {}];
   mlen];

And here are some test cases correctly analyzed by idealDimension that I have verified from on-line sources.

polys1 = {x y - z, y z - x, z x - y};
vars1 = {x, y, z};
idealDimension[polys1, vars1]
(*
 From Maple isZeroDimensional
*)
polys2 = {x^2 - 2 x z + 5, x y^2 + y z^3, 3 y^2 - 8 z^3};
vars2 = {x, y, z};
idealDimension[polys2, vars2]
(*
 From Wolfram MathGroup archive:  \
forums.wolfram.com/mathgroup/archive/1999/Jul/msg00150.html
*)
polys3 = {x^2*y + 3*w*x*z - 4, t*y^2 - w^2*x*y + t*z + 2*x - 3, 
   w*x^2*y + 2*t^2*x*z^2 - 5*w*y*z^2 + 7};
vars3 = {t, w, x, y, z};
idealDimension[polys3, vars3]
(*
 some others
*)
polys3b = {x^2 y + 3 x z - 4, y^2 - x y + z + 2};
vars3b = {x, y, z};
idealDimension[polys3b, vars3b]

polys4 = {y^2 - x y - 2 z x, y^3 + z^2 + 1, x^2 y z - z y};
vars4 = {x, y, z};
idealDimension[polys4, vars4]

poly5 = {x y^2 + 2 x z - y z, x^2 y z + y^2};
vars5 = {x, y, z};
idealDimension[poly5, vars5]

0

0

2

1

0

1
$\endgroup$
3
  • $\begingroup$ (1) Thanks for posting and testing. Also for updating the code if you needed to do that. $\endgroup$ Apr 3 at 19:54
  • $\begingroup$ (2) A probabilistic alternative method occurs to me. Add random hyperplane functions to the polynomials. Could start with [n/2] say. If the GroebnerBasis gives {1} then the augmented system is overdetermined so remove hyperplanes (half of them, say). Whenever the GB does not give {1} add half again as many hyperplanes as you previously added or removed. The ideal dimension will be the largest number you added without getting a GB of {1}. This can be faster than the non-probabilistic method because you can also work modulo a multiple digit prime; with high probability the result is unchanged. $\endgroup$ Apr 3 at 19:58
  • $\begingroup$ (3) Comment (2) made it in with zero characters to spare! $\endgroup$ Apr 3 at 19:58
1
$\begingroup$

@Daniel:

Regarding your comments above. I am working with iterated polynomial systems in which idealDimension quickly become CPU-bound after only a few iterations. Here is a benchmark running on a 4.5 GHz quad-core machine running in parallel. Maybe would be interesting to see if your probabilistic method would improve the performance (I stopped the calc for n=10 after around 30 min or so):

(*
 create simple square system in 2 variables
*)
g0[{z_, w_}] = 1 + 1/4 w + z^2;
h0[{z_, w_}] = z;
vectorF[{z_, w_}] = {g0[{z, w}], h0[{z, w}]};
(*
 fold the system 9 times and compute the ideal dimension
*)
idealTable = ParallelTable[
  timing = AbsoluteTiming[
    poly16 = Nest[vectorF, {z, w}, n];
    vars16 = {z, w};
    id = idealDimension[poly16, vars16];
    ];
  {n, id, timing[[1]]},
  {n, 1, 9}]

$$ \begin{array}{ccc} \text{n} & \text{dim} & \text{Time (sec)} \\ 1 & 0 & 0.0008918 \\ 2 & 0 & 0.0009232 \\ 3 & 0 & 0.001006 \\ 4 & 0 & 0.0025332 \\ 5 & 0 & 0.0065017 \\ 6 & 0 & 0.24913 \\ 7 & 0 & 0.857535 \\ 8 & 0 & 8.11298 \\ 9 & 0 & 178.119 \\ \end{array} $$

Also, you may be interested in this problem regarding their ideals: Ideal of iterated polynomial systems I'm afraid I am a bit handicapped to prove that but suspect someone else can. Might be of interest to you. :)

$\endgroup$
3
  • $\begingroup$ About all I can say is that it's an interesting question. More generally, if F and G have compatible dimension and are zero dimensional systems, under what conditions might G(F) not be zero dimensional? I have a thought about this which I'll put in a separate comment. (It is insufficiently developed for me to post as a response to your MO question,) $\endgroup$ Apr 4 at 14:49
  • $\begingroup$ Square zero dimensional polynomial systems are generic in the sense that for almost all constants you might provide, you will get the same (finite) number of solutions. This means they will, for almost all values, remain zero dimensional. Solving F(F(x))=0 is equivalent to solving F(y)=0 with y=F(x). (I regard x,y as vectors here.) I think this implies that a given zero dimensional polynomial system F(x) will almost always have all iterates also zero dimensional. You would have to have carefully selected coefficients of F in order to obtain an exception. I think. $\endgroup$ Apr 4 at 14:54
  • $\begingroup$ Thanks. That's interesting. Would then be interesting to devise an F(X) (non-trivial) which is zero dimension but some iterate is not. Even devise one which only becomes non-zero dimensional only after k iterates. $\endgroup$
    – Dominic
    Apr 4 at 15:11

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.