source: git/Singular/LIB/ratgb.lib @ 9689f2

//////////////////////////////////////////////////////////////////////////////
version="$Id: ratgb.lib,v 1.8 2007-11-09 15:56:58 levandov Exp $";
category="Noncommutative";
info="
LIBRARY: ratgb.lib  Groebner bases in Ore localizations
AUTHOR: Viktor Levandovskyy,     levandov@risc.uni-linz.ac.at

PROCEDURES:
ratstd(ideal I, int n);   compute Groebner basis in Ore localization of the basering wrt first n variables

SUPPORT: SpezialForschungsBereich F1301 of the Austrian FWF
"

LIB "poly.lib";

static proc rm_content_id(ideal J)
"USAGE:  rm_content_id(I);  I an ideal
RETURN:  ideal
PURPOSE: remove the content of every generator of I
EXAMPLE: example rm_content_id; shows examples
"
{
  ideal I = J;
  int i;
  int s = size(I);
  for (i=1; i<=s; i++)
  {
    if (I[i]!=0)
    {
      I[i] = I[i]/content(I[i]);
    }
  }
  return(I);
}
example
{
  "EXAMPLE:"; echo = 2;
  ring r = (0,k,n),(K,N),dp;
  ideal I = n*((k+1)*K - (n-k)), k*((n-k+1)*N - (n+1));
  I;
  rm_content_id(I);
}

