singular-data 4.0.3+ds-1 / usr / share / singular / LIB / grwalk.lib

///////////////////////////////////////////////////////////////

version="version grwalk.lib 4.0.0.0 Jun_2013 "; // $Id: 1a264018e31e8769fe6ecdccc9928a87728b9129 $
category="Commutative Algebra";

info="
LIBRARY: grwalk.lib   Groebner Walk Conversion Algorithms
AUTHOR: I Made Sulandra

PROCEDURES:
 fwalk(ideal[,intvec]);   standard basis of ideal via fractalwalk alg
 twalk(ideal[,intvec]);   standard basis of ideal via Tran's alg
 awalk1(ideal[,intvec]);   standard basis of ideal via the first alt. alg
 awalk2(ideal[,intvec]);   standard basis of ideal via the second alt. alg
 pwalk(ideal[,intvec]);   standard basis of ideal via perturbation walk alg
 gwalk(ideal[,intvec]);   standard basis of ideal via groebnerwalk alg
";

//////////////////////////////////////////////////////////////////////////////

static proc OrderStringalp_NP(string Wpal,list #)
{
  int n= nvars(basering);
  string order_str = "dp";

  int nP = 1;// in pwalk, call LastGB to compute the wanted GB

  //Default:
  // if size(#)=0, the Groebnerwalk algorithm and its developments compute
  // a Groebner basis from "dp" to "lp"

  intvec curr_weight = system("Mivdp",n); //define (1,1,...,1)
  intvec target_weight = system("Mivlp",n); //define (1,0,...,0)

  if(size(#) != 0)
  {
    if(size(#) == 1)
    {
      if(typeof(#[1]) == "intvec") {
        curr_weight = #[1];

        if(Wpal == "al"){
          order_str = "(a("+string(#[1])+"),lp("+string(n) + "),C)";
        }
        else {
          order_str = "(Wp("+string(#[1])+"),C)";
        }
      }
      else {
        if(typeof(#[1]) == "int"){
          nP = #[1];
        }
        else {
          if(typeof(#[1]) == "string")
          {
            if(#[1] == "Dp") {
              order_str = "Dp";
             }
             else {
                order_str = "dp";
             }
          }
          else {
            print("// ** the input must be \"(ideal, intvec)\" or ");
            print("// **                   \"(ideal, string)\" or ");
            print("// **                   \"(ideal, string,intvec)\" or ");
            print("// **                   \"(ideal, intvec,intvec)\".");
            print("// ** a lex. GB will be computed from \"dp\" to \"lp\".");
          }
        }
      }
    }
    else {
      if(size(#) == 2) {
        if(typeof(#[1]) == "intvec" and typeof(#[2]) == "int") {
          curr_weight = #[1];
          order_str = "(Wp("+string(#[1])+"),C)";
          if(Wpal == "al") {
            order_str = "(a("+string(#[1])+"),lp("+string(n) + "),C)";
          }
          if(Wpal == "M") {
            order_str = "(M("+string(#[1])+"),C)";
          }
        }
        else {
          if(typeof(#[1]) == "intvec" and typeof(#[2]) == "intvec") {
            curr_weight = #[1];
            target_weight = #[2];
            order_str = "(Wp("+string(#[1])+"),C)";
            if(Wpal == "al") {
              order_str = "(a("+string(#[1])+"),lp("+string(n) + "),C)";
            }
            if(Wpal == "M"){
              order_str = "(M("+string(#[1])+"),C)";
            }
          }
          else {
            if(typeof(#[1]) == "string" and typeof(#[2]) == "intvec") {
              target_weight = #[2];
              if(#[1] == "Dp") {
                order_str = "Dp";
               }
               else {
                 order_str = "dp";
               }
            }
            else {
              print("// ** the input must be \"(ideal, intvec)\" or ");
              print("// **                   \"(ideal, string)\" or ");
              print("// **                   \"(ideal, string,intvec)\" or ");
              print("// **                   \"(ideal, intvec,intvec)\".");
              print("// ** a lex. GB will be computed from \"dp\" to \"lp\".");
            }
          }
        }
      }
      else {
        if(size(#) == 3) {
          if(typeof(#[1]) == "intvec" and typeof(#[2]) == "intvec" and
            typeof(#[3]) == "int") {
            curr_weight = #[1];
            target_weight = #[2];
            nP = #[3];
            order_str = "(Wp("+string(#[1])+"),C)";
            if(Wpal == "al") {
              order_str = "(a("+string(#[1])+"),lp("+string(n) + "),C)";
            }
            if(Wpal == "M") {
              order_str = "(M("+string(#[1])+"),C)";
            }
          }
          else {
            if(typeof(#[1]) == "string" and typeof(#[2]) == "intvec" and
            typeof(#[3]) == "int") {
              target_weight = #[2];
              nP = #[3];
              if(#[1] == "Dp") {
                order_str = "Dp";
              }
              else {
                order_str = "dp";
              }
            }
            else {
              print("// ** the input must be \"(ideal,intvec,intvec,int)\"");
              print("// ** and a lex. GB will be computed from \"dp\" to \"lp\"");
            }
          }
        }
        else {
          print("// ** The given input is wrong");
          print("// ** and a lex. GB will be computed from \"dp\" to \"lp\"");
        }
      }
    }
  }

  list result;
  result[1] = nP;
  result[2] = order_str;
  result[3] = curr_weight;
  result[4] = target_weight;
  return(result);
}




/* 16 Mai 2003 */
proc awalk1(ideal G, list #)
"SYNTAX: awalk1(ideal i);
         awalk1(ideal i, int n);
         awalk1(ideal i, int n, intvec v, intvec w);
         awalk1(ideal i, intvec v, intvec w);
TYPE:    ideal
PURPOSE: compute the standard basis of the ideal, calculated via
          the first alternative algorithm from an ordering
         \"(a(v),lp)\", \"dp\" or \"Dp\" to the ordering
         \"(a(w),lp)\" or \"(a(1,0,...,0),lp)\"
         with a perturbation degree n for the weight vector w.
SEE ALSO: std, stdfglm, groebner, gwalk, pwalk, fwalk, twalk, awalk2
KEYWORDS: the first alternative algorithm
EXAMPLE: example awalk1; shows an example"
{
  if (size(#) == 0)
  {
    return (awalk1_tmp(G, nvars(basering)-1));
  }
  else {
    if(typeof(#[1]) == "int")
    {
      return (awalk1_tmp(G, #[1]));
    }
    else  {
      return (awalk1_tmp(G, nvars(basering)-1, #));
    }
  }
}
example
{
    "EXAMPLE:"; echo = 2;
    ring r = 32003,(z,y,x), lp;
    ideal I = y3+xyz+y2z+xz3, 3+xy+x2y+y2z;
    awalk1(I,3);
}

proc gwalk(ideal Go, list #)
"SYNTAX: gwalk(ideal i);
         gwalk(ideal i, intvec v, intvec w);
TYPE:    ideal
PURPOSE: compute the standard basis of the ideal, calculated via
         the improved Groebner walk algorithm  from the ordering
         \"(a(v),lp)\", \"dp\" or \"Dp\"
         to the ordering  \"(a(w),lp)\" or \"(a(1,0,...,0),lp)\".
SEE ALSO: std, stdfglm, groebner, pwalk, fwalk, twalk, awalk1, awalk2
KEYWORDS: Groebner walk
EXAMPLE: example gwalk; shows an example"
{

   /* we use ring with ordering (a(...),lp,C) */
   list OSCTW    = OrderStringalp_NP("al", #);

   string ord_str =   OSCTW[2];
   intvec curr_weight   =   OSCTW[3]; /* original weight vector */
   intvec target_weight =   OSCTW[4]; /* target weight vector */
   kill OSCTW;
   option(redSB);
   def xR = basering;

   execute("ring ostR = ("+charstr(xR)+"),("+varstr(xR)+"),"+ord_str+";");
   def old_ring = basering;

   //print("//** help ring = " + string(basering));
   ideal G = fetch(xR, Go);
   int reduction=1;
   int printout=0;
   G = system("Mwalk", G, curr_weight, target_weight,basering,reduction,printout);

   setring xR;
   //kill Go;

   keepring basering;
   ideal result = fetch(old_ring, G);
   attrib(result,"isSB",1);
   return (result);
}
example
{
  "EXAMPLE:"; echo = 2;
  //** compute a Groebner basis of I w.r.t. lp.
  ring r = 32003,(z,y,x), lp;
  ideal I = zy2+yx2+yx+3,
            z3x+y3+zyx-yx2-yx-3,
            z2yx3-y5+z2yx2+y3x2+y2x3+y3x+y2x2+3z2x+3y2+3yx,
            zyx5+y6-y4x2-y3x3+2zyx4-y4x-y3x2+zyx3-3z2yx+3zx3-3y3-3y2x+3zx2,
            yx7-y7+y5x2+y4x3+3yx6+y5x+y4x2+3yx5-6zyx3+yx4+3x5+3y4+3y3x-6zyx2+6x4+3x3-9zx;
  gwalk(I);
}


proc awalk1_tmp(ideal Go, int n2, list #)
//proc awalk1(ideal Go, int n1, int n2, list #)
{
   int nV = nvars(basering);
   int n1 = 1;

   //assume(n1 >= 1 && n1 <= nV && n2 >= 1 && n2 <= nV);
   if(n1 < 1 || n1 > nV || n2 < 1 || n2 > nV)
   {
     print("//Erorr: The perturbed degree is wrong!!");
     print("//       It must be between 1 and " + string(nV));
     return();
   }

   /* we use ring with ordering (a(...),lp,C) */
   list OSCTW = OrderStringalp_NP("al", #);

   string ord_str = OSCTW[2];
   intvec curr_weight = OSCTW[3]; /* original weight vector */
   intvec target_weight = OSCTW[4]; /* terget weight vector */
   kill OSCTW;
   option(redSB);

   def xR = basering;

   execute("ring ostR = ("+charstr(xR)+"),("+varstr(xR)+"),"+ord_str+";");
   def old_ring = basering;
   //print("//** help ring = " + string(basering));

   ideal G = fetch(xR, Go);
   G = system("MAltwalk1", G, n1, n2, curr_weight, target_weight);

   setring xR;
   //kill Go;

   keepring basering;
   ideal result = fetch(old_ring, G);
   attrib(result,"isSB",1);
   return (result);
}

proc fwalk(ideal Go, list #)
"SYNTAX: fwalk(ideal i);
         fwalk(ideal i, intvec v, intvec w);
TYPE:    ideal
PURPOSE: compute the standard basis of the ideal w.r.t. the
        lexicographical ordering or a weighted-lex ordering,
        calculated via  the fractal walk algorithm.
SEE ALSO: std, stdfglm, groebner, gwalk, pwalk, twalk, awalk1, awalk2
KEYWORDS: The fractal walk algorithm
EXAMPLE: example fwalk; shows an example"
{
   /* we use ring with ordering (a(...),lp,C) */
   list OSCTW    = OrderStringalp_NP("al", #);

   string ord_str =   OSCTW[2];
   intvec curr_weight   =   OSCTW[3]; /* original weight vector */
   intvec target_weight =   OSCTW[4]; /* target weight vector */
   kill OSCTW;
   option(redSB);
   def xR = basering;

   execute("ring ostR = ("+charstr(xR)+"),("+varstr(xR)+"),"+ord_str+";");
   def old_ring = basering;
   //print("//** help ring = " + string(basering));

   ideal G = fetch(xR, Go);
   int reduction=1;
   int printout=0;
   G = system("Mfwalk", G, curr_weight, target_weight, reduction, printout);

   setring xR;
   //kill Go;

   keepring basering;
   ideal result = fetch(old_ring, G);
   attrib(result,"isSB",1);
   return (result);
}
example
{
    "EXAMPLE:"; echo = 2;
    ring r = 32003,(z,y,x), lp;
    ideal I = y3+xyz+y2z+xz3, 3+xy+x2y+y2z;
    fwalk(I);
}



proc awalk2(ideal Go, list #)
"SYNTAX: awalk2(ideal i);
         awalk2(ideal i, intvec v, intvec w);
TYPE:    ideal
PURPOSE: compute the standard basis of the ideal, calculated via
         the second alternative algorithm from the ordering
         \"(a(v),lp)\", \"dp\" or \"Dp\"
         to the ordering  \"(a(w),lp)\" or \"(a(1,0,...,0),lp)\".
SEE ALSO: std, stdfglm, groebner, gwalk, pwalk, fwalk, twalk, awalk1
KEYWORDS: Groebner walk
EXAMPLE: example awalk2; shows an example"
{
   /* we use ring with ordering (a(...),lp,C) */
   list OSCTW    = OrderStringalp_NP("al", #);//"dp"

   string ord_str =   OSCTW[2];
   intvec curr_weight   =   OSCTW[3]; /* original weight vector */
   intvec target_weight =   OSCTW[4]; /* terget weight vector */
   kill OSCTW;
   option(redSB);   def xR = basering;

   execute("ring ostR = ("+charstr(xR)+"),("+varstr(xR)+"),"+ord_str+";");
   def old_ring = basering;

   //print("//** help ring = " + string(basering));
   ideal G = fetch(xR, Go);
   G = system("MAltwalk2", G, curr_weight, target_weight);

   setring xR;
   //kill Go;

   keepring basering;
   ideal result = fetch(old_ring, G);
   attrib(result,"isSB",1);
   return (result);
}
example
{
    "EXAMPLE:"; echo = 2;
    ring r = 32003,(z,y,x), lp;
    ideal I = y3+xyz+y2z+xz3, 3+xy+x2y+y2z;
    awalk2(I);
}

proc pwalk(ideal Go, int n1, int n2, list #)
"SYNTAX: pwalk(int d, ideal i, int n1, int n2);
         pwalk(int d, ideal i, int n1, int n2, intvec v, intvec w);
TYPE:    ideal
PURPOSE: compute the standard basis of the ideal, calculated via
         the perturbation walk algorithm  from the ordering
         \"(a(v),lp)\", \"dp\" or \"Dp\"
         to the ordering  \"(a(w),lp)\" or \"(a(1,0,...,0),lp)\"
         with a perturbation degree n, m for v and w, resp.
SEE ALSO: std, stdfglm, groebner, gwalk, fwalk, twalk, awalk1, awalk2
KEYWORDS: Perturbation walk
EXAMPLE: example pwalk; shows an example"
{
  int nV = nvars(basering);
  //assume(n1 >= 1 && n1 <= nV && n2 >= 1 && n2 <= nV);
  if(n1 < 1 || n1 > nV || n2 < 1 || n2 > nV)
  {
    print("//Erorr: The perturbed degree is wrong!!");
    print("//       It must be between 1 and " + string(nV));
    return();
  }

  /* we use ring with ordering (a(...),lp,C) */
  list OSCTW    = OrderStringalp_NP("al", #);

  int nP = OSCTW[1];

  string ord_str =   OSCTW[2];
  intvec curr_weight   =   OSCTW[3]; /* original weight vector */
  intvec target_weight =   OSCTW[4]; /* terget weight vector */
  kill OSCTW;
  option(redSB);

  def xR = basering;

  execute("ring ostR = ("+charstr(xR)+"),("+varstr(xR)+"),"+ord_str+";");
  def old_ring = basering;

  ideal G = fetch(xR, Go);
  int reduction=1;
  int printout=0;
  G = system("Mpwalk",G,n1,n2,curr_weight,target_weight,nP,reduction,printout);

  setring xR;
  //kill Go; //unused

  keepring basering;
  ideal result = fetch(old_ring, G);
  attrib(result,"isSB",1);
  return (result);
}
example
{
    "EXAMPLE:"; echo = 2;
    ring r = 32003,(z,y,x), lp;
    ideal I = y3+xyz+y2z+xz3, 3+xy+x2y+y2z;
    pwalk(I,2,2);
}


proc twalk(ideal Go, list #)
"SYNTAX: twalk(ideal i);
         twalk(ideal i, intvec v, intvec w);
TYPE:    ideal
PURPOSE: compute the standard basis of the ideal w.r.t.
         the ordering  \"(a(w),lp)\" or \"(a(1,0,...,0),lp)\",
         calculated via the Tran algorithm.
SEE ALSO: std, stdfglm, groebner, gwalk, pwalk, fwalk, awalk1, awalk2
KEYWORDS: The Tran algorithm
EXAMPLE: example twalk; shows an example"
{
  list L = OrderStringalp_NP("al", #);
  int nP = L[1];

  /* we use ring with ordering (a(...),lp,C) */
  string ord_str =   L[2];
  intvec curr_weight   = L[3];
  intvec target_weight =  L[4];
  kill L;

  option(redSB);
  def xR = basering;

  execute("ring ostR = ("+charstr(xR)+"),("+varstr(xR)+"),"+ord_str+";");
  def old_ring = basering;

  //print("//** help ring = " + string(basering));
  ideal G = fetch(xR, Go);
  G = system("TranMImprovwalk", G, curr_weight, target_weight, nP);

  setring xR;
   //kill Go;

  keepring basering;
  ideal result = fetch(old_ring, G);
  attrib(result,"isSB",1);
  return (result);
}
example
{
    "EXAMPLE:"; echo = 2;
    ring r = 32003,(z,y,x), lp;
    ideal I = y3+xyz+y2z+xz3, 3+xy+x2y+y2z;
    twalk(I);
}