source: git/Singular/tgb.cc @ 4f006f

spielwiese
Last change on this file since 4f006f was 4f006f, checked in by Michael Brickenstein <bricken@…>, 21 years ago
* bricken: new structures, cleaning git-svn-id: file:///usr/local/Singular/svn/trunk@6550 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 54.4 KB
Line 
1
2// #define OM_CHECK 3
3// #define OM_TRACK 5
4// #define OM_KEEP  1
5// TODO:
6//       deg -> poly_crit
7//       "e"
8//       multiple rings
9//       shorten_tails und dessen Aufrufe pruefen wlength!!!
10#include "tgb.h"
11#define OM_KEEP 0
12#define LEN_VAR1
13
14#ifdef LEN_VAR1
15// erste Variante: Laenge: Anzahl der Monome
16int pSLength(poly p, int l) {
17  return l; }
18int kSBucketLength(kBucket* bucket) {return bucket_guess(bucket);}
19#endif
20
21#ifdef LEN_VAR2
22// 2. Variante: Laenge: Platz fuer die Koeff.
23int pSLength(poly p,int l)
24{
25  int s=0;
26  while (p!=NULL) { s+=nSize(pGetCoeff(p));pIter(p); }
27  return s;
28}
29int kSBucketLength(kBucket* b)
30{
31  int s=0;
32  int i;
33  for (i=MAX_BUCKET;i>=0;i--)
34  {
35    s+=pSLength(b->buckets[i],0);
36  }
37  return s;
38}
39#endif
40
41#ifdef LEN_VAR3
42// 3.Variante: Laenge: Platz fuer Leitk * Monomanzahl
43int pSLength(poly p,int l)
44{
45  int c=nSize(pGetCoeff(p));
46  return c*l /*pLength(p)*/;
47}
48int kSBucketLength(kBucket* b)
49{
50  int s=0;
51  int c=nSize(pGetCoeff(kBucketGetLm(b)))+1;
52  int i;
53  for (i=MAX_BUCKET;i>0;i--)
54  {
55    s+=b->buckets_length[i] /*pLength(b->buckets[i])*/;
56  }
57  return s*c;
58}
59#endif
60
61#ifdef LEN_VAR4
62// 4.Variante: Laenge: Platz fuer Leitk * (1+Platz fuer andere Koeff.)
63int pSLength(poly p, int l)
64{
65  int s=1;
66  int c=nSize(pGetCoeff(p));
67  pIter(p);
68  while (p!=NULL) { s+=nSize(pGetCoeff(p));pIter(p); }
69  return s*c;
70}
71int kSBucketLength(kBucket* b)
72{
73  int s=1;
74  int c=nSize(pGetCoeff(kBucketGetLm(b)));
75  int i;
76  for (i=MAX_BUCKET;i>0;i--)
77  {
78    if(b->buckets[i]==NULL) continue;
79    s+=pSLength(b->buckets[i],0);
80  }
81  return s*c;
82}
83#endif
84
85static int LObject_better_gen(const void* ap, const void* bp)
86{
87  LObject* a=*(LObject**)ap;
88  LObject* b=*(LObject**)bp;
89  return(pLmCmp(a->p,b->p));
90}
91static int red_object_better_gen(const void* ap, const void* bp)
92{
93
94
95  return(pLmCmp(((red_object*) ap)->p,((red_object*) bp)->p));
96}
97static int pair_better_gen2(const void* ap,const void* bp){
98  return(-pair_better_gen(ap,bp));
99}
100static int kFindDivisibleByInS_easy(kStrategy strat,const red_object & obj){
101  int i;
102  long not_sev=~obj.sev;
103  poly p=obj.p;
104  for(i=0;i<=strat->sl;i++){
105    if (pLmShortDivisibleBy(strat->S[i],strat->sevS[i],p,not_sev))
106      return i;
107  }
108  return -1;
109}
110static int posInPairs (sorted_pair_node**  p, int pn, sorted_pair_node* qe,calc_dat* c,int an=0)
111{
112  if(pn==0) return 0;
113
114  int length=pn-1;
115  int i;
116  //int an = 0;
117  int en= length;
118
119  if (pair_better(qe,p[en],c))
120    return length+1;
121
122  while(1)
123    {
124      //if (an >= en-1)
125      if(en-1<=an)
126      {
127        if (pair_better(p[an],qe,c)) return an;
128        return en;
129      }
130      i=(an+en) / 2;
131        if (pair_better(p[i],qe,c))
132          en=i;
133      else an=i;
134    }
135}
136static BOOLEAN  ascending(int* i,int top){
137  if(top<1) return TRUE;
138  if(i[top]<i[top-1]) return FALSE;
139  return ascending(i,top-1);
140}
141
142sorted_pair_node**  merge(sorted_pair_node** p, int pn,sorted_pair_node **q, int qn,calc_dat* c){
143  int i;
144  int* a= (int*) omalloc(qn*sizeof(int));
145//   int mc;
146//   PrintS("Debug\n");
147//   for(mc=0;mc<qn;mc++)
148// {
149
150//     wrp(q[mc]->lcm_of_lm);
151//     PrintS("\n");
152// }
153//    PrintS("Debug they are in\n");
154//   for(mc=0;mc<pn;mc++)
155// {
156
157//     wrp(p[mc]->lcm_of_lm);
158//     PrintS("\n");
159// }
160  int lastpos=0;
161  for(i=0;i<qn;i++){
162    lastpos=posInPairs(p,pn,q[i],c, max(lastpos-1,0));
163    //   cout<<lastpos<<"\n";
164    a[i]=lastpos;
165
166  }
167  if((pn+qn)>c->max_pairs){
168    p=(sorted_pair_node**) omrealloc(p,2*(pn+qn)*sizeof(sorted_pair_node*));
169    c->max_pairs=2*(pn+qn);
170  }
171  for(i=qn-1;i>=0;i--){
172    size_t size;
173    if(qn-1>i)
174      size=(a[i+1]-a[i])*sizeof(sorted_pair_node*);
175    else
176      size=(pn-a[i])*sizeof(sorted_pair_node*); //as indices begin with 0
177    memmove (p+a[i]+(1+i), p+a[i], size);
178    p[a[i]+i]=q[i];
179  }
180  omfree(a);
181  return p;
182}
183
184
185static BOOLEAN trivial_syzygie(int pos1,int pos2,poly bound,calc_dat* c){
186
187
188  poly p1=c->S->m[pos1];
189  poly p2=c->S->m[pos2];
190  ring r=c->r;
191 
192
193  if (pGetComp(p1) > 0 || pGetComp(p2) > 0)
194    return FALSE;
195  int i = 1;
196  poly m=NULL;
197  poly gcd1=c->gcd_of_terms[pos1];
198  poly gcd2=c->gcd_of_terms[pos2];
199 
200  if((gcd1!=NULL) && (gcd2!=NULL)) 
201    {
202      gcd1->next=gcd2; //may ordered incorrect
203      poly m=gcd_of_terms(gcd1,c->r);
204      gcd1->next=NULL;
205     
206    } 
207
208  if (m==NULL) 
209  {
210     loop
211      {
212        if (pGetExp(p1, i)+ pGetExp(p2, i) > pGetExp(bound,i))   return FALSE;
213        if (i == pVariables){
214          PrintS("trivial");
215          return TRUE;
216        }
217        i++;
218      }
219  }
220  else 
221  {
222    loop
223      {
224        if (pGetExp(p1, i)-pGetExp(m,i) + pGetExp(p2, i) > pGetExp(bound,i))   return FALSE;
225        if (i == pVariables){
226          pDelete(&m);
227          PrintS("trivial");
228          return TRUE;
229        }
230        i++;
231      }
232  }
233
234 
235
236 
237}
238
239BOOLEAN good_has_t_rep(int i, int j,calc_dat* c){
240  assume(i>=0);
241    assume(j>=0);
242  if (has_t_rep(i,j,c)) return TRUE;
243  poly lm=pOne();
244
245  pLcm(c->S->m[i], c->S->m[j], lm);
246  pSetm(lm);
247  assume(lm!=NULL);
248  int deciding_deg= pTotaldegree(lm);
249  int* i_con =make_connections(i,j,lm,c);
250  p_Delete(&lm,c->r);
251
252
253  for (int n=0;((n<c->n) && (i_con[n]>=0));n++){
254    if (i_con[n]==j){
255      now_t_rep(i,j,c);
256      omfree(i_con);
257
258      return TRUE;
259    }
260  }
261  omfree(i_con);
262
263  return FALSE;
264}
265BOOLEAN lenS_correct(kStrategy strat){
266  int i;
267  for(i=0;i<=strat->sl;i++){
268    if (strat->lenS[i]!=pLength(strat->S[i]))
269      return FALSE;
270  }
271  return TRUE;
272}
273
274static void notice_miss(int i, int j, calc_dat* c){
275  PrintS("-");
276 
277}
278
279static void cleanS(kStrategy strat){
280  int i=0;
281  LObject P;
282  while(i<=strat->sl){
283    P.p=strat->S[i];
284    P.sev=strat->sevS[i];
285    if(kFindDivisibleByInS(strat->S,strat->sevS,strat->sl,&P)!=i){
286      deleteInS(i,strat);
287      //remember destroying poly
288    }
289    else i++;
290  }
291}
292static int bucket_guess(kBucket* bucket){
293  int sum=0;
294  int i;
295  for (i=MAX_BUCKET;i>=0;i--){
296    sum+=bucket->buckets_length[i];
297  }
298  return sum;
299}
300
301
302
303
304
305
306static int add_to_reductors(calc_dat* c, poly h, int len){
307  assume(lenS_correct(c->strat));
308 
309  int i;
310  if (c->is_char0)
311       i=simple_posInS(c->strat,h,pSLength(h,len),c->is_char0);
312  else
313    i=simple_posInS(c->strat,h,len,c->is_char0);
314 
315  LObject P; memset(&P,0,sizeof(P));
316  P.tailRing=c->r;
317  P.p=h; /*p_Copy(h,c->r);*/
318  P.FDeg=pFDeg(P.p,c->r);
319  if (!rField_is_Zp(c->r)){ 
320    pCleardenom(P.p);
321    pContent(P.p); //is a duplicate call, but belongs here
322  }
323 
324  else                     
325    pNorm(P.p);
326 
327 
328  c->strat->enterS(P,i,c->strat);
329 
330 
331
332  c->strat->lenS[i]=len;
333 
334  if(c->strat->lenSw)
335    c->strat->lenSw[i]=pSLength(P.p,len);
336  return i;
337 
338}
339static void length_one_crit(calc_dat* c, int pos, int len)
340{
341  if (len==1)
342  {
343    int i;
344    for ( i=0;i<pos;i++)
345    {
346      if (c->lengths[i]==1)
347        c->states[pos][i]=HASTREP;
348    }
349    for ( i=pos+1;i<c->n;i++){
350      if (c->lengths[i]==1)
351        c->states[i][pos]=HASTREP;
352    }
353    shorten_tails(c,c->S->m[pos]);
354  }
355}
356static sorted_pair_node* find_next_pair2(calc_dat* c, BOOLEAN go_higher){
357  clean_top_of_pair_list(c);
358  sorted_pair_node* s=pop_pair(c);
359
360
361  return s;
362}
363
364static void move_forward_in_S(int old_pos, int new_pos,kStrategy strat, BOOLEAN is_char0)
365{
366  assume(old_pos>=new_pos);
367  poly p=strat->S[old_pos];
368  int ecart=strat->ecartS[old_pos];
369  long sev=strat->sevS[old_pos];
370  int s_2_r=strat->S_2_R[old_pos];
371  int length=strat->lenS[old_pos];
372  int length_w;
373  if(is_char0)
374    length_w=strat->lenSw[old_pos];
375  int i;
376  for (i=old_pos; i>new_pos; i--)
377  {
378    strat->S[i] = strat->S[i-1];
379    strat->ecartS[i] = strat->ecartS[i-1];
380    strat->sevS[i] = strat->sevS[i-1];
381    strat->S_2_R[i] = strat->S_2_R[i-1];
382  }
383  if (strat->lenS!=NULL)
384    for (i=old_pos; i>new_pos; i--)
385      strat->lenS[i] = strat->lenS[i-1];
386  if (strat->lenSw!=NULL)
387    for (i=old_pos; i>new_pos; i--)
388      strat->lenSw[i] = strat->lenSw[i-1];
389
390  strat->S[new_pos]=p;
391  strat->ecartS[new_pos]=ecart;
392  strat->sevS[new_pos]=sev;
393  strat->S_2_R[new_pos]=s_2_r;
394  strat->lenS[new_pos]=length;
395  if(is_char0)
396    strat->lenSw[new_pos]=length_w;
397  //assume(lenS_correct(strat));
398}
399static void replace_pair(int & i, int & j, calc_dat* c)
400{
401  c->soon_free=NULL;
402  int curr_deg;
403  poly lm=pOne();
404
405  pLcm(c->S->m[i], c->S->m[j], lm);
406  pSetm(lm);
407  int deciding_deg= pTotaldegree(lm);
408  int* i_con =make_connections(i,j,lm,c);
409  int z=0;
410
411  for (int n=0;((n<c->n) && (i_con[n]>=0));n++){
412    if (i_con[n]==j){
413      now_t_rep(i,j,c);
414      omfree(i_con);
415      p_Delete(&lm,c->r);
416      return;
417    }
418  }
419
420  int* j_con =make_connections(j,lm,c);
421  i= i_con[0];
422  j=j_con[0];
423  if(c->n>1){
424    if (i_con[1]>=0)
425      i=i_con[1];
426    else {
427      if (j_con[1]>=0)
428        j=j_con[1];
429    }
430  }
431  pLcm(c->S->m[i], c->S->m[j], lm);
432  pSetm(lm);
433  poly short_s;
434  curr_deg=pTotaldegree(lm);
435  int_pair_node* last=NULL;
436
437  for (int n=0;((n<c->n) && (j_con[n]>=0));n++){
438    for (int m=0;((m<c->n) && (i_con[m]>=0));m++){
439      pLcm(c->S->m[i_con[m]], c->S->m[j_con[n]], lm);
440      pSetm(lm);
441      if (pTotaldegree(lm)>=deciding_deg)
442      {
443        soon_t_rep(i_con[m],j_con[n],c);
444        int_pair_node* h= (int_pair_node*)omalloc(sizeof(int_pair_node));
445        if (last!=NULL)
446          last->next=h;
447        else
448          c->soon_free=h;
449        h->next=NULL;
450        h->a=i_con[m];
451        h->b=j_con[n];
452        last=h;
453      }
454      //      if ((comp_deg<curr_deg)
455      //  ||
456      //  ((comp_deg==curr_deg) &&
457      short_s=ksCreateShortSpoly(c->S->m[i_con[m]],c->S->m[j_con[n]],c->r);
458      if (short_s==NULL) {
459        i=i_con[m];
460        j=j_con[n];
461        now_t_rep(i_con[m],j_con[n],c);
462        p_Delete(&lm,c->r);
463        omfree(i_con);
464        omfree(j_con);
465
466        return;
467      }
468#ifdef QUICK_SPOLY_TEST
469      for (int dz=0;dz<=c->n;dz++){
470        if (dz==c->n) {
471          //have found not head reducing pair
472          i=i_con[m];
473          j=j_con[n];
474          p_Delete(&short_s,c->r);
475          p_Delete(&lm,c->r);
476          omfree(i_con);
477          omfree(j_con);
478
479          return;
480        }
481        if (p_LmDivisibleBy(c->S->m[dz],short_s,c->r)) break;
482      }
483#endif
484      int comp_deg(pTotaldegree(short_s));
485      p_Delete(&short_s,c->r);
486      if ((comp_deg<curr_deg))
487         
488      {
489        curr_deg=comp_deg;
490        i=i_con[m];
491        j=j_con[n];
492      }
493    }
494  }
495  p_Delete(&lm,c->r);
496  omfree(i_con);
497  omfree(j_con);
498  return;
499}
500
501
502static int* make_connections(int from, poly bound, calc_dat* c)
503{
504  ideal I=c->S;
505  int s=pTotaldegree(bound);
506  int* cans=(int*) omalloc(c->n*sizeof(int));
507  int* connected=(int*) omalloc(c->n*sizeof(int));
508  int cans_length=0;
509  connected[0]=from;
510  int connected_length=1;
511  long neg_bounds_short= ~p_GetShortExpVector(bound,c->r);
512  for (int i=0;i<c->n;i++){
513    if (c->T_deg[i]>s) continue;
514    if (i!=from){
515      if(p_LmShortDivisibleBy(I->m[i],c->short_Exps[i],bound,neg_bounds_short,c->r)){
516        cans[cans_length]=i;
517        cans_length++;
518      }
519    }
520  }
521  int not_yet_found=cans_length;
522  int con_checked=0;
523  int pos;
524  while((not_yet_found>0) && (con_checked<connected_length)){
525    pos=connected[con_checked];
526    for(int i=0;i<cans_length;i++){
527      if (cans[i]<0) continue;
528      if (has_t_rep(pos,cans[i],c))
529      {
530        connected[connected_length]=cans[i];
531        connected_length++;
532        cans[i]=-1;
533        --not_yet_found;
534      }
535    }
536    con_checked++;
537  }
538  if (connected_length<c->n){
539    connected[connected_length]=-1;
540  }
541  omfree(cans);
542  return connected;
543}
544static int* make_connections(int from, int to, poly bound, calc_dat* c)
545{
546  ideal I=c->S;
547  int s=pTotaldegree(bound);
548  int* cans=(int*) omalloc(c->n*sizeof(int));
549  int* connected=(int*) omalloc(c->n*sizeof(int));
550  cans[0]=to;
551  int cans_length=1;
552  connected[0]=from;
553  int last_cans_pos=-1;
554  int connected_length=1;
555  long neg_bounds_short= ~p_GetShortExpVector(bound,c->r);
556
557  int not_yet_found=cans_length;
558  int con_checked=0;
559  int pos;
560  BOOLEAN can_find_more=TRUE;
561  while(((not_yet_found>0) && (con_checked<connected_length))||can_find_more){
562    if ((con_checked<connected_length)&& (not_yet_found>0)){
563      pos=connected[con_checked];
564      for(int i=0;i<cans_length;i++){
565        if (cans[i]<0) continue;
566        if (has_t_rep(pos,cans[i],c))//||(trivial_syzygie(pos,cans[i],bound,c))
567{
568
569          connected[connected_length]=cans[i];
570          connected_length++;
571          cans[i]=-1;
572          --not_yet_found;
573
574          if (connected[connected_length-1]==to){
575            if (connected_length<c->n){
576              connected[connected_length]=-1;
577            }
578            omfree(cans);
579            return connected;
580          }
581        }
582      }
583      con_checked++;
584    }
585    else
586    {
587      for(last_cans_pos++;last_cans_pos<=c->n;last_cans_pos++){
588        if (last_cans_pos==c->n){
589          if (connected_length<c->n){
590            connected[connected_length]=-1;
591          }
592          omfree(cans);
593          return connected;
594        }
595        if ((last_cans_pos==from)||(last_cans_pos==to))
596          continue;
597        if(p_LmShortDivisibleBy(I->m[last_cans_pos],c->short_Exps[last_cans_pos],bound,neg_bounds_short,c->r)){
598          cans[cans_length]=last_cans_pos;
599          cans_length++;
600          break;
601        }
602      }
603      not_yet_found++;
604      for (int i=0;i<con_checked;i++){
605        if (has_t_rep(connected[i],last_cans_pos,c)){
606
607          connected[connected_length]=last_cans_pos;
608          connected_length++;
609          cans[cans_length-1]=-1;
610
611          --not_yet_found;
612          if (connected[connected_length-1]==to){
613            if (connected_length<c->n){
614              connected[connected_length]=-1;
615            }
616
617            omfree(cans);
618            return connected;
619          }
620          break;
621        }
622      }
623    }
624  }
625  if (connected_length<c->n){
626    connected[connected_length]=-1;
627  }
628
629  omfree(cans);
630  return connected;
631}
632#ifdef HEAD_BIN
633static inline poly p_MoveHead(poly p, omBin b)
634{
635  poly np;
636  omTypeAllocBin(poly, np, b);
637  memmove(np, p, b->sizeW*sizeof(long));
638  omFreeBinAddr(p);
639  return np;
640}
641#endif
642
643
644static void initial_data(calc_dat* c, ideal I){
645  void* h;
646  poly hp;
647  int i,j;
648  c->easy_product_crit=0;
649  c->extended_product_crit=0;
650  c->is_char0=(rChar()==0);
651  c->reduction_steps=0;
652  c->last_index=-1;
653
654
655
656  c->Rcounter=0;
657
658  c->soon_free=NULL;
659
660
661  c->normal_forms=0;
662  c->current_degree=1;
663 
664  c->max_pairs=5*I->idelems();
665 
666  c->apairs=(sorted_pair_node**) omalloc(sizeof(sorted_pair_node*)*c->max_pairs);
667  c->pair_top=-1;
668  int n=I->idelems();
669  for (i=0;i<n;i++){
670    wrp(I->m[i]);
671    PrintS("\n");
672  }
673    i=0;
674  c->n=0;
675  c->T_deg=(int*) omalloc(n*sizeof(int));
676 
677#ifdef HEAD_BIN
678  c->HeadBin=omGetSpecBin(POLYSIZE + (currRing->ExpL_Size)*sizeof(long));
679#endif
680  /* omUnGetSpecBin(&(c->HeadBin)); */
681  h=omalloc(n*sizeof(char*));
682  c->states=(char**) h;
683  h=omalloc(n*sizeof(int));
684  c->lengths=(int*) h;
685  h=omalloc(n*sizeof(int));
686        c->gcd_of_terms=(poly*) omalloc(n*sizeof(poly));
687  c->rep=(int*) h;
688  c->short_Exps=(long*) omalloc(n*sizeof(long));
689  c->S=idInit(n,1);
690  c->strat=new skStrategy;
691  c->strat->syzComp = 0;
692  initBuchMoraCrit(c->strat);
693  initBuchMoraPos(c->strat);
694  c->strat->initEcart = initEcartBBA;
695  c->strat->enterS = enterSBba;
696  c->strat->sl = -1;
697  i=n;
698  /* initS(c->S,NULL,c->strat); */
699/* intS start: */
700  i=((i+IDELEMS(c->S)+15)/16)*16;
701  c->strat->ecartS=(intset)omAlloc(i*sizeof(int)); /*initec(i);*/
702  c->strat->sevS=(unsigned long*)omAlloc0(i*sizeof(unsigned long));
703  /*initsevS(i);*/
704  c->strat->S_2_R=(int*)omAlloc0(i*sizeof(int));/*initS_2_R(i);*/
705  c->strat->fromQ=NULL;
706  c->strat->Shdl=idInit(1,1);
707  c->strat->S=c->strat->Shdl->m;
708  c->strat->lenS=(int*)omAlloc0(i*sizeof(int));
709  if(c->is_char0)
710    c->strat->lenSw=(int*)omAlloc0(i*sizeof(int));
711  else
712    c->strat->lenSw=NULL;
713  sorted_pair_node* si;
714  assume(n>0);
715  add_to_basis(I->m[0],-1,-1,c);
716
717  assume(c->strat->sl==c->strat->Shdl->idelems()-1);
718
719  for (i=1;i<n;i++)//the 1 is wanted, because first element is added to basis
720   {
721//     add_to_basis(I->m[i],-1,-1,c);
722     si=(sorted_pair_node*) omalloc(sizeof(sorted_pair_node));
723      si->i=-1;
724      si->j=-1;
725      si->expected_length=pLength(I->m[i]);
726      si->deg=pTotaldegree(I->m[i]);
727      si->lcm_of_lm=I->m[i];
728
729//      c->apairs[n-1-i]=si;
730      c->apairs[n-i-1]=si;
731      ++(c->pair_top);
732   }
733}
734//very important: ILM
735
736//len should be weighted length in char 0
737static int simple_posInS (kStrategy strat, poly p,int len, BOOLEAN is_char0)
738{
739
740
741  if(strat->sl==-1) return 0;
742  polyset set=strat->S;
743  intset setL=strat->lenS;
744  if (is_char0) setL=strat->lenSw;
745  int length=strat->sl;
746  int i;
747  int an = 0;
748  int en= length;
749
750  if ((len>setL[length])
751      || ((len==setL[length]) && (pLmCmp(set[length],p)== -1)))
752    return length+1;
753
754  loop
755  {
756    if (an >= en-1)
757    {
758      if ((len<setL[an])
759          || ((len==setL[an]) && (pLmCmp(set[an],p) == 1))) return an;
760      return en;
761    }
762    i=(an+en) / 2;
763    if ((len<setL[i])
764        || ((len==setL[i]) && (pLmCmp(set[i],p) == 1))) en=i;
765    //else if ((len>setL[i])
766    //|| ((len==setL[i]) && (pLmCmp(set[i],p) == -1))) an=i;
767    else an=i;
768  }
769}
770/*2
771 *if the leading term of p
772 *divides the leading term of some S[i] it will be canceled
773 */
774static inline void clearS (poly p, unsigned long p_sev,int l, int* at, int* k,
775                           kStrategy strat)
776{
777  assume(p_sev == pGetShortExpVector(p));
778  if (!pLmShortDivisibleBy(p,p_sev, strat->S[*at], ~ strat->sevS[*at])) return;
779  if (l>=strat->lenS[*at]) return;
780  PrintS("!");mflush();
781  //pDelete(&strat->S[*at]);
782  deleteInS((*at),strat);
783  (*at)--;
784  (*k)--;
785//  assume(lenS_correct(strat));
786}
787static sorted_pair_node** add_to_basis(poly h, int i_pos, int j_pos,calc_dat* c, int* ip)
788{
789
790  assume(h!=NULL);
791//  BOOLEAN corr=lenS_correct(c->strat);
792  BOOLEAN R_found=FALSE;
793  void* hp;
794
795  ++(c->n);
796  ++(c->S->ncols);
797  int i,j;
798  i=c->n-1;
799  sorted_pair_node** nodes=(sorted_pair_node**) omalloc(sizeof(sorted_pair_node*)*i);
800  int spc=0;
801  c->T_deg=(int*) omrealloc(c->T_deg,c->n*sizeof(int));
802  c->T_deg[i]=pTotaldegree(h);
803  hp=omrealloc(c->rep, c->n *sizeof(int));
804  if (hp!=NULL){
805    c->rep=(int*) hp;
806  } else {
807    exit(1);
808  }
809  c->short_Exps=(long *) omrealloc(c->short_Exps ,c->n*sizeof(long));
810
811  hp=omrealloc(c->lengths, c->n *sizeof(int));
812  if (hp!=NULL){
813    c->lengths=(int*) hp;
814  } else {
815    exit(1);
816  }
817  c->lengths[i]=pLength(h);
818  hp=omrealloc(c->states, c->n * sizeof(char*));
819 
820    c->states=(char**) hp;
821  c->gcd_of_terms=(poly*) omrealloc(c->gcd_of_terms, c->n *sizeof(poly));
822  c->gcd_of_terms[i]=gcd_of_terms(h,c->r);
823  c->rep[i]=i;
824  hp=omalloc(i*sizeof(char));
825  if (hp!=NULL){
826    c->states[i]=(char*) hp;
827  } else {
828    exit(1);
829  }
830  hp=omrealloc(c->S->m,c->n*sizeof(poly));
831  if (hp!=NULL){
832    c->S->m=(poly*) hp;
833  } else {
834    exit(1);
835  }
836  c->S->m[i]=h;
837  c->short_Exps[i]=p_GetShortExpVector(h,c->r);
838  for (j=0;j<i;j++){
839    if (c->rep[j]==j){
840      //check product criterion
841
842      c->states[i][j]=UNCALCULATED;
843
844      //lies I[i] under I[j] ?
845      if(p_LmShortDivisibleBy(c->S->m[i],c->short_Exps[i],c->S->m[j],~(c->short_Exps[j]),c->r)){
846        c->rep[j]=i;
847       
848        PrintS("R"); R_found=TRUE;
849
850        c->Rcounter++;
851        if((i_pos>=0) && (j_pos>=0)){
852       
853        }
854        for(int z=0;z<j;z++){
855          if(c->rep[z]!=z) continue;
856          if (c->states[j][z]==UNCALCULATED){
857            c->states[j][z]=UNIMPORTANT;
858          }
859        }
860        for(int z=j+1;z<i;z++){
861          if(c->rep[z]!=z) continue;
862          if (c->states[z][j]==UNCALCULATED){
863            c->states[z][j]=UNIMPORTANT;
864          }
865        }
866      }
867    }
868    else {
869      c->states[i][j]=UNIMPORTANT;
870    }
871    if ((c->lengths[i]==1) && (c->lengths[j]==1))
872      c->states[i][j]=HASTREP;
873    else if (pHasNotCF(c->S->m[i],c->S->m[j])){
874      c->easy_product_crit++;
875      c->states[i][j]=HASTREP;
876    }
877                        else if(extended_product_criterion(c->S->m[i],c->gcd_of_terms[i],c->S->m[j],c->gcd_of_terms[j],c)){
878                                        c->states[i][j]=HASTREP;
879                                        c->extended_product_crit++;
880                                        //PrintS("E");
881                        }
882    if (c->states[i][j]==UNCALCULATED){
883
884     
885      poly short_s=ksCreateShortSpoly(c->S->m[i],c->S->m[j],c->r);
886      if (short_s)
887      {
888        sorted_pair_node* s=(sorted_pair_node*) omalloc(sizeof(sorted_pair_node));
889        s->i=max(i,j);
890        s->j=min(i,j);
891        s->expected_length=c->lengths[i]+c->lengths[j]-2;
892        s->deg=pTotaldegree(short_s);
893        poly lm=pOne();
894
895        pLcm(c->S->m[i], c->S->m[j], lm);
896        pSetm(lm);
897        s->lcm_of_lm=lm;
898          pDelete(&short_s);
899        //assume(lm!=NULL);
900        nodes[spc]=s;
901        spc++;
902      }
903      else
904      {
905        c->states[i][j]=HASTREP;
906      }
907    }
908  }
909
910  add_to_reductors(c, h, c->lengths[c->n-1]);
911  //i=posInS(c->strat,c->strat->sl,h,0 /*ecart*/);
912
913  if (c->lengths[c->n-1]==1)
914    shorten_tails(c,c->S->m[c->n-1]);
915  //you should really update c->lengths, c->strat->lenS, and the oder of polys in strat if you sort after lengths
916
917  //for(i=c->strat->sl; i>0;i--)
918  //  if(c->strat->lenS[i]<c->strat->lenS[i-1]) printf("fehler bei %d\n",i);
919  if (c->Rcounter>50) {
920    c->Rcounter=0;
921    cleanS(c->strat);
922  }
923  if(!ip){
924    qsort(nodes,spc,sizeof(sorted_pair_node*),pair_better_gen2);
925 
926   
927    c->apairs=merge(c->apairs,c->pair_top+1,nodes,spc,c);
928    c->pair_top+=spc;
929    clean_top_of_pair_list(c);
930    omfree(nodes);
931    return NULL;
932  }
933  {
934    *ip=spc;
935    return nodes;
936  }
937
938 
939
940}
941#if 0
942static poly redNF (poly h,kStrategy strat)
943{
944  int j = 0;
945  int z = 3;
946  unsigned long not_sev;
947
948  if (0 > strat->sl)
949  {
950    return h;
951  }
952  not_sev = ~ pGetShortExpVector(h);
953  loop
954    {
955      if (pLmShortDivisibleBy(strat->S[j], strat->sevS[j], h, not_sev))
956      {
957        //if (strat->interpt) test_int_std(strat->kIdeal);
958        /*- compute the s-polynomial -*/
959#ifdef KDEBUG
960        if (TEST_OPT_DEBUG)
961        {
962          PrintS("red:");
963          wrp(h);
964          PrintS(" with ");
965          wrp(strat->S[j]);
966        }
967#endif
968        h = ksOldSpolyRed(strat->S[j],h,strat->kNoether);
969#ifdef KDEBUG
970        if (TEST_OPT_DEBUG)
971        {
972          PrintS("\nto:");
973          wrp(h);
974          PrintLn();
975        }
976#endif
977        if (h == NULL) return NULL;
978        z++;
979        if (z>=10)
980        {
981          z=0;
982          pNormalize(h);
983        }
984        /*- try to reduce the s-polynomial -*/
985        j = 0;
986        not_sev = ~ pGetShortExpVector(h);
987      }
988      else
989      {
990        if (j >= strat->sl) return h;
991        j++;
992      }
993    }
994}
995#else
996
997static poly redNF2 (poly h,calc_dat* c , int &len)
998{
999  len=0;
1000  if (h==NULL) return NULL;
1001
1002  len=pLength(h);
1003  kStrategy strat=c->strat;
1004  if (0 > strat->sl)
1005  {
1006    return h;
1007  }
1008  int j;
1009  int len_upper_bound=len;
1010  LObject P(h);
1011  P.SetShortExpVector();
1012  P.bucket = kBucketCreate(currRing);
1013  // BOOLEAN corr=lenS_correct(strat);
1014  kBucketInit(P.bucket,P.p,len /*pLength(P.p)*/);
1015  //int max_pos=simple_posInS(strat,P.p);
1016  loop
1017    {
1018//       if (corr){
1019
1020//      corr=lenS_correct(strat);
1021//      if(!corr){
1022//        PrintS("korupt");
1023//      }
1024//       }
1025      int compare_bound;
1026      compare_bound=bucket_guess(P.bucket);
1027      len_upper_bound=min(compare_bound,len_upper_bound);
1028      j=kFindDivisibleByInS(strat->S,strat->sevS,strat->sl,&P);
1029      if (j>=0)
1030      {
1031        poly sec_copy=NULL;
1032        //pseudo code
1033        BOOLEAN must_expand=FALSE;
1034        BOOLEAN must_replace_in_basis=(len_upper_bound<strat->lenS[j]);//first test
1035        if (must_replace_in_basis)
1036        {
1037          //second test
1038          if (pLmEqual(P.p,strat->S[j]))
1039          {
1040            PrintS("b");
1041            sec_copy=kBucketClear(P.bucket);
1042            sec_copy=redTailShort(sec_copy, strat);
1043            kBucketInit(P.bucket,pCopy(sec_copy),pLength(sec_copy));
1044          }
1045          else
1046          {
1047            must_replace_in_basis=FALSE;
1048            if ((len_upper_bound==1)
1049                ||(len_upper_bound==2)
1050                ||(len_upper_bound<strat->lenS[j]/2))
1051            {
1052              PrintS("e");
1053              int dummy_len;
1054              kBucketClear(P.bucket,&sec_copy,&dummy_len);
1055              kBucketInit(P.bucket,pCopy(sec_copy),dummy_len
1056                                                  /*pLength(sec_copy)*/);
1057              must_expand=TRUE;
1058            }
1059          }
1060        }
1061//        must_expand=FALSE;
1062//        must_replace_in_basis=FALSE;
1063        nNormalize(pGetCoeff(P.p));
1064#ifdef KDEBUG
1065        if (TEST_OPT_DEBUG)
1066        {
1067          PrintS("red:");
1068          wrp(h);
1069          PrintS(" with ");
1070          wrp(strat->S[j]);
1071        }
1072#endif
1073        len_upper_bound=len_upper_bound+strat->lenS[j]-2;
1074        number coef=kBucketPolyRed(P.bucket,strat->S[j],
1075                                   strat->lenS[j]/*pLength(strat->S[j])*/,
1076                                   strat->kNoether);
1077        nDelete(&coef);
1078        h = kBucketGetLm(P.bucket);
1079
1080        if (must_replace_in_basis){
1081          int pos_in_c=-1;
1082          poly p=strat->S[j];
1083          int z;
1084
1085          int new_length=pLength(sec_copy);
1086          Print("%i",strat->lenS[j]-new_length);
1087          len_upper_bound=new_length +strat->lenS[j]-2;//old entries length
1088          int new_pos;
1089          if(c->is_char0)
1090            new_pos=simple_posInS(c->strat,sec_copy,
1091                                  pSLength(sec_copy,new_length),
1092                                  c->is_char0);//hac
1093          else
1094            new_pos=simple_posInS(c->strat,sec_copy,new_length,c->is_char0);//hack
1095          assume(new_pos<=j);
1096//          p=NULL;
1097          for (z=c->n;z;z--)
1098          {
1099            if(p==c->S->m[z-1])
1100            {
1101
1102
1103              pos_in_c=z-1;
1104
1105              break;
1106            }
1107          }
1108          if (z<=0){
1109            //not in c->S
1110            //LEAVE
1111            deleteInS(j,c->strat);
1112
1113            add_to_reductors(c,sec_copy,pLength(sec_copy));
1114          }
1115          else {
1116//shorten_tails may alter position (not the length, even not by recursion in GLOBAL case)
1117
1118            strat->S[j]=sec_copy;
1119            c->strat->lenS[j]=new_length;
1120            pDelete(&p);
1121
1122            //        replace_quietly(c,j,sec_copy);
1123            // have to do many additional things for consistency
1124            {
1125
1126
1127
1128
1129              int old_pos=j;
1130              new_pos=min(old_pos, new_pos);
1131              assume(new_pos<=old_pos);
1132
1133
1134              c->strat->lenS[old_pos]=new_length;
1135              if(c->strat->lenSw)
1136                c->strat->lenSw[old_pos]=pSLength(sec_copy,new_length);
1137              int i=0;
1138              for(i=new_pos;i<old_pos;i++){
1139                if (strat->lenS[i]<=new_length)
1140                  new_pos++;
1141                else
1142                  break;
1143              }
1144              if (new_pos<old_pos)
1145                move_forward_in_S(old_pos,new_pos,c->strat, c->is_char0);
1146
1147              c->S->m[pos_in_c]=sec_copy;
1148
1149              c->lengths[pos_in_c]=new_length;
1150              if (new_length==1)
1151              {
1152                int i;
1153                for ( i=0;i<pos_in_c;i++)
1154                {
1155                  if (c->lengths[i]==1)
1156                    c->states[pos_in_c][i]=HASTREP;
1157                }
1158                for ( i=z;i<c->n;i++){
1159                  if (c->lengths[i]==1)
1160                    c->states[i][pos_in_c]=HASTREP;
1161                }
1162                shorten_tails(c,sec_copy);
1163              }
1164            }
1165          }
1166        }
1167        if(must_expand){
1168
1169          add_to_reductors(c,sec_copy,pLength(sec_copy));
1170        }
1171        if (h==NULL) return NULL;
1172        P.p=h;
1173        P.t_p=NULL;
1174        P.SetShortExpVector();
1175#ifdef KDEBUG
1176        if (TEST_OPT_DEBUG)
1177        {
1178          PrintS("\nto:");
1179          wrp(h);
1180          PrintLn();
1181        }
1182#endif
1183      }
1184      else
1185      {
1186        kBucketClear(P.bucket,&(P.p),&len);
1187        kBucketDestroy(&P.bucket);
1188        pNormalize(P.p);
1189        return P.p;
1190      }
1191    }
1192}
1193
1194
1195static poly redTailShort(poly h, kStrategy strat){
1196
1197  int sl=strat->sl;
1198  int i;
1199  int len=pLength(h);
1200  for(i=0;i<=strat->sl;i++){
1201    if(strat->lenS[i]>2)
1202      break;
1203  }
1204  return(redNFTail(h,i-1,strat, len));
1205}
1206
1207static void line_of_extended_prod(int fixpos,calc_dat* c){
1208    if (c->gcd_of_terms[fixpos]==NULL)
1209  {
1210    c->gcd_of_terms[fixpos]=gcd_of_terms(c->S->m[fixpos],c->r);
1211    if (c->gcd_of_terms[fixpos])
1212    {
1213      int i;
1214      for(i=0;i<fixpos;i++)
1215        if((c->states[fixpos][i]!=HASTREP)&& (extended_product_criterion(c->S->m[fixpos],c->gcd_of_terms[fixpos], c->S->m[i],c->gcd_of_terms[i],c)))
1216{
1217          c->states[fixpos][i]=HASTREP;
1218          c->extended_product_crit++;
1219}     
1220      for(i=fixpos+1;i<c->n;i++)
1221        if((c->states[i][fixpos]!=HASTREP)&& (extended_product_criterion(c->S->m[fixpos],c->gcd_of_terms[fixpos], c->S->m[i],c->gcd_of_terms[i],c)))
1222        {        c->states[i][fixpos]=HASTREP;
1223        c->extended_product_crit++;
1224        }
1225    }
1226  }
1227}
1228static void c_S_element_changed_hook(int pos, calc_dat* c){
1229  length_one_crit(c,pos, c->lengths[pos]);
1230  line_of_extended_prod(pos,c);
1231}
1232
1233static void go_on (calc_dat* c){
1234  //set limit of 1000 for multireductions, at the moment for
1235  //programming reasons
1236  int i=0;
1237  red_object* buf=(red_object*) omalloc(100*sizeof(red_object));
1238  int curr_deg=-1;
1239  while(i<100){
1240    sorted_pair_node* s=top_pair(c);
1241    if (!s) break;
1242    if(curr_deg>=0){
1243      if (s->deg >curr_deg) break;
1244    }
1245
1246    else curr_deg=s->deg;
1247    quick_pop_pair(c);
1248    if(s->i>=0){
1249      //replace_pair(s->i,s->j,c);
1250    if(s->i==s->j) {
1251      free_sorted_pair_node(s,c->r);
1252      continue;
1253        }
1254    }
1255    poly h;
1256    if(s->i>=0)
1257      h=ksOldCreateSpoly(c->S->m[s->i], c->S->m[s->j], NULL, c->r);
1258    else
1259      h=s->lcm_of_lm;
1260    if(s->i>=0)
1261      now_t_rep(s->j,s->i,c);
1262    free_sorted_pair_node(s,c->r);
1263    if(!h) continue;
1264    int len=pLength(h);
1265    buf[i].p=h;
1266    buf[i].sev=pGetShortExpVector(h);
1267    buf[i].sum=NULL;
1268    buf[i].bucket = kBucketCreate(currRing);
1269    kBucketInit(buf[i].bucket,buf[i].p,len);
1270    i++;
1271  }
1272  c->normal_forms+=i;
1273  qsort(buf,i,sizeof(red_object),red_object_better_gen);
1274//    Print("\ncurr_deg:%i\n",curr_deg);
1275  Print("M[%i, ",i); 
1276  multi_reduction(buf, i, c);
1277  Print("%i]",i);
1278  int j;
1279 //  for(j=0;j<i;j++){
1280//     if(buf[j].p==NULL) PrintS("\n ZERO ALERT \n");
1281//     int z;
1282//      for(z=0;z<j;z++){
1283//       if (pLmEqual(buf[z].p, buf[j].p))
1284//      PrintS("\n Critical Warning!!!! \n");
1285     
1286//     }
1287//   }
1288  int* ibuf=(int*) omalloc(i*sizeof(int));
1289  sorted_pair_node*** sbuf=(sorted_pair_node***) omalloc(i*sizeof(sorted_pair_node**));
1290  for(j=0;j<i;j++){
1291 
1292 
1293    int len;
1294    poly p;
1295    kBucketClear(buf[j].bucket,&p, &len);
1296    kBucketDestroy(&buf[j].bucket);
1297    // delete buf[j];
1298    //remember to free res here
1299    p=redTailShort(p, c->strat);
1300    sbuf[j]=add_to_basis(p,-1,-1,c,ibuf+j);
1301   
1302  }
1303  int sum=0;
1304  for(j=0;j<i;j++){
1305    sum+=ibuf[j];
1306  }
1307  sorted_pair_node** big_sbuf=(sorted_pair_node**) omalloc(sum*sizeof(sorted_pair_node*));
1308  int partsum=0;
1309  for(j=0;j<i;j++){
1310    memmove(big_sbuf+partsum, sbuf[j],ibuf[j]*sizeof(sorted_pair_node*));
1311    omfree(sbuf[j]);
1312    partsum+=ibuf[j];
1313  }
1314
1315  qsort(big_sbuf,sum,sizeof(sorted_pair_node*),pair_better_gen2);
1316  c->apairs=merge(c->apairs,c->pair_top+1,big_sbuf,sum,c);
1317  c->pair_top+=sum;
1318  clean_top_of_pair_list(c);
1319  omfree(big_sbuf);
1320  omfree(sbuf);
1321  omfree(ibuf);
1322  omfree(buf);
1323  return;
1324}
1325
1326static poly redNF (poly h,kStrategy strat, int &len)
1327{
1328  len=0;
1329  if (h==NULL) return NULL;
1330  int j;
1331
1332  len=pLength(h);
1333  if (0 > strat->sl)
1334  {
1335    return h;
1336  }
1337  LObject P(h);
1338  P.SetShortExpVector();
1339  P.bucket = kBucketCreate(currRing);
1340  kBucketInit(P.bucket,P.p,len /*pLength(P.p)*/);
1341  //int max_pos=simple_posInS(strat,P.p);
1342  loop
1343    {
1344      j=kFindDivisibleByInS(strat->S,strat->sevS,strat->sl,&P);
1345      if (j>=0)
1346      {
1347        nNormalize(pGetCoeff(P.p));
1348#ifdef KDEBUG
1349        if (TEST_OPT_DEBUG)
1350        {
1351          PrintS("red:");
1352          wrp(h);
1353          PrintS(" with ");
1354          wrp(strat->S[j]);
1355        }
1356#endif
1357        number coef=kBucketPolyRed(P.bucket,strat->S[j],
1358                                   strat->lenS[j]/*pLength(strat->S[j])*/,
1359                                   strat->kNoether);
1360        nDelete(&coef);
1361        h = kBucketGetLm(P.bucket);
1362        if (h==NULL) return NULL;
1363        P.p=h;
1364        P.t_p=NULL;
1365        P.SetShortExpVector();
1366#ifdef KDEBUG
1367        if (TEST_OPT_DEBUG)
1368        {
1369          PrintS("\nto:");
1370          wrp(h);
1371          PrintLn();
1372        }
1373#endif
1374      }
1375      else
1376      {
1377        kBucketClear(P.bucket,&(P.p),&len);
1378        kBucketDestroy(&P.bucket);
1379        pNormalize(P.p);
1380        return P.p;
1381      }
1382    }
1383}
1384#endif
1385#ifdef REDTAIL_S
1386
1387static poly redNFTail (poly h,const int sl,kStrategy strat, int len)
1388{
1389  if (h==NULL) return NULL;
1390  pTest(h);
1391  if (0 > sl)
1392    return h;
1393  if (pNext(h)==NULL) return h;
1394
1395  int j;
1396  poly res=h;
1397  poly act=res;
1398  LObject P(pNext(h));
1399  pNext(res)=NULL;
1400  P.bucket = kBucketCreate(currRing);
1401  len--;
1402  h=P.p;
1403  if (len <=0) len=pLength(h);
1404  kBucketInit(P.bucket,h /*P.p*/,len /*pLength(P.p)*/);
1405  pTest(h);
1406  loop
1407    {
1408      P.p=h;
1409      P.t_p=NULL;
1410      P.SetShortExpVector();
1411      loop
1412        {
1413          j=kFindDivisibleByInS(strat->S,strat->sevS,sl,&P);
1414          if (j>=0)
1415          {
1416#ifdef REDTAIL_PROT
1417            PrintS("r");
1418#endif
1419            nNormalize(pGetCoeff(P.p));
1420#ifdef KDEBUG
1421            if (TEST_OPT_DEBUG)
1422            {
1423              PrintS("red tail:");
1424              wrp(h);
1425              PrintS(" with ");
1426              wrp(strat->S[j]);
1427            }
1428#endif
1429            number coef;
1430            pTest(strat->S[j]);
1431            coef=kBucketPolyRed(P.bucket,strat->S[j],
1432                                strat->lenS[j]/*pLength(strat->S[j])*/,strat->kNoether);
1433            pMult_nn(res,coef);
1434            nDelete(&coef);
1435            h = kBucketGetLm(P.bucket);
1436            pTest(h);
1437            if (h==NULL)
1438            {
1439#ifdef REDTAIL_PROT
1440              PrintS(" ");
1441#endif
1442              return res;
1443            }
1444            pTest(h);
1445            P.p=h;
1446            P.t_p=NULL;
1447            P.SetShortExpVector();
1448#ifdef KDEBUG
1449            if (TEST_OPT_DEBUG)
1450            {
1451              PrintS("\nto tail:");
1452              wrp(h);
1453              PrintLn();
1454            }
1455#endif
1456          }
1457          else
1458          {
1459#ifdef REDTAIL_PROT
1460            PrintS("n");
1461#endif
1462            break;
1463          }
1464        } /* end loop current mon */
1465      poly tmp=pHead(h /*kBucketGetLm(P.bucket)*/);
1466      act->next=tmp;pIter(act);
1467      poly tmp2=pHead(h);
1468      pNeg(tmp2);
1469      int ltmp2=1;
1470      pTest(tmp2);
1471      kBucket_Add_q(P.bucket, tmp2, &ltmp2);
1472
1473      h = kBucketGetLm(P.bucket);
1474      if (h==NULL)
1475      {
1476#ifdef REDTAIL_PROT
1477        PrintS(" ");
1478#endif
1479        return res;
1480      }
1481      pTest(h);
1482    }
1483}
1484#endif
1485
1486static void do_this_spoly_stuff(int i,int j,calc_dat* c){
1487  poly f=c->S->m[i];
1488  poly g=c->S->m[j];
1489  poly h=ksOldCreateSpoly(f, g, NULL, c->r);
1490  poly hr=NULL;
1491#ifdef FULLREDUCTIONS
1492  if (h!=NULL)
1493  {
1494    int len;
1495
1496    hr=redNF2(h,c,len);
1497//      hr=redNF(h,c->strat,len);
1498
1499    if (hr!=NULL)
1500#ifdef REDTAIL_S
1501      hr = redNFTail(hr,c->strat->sl,c->strat,len);
1502#else
1503    hr = redtailBba(hr,c->strat->sl,c->strat);
1504#endif
1505
1506  }
1507#else
1508  if (h!=NULL)
1509  {
1510    int len;
1511    hr=redNF2(h,c,len);
1512  }
1513#endif
1514  c->normal_forms++;
1515  if (hr==NULL)
1516  {
1517    notice_miss(i, j, c);
1518
1519  }
1520  else
1521  {
1522
1523#ifdef HEAD_BIN
1524    hr=p_MoveHead(hr,c->HeadBin);
1525#endif
1526    add_to_basis(hr, i,j,c);
1527  }
1528}
1529//try to fill, return FALSE iff queue is empty
1530
1531static int poly_crit(const void* ap1, const void* ap2){
1532  poly p1,p2;
1533  p1=*((poly*) ap1);
1534  p2=*((poly*)ap2);
1535
1536  int c=pLmCmp(p1,p2);
1537  if (c !=0) return c;
1538  int l1=pLength(p1);
1539  int l2=pLength(p2);
1540  if (l1<l2) return -1;
1541  if (l1>l2) return 1;
1542  return 0;
1543}
1544ideal t_rep_gb(ring r,ideal arg_I){
1545   Print("Idelems %i \n----------\n",IDELEMS(arg_I));
1546  ideal I=idCompactify(arg_I);
1547  qsort(I->m,IDELEMS(I),sizeof(poly),poly_crit);
1548  Print("Idelems %i \n----------\n",IDELEMS(I));
1549  calc_dat* c=(calc_dat*) omalloc(sizeof(calc_dat));
1550  c->r=currRing;
1551
1552  initial_data(c,I);
1553
1554  while(c->pair_top>=0)
1555    go_on(c);
1556
1557  for(int z=0;z<c->n;z++){
1558    omfree(c->states[z]);
1559  }
1560  omfree(c->states);
1561  omfree(c->lengths);
1562
1563
1564  omfree(c->short_Exps);
1565  omfree(c->T_deg);
1566  int i;
1567  for(i=0;i<c->n;i++){
1568    if(c->gcd_of_terms[i])
1569      pDelete(&(c->gcd_of_terms[i]));
1570  }
1571  omfree(c->gcd_of_terms);
1572
1573  omfree(c->apairs);
1574  printf("calculated %d NFs\n",c->normal_forms);
1575  printf("applied %i product crit, %i extended_product crit \n", c->easy_product_crit, c->extended_product_crit);
1576  int deleted_form_c_s=0;
1577
1578  for(i=0;i<c->n;i++){
1579    if (c->rep[i]!=i){
1580      for(int j=0;j<=c->strat->sl;j++){
1581        if(c->strat->S[j]==c->S->m[i]){
1582          c->strat->S[j]=NULL;
1583          break;
1584        }
1585      }
1586      PrintS("R_delete");
1587      pDelete(&c->S->m[i]);
1588    }
1589  }
1590  for(i=0;i<=c->strat->sl;i++){
1591    if (!c->strat->S[i]) continue;
1592    BOOLEAN found=FALSE;
1593    for(int j=0;j<c->n;j++){
1594      if (c->S->m[j]==c->strat->S[i]){
1595        found=TRUE;
1596        break;
1597      }
1598    }
1599    if(!found) pDelete(&c->strat->S[i]);
1600  }
1601  omfree(c->rep);
1602    I=c->S;
1603  IDELEMS(I)=c->n;
1604
1605  idSkipZeroes(c->S);
1606 
1607
1608  omfree(c);
1609
1610  return(I);
1611}
1612static void now_t_rep(const int & arg_i, const int & arg_j, calc_dat* c){
1613  int i,j;
1614  if (arg_i==arg_j){
1615    return;
1616  }
1617  if (arg_i>arg_j){
1618    i=arg_j;
1619    j=arg_i;
1620  } else {
1621    i=arg_i;
1622    j=arg_j;
1623  }
1624  c->states[j][i]=HASTREP;
1625}
1626static void soon_t_rep(const int& arg_i, const int& arg_j, calc_dat* c)
1627{
1628  assume(0<=arg_i);
1629  assume(0<=arg_j);
1630  assume(arg_i<c->n);
1631  assume(arg_j<c->n);
1632  int i,j;
1633  if (arg_i==arg_j){
1634    return;
1635  }
1636  if (arg_i>arg_j){
1637    i=arg_j;
1638    j=arg_i;
1639  } else {
1640    i=arg_i;
1641    j=arg_j;
1642  }
1643  if (!
1644      (c->states[j][i]==HASTREP))
1645    c->states[j][i]=SOONTREP;
1646}
1647static BOOLEAN has_t_rep(const int & arg_i, const  int & arg_j, calc_dat* state){
1648  assume(0<=arg_i);
1649  assume(0<=arg_j);
1650  assume(arg_i<state->n);
1651  assume(arg_j<state->n);
1652  if (arg_i==arg_j)
1653  {
1654    return (TRUE);
1655  }
1656  if (arg_i>arg_j)
1657  {
1658    return (state->states[arg_i][arg_j]==HASTREP);
1659  } else
1660  {
1661    return (state->states[arg_j][arg_i]==HASTREP);
1662  }
1663}
1664static int pLcmDeg(poly a, poly b)
1665{
1666  int i;
1667  int n=0;
1668  for (i=pVariables; i; i--)
1669  {
1670    n+=max( pGetExp(a,i), pGetExp(b,i));
1671  }
1672  return n;
1673
1674}
1675
1676
1677
1678static void shorten_tails(calc_dat* c, poly monom)
1679{
1680  return;
1681// BOOLEAN corr=lenS_correct(c->strat);
1682  for(int i=0;i<c->n;i++)
1683  {
1684    //enter tail
1685    if (c->rep[i]!=i) continue;
1686    if (c->S->m[i]==NULL) continue;
1687    poly tail=c->S->m[i]->next;
1688    poly prev=c->S->m[i];
1689    BOOLEAN did_something=FALSE;
1690    while((tail!=NULL)&& (pLmCmp(tail, monom)>=0))
1691    {
1692      if (p_LmDivisibleBy(monom,tail,c->r))
1693      {
1694        did_something=TRUE;
1695        prev->next=tail->next;
1696        tail->next=NULL;
1697        p_Delete(& tail,c->r);
1698        tail=prev;
1699        //PrintS("Shortened");
1700        c->lengths[i]--;
1701      }
1702      prev=tail;
1703      tail=tail->next;
1704    }
1705    if (did_something)
1706    {
1707      int new_pos;
1708      if (c->is_char0) 
1709        simple_posInS(c->strat,c->S->m[i],pSLength(c->S->m[i],c->lengths[i]),c->is_char0);
1710      else     
1711        simple_posInS(c->strat,c->S->m[i],c->lengths[i],c->is_char0);
1712      int old_pos=-1;
1713      //assume new_pos<old_pos
1714      for (int z=0;z<=c->strat->sl;z++)
1715      {
1716        if (c->strat->S[z]==c->S->m[i])
1717        {
1718          old_pos=z;
1719          break;
1720        }
1721      }
1722      if (old_pos== -1)
1723        for (int z=new_pos-1;z>=0;z--)
1724        {
1725          if (c->strat->S[z]==c->S->m[i])
1726          {
1727            old_pos=z;
1728            break;
1729          }
1730        }
1731      assume(old_pos>=0);
1732      assume(new_pos<=old_pos);
1733      assume(pLength(c->strat->S[old_pos])==c->lengths[i]);
1734      c->strat->lenS[old_pos]=c->lengths[i];
1735      if (c->strat->lenSw)
1736        c->strat->lenSw[old_pos]=pSLength(c->S->m[i],c->lengths[i]);
1737
1738      if (new_pos<old_pos)
1739        move_forward_in_S(old_pos,new_pos,c->strat, c->is_char0);
1740
1741      length_one_crit(c,i,c->lengths[i]);
1742    }
1743  }
1744}
1745static sorted_pair_node* pop_pair(calc_dat* c){
1746  clean_top_of_pair_list(c);
1747
1748  if(c->pair_top<0) return NULL;
1749  else return (c->apairs[c->pair_top--]);
1750}
1751static sorted_pair_node* top_pair(calc_dat* c){
1752  super_clean_top_of_pair_list(c);//yeah, I know, it's odd that I use a different proc here
1753
1754  if(c->pair_top<0) return NULL;
1755  else return (c->apairs[c->pair_top]);
1756}
1757static sorted_pair_node* quick_pop_pair(calc_dat* c){
1758  if(c->pair_top<0) return NULL;
1759  else return (c->apairs[c->pair_top--]);
1760}
1761static BOOLEAN no_pairs(calc_dat* c){
1762  clean_top_of_pair_list(c);
1763  return (c->pair_top==-1);
1764}
1765
1766
1767static void super_clean_top_of_pair_list(calc_dat* c){
1768  while((c->pair_top>=0) && (c->apairs[c->pair_top]->i>=0) && (good_has_t_rep(c->apairs[c->pair_top]->j, c->apairs[c->pair_top]->i,c))){
1769
1770    free_sorted_pair_node(c->apairs[c->pair_top],c->r);
1771    c->pair_top--;
1772
1773  }
1774}
1775static void clean_top_of_pair_list(calc_dat* c){
1776  while((c->pair_top>0) && (c->apairs[c->pair_top]->i>=0) && (!state_is(UNCALCULATED,c->apairs[c->pair_top]->j, c->apairs[c->pair_top]->i,c))){
1777
1778    free_sorted_pair_node(c->apairs[c->pair_top],c->r);
1779    c->pair_top--;
1780
1781  }
1782}
1783static BOOLEAN state_is(calc_state state, const int & arg_i, const  int & arg_j, calc_dat* c){
1784  assume(0<=arg_i);
1785  assume(0<=arg_j);
1786  assume(arg_i<c->n);
1787  assume(arg_j<c->n);
1788  if (arg_i==arg_j)
1789  {
1790    return (TRUE);
1791  }
1792  if (arg_i>arg_j)
1793  {
1794    return (c->states[arg_i][arg_j]==state);
1795  }
1796  else return(c->states[arg_j][arg_i]==state);
1797}
1798static void free_sorted_pair_node(sorted_pair_node* s, ring r){
1799  if (s->i>=0)
1800    p_Delete(&s->lcm_of_lm,r);
1801  omfree(s);
1802}
1803static BOOLEAN pair_better(sorted_pair_node* a,sorted_pair_node* b, calc_dat* c){
1804  if (a->deg<b->deg) return TRUE;
1805  if (a->deg>b->deg) return FALSE;
1806
1807  if (a->expected_length<b->expected_length) return TRUE;
1808  if (a->expected_length>b->expected_length) return FALSE;
1809  int comp=pLmCmp(a->lcm_of_lm, b->lcm_of_lm);
1810  if (comp==1) return FALSE;
1811  if (-1==comp) return TRUE;
1812  if (a->i<b->i) return TRUE;
1813  if (a->j<b->j) return TRUE;
1814  return FALSE;
1815}
1816
1817static int pair_better_gen(const void* ap,const void* bp){
1818
1819  sorted_pair_node* a=*((sorted_pair_node**)ap);
1820  sorted_pair_node* b=*((sorted_pair_node**)bp);
1821  assume(a->i>a->j);
1822  assume(b->i>b->j);
1823  if (a->deg<b->deg) return -1;
1824  if (a->deg>b->deg) return 1;
1825
1826
1827  if (a->expected_length<b->expected_length) return -1;
1828  if (a->expected_length>b->expected_length) return 1;
1829 int comp=pLmCmp(a->lcm_of_lm, b->lcm_of_lm);
1830 
1831  if (comp==1) return 1;
1832  if (-1==comp) return -1;
1833  if (a->i<b->i) return -1;
1834  if (a->j<b->j) return -1;
1835  return 0;
1836}
1837
1838
1839static poly gcd_of_terms(poly p, ring r){
1840  int max_g_0=0;
1841  assume(p!=NULL);
1842  int i;
1843  poly m=pOne();
1844  poly t;
1845  for (i=pVariables; i; i--)
1846  {
1847      pSetExp(m,i, pGetExp(p,i));
1848      if (max_g_0==0)
1849        if (pGetExp(m,i)>0)
1850          max_g_0=i;
1851  }
1852 
1853  t=p->next;
1854  while (t!=NULL){
1855   
1856    if (max_g_0==0) break;
1857    for (i=pVariables; i; i--)
1858    {
1859      pSetExp(m,i, min(pGetExp(t,i),pGetExp(m,i)));
1860      if (max_g_0==i)
1861        if (pGetExp(m,i)==0)
1862          max_g_0=0;
1863      if ((max_g_0==0) && (pGetExp(m,i)>0)){
1864        max_g_0=i;
1865      }
1866    }
1867                t=t->next;
1868  }
1869        for (i=pVariables;i;i--)
1870        {
1871                if(pGetExp(m,i)>0)
1872                        return m;
1873  }
1874        pDelete(&m);
1875  return NULL;
1876}
1877static BOOLEAN pHasNotCFExtended(poly p1, poly p2, poly m)
1878{
1879
1880  if (pGetComp(p1) > 0 || pGetComp(p2) > 0)
1881    return FALSE;
1882  int i = 1;
1883  loop
1884  {
1885    if ((pGetExp(p1, i)-pGetExp(m,i) >0) && (pGetExp(p2, i) -pGetExp(m,i)> 0))   return FALSE;
1886    if (i == pVariables)                                return TRUE;
1887    i++;
1888  }
1889}
1890
1891
1892//for impl reasons may return false if the the normal product criterion matches
1893static BOOLEAN extended_product_criterion(poly p1, poly gcd1, poly p2, poly gcd2, calc_dat* c){
1894  if(gcd1==NULL) return FALSE;
1895        if(gcd2==NULL) return FALSE;
1896        gcd1->next=gcd2; //may ordered incorrect
1897        poly m=gcd_of_terms(gcd1,c->r);
1898        gcd1->next=NULL;
1899        if (m==NULL) return FALSE;
1900
1901        BOOLEAN erg=pHasNotCFExtended(p1,p2,m);
1902        pDelete(&m);
1903        return erg;
1904}
1905static poly kBucketGcd(kBucket* b, ring r)
1906{
1907  int s=0;
1908  int i;
1909  poly m, n;
1910  BOOLEAN initialized=FALSE;
1911  for (i=MAX_BUCKET-1;i>=0;i--)
1912  { 
1913    if (b->buckets[i]!=NULL){
1914      if (!initialized){
1915        m=gcd_of_terms(b->buckets[i],r);
1916        initialized=TRUE;
1917        if (m==NULL) return NULL;
1918      }
1919      else
1920        {
1921          n=gcd_of_terms(b->buckets[i],r);
1922          if (n==NULL) {
1923            pDelete(&m);
1924            return NULL;   
1925          }
1926          n->next=m;
1927          poly t=gcd_of_terms(n,r);
1928          n->next=NULL;
1929          pDelete(&m);
1930          pDelete(&n);
1931          m=t;
1932          if (m==NULL) return NULL;
1933         
1934        }
1935    }
1936  }
1937  return m;
1938}
1939
1940
1941struct find_erg{
1942  poly expand;
1943  int expand_length;
1944  int to_reduce_u;
1945  int to_reduce_l;
1946  int reduce_by;//index of reductor
1947  BOOLEAN fromS;//else from los
1948
1949};
1950static int guess_quality(const red_object & p, calc_dat* c){
1951  //looks only on bucket
1952  if (c->is_char0) return kSBucketLength(p.bucket);
1953  return (bucket_guess(p.bucket));
1954}
1955static int quality_of_pos_in_strat_S(int pos, calc_dat* c){
1956  if (c->is_char0) return c->strat->lenSw[pos];
1957  return c->strat->lenS[pos];
1958}
1959static int quality(poly p, int len, calc_dat* c){
1960  if (c->is_char0) return pSLength(p,len);
1961  return pLength(p);
1962}
1963static void multi_reduction_lls_trick(red_object* los, int losl,calc_dat* c,find_erg & erg){
1964  erg.expand=NULL;
1965  BOOLEAN swap_roles; //from reduce_by, to_reduce_u if fromS
1966  if(erg.fromS){
1967    if(pLmEqual(c->strat->S[erg.reduce_by],los[erg.to_reduce_u].p))
1968    {
1969      int i;
1970      int quality_a=quality_of_pos_in_strat_S(erg.reduce_by,c);
1971      int best=erg.to_reduce_u+1;
1972      for (i=erg.to_reduce_u;i>=erg.to_reduce_l;i--){
1973        int qc=guess_quality(los[i],c);
1974        if (qc<quality_a){
1975          best=i;
1976          quality_a=qc;
1977        }
1978      }
1979      if(best!=erg.to_reduce_u+1){
1980        red_object h=los[erg.to_reduce_u];
1981        los[erg.to_reduce_u]=los[best];
1982        los[best]=h;
1983        swap_roles=TRUE;
1984      }
1985      else{
1986       
1987        swap_roles=FALSE;
1988      }
1989 
1990    }
1991      else
1992    {
1993      if (erg.to_reduce_u>erg.to_reduce_l){
1994
1995        int i;
1996        int quality_a=quality_of_pos_in_strat_S(erg.reduce_by,c);
1997        int best=erg.to_reduce_u+1;
1998        for (i=erg.to_reduce_u;i>=erg.to_reduce_l;i--){
1999          int qc=guess_quality(los[i],c);
2000          if (qc<quality_a){
2001            best=i;
2002            quality_a=qc;
2003          }
2004        }
2005        if(best!=erg.to_reduce_u+1){
2006          red_object h=los[erg.to_reduce_l];
2007          los[erg.to_reduce_l]=los[best];
2008          los[best]=h;
2009          erg.reduce_by=erg.to_reduce_l;
2010          erg.fromS=FALSE;
2011          erg.to_reduce_l++;
2012         
2013        }
2014      }
2015      else 
2016      {
2017        assume(erg.to_reduce_u==erg.to_reduce_l);
2018        int quality_a=quality_of_pos_in_strat_S(erg.reduce_by,c);
2019        int qc=guess_quality(los[erg.to_reduce_u],c);
2020        if(qc<quality_a){
2021          BOOLEAN exp=FALSE;
2022          if(qc<=2)
2023            exp=TRUE;
2024          else {
2025            if (qc<quality_a/2)
2026              exp=TRUE;
2027            else
2028              if(erg.reduce_by<c->n/4)
2029                exp=TRUE;
2030          }
2031          if (exp){
2032            poly clear_into;
2033           
2034            kBucketClear(los[erg.to_reduce_u].bucket,&clear_into,&erg.expand_length);
2035            erg.expand=pCopy(clear_into);
2036            kBucketInit(los[erg.to_reduce_u].bucket,clear_into,erg.expand_length);
2037            PrintS("e");
2038           
2039          }
2040        }
2041
2042       
2043      }
2044     
2045      swap_roles=FALSE;
2046      return;
2047      }
2048   
2049  }
2050  else{
2051    if(erg.reduce_by>erg.to_reduce_u){
2052      //then lm(rb)>= lm(tru) so =
2053      assume(erg.reduce_by==erg.to_reduce_u+1);
2054      int best=erg.reduce_by;
2055      int quality_a=guess_quality(los[erg.reduce_by],c);
2056      int i;
2057        for (i=erg.to_reduce_u;i>=erg.to_reduce_l;i--){
2058          int qc=guess_quality(los[i],c);
2059          if (qc<quality_a){
2060            best=i;
2061            quality_a=qc;
2062          }
2063        }
2064        if(best!=erg.reduce_by){
2065          red_object h=los[erg.reduce_by];
2066          los[erg.reduce_by]=los[best];
2067          los[best]=h;
2068        }
2069        swap_roles=FALSE;
2070        return;
2071       
2072         
2073    }
2074    else
2075    {
2076      assume(!pLmEqual(los[erg.reduce_by].p,los[erg.to_reduce_l].p));
2077      //further assume, that reduce_by is the above all other polys
2078      //with same leading term
2079      int il=erg.reduce_by;
2080      int quality_a =guess_quality(los[erg.reduce_by],c);
2081      int qc;
2082      while((il>0) && pLmEqual(los[il-1].p,los[il].p)){
2083        il--;
2084        qc=guess_quality(los[il],c);
2085        if (qc<quality_a){
2086          quality_a=qc;
2087          erg.reduce_by=il;
2088        }
2089      }
2090      swap_roles=FALSE;
2091    }
2092 
2093  }
2094  if(swap_roles){
2095    PrintS("b");
2096    poly clear_into;
2097    int dummy_len;
2098    int new_length;
2099    int bp=erg.to_reduce_u;//bucket_positon
2100    kBucketClear(los[bp].bucket,&clear_into,&new_length);
2101    poly p=c->strat->S[erg.reduce_by];
2102    int j=erg.reduce_by;
2103    int old_length=c->strat->lenS[j];// in view of S
2104    los[bp].p=p;
2105    kBucketInit(los[bp].bucket,p,old_length);
2106    int qal=quality(clear_into,new_length,c);
2107    int pos_in_c=-1;   
2108    int z;
2109    int new_pos;
2110    new_pos=simple_posInS(c->strat,clear_into,qal,c->is_char0);
2111    assume(new_pos<=j);
2112    for (z=c->n;z;z--)
2113    {
2114      if(p==c->S->m[z-1])
2115      {
2116        pos_in_c=z-1;
2117        break;
2118      }
2119    }
2120    if(pos_in_c>=0)
2121    {
2122      c->S->m[pos_in_c]=clear_into;
2123      c->lengths[pos_in_c]=new_length;
2124      c_S_element_changed_hook(pos_in_c,c);
2125    }
2126    c->strat->S[j]=clear_into;
2127    c->strat->lenS[j]=new_length;
2128    if(c->strat->lenSw)
2129      c->strat->lenS[j]=qal;
2130    if(c->is_char0)
2131    {
2132      pContent(clear_into);
2133      pCleardenom(clear_into);
2134    }
2135  else                     
2136    pNorm(clear_into);
2137    if (new_pos<j){
2138      move_forward_in_S(j,new_pos,c->strat,c->is_char0);
2139      erg.reduce_by=new_pos;
2140    }
2141  }
2142}
2143static void multi_reduction_find(red_object* los, int losl,calc_dat* c,int startf,find_erg & erg){
2144  kStrategy strat=c->strat;
2145
2146  assume(startf<=losl);
2147  assume((startf==losl-1)||(pLmCmp(los[startf].p,los[startf+1].p)==-1));
2148  int i=startf;
2149 
2150  int j;
2151  while(i>=0){
2152    assume((i==losl-1)||(pLmCmp(los[i].p,los[i+1].p)<=0));
2153    j=kFindDivisibleByInS_easy(strat,los[i]);
2154    if(j>=0){
2155     
2156      erg.to_reduce_u=i;
2157      erg.reduce_by=j;
2158      erg.fromS=TRUE;
2159      int i2;
2160      for(i2=i-1;i2>=0;i2--){
2161        if(!pLmEqual(los[i].p,los[i2].p))
2162          break;
2163      }
2164      erg.to_reduce_l=i2+1;
2165      assume((i==losl-1)||(pLmCmp(los[i].p,los[i+1].p)==-1));
2166      return;
2167    }
2168    if (j<0){
2169     
2170      //not reduceable, try to use this for reducing higher terms
2171      int i2;
2172      i2=i;
2173      while((i2>0)&&(pLmEqual(los[i].p,los[i2-1].p)))
2174        i2--;
2175      if(i2!=i){
2176       
2177        erg.to_reduce_u=i-1;
2178        erg.to_reduce_l=i2;
2179        erg.reduce_by=i;
2180        erg.fromS=FALSE;
2181        assume((i==losl-1)||(pLmCmp(los[i].p,los[i+1].p)==-1));
2182        return;
2183      }
2184 
2185      for (i2=i+1;i2<losl;i2++){
2186        if (p_LmShortDivisibleBy(los[i].p,los[i].sev,los[i2].p,~los[i2].sev,
2187                                c->r)){
2188          int i3=i2;
2189          while((i3+1<losl) && (pLmEqual(los[i2].p, los[i3+1].p)))
2190            i3++;
2191          erg.to_reduce_u=i3;
2192          erg.to_reduce_l=i2;
2193          erg.reduce_by=i;
2194          erg.fromS=FALSE;
2195          assume((i==losl-1)||(pLmCmp(los[i].p,los[i+1].p)==-1));
2196          return;
2197        }
2198//      else {assume(!p_LmDivisibleBy(los[i].p, los[i2].p,c->r));}
2199      }
2200
2201      i--;
2202    }
2203  }
2204  erg.reduce_by=-1;//error code
2205  return;
2206}
2207
2208 //  nicht reduzierbare eintraege in ergebnisliste schreiben
2209//   nullen loeschen
2210//   while(finde_groessten leitterm reduzierbar(c,erg)){
2211 
2212static int multi_reduction_clear_zeroes(red_object* los, int  losl, int l, int u)
2213{
2214
2215
2216  int deleted=0;
2217  int  i=l;
2218  int last=-1;
2219  while(i<=u)
2220  {
2221   
2222    if(los[i].p==NULL){
2223      kBucketDestroy(&los[i].bucket);
2224//      delete los[i];//here we assume los are constructed with new
2225      //destroy resources, must be added here   
2226     if (last>=0)
2227     {
2228       memmove(los+(int)(last+1-deleted),los+(last+1),sizeof(red_object)*(i-1-last));
2229     }
2230     last=i;
2231     deleted++;
2232    }
2233    i++;
2234  }
2235  if((last>=0)&&(last!=losl-1))
2236      memmove(los+(int)(last+1-deleted),los+last+1,sizeof(red_object)*(losl-1-last));
2237  return deleted;
2238 
2239}
2240
2241static void sort_region_down(red_object* los, int l, int u, calc_dat* c)
2242{
2243  qsort(los+l,u-l+1,sizeof(red_object),red_object_better_gen);
2244  int i;
2245
2246  for(i=l;i<=u;i++)
2247  {
2248    BOOLEAN moved=FALSE;
2249    int j;
2250    for(j=i;j;j--)
2251    {
2252      if(pLmCmp(los[j].p,los[j-1].p)==-1){
2253        red_object h=los[j];
2254        los[j]=los[j-1];
2255        los[j-1]=h;
2256        moved=TRUE;
2257      }
2258      else break;
2259    }
2260    if(!moved) return;
2261  }
2262}
2263
2264//assume that los is ordered ascending by leading term, all non zero
2265static void multi_reduction(red_object* los, int & losl, calc_dat* c)
2266{
2267 
2268  //initialize;
2269  assume(c->strat->sl>=0);
2270  assume(losl>0);
2271  int i;
2272  for(i=0;i<losl;i++){
2273    los[i].sev=pGetShortExpVector(los[i].p);
2274//SetShortExpVector();
2275    los[i].p=kBucketGetLm(los[i].bucket);
2276  }
2277
2278  kStrategy strat=c->strat;
2279  int curr_pos=losl-1;
2280
2281
2282//  nicht reduzierbare einträge in ergebnisliste schreiben
2283  // nullen loeschen
2284  while(curr_pos>=0){
2285    find_erg erg;
2286    multi_reduction_find(los, losl,c,curr_pos,erg);//last argument should be curr_pos
2287   //  PrintS("\n erg:\n");
2288//     Print("upper:%i\n",erg.to_reduce_u);
2289//     Print("lower:%i\n",erg.to_reduce_l);
2290//     Print("reduce_by:%i\n",erg.reduce_by);
2291//     Print("fromS:%i\n",erg.fromS);
2292    if(erg.reduce_by<0) break;
2293    multi_reduction_lls_trick(los,losl,c,erg);
2294    //erweitern? muß noch implementiert werden
2295    int i;
2296    int len;
2297    poly reductor;
2298    if(erg.fromS){
2299      reductor=strat->S[erg.reduce_by];
2300      len=strat->lenS[erg.reduce_by];
2301     
2302    }
2303    else 
2304    {
2305      //bucket aufloesen reduzieren, neu füllen
2306     
2307   
2308      int bn=kBucketCanonicalize(los[erg.reduce_by].bucket);
2309      reductor=los[erg.reduce_by].bucket->buckets[bn];
2310      len=los[erg.reduce_by].bucket->buckets_length[bn];
2311      if(c->is_char0)
2312        pContent(reductor);
2313 
2314    }
2315    for(i=erg.to_reduce_l;i<=erg.to_reduce_u;i++)
2316    {
2317   
2318      assume((erg.fromS)||(i!=erg.reduce_by));
2319      assume(reductor!=NULL);
2320       number coef=kBucketPolyRed(los[i].bucket,reductor,
2321                                  len,
2322                                  strat->kNoether);
2323       nDelete(&coef);
2324       los[i].p = kBucketGetLm(los[i].bucket);
2325       if(los[i].p!=NULL)
2326         if((i>0)&&(los[i-1].p!=NULL)&&(pLmEqual(los[i-1].p,los[i].p)))
2327             los[i].sev=los[i-1].sev;
2328         else
2329           los[i].sev=pGetShortExpVector(los[i].p);
2330       //better would be first sorting before sev
2331    }
2332 
2333                 
2334    int deleted=multi_reduction_clear_zeroes(los, losl, erg.to_reduce_l, erg.to_reduce_u);
2335    curr_pos=erg.to_reduce_u;
2336    losl -= deleted;
2337    curr_pos -= deleted;
2338
2339    //Print("deleted %i \n",deleted);
2340    sort_region_down(los, erg.to_reduce_l, erg.to_reduce_u-deleted, c);
2341//   sort_region_down(los, 0, losl-1, c);
2342    //  qsort(los,losl,sizeof(red_object),red_object_better_gen);
2343    if(erg.expand)
2344      add_to_reductors(c,erg.expand,erg.expand_length);
2345  }
2346  return;
2347}
2348void red_object::flatten(){
2349  if (sum!=NULL)
2350  {
2351
2352 
2353    if(kBucketGetLm(sum->ac->bucket)!=NULL){
2354      number mult_my=n_Mult(sum->c_my,sum->ac->multiplied,currRing);
2355      poly add_this;
2356      if(!nIsOne(mult_my))
2357        kBucket_Mult_n(bucket,mult_my);
2358      int len;
2359      poly clear_into;
2360      kBucketClear(sum->ac->bucket,&clear_into,&len);
2361      if(sum->ac->counter>1){
2362        add_this=pCopy(clear_into);
2363        kBucketInit(bucket,clear_into,len);
2364      }
2365      else
2366        add_this=clear_into;
2367      pMult_nn(add_this, sum->c_ac);
2368      nDelete(&sum->c_ac);
2369      nDelete(&sum->c_my);
2370      nDelete(&mult_my);
2371      delete sum;
2372      kBucket_Add_q(bucket,add_this, &len);
2373      sum->ac->decrease_counter();
2374     
2375    }
2376  }
2377}
2378void red_object::validate(){
2379  if(sum!=NULL)
2380  {
2381    poly lm=kBucketGetLm(bucket);
2382    poly lm_ac=kBucketGetLm(sum->ac->bucket);
2383    if ((lm_ac==NULL)||((lm!=NULL) && (pLmCmp(lm,lm_ac)!=-1))){
2384      flatten();
2385      p=kBucketGetLm(bucket);
2386    } 
2387    else
2388    {
2389      p=lm_ac;
2390    }
2391   
2392  }
2393  else
2394    p=kBucketGetLm(bucket);
2395
2396}
Note: See TracBrowser for help on using the repository browser.