proc ratstd(ideal I, int is)
"USAGE:  ratstd(I, n);  I an ideal, n an integer
RETURN:  ring
PURPOSE: compute the Groebner basis of I in the Ore localization of
the basering with respect to the subalgebra, generated by first n variables
ASSUME: the variables are organized in two blocks and
@* the first block of length n contains the elements
@*     with respect to which one localizes,
@* the basering is equipped with the elimination ordering
@*     for the variables in the second block
NOTE: the output ring O is commutative. The ideal rGBid in O
represents the rational form of the output ideal pGBid in the basering.
@* During the computation, the D-dimension of I and the corresponding
vector space D-dimension of I are computed and printed out.
TRACING: In order to see the steps of the computation, set printlevel to >=2
EXAMPLE: example ratstd; shows examples
"
{
  // 0. do the subst's /reformulations
  // for the time being, ASSUME
  // the ord. is an elim. ord. for D
  // and the block of X's is on the left
  // its length is 'is'

  int i,j,k;
  int ppl = printlevel-voice+1;
  dbprint(ppl,"// -1- creating K(x)[D]");

  // 1. create K(x)[D], commutative
  def save = basering;
  list L = ringlist(save);
  list RL, tmp1,tmp2,tmp3,tmp4;
  intvec iv;
  // copy: field, enlarge it with Xs

  if ( size(L[1]) == 0)
  {
    // i.e. the field with char only
    tmp2[1] = L[1];
    //    tmp1 = L[2];
    j    = size(L[2]);
    iv   = 1;
    for (i=1; i<=is; i++)
    {
      tmp1[i] = L[2][i];
      iv = iv,1;
    }
    iv = iv[1..size(iv)-1]; //extra 1
    tmp2[2]       = tmp1;
    tmp3[1] = "lp";
    tmp3[2] = iv;
    //    tmp2[3] = 0;
    tmp4[1] = tmp3;
    tmp2[3] = tmp4;
    //[1] = "lp";
    //    tmp2[3][2] = iv;
    tmp2[4]       = ideal(0);
    RL[1] = tmp2;
  }

  if ( size(L[1]) >0 )
  {
    // TODO!!!!!
    tmp2[1] = L[1][1]; //char K
    // there are parameters
    // add to them X's, IGNORE alg.extension
    // the ordering on pars
    tmp1 = L[1][2]; // param names
    j    = size(tmp1);
    iv = L[1][3][1][2];
    for (i=1; i<=is; i++)
    {
      tmp1[j+i] = L[2][i];
      iv = iv,1;
    }
    tmp2[2] = tmp1;
    tmp2[3] = L[1][3];
    tmp2[3][1][2] = iv;
    tmp2[4] = ideal(0);
    RL[1] = tmp2;
  }

  // vars: leave only D's
  kill tmp1; list tmp1;
  //  tmp1 = L[2];
  for (i=is+1; i<= size(L[2]); i++)
  {
    tmp1[i-is] = L[2][i];
  }
  RL[2] = tmp1;

  // assume the ordering is the block with (a(0:is),ORD)
  // set up ORD as the ordering
  //  L; "RL:"; RL;
  if (size(L[3]) != 3)
  {
    "note: strange ordering\n";
  }
  kill tmp2; list tmp2;
  tmp2[1] = L[3][2];
  tmp2[2] = L[3][3];
  RL[3]   = tmp2;

  // factor ideal is ignored
  RL[4] = ideal(0);

  def @RAT = ring(RL);

  dbprint(ppl,"// -2- preprocessing with content");
  // 2. preprocess input with rm_content_id
  setring @RAT;
  ideal CI = imap(save,I);
  CI = rm_content_id(CI);

  dbprint(ppl,"// -3- running groebner");
  // 3. compute G = GB(I) wrt. the elim. ord. for D
  setring save;
  ideal CI = imap(@RAT,CI);
  option(redSB);
  option(redTail);
  ideal G = groebner(CI); // although slimgb looks better
  G = simplify(G,2); // to be sure there are no 0's

  dbprint(ppl,"// -4- postprocessing with content");
  // 4. postprocess the output with 1) rm_content_id,  2) lm-minimization;
  setring @RAT;
  ideal CG = imap(save,G);
  CG = rm_content_id(CG);
  CG = simplify(CG,2+32);

  // 4b. create L(G) with X's as coeffs (for minimization)
  int sG  = ncols(CG);
  ideal LG;
  for (i=1; i<= sG; i++)
  {
    LG[i] = lead(CG[i]);
  }

//   ideal SLG = simplify(LG,8+32); //contains zeros
//   intvec islg;
//   if (SLG[1] == 0)
//   {  islg = 0;  }
//   else
//   {    islg = 1;  }
//   for (i=2; i<= ncols(SLG); i++)
//   {
//     if (SLG[i] == 0)
//     {
//       islg = islg, 0;
//     }
//     else
//     {
//       islg = islg, 1;
//     }
//   }

  // compute the D-dimension of the ideal

  LG = groebner(LG); // cosmetics
  int d = dim(LG);
  int Ddim = d;
  printf("the D-dimension is %s",d);
  if (d==0)
  {
    d = vdim(LG);
    int Dvdim = d;
    printf("the K-dimension is %s",d);
  }
  setring save;
//   for (i=1; i<= ncols(LG); i++)
//   {
//     if (islg[i] == 0)
//     {
//       G[i] = 0;
//     }
//   }
//   G = simplify(G,2); // ready!

  G = imap(@RAT,CG);
  // return the result
  ideal pGBid = G;
  export pGBid;
  //  export Ddim;
  //  export Dvdim;
  setring @RAT;
  ideal rGBid = CG;
  //imap(save,G);
  export rGBid;
  setring save;
  return(@RAT);
  //  kill @RAT;
  //  return(G);
}
example
{
  "EXAMPLE:"; echo = 2;
  ring r = 0,(k,n,K,N),(a(0,0,1,1),dp);
  matrix D[4][4];
  D[1,3] = K;
  D[2,4] = N;
  def S=nc_algebra(1,D);setring S;
  ideal I = (k+1)*K - (n-k), (n-k+1)*N - (n+1);
  int is = 2;
  def A  = ratstd(I,is);
  pGBid; // polynomial form
  setring A;
  rGBid; // rational form
}

static proc exParam()
{
  // Appel F4
  LIB "ratgb.lib";
  ring r = (0,a,b,c,d),(x,y,Dx,Dy),(a(0,0,1,1),dp);
  matrix @D[4][4];
  @D[1,3]=1; @D[2,4]=1;
  def S=nc_algebra(1,@D);
  setring S;
  ideal I =
    x*Dx*(x*Dx+c-1) - x*(x*Dx+y*Dy+a)*(x*Dx+y*Dy+b),
    y*Dy*(y*Dy+d-1) - y*(x*Dx+y*Dy+a)*(x*Dx+y*Dy+b);
  def A = ratstd(I,2);
  pGBid; // polynomial form
  setring A;
  rGBid; // rational form
}