1
$\begingroup$

This question was well posed four years ago without answer at Operations on ideals of polynomial rings. I asked again in Nov 2021 and posted possible function defininitions. Lichtblau commented pointing out errors. I then wrote the following functions. Please let me know if you think these are correct. And pleaes indulge my primitive code. I'm still learning Mathematica.

variables[arg_, ord_] :=
 Module[{varord},
  If[
   ListQ[ord], Return[ord],
   If[ ord == 1,
    Return[Sort[Variables[arg]]],
    Return[ReverseSort[Variables[arg]]]]]]
variables[{x^2 - y z, z^2 + x}, -1];

idealSum[ideal1_, ideal2_, ord_] :=
 Module[{gb1, gb2, union},
  gb1 = GroebnerBasis[ideal1, variables[ideal1, ord]];
  gb2 = GroebnerBasis[ideal2, variables[ideal2, ord]];
  union = Union[ideal1, ideal2];
  GroebnerBasis[union, variables[union, ord]]]
idealSum[{x^2 - 3 y, x ^2 y^3 + x^2, x^5 y - 5 y}, {x^2 z - y^2, 
   z^4 - 3}, 1];

idealProd[ideal1_, ideal2_, ord_] :=
 Module[{gb1, gb2, tuples, prod},
  gb1 = GroebnerBasis[ideal1, variables[ideal1, ord]];
  gb2 = GroebnerBasis[ideal2, variables[ideal2, ord]];
  tuples = Tuples[{gb1, gb2}];
  prod = Apply[Times, tuples, {1}];
  GroebnerBasis[prod, variables[prod, ord]]]
idealProd[{x^2 - 3 y, x ^2 y^3 + x^2, x^5 y - 5 y}, {x^2 z - y^2, 
   z^4 - 3}, 1];

idealIntersect[ideal1_, ideal2_, ord_] :=
 Module[{gb1, gb2, extnd},
  gb1 = t GroebnerBasis[ideal1, variables[ideal1, ord]];
  gb2 = (1 - t) GroebnerBasis[ideal2, variables[ideal2, ord]];
  extnd = idealSum[gb1, gb2, ord];
  GroebnerBasis[extnd, variables[extnd, ord], t]]
idealIntersect[{x^2 y}, {x y^2}];

idealQuot[idealDividend_, idealDivisor_, ord_] :=
 Module[{quotnts, bquotnts},
  (* Create a table where ith element is the inersection of dividend \
and ith element of divisor *)
  quotnts =
   Table[
    GroebnerBasis[
     idealIntersect[idealDividend, idealDivisor[[i]], ord],
     variables[{idealDividend, idealDivisor[[i]]}, ord]],
    {i, 1, Length[idealDivisor]}];
  (*Divide each ith element of table by ith element of divisor*)
  bquotnts =
   Table[
    PolynomialReduce[quotnts[[i]], idealDivisor[[i]],
     variables[{quotnts, idealDivisor}, ord]],
    {i, 1, Length[idealDivisor]}];
  bquotnts = ArrayFlatten[bquotnts, 1];
  bquotnts = bquotnts[[1 ;; Length[bquotnts], 1]];
  (*Intersect all the elements of the table*)
  While[
   Length[bquotnts > 2],
   bquotnts = 
    Union[Table[idealIntersect[bquotnts[[1]], bquotnts[[2]], ord], 
      bquotnts[[i]],
      {i, 3, Length[bquotnts]}]]];
  bquotnts = Union[bquotnts];
  (*Output the Groebner Basis of the result*)
  GroebnerBasis[bquotnts, variables[bquotnts, ord]]]
idealQuot[{x z - y^2, x^3 - y z}, {x, y}, -1]
GroebnerBasis[{x z - y^2, x^3 - y z, x^2 y - z^2}, {z, y, x}]

(*polyIdealUnion[{f1,...,fn},{g1,...,gn},...}]*)
(* Takes takes an arbitrary number of ideals as sets of generating \
polynomials and returns the Grobner basis of the union  of the \
ideals. Assumes Lexicographic monomial order *)
polyIdealUnion[polys_] :=
 Module[{},
  StringForm[
   "`` is the Grobner basis of the union of the `` ideals generated \
by ``.",
   GroebnerBasis[
    Table[
     Apply[Times, Tuples[polys][[i]]], {i, 1, Length[Tuples[polys]]}],
     Variables[polys]],
   IntegerName[Length[polys]],
   polys]]
(* For example *)
polyIdealUnion[{{x^2, y^5 + y x, 3 y^3 - 2}, {x y + z}, {z^2}}]
$\endgroup$
8
  • 1
    $\begingroup$ A useful place to check is the Wolfram Function Repository. $\endgroup$
    – Bob Hanlon
    Commented Nov 9, 2021 at 16:59
  • $\begingroup$ To my knowledge, this is not implemented in Mathematica. Maybe you can try Singular (singular.uni-kl.de/index.php). $\endgroup$
    – Wen Chern
    Commented Nov 9, 2021 at 18:22
  • 1
    $\begingroup$ I missed that question from four years ago. The sum is just found by joining the generators. Dimension can be done using code from this old post which is also in MSE here. I am not aware of code to compute the radical. There are a couple of good ways to compute intersection. Easiest might be GroebnerBasis[Join[w*polys1,(1-w)*polys2],vars,w,...]. Quotients can be computed from successive intersections and divisions by generators. $\endgroup$ Commented Nov 9, 2021 at 20:34
  • $\begingroup$ Thanks, Daniel Lichtblau. I went ahead and coded what might be correct union and intersection functions (see below). I just now coded them and am going to bed without testing. Radical of an ideal is more challenging. According to Cox, Little O'Shea, these functions have all been implimented in CoCoA, Singular, and Macaulay2. But I don't know much about those computer algebra systems. $\endgroup$
    – crabtree
    Commented Nov 10, 2021 at 2:59
  • $\begingroup$ Your intersection looks like it is actually doing the ideal union. And your union appears to be computing the ideal product. $\endgroup$ Commented Nov 10, 2021 at 14:55

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.