Changeset cb0fbe in git for kernel/shiftgb.cc


Ignore:
Timestamp:
Jun 24, 2007, 6:44:42 PM (16 years ago)
Author:
Viktor Levandovskyy <levandov@…>
Branches:
(u'jengelh-datetime', 'ceac47cbc86fe4a15902392bdbb9bd2ae0ea02c6')(u'spielwiese', 'a800fe4b3e9d37a38c5a10cc0ae9dfa0c15a4ee6')
Children:
502966ccc93312cccaa355b8008b73f25689ad2a
Parents:
2948552e9bc6affb02b4648d16ae45f6040d286d
Message:
*levandov: shiftg related changes


git-svn-id: file:///usr/local/Singular/svn/trunk@10146 2c84dea3-7e68-4137-9b89-c4e89433aadc
File:
1 edited

Legend:

Unmodified
Added
Removed

  • kernel/shiftgb.cc

    r2948552 rcb0fbe  
    22*  Computer Algebra System SINGULAR     *
    33****************************************/
    4 /* $Id: shiftgb.cc,v 1.1 2007-06-02 13:29:07 levandov Exp $ */
     4/* $Id: shiftgb.cc,v 1.2 2007-06-24 16:44:41 levandov Exp $ */
    55/*
    66* ABSTRACT: kernel: utils for shift GB and free GB
    77*/
    88
    9 
    10 ideal freegb(ideal I, int uptodeg, int lVblock)
    11 {
    12 }
     9#include "mod2.h"
     10#include "febase.h"
     11#include "ring.h"
     12#include "polys.h"
     13#include "numbers.h"
     14#include "ideals.h"
     15#include "matpol.h"
     16#include "kbuckets.h"
     17#include "kstd1.h"
     18#include "sbuckets.h"
     19#include "p_Mult_q.h"
     20#include "kutil.h"
     21#include "structs.h"
     22#include "omalloc.h"
     23#include "khstd.h"
     24#include "kbuckets.h"
     25#include "weight.h"
     26#include "intvec.h"
     27#include "structs.h"
     28#include "kInline.cc"
     29#include "stairc.h"
     30#include "weight.h"
     31#include "intvec.h"
     32#include "timer.h"
     33#include "shiftgb.h"
     34#include "sca.h"
     35
     36
     37#define freeT(A,v) omFreeSize((ADDRESS)A,(v+1)*sizeof(int))
    1338
    1439poly pLPshift(poly p, int sh, int uptodeg, int lV)
    1540{
    1641  /* assume shift takes place */
    17   /* shifts the poly by sh */
     42  /* shifts the poly p by sh */
     43
     44  /* assume sh and uptodeg agree */
    1845
    1946  if (sh == 0) return(p); /* the zero shift */
    2047
    21   poly q = NULL;
    22   while (p!=NULL)
    23   {
    24     q = p_Add_q(q,pmLPshift(p,sh,uptodeg,lV));
    25     pIter(p);
    26   }
    27 
     48  poly q  = NULL;
     49  poly pp = pCopy(p);
     50  while (pp!=NULL)
     51  {
     52    q = p_Add_q(q, pmLPshift(pp,sh,uptodeg,lV),currRing);
     53    pIter(pp);
     54  }
     55  /* delete pp? */
    2856  /* int version: returns TRUE if it was successful */
    29 }
    30 
     57  return(q);
     58}
    3159
    3260poly pmLPshift(poly p, int sh, int uptodeg, int lV)
    … …  
    3664  if (sh == 0) return(p); /* the zero shift */
    3765
     66  if (sh < 0 )
     67  {
     68#ifdef PDEBUG
     69    Print("pmLPshift: negative shift requested");
     70#endif
     71    return(NULL); /* violation, 2check */
     72  }
     73
    3874  int L = pmLastVblock(p,lV);
    39   if (L+sh > uptodeg)
    40   {
     75  if (L+sh-1 > uptodeg)
     76  {
     77#ifdef PDEBUG
     78    Print("pmLPshift: too big shift requested");
     79#endif
    4180    return(NULL); /* violation, 2check */
    4281  }
    43   int *e=(int *)omAlloc0((currRing->N)*sizeof(int));
    44   int *s=(int *)omAlloc0((currRing->N)*sizeof(int));
     82  int *e=(int *)omAlloc0((currRing->N+1)*sizeof(int));
     83  int *s=(int *)omAlloc0((currRing->N+1)*sizeof(int));
    4584  pGetExpV(p,e);
    4685  number c = pGetCoeff(p);
    47   int i,j;
    48   for (i=1; i<=currRing->N; i++)
     86  int j;
     87  for (j=1; j<=currRing->N; j++)
    4988  {
    5089    if (e[j])
    5190    {
    52       s[j+sh] = e[j]; /* actually 1 */
     91      s[j + (sh*lV)] = e[j]; /* actually 1 */
    5392    }
    5493  }
    5594  poly m = pOne();
    5695  pSetExpV(m,s);
     96  /*  pSetm(m); */ /* done in the pSetExpV */
    5797  pSetCoeff0(m,c);
    5898  freeT(e, currRing->N);
    5999  freeT(s, currRing->N);
    60   /*  pSetm(m); */ /* done in the pSetExpV */
    61100  return(m);
    62101}
    … …  
    67106  /* appearing among the monomials of p */
    68107  poly q = pCopy(p); /* need it ? */
    69   int ans = 0; int ansnew;
     108  int ans = 0;
     109  int ansnew = 0;
    70110  while (q!=NULL)
    71111  {
    72112    ansnew = pmLastVblock(q,lV);
    73     ans = si_max(ans,ansnew);
     113    ans    = si_max(ans,ansnew);
    74114    pIter(q);
    75115  }
     116  /* do not need to delete q */
    76117  return(ans);
    77118}
    … …  
    81122  /* for a monomial p, returns the number of the last block */
    82123  /* where a nonzero exponent is sitting */
    83   int *e=(int *)omAlloc0((currRing->N)*sizeof(int));
     124  int *e=(int *)omAlloc0((currRing->N+1)*sizeof(int));
    84125  pGetExpV(p,e);
    85126  int j,b;
     127  j = currRing->N;
    86128  while ( (!e[j]) && (j>=1) ) j--;
    87   b = (int)(j/lV) + 1; /* the number of the block */
     129  if (j==0)
     130  {
     131#ifdef PDEBUG
     132    Print("pmLastVblock: unexpected zero exponent");
     133#endif   
     134    return(j);
     135  }
     136  b = (int)(j/lV) + 1; /* the number of the block, >=1 */
    88137  return (b);
    89138}
    … …  
    91140int isInV(poly p, int lV)
    92141{
    93   if (lV<=0) return;
     142  if (lV <= 0) return(0);
    94143  /* returns 1 iff p is in V */
    95   /* that is in the same block there is only one nonzero exponent */
     144  /* that is in each block up to a certain one there is only one nonzero exponent */
    96145  /* lV = the length of V = the number of orig vars */
    97   int *e = (int *)omAlloc0((currRing->N)*sizeof(int));
     146  int *e = (int *)omAlloc0((currRing->N+1)*sizeof(int));
    98147  int  b = (int)(currRing->N)/lV; /* the number of blocks */
    99   int *B = (int *)omAlloc0((b)*sizeof(int)); /* the num of elements in a block */
     148  int *B = (int *)omAlloc0((b+1)*sizeof(int)); /* the num of elements in a block */
    100149  pGetExpV(p,e);
    101150  int i,j;
    … …  
    127176}
    128177
    129 /* including the self pairs? */
    130 
    131 /*1
    132 * put the pairs (s[i],sh \dot p)  into the set B, ecart=ecart(p)
    133 */
    134 
    135 
    136 void enterOnePairManyShifts (int i, poly p, int ecart, int isFromQ, kStrategy strat, int atR = -1, int uptodeg, int lV)
    137 {
    138 
    139   int j;
    140   int lb = pLastVblock(p,lV);
    141   poly q;
    142   for (j=0; j<= uptodeg - lb; j++)
    143   {
    144     q = pLPshift(p,j,uptodeg,lV);
    145     enterOnePairShift(i, p, ecart, isFromQ, strat, -1, uptodeg, lV);
    146   }
    147 }
    148 
    149 /*2
    150 * put the pair (s[i],p)  into the set B, ecart=ecart(p)
    151 */
    152 
    153 
    154 void enterOnePairShift (int i, poly p, int ecart, int isFromQ, kStrategy strat, int atR = -1, int uptodeg, int lV)
    155 {
    156 
    157   /* need additionally: int up_to_degree, poly V0 with the variables in (0)  or just the number lV = the length of the first block */
    158   /* should cycle through all shifts of s[i] until up_to_degree - lastVblock(s[i]) */
    159   /* that is create the pairs (f, s \dot g) for deg(s\dot g)= */
    160 
    161   assume(i<=strat->sl);
    162   if (strat->interred_flag) return;
    163 
    164   int      l,j,compare;
    165   LObject  Lp;
    166   Lp.i_r = -1;
    167 
    168 #ifdef KDEBUG
    169   Lp.ecart=0; Lp.length=0;
    170 #endif
    171   /*- computes the lcm(s[i],p) -*/
    172   Lp.lcm = pInit();
    173 
    174   pLcm(p,strat->S[i],Lp.lcm);
    175   pSetm(Lp.lcm);
    176 
    177   /* apply the V criterion */
    178   if (!isInV(Lp.lcm))
    179   {
    180     pLmFree(Lp.lcm);
    181     Lp.lcm=NULL;
    182     return;
    183   }
    184 
    185 
    186 #ifdef HAVE_PLURAL
    187   const BOOLEAN bIsPluralRing = rIsPluralRing(currRing);
    188   const BOOLEAN bIsSCA        = rIsSCA(currRing) && strat->homog; // for prod-crit
    189   const BOOLEAN bNCProdCrit   = ( !bIsPluralRing || bIsSCA ); // commutative or homogeneous SCA
    190 #else
    191   const BOOLEAN bIsPluralRing = FALSE;
    192   const BOOLEAN bIsSCA        = FALSE;
    193   const BOOLEAN bNCProdCrit   = TRUE;
    194 #endif
    195 
    196   if (strat->sugarCrit && bNCProdCrit)
    197   {
    198     if((!((strat->ecartS[i]>0)&&(ecart>0)))
    199     && pHasNotCF(p,strat->S[i]))
    200     {
    201     /*
    202     *the product criterion has applied for (s,p),
    203     *i.e. lcm(s,p)=product of the leading terms of s and p.
    204     *Suppose (s,r) is in L and the leading term
    205     *of p divides lcm(s,r)
    206     *(==> the leading term of p divides the leading term of r)
    207     *but the leading term of s does not divide the leading term of r
    208     *(notice that this condition is automatically satisfied if r is still
    209     *in S), then (s,r) can be cancelled.
    210     *This should be done here because the
    211     *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
    212     *
    213     *Moreover, skipping (s,r) holds also for the noncommutative case.
    214     */
    215       strat->cp++;
    216       pLmFree(Lp.lcm);
    217       Lp.lcm=NULL;
    218       return;
    219     }
    220     else
    221       Lp.ecart = si_max(ecart,strat->ecartS[i]);
    222     if (strat->fromT && (strat->ecartS[i]>ecart))
    223     {
    224       pLmFree(Lp.lcm);
    225       Lp.lcm=NULL;
    226       return;
    227       /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
    228     }
    229     /*
    230     *the set B collects the pairs of type (S[j],p)
    231     *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
    232     *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
    233     *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
    234     */
    235     {
    236       j = strat->Bl;
    237       loop
    238       {
    239         if (j < 0)  break;
    240         compare=pDivComp(strat->B[j].lcm,Lp.lcm);
    241         if ((compare==1)
    242         &&(sugarDivisibleBy(strat->B[j].ecart,Lp.ecart)))
    243         {
    244           strat->c3++;
    245           if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
    246           {
    247             pLmFree(Lp.lcm);
    248             return;
    249           }
    250           break;
    251         }
    252         else
    253         if ((compare ==-1)
    254         && sugarDivisibleBy(Lp.ecart,strat->B[j].ecart))
    255         {
    256           deleteInL(strat->B,&strat->Bl,j,strat);
    257           strat->c3++;
    258         }
    259         j--;
    260       }
    261     }
    262   }
    263   else /*sugarcrit*/
    264   {
    265     if (bNCProdCrit)
    266     {
    267       // if currRing->nc_type!=quasi (or skew)
    268       // TODO: enable productCrit for super commutative algebras...
    269       if(/*(strat->ak==0) && productCrit(p,strat->S[i])*/
    270       pHasNotCF(p,strat->S[i]))
    271       {
    272       /*
    273       *the product criterion has applied for (s,p),
    274       *i.e. lcm(s,p)=product of the leading terms of s and p.
    275       *Suppose (s,r) is in L and the leading term
    276       *of p devides lcm(s,r)
    277       *(==> the leading term of p devides the leading term of r)
    278       *but the leading term of s does not devide the leading term of r
    279       *(notice that tis condition is automatically satisfied if r is still
    280       *in S), then (s,r) can be canceled.
    281       *This should be done here because the
    282       *case lcm(s,r)=lcm(s,p) is not covered by chainCrit.
    283       */
    284           strat->cp++;
    285           pLmFree(Lp.lcm);
    286           Lp.lcm=NULL;
    287           return;
    288       }
    289       if (strat->fromT && (strat->ecartS[i]>ecart))
    290       {
    291         pLmFree(Lp.lcm);
    292         Lp.lcm=NULL;
    293         return;
    294         /*the pair is (s[i],t[.]), discard it if the ecart is too big*/
    295       }
    296       /*
    297       *the set B collects the pairs of type (S[j],p)
    298       *suppose (r,p) is in B and (s,p) is the new pair and lcm(s,p)#lcm(r,p)
    299       *if the leading term of s devides lcm(r,p) then (r,p) will be canceled
    300       *if the leading term of r devides lcm(s,p) then (s,p) will not enter B
    301       */
    302       for(j = strat->Bl;j>=0;j--)
    303       {
    304         compare=pDivComp(strat->B[j].lcm,Lp.lcm);
    305         if (compare==1)
    306         {
    307           strat->c3++;
    308           if ((strat->fromQ==NULL) || (isFromQ==0) || (strat->fromQ[i]==0))
    309           {
    310             pLmFree(Lp.lcm);
    311             return;
    312           }
    313           break;
    314         }
    315         else
    316         if (compare ==-1)
    317         {
    318           deleteInL(strat->B,&strat->Bl,j,strat);
    319           strat->c3++;
    320         }
    321       }
    322     }
    323   }
    324   /*
    325   *the pair (S[i],p) enters B if the spoly != 0
     178/* shiftgb stuff */
     179
     180void initBbaShift(ideal F,kStrategy strat)
     181{
     182  int i;
     183  idhdl h;
     184 /* setting global variables ------------------- */
     185  strat->enterS = enterSBba;
     186
     187  strat->red = redFirstShift;
     188
     189  /* perhaps the following?
     190   *    strat->LazyPass *=4;
     191   *    strat->red = redHomogShift;
     192   */
     193
     194  /*    strat->red = redHoney;
     195   *  if (strat->honey)
     196   *    strat->red = redHoney;
     197   *  else if (pLexOrder && !strat->homog)
     198   *    strat->red = redLazy;
     199   *  else
     200   *  {
     201   *    strat->LazyPass *=4;
     202   *    strat->red = redHomog;
     203   *  }
     204   *#ifdef HAVE_RINGS  //TODO Oliver
     205   *  if (rField_is_Ring(currRing)) {
     206   *    strat->red = redRing2toM;
     207   *  }
     208   *#endif
    326209  */
    327   /*-  compute the short s-polynomial -*/
    328   if (strat->fromT && !TEST_OPT_INTSTRATEGY)
    329     pNorm(p);
    330   if ((strat->S[i]==NULL) || (p==NULL))
    331     return;
    332   if ((strat->fromQ!=NULL) && (isFromQ!=0) && (strat->fromQ[i]!=0))
    333     Lp.p=NULL;
     210
     211  if (pLexOrder && strat->honey)
     212    strat->initEcart = initEcartNormal;
    334213  else
    335   {
    336     #ifdef HAVE_PLURAL
    337     if ( bIsPluralRing )
    338     {
    339       if(pHasNotCF(p, strat->S[i]))
    340       {
    341         if(ncRingType(currRing) == nc_lie)
    342         {
    343             // generalized prod-crit for lie-type
    344             strat->cp++;
    345             Lp.p = nc_p_Bracket_qq(pCopy(p),strat->S[i]);
    346         }
    347         else
    348         if( bIsSCA )
    349         {
    350             // product criterion for homogeneous case in SCA
    351             strat->cp++;
    352             Lp.p = NULL;
    353         }
    354         else
    355           Lp.p = nc_CreateSpoly(strat->S[i],p,currRing); // ?
    356       }
    357       else  Lp.p = nc_CreateSpoly(strat->S[i],p,currRing);
    358     }
    359     else
    360     #endif
    361     {
    362       Lp.p = ksCreateShortSpoly(strat->S[i],p, strat->tailRing);
    363     }
    364   }
    365   if (Lp.p == NULL)
    366   {
    367     /*- the case that the s-poly is 0 -*/
    368     if (strat->pairtest==NULL) initPairtest(strat);
    369     strat->pairtest[i] = TRUE;/*- hint for spoly(S^[i],p)=0 -*/
    370     strat->pairtest[strat->sl+1] = TRUE;
    371     /*hint for spoly(S[i],p) == 0 for some i,0 <= i <= sl*/
    372     /*
    373     *suppose we have (s,r),(r,p),(s,p) and spoly(s,p) == 0 and (r,p) is
    374     *still in B (i.e. lcm(r,p) == lcm(s,p) or the leading term of s does not
    375     *devide lcm(r,p)). In the last case (s,r) can be canceled if the leading
    376     *term of p devides the lcm(s,r)
    377     *(this canceling should be done here because
    378     *the case lcm(s,p) == lcm(s,r) is not covered in chainCrit)
    379     *the first case is handeled in chainCrit
    380     */
    381     if (Lp.lcm!=NULL) pLmFree(Lp.lcm);
    382   }
     214    strat->initEcart = initEcartBBA;
     215  if (strat->honey)
     216    strat->initEcartPair = initEcartPairMora;
    383217  else
    384   {
    385     /*- the pair (S[i],p) enters B -*/
    386     Lp.p1 = strat->S[i];
    387     Lp.p2 = p;
    388 
    389     if ( !bIsPluralRing )
    390       pNext(Lp.p) = strat->tail;
    391 
    392     if (atR >= 0)
    393     {
    394       Lp.i_r1 = strat->S_2_R[i];
    395       Lp.i_r2 = atR;
    396     }
    397     else
    398     {
    399       Lp.i_r1 = -1;
    400       Lp.i_r2 = -1;
    401     }
    402     strat->initEcartPair(&Lp,strat->S[i],p,strat->ecartS[i],ecart);
    403 
    404     if (TEST_OPT_INTSTRATEGY)
    405     {
    406       if (!bIsPluralRing)
    407         nDelete(&(Lp.p->coef));
    408     }
    409 
    410     l = strat->posInL(strat->B,strat->Bl,&Lp,strat);
    411     enterL(&strat->B,&strat->Bl,&strat->Bmax,Lp,l);
    412   }
    413 }
    414 
    415 
    416 
    417 /*3
    418 *(s[0],h),...,(s[k],h) will be put to the pairset L
    419 * additionally we put the pairs (h, s \sdot h) for s>=1 to L
    420 */
    421 void initenterpairsShift (poly h,int k,int ecart,int isFromQ,kStrategy strat, int atR = -1)
    422 {
    423 
    424   if ((strat->syzComp==0)
    425   || (pGetComp(h)<=strat->syzComp))
    426   {
    427     int j;
    428     BOOLEAN new_pair=FALSE;
    429 
    430     if (pGetComp(h)==0)
    431     {
    432       /* for Q!=NULL: build pairs (f,q),(f1,f2), but not (q1,q2)*/
    433       if ((isFromQ)&&(strat->fromQ!=NULL))
    434       {
    435         for (j=0; j<=k; j++)
    436         {
    437           if (!strat->fromQ[j])
    438           {
    439             new_pair=TRUE;
    440             enterOnePair(j,h,ecart,isFromQ,strat, atR);
    441           //Print("j:%d, Ll:%d\n",j,strat->Ll);
    442           }
    443         }
    444       }
    445       else
    446       {
    447         new_pair=TRUE;
    448         for (j=0; j<=k; j++)
    449         {
    450           enterOnePair(j,h,ecart,isFromQ,strat, atR);
    451         }
    452         /* HERE we put (h, s*h) pairs */
    453       }
    454     }
    455     else
    456     {
    457       for (j=0; j<=k; j++)
    458       {
    459         if ((pGetComp(h)==pGetComp(strat->S[j]))
    460         || (pGetComp(strat->S[j])==0))
    461         {
    462           new_pair=TRUE;
    463           enterOnePair(j,h,ecart,isFromQ,strat, atR);
    464         //Print("j:%d, Ll:%d\n",j,strat->Ll);
    465         }
    466       }
    467       /* HERE we put (h, s*h) pairs TOO */
    468     }
    469 
    470     if (new_pair) chainCrit(h,ecart,strat);
    471 
    472   }
    473 }
    474 
    475 
    476 
    477 ideal bbaShift(ideal F, ideal Q,intvec *w,intvec *hilb,kStrategy strat)
    478 {
    479 #ifdef KDEBUG
    480   bba_count++;
    481   int loop_count = 0;
    482 #endif
    483   om_Opts.MinTrack = 5;
    484   int   srmax,lrmax, red_result = 1;
    485   int   olddeg,reduc;
    486   int hilbeledeg=1,hilbcount=0,minimcnt=0;
    487   BOOLEAN withT = FALSE;
    488 
    489   initBuchMoraCrit(strat); /*set Gebauer, honey, sugarCrit*/
    490   initBuchMoraPos(strat);
    491   initHilbCrit(F,Q,&hilb,strat);
    492   initBba(F,strat);
    493   /*set enterS, spSpolyShort, reduce, red, initEcart, initEcartPair*/
    494   /*Shdl=*/initBuchMora(F, Q,strat);
    495   if (strat->minim>0) strat->M=idInit(IDELEMS(F),F->rank);
    496   srmax = strat->sl;
    497   reduc = olddeg = lrmax = 0;
    498 
    499 #ifndef NO_BUCKETS
    500   if (!TEST_OPT_NOT_BUCKETS)
    501     strat->use_buckets = 1;
    502 #endif
    503 
    504   // redtailBBa against T for inhomogenous input
    505   if (!K_TEST_OPT_OLDSTD)
    506     withT = ! strat->homog;
    507 
    508   // strat->posInT = posInT_pLength;
    509   kTest_TS(strat);
    510 
    511 #ifdef HAVE_TAIL_RING
    512   kStratInitChangeTailRing(strat);
    513 #endif
    514 
    515   /* compute------------------------------------------------------- */
    516   while (strat->Ll >= 0)
    517   {
    518     if (strat->Ll > lrmax) lrmax =strat->Ll;/*stat.*/
    519 #ifdef KDEBUG
    520     loop_count++;
    521     if (TEST_OPT_DEBUG) messageSets(strat);
    522 #endif
    523     if (strat->Ll== 0) strat->interpt=TRUE;
    524     if (TEST_OPT_DEGBOUND
    525         && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
    526             || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))))
    527     {
    528       /*
    529        *stops computation if
    530        * 24 IN test and the degree +ecart of L[strat->Ll] is bigger then
    531        *a predefined number Kstd1_deg
    532        */
    533       while ((strat->Ll >= 0)
    534         && (strat->L[strat->Ll].p1!=NULL) && (strat->L[strat->Ll].p2!=NULL)
    535         && ((strat->honey && (strat->L[strat->Ll].ecart+pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg))
    536             || ((!strat->honey) && (pFDeg(strat->L[strat->Ll].p,currRing)>Kstd1_deg)))
    537         )
    538         deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
    539       if (strat->Ll<0) break;
    540       else strat->noClearS=TRUE;
    541     }
    542     /* picks the last element from the lazyset L */
    543     strat->P = strat->L[strat->Ll];
    544     strat->Ll--;
    545 
    546     if (pNext(strat->P.p) == strat->tail)
    547     {
    548       // deletes the short spoly
    549       pLmFree(strat->P.p);
    550       strat->P.p = NULL;
    551       poly m1 = NULL, m2 = NULL;
    552 
    553       // check that spoly creation is ok
    554       while (strat->tailRing != currRing &&
    555              !kCheckSpolyCreation(&(strat->P), strat, m1, m2))
    556       {
    557         assume(m1 == NULL && m2 == NULL);
    558         // if not, change to a ring where exponents are at least
    559         // large enough
    560         kStratChangeTailRing(strat);
    561       }
    562       // create the real one
    563       ksCreateSpoly(&(strat->P), NULL, strat->use_buckets,
    564                     strat->tailRing, m1, m2, strat->R);
    565     }
    566     else if (strat->P.p1 == NULL)
    567     {
    568       if (strat->minim > 0)
    569         strat->P.p2=p_Copy(strat->P.p, currRing, strat->tailRing);
    570       // for input polys, prepare reduction
    571       strat->P.PrepareRed(strat->use_buckets);
    572     }
    573 
    574     if (strat->P.p == NULL && strat->P.t_p == NULL)
    575     {
    576       red_result = 0;
    577     }
    578     else
    579     {
    580       if (TEST_OPT_PROT)
    581         message((strat->honey ? strat->P.ecart : 0) + strat->P.pFDeg(),
    582                 &olddeg,&reduc,strat, red_result);
    583 
    584       /* reduction of the element choosen from L */
    585       red_result = strat->red(&strat->P,strat);
    586     }
    587 
    588     // reduction to non-zero new poly
    589     if (red_result == 1)
    590     {
    591       /* statistic */
    592       if (TEST_OPT_PROT) PrintS("s");
    593 
    594       // get the polynomial (canonicalize bucket, make sure P.p is set)
    595       strat->P.GetP(strat->lmBin);
    596 
    597       int pos=posInS(strat,strat->sl,strat->P.p,strat->P.ecart);
    598 
    599       // reduce the tail and normalize poly
    600       if (TEST_OPT_INTSTRATEGY)
    601       {
    602         strat->P.pCleardenom();
    603         if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
    604         {
    605           strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
    606           strat->P.pCleardenom();
    607         }
    608       }
    609       else
    610       {
    611         strat->P.pNorm();
    612         if ((TEST_OPT_REDSB)||(TEST_OPT_REDTAIL))
    613           strat->P.p = redtailBba(&(strat->P),pos-1,strat, withT);
    614       }
    615 
    616 #ifdef KDEBUG
    617       if (TEST_OPT_DEBUG){PrintS("new s:");strat->P.wrp();PrintLn();}
    618 #endif
    619 
    620       // min_std stuff
    621       if ((strat->P.p1==NULL) && (strat->minim>0))
    622       {
    623         if (strat->minim==1)
    624         {
    625           strat->M->m[minimcnt]=p_Copy(strat->P.p,currRing,strat->tailRing);
    626           p_Delete(&strat->P.p2, currRing, strat->tailRing);
    627         }
    628         else
    629         {
    630           strat->M->m[minimcnt]=strat->P.p2;
    631           strat->P.p2=NULL;
    632         }
    633         if (strat->tailRing!=currRing && pNext(strat->M->m[minimcnt])!=NULL)
    634           pNext(strat->M->m[minimcnt])
    635             = strat->p_shallow_copy_delete(pNext(strat->M->m[minimcnt]),
    636                                            strat->tailRing, currRing,
    637                                            currRing->PolyBin);
    638         minimcnt++;
    639       }
    640 
    641       // enter into S, L, and T
    642       //if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
    643         enterT(strat->P, strat);
    644         enterpairs(strat->P.p,strat->sl,strat->P.ecart,pos,strat, strat->tl);
    645       // posInS only depends on the leading term
    646       if ((!TEST_OPT_IDLIFT) || (pGetComp(strat->P.p) <= strat->syzComp))
    647       {
    648       strat->enterS(strat->P, pos, strat, strat->tl);
    649       }
    650       else
    651       {
    652       //  strat->P.Delete(); // syzComp test: it is in T
    653       }
    654       if (hilb!=NULL) khCheck(Q,w,hilb,hilbeledeg,hilbcount,strat);
    655 //      Print("[%d]",hilbeledeg);
    656       if (strat->P.lcm!=NULL) pLmFree(strat->P.lcm);
    657       if (strat->sl>srmax) srmax = strat->sl;
    658     }
    659     else if (strat->P.p1 == NULL && strat->minim > 0)
    660     {
    661       p_Delete(&strat->P.p2, currRing, strat->tailRing);
    662     }
    663 #ifdef KDEBUG
    664     memset(&(strat->P), 0, sizeof(strat->P));
    665 #endif
    666     kTest_TS(strat);
    667   }
    668 #ifdef KDEBUG
    669   if (TEST_OPT_DEBUG) messageSets(strat);
    670 #endif
    671   /* complete reduction of the standard basis--------- */
    672   if (TEST_OPT_SB_1)
    673   {
    674     int k=1;
    675     int j;
    676     while(k<=strat->sl)
    677     {
    678       j=0;
    679       loop
    680       {
    681         if (j>=k) break;
    682         clearS(strat->S[j],strat->sevS[j],&k,&j,strat);
    683         j++;
    684       }
    685       k++;
    686     }
    687   }
    688 
    689   if (TEST_OPT_REDSB)
    690   {
    691     completeReduce(strat);
    692     if (strat->completeReduce_retry)
    693     {
    694       // completeReduce needed larger exponents, retry
    695       // to reduce with S (instead of T)
    696       // and in currRing (instead of strat->tailRing)
    697       cleanT(strat);strat->tailRing=currRing;
    698       int i;
    699       for(i=strat->sl;i>=0;i--) strat->S_2_R[i]=-1;
    700       completeReduce(strat);
    701     }
    702   }
    703 
    704   /* release temp data-------------------------------- */
    705   exitBuchMora(strat);
    706   if (TEST_OPT_WEIGHTM)
    707   {
    708     pRestoreDegProcs(pFDegOld, pLDegOld);
    709     if (ecartWeights)
    710     {
    711       omFreeSize((ADDRESS)ecartWeights,(pVariables+1)*sizeof(short));
    712       ecartWeights=NULL;
    713     }
    714   }
    715   if (TEST_OPT_PROT) messageStat(srmax,lrmax,hilbcount,strat);
    716   if (Q!=NULL) updateResult(strat->Shdl,Q,strat);
    717   return (strat->Shdl);
    718 }
     218    strat->initEcartPair = initEcartPairBba;
     219  strat->kIdeal = NULL;
     220  //if (strat->ak==0) strat->kIdeal->rtyp=IDEAL_CMD;
     221  //else              strat->kIdeal->rtyp=MODUL_CMD;
     222  //strat->kIdeal->data=(void *)strat->Shdl;
     223  if ((TEST_OPT_WEIGHTM)&&(F!=NULL))
     224  {
     225    //interred  machen   Aenderung
     226    pFDegOld=pFDeg;
     227    pLDegOld=pLDeg;
     228    //h=ggetid("ecart");
     229    //if ((h!=NULL) /*&& (IDTYP(h)==INTVEC_CMD)*/)
     230    //{
     231    //  ecartWeights=iv2array(IDINTVEC(h));
     232    //}
     233    //else
     234    {
     235      ecartWeights=(short *)omAlloc((pVariables+1)*sizeof(short));
     236      /*uses automatic computation of the ecartWeights to set them*/
     237      kEcartWeights(F->m,IDELEMS(F)-1,ecartWeights);
     238    }
     239    pRestoreDegProcs(totaldegreeWecart, maxdegreeWecart);
     240    if (TEST_OPT_PROT)
     241    {
     242      for(i=1; i<=pVariables; i++)
     243        Print(" %d",ecartWeights[i]);
     244      PrintLn();
     245      mflush();
     246    }
     247  }
     248}
     249
Note: See TracChangeset for help on using the changeset viewer.