source: git/Singular/kbuckets.cc @ 6cf5e6

spielwiese
Last change on this file since 6cf5e6 was 5be1b7, checked in by Hans Schönemann <hannes@…>, 21 years ago
*hannes: coef buckets git-svn-id: file:///usr/local/Singular/svn/trunk@6553 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 18.9 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: kbuckets.cc,v 1.25 2003-03-03 15:24:28 Singular Exp $ */
5
6#include "mod2.h"
7#include "tok.h"
8#include "structs.h"
9#include "omalloc.h"
10#include "p_polys.h"
11#include "febase.h"
12#include "pShallowCopyDelete.h"
13#include "kbuckets.h"
14#include "numbers.h"
15#include "p_Procs.h"
16
17#ifdef HAVE_COEF_BUCKETS
18#define USE_COEF_BUCKETS
19#endif
20
21#ifdef USE_COEF_BUCKETS
22#define MULTIPLY_BUCKET(B,I) do                                        \
23  { if (B->coef[I]!=NULL)                                              \
24    {                                                                  \
25      B->buckets[I]=p_Mult_q(B->buckets[I],B->coef[I],B->bucket_ring); \
26      B->coef[I]=NULL;                                                 \
27    }                                                                  \
28  } while(0)
29#else
30#define MULTIPLY_BUCKET(B,I)
31#endif
32static omBin kBucket_bin = omGetSpecBin(sizeof(kBucket));
33
34//////////////////////////////////////////////////////////////////////////
35///
36/// Some internal stuff
37///
38
39// returns ceil(log_4(l))
40inline unsigned int pLogLength(unsigned int l)
41{
42  unsigned int i = 0;
43
44  if (l == 0) return 0;
45  l--;
46#ifdef BUCKET_TWO_BASE
47  while ((l = (l >> 1))) i++;
48#else
49  while ((l = (l >> 2))) i++;
50#endif
51  return i+1;
52}
53
54// returns ceil(log_4(pLength(p)))
55inline unsigned int pLogLength(poly p)
56{
57  return pLogLength((unsigned int) pLength(p));
58}
59
60#ifdef KDEBUG
61
62#ifndef HAVE_PSEUDO_BUCKETS
63BOOLEAN kbTest_i(kBucket_pt bucket, int i)
64{
65  #ifdef USE_COEF_BUCKETS
66  assume(bucket->coef[0]==NULL);
67  if ((bucket->coef[i]!=NULL) && (bucket->buckets[i]==NULL))
68  {
69    dReportError("Bucket %d coef not NULL", i);
70  }
71  if (bucket->coef[i]!=NULL)
72    _p_Test(bucket->coef[i],bucket->bucket_ring,PDEBUG);
73  #endif
74  pFalseReturn(p_Test(bucket->buckets[i], bucket->bucket_ring));
75  if (bucket->buckets_length[i] != pLength(bucket->buckets[i]))
76  {
77    dReportError("Bucket %d lengths difference should:%d has:%d",
78                 i, bucket->buckets_length[i], pLength(bucket->buckets[i]));
79  }
80  else if (i > 0 && (int) pLogLength(bucket->buckets_length[i]) > i)
81  {
82    dReportError("Bucket %d too long %d",
83                 i, bucket->buckets_length[i]);
84  }
85  if (i==0 && bucket->buckets_length[0] > 1)
86  {
87    dReportError("Bucket 0 too long");
88  }
89  return TRUE;
90}
91
92
93BOOLEAN kbTest(kBucket_pt bucket)
94{
95  int i;
96  poly lm = bucket->buckets[0];
97
98  omCheckAddrBin(bucket, kBucket_bin);
99  if (! kbTest_i(bucket, 0)) return FALSE;
100  for (i=1; i<= (int) bucket->buckets_used; i++)
101  {
102    if (!kbTest_i(bucket, i)) return FALSE;
103    if (lm != NULL &&  bucket->buckets[i] != NULL
104        && p_LmCmp(lm, bucket->buckets[i], bucket->bucket_ring) != 1)
105    {
106      dReportError("Bucket %d larger than lm", i);
107      return FALSE;
108    }
109    if (!p_Test(bucket->buckets[i],bucket->bucket_ring))
110    {
111      dReportError("Bucket %d is not =0(4)", i);
112      return FALSE;
113    }
114  }
115
116  for (; i<=MAX_BUCKET; i++)
117  {
118    if (bucket->buckets[i] != NULL || bucket->buckets_length[i] != 0)
119    {
120      dReportError("Bucket %d not zero", i);
121      return FALSE;
122    }
123  }
124  return TRUE;
125}
126
127#else // HAVE_PSEUDO_BUCKETS
128BOOLEAN kbTest(kBucket_pt bucket)
129{
130  return TRUE;
131}
132#endif // ! HAVE_PSEUDO_BUCKETS
133#endif // KDEBUG
134
135//////////////////////////////////////////////////////////////////////////
136///
137/// Creation/Destruction of buckets
138///
139
140kBucket_pt kBucketCreate(ring bucket_ring)
141{
142  assume(bucket_ring != NULL);
143  kBucket_pt bucket = (kBucket_pt) omAlloc0Bin(kBucket_bin);
144  bucket->bucket_ring = bucket_ring;
145  return bucket;
146}
147void kBucketDestroy(kBucket_pt *bucket_pt)
148{
149  omFreeBin(*bucket_pt, kBucket_bin);
150  *bucket_pt = NULL;
151}
152
153
154void kBucketDeleteAndDestroy(kBucket_pt *bucket_pt)
155{
156  kBucket_pt bucket = *bucket_pt;
157  kbTest(bucket);
158  int i;
159  for (i=0; i<= bucket->buckets_used; i++)
160  {
161    if (bucket->buckets[i] != NULL)
162    {
163      p_Delete(&(bucket->buckets[i]), bucket->bucket_ring);
164#ifdef USE_COEF_BUCKETS
165      if (bucket->coef[i]!=NULL)
166        p_Delete(&(bucket->coef[i]), bucket->bucket_ring);
167#endif
168    }
169  }
170  omFreeBin(bucket, kBucket_bin);
171  *bucket_pt = NULL;
172}
173
174/////////////////////////////////////////////////////////////////////////////
175// Convertion from/to Bpolys
176//
177#ifndef HAVE_PSEUDO_BUCKETS
178
179inline void kBucketMergeLm(kBucket_pt bucket)
180{
181  if (bucket->buckets[0] != NULL)
182  {
183    poly lm = bucket->buckets[0];
184    int i = 1;
185#ifdef BUCKET_TWO_BASE
186    int l = 2;
187    while ( bucket->buckets_length[i] >= l)
188    {
189      i++;
190      l = l << 1;
191    }
192#else
193    int l = 4;
194    while ( bucket->buckets_length[i] >= l)
195    {
196      i++;
197      l = l << 2;
198    }
199#endif
200    MULTIPLY_BUCKET(bucket,i);
201    pNext(lm) = bucket->buckets[i];
202    bucket->buckets[i] = lm;
203    bucket->buckets_length[i]++;
204    assume(i <= bucket->buckets_used+1);
205    if (i > bucket->buckets_used)  bucket->buckets_used = i;
206    bucket->buckets[0] = NULL;
207    bucket->buckets_length[0] = 0;
208  }
209}
210
211static BOOLEAN kBucketIsCleared(kBucket_pt bucket)
212{
213  int i;
214
215  for (i = 0;i<=MAX_BUCKET;i++)
216  {
217    if (bucket->buckets[i] != NULL) return FALSE;
218    if (bucket->buckets_length[i] != 0) return FALSE;
219  }
220  return TRUE;
221}
222
223void kBucketInit(kBucket_pt bucket, poly lm, int length)
224{
225  assume(bucket != NULL);
226  assume(length <= 0 || length == pLength(lm));
227  assume(kBucketIsCleared(bucket));
228
229  if (lm == NULL) return;
230
231  if (length <= 0)
232    length = pLength(lm);
233
234  bucket->buckets[0] = lm;
235  bucket->buckets_length[0] = 1;
236  if (length > 1)
237  {
238    unsigned int i = pLogLength(length-1);
239    bucket->buckets[i] = pNext(lm);
240    pNext(lm) = NULL;
241    bucket->buckets_length[i] = length-1;
242    bucket->buckets_used = i;
243  }
244  else
245  {
246    bucket->buckets_used = 0;
247  }
248}
249
250int kBucketCanonicalize(kBucket_pt bucket)
251{
252  kbTest(bucket);
253  poly p = bucket->buckets[1];
254  poly lm;
255  int pl = bucket->buckets_length[1], i;
256  bucket->buckets[1] = NULL;
257  bucket->buckets_length[1] = 0;
258  ring r=bucket->bucket_ring;
259
260
261  for (i=2; i<=bucket->buckets_used; i++)
262  {
263  #ifdef USE_COEF_BUCKETS
264    if (bucket->coef[i]!=NULL)
265    {
266      p = p_Plus_mm_Mult_qq(p, bucket->coef[i], bucket->buckets[i],
267                 pl, bucket->buckets_length[i], r);
268      p_Delete(&bucket->coef[i],r);
269      p_Delete(&bucket->buckets[i],r);
270    }
271    else
272    p = p_Add_q(p, bucket->buckets[i],
273                 pl, bucket->buckets_length[i], r);
274  #else
275    q = p_Add_q(q, bucket->buckets[i],
276                 pl, bucket->buckets_length[i], r);
277  #endif
278    bucket->buckets[i] = NULL;
279    bucket->buckets_length[i] = 0;
280  }
281
282  lm = bucket->buckets[0];
283  if (lm != NULL)
284  {
285    pNext(lm) = p;
286    p = lm;
287    pl++;
288    bucket->buckets[0] = NULL;
289    bucket->buckets_length[0] = 0;
290  }
291  if (pl > 0)
292  {
293    i = pLogLength(pl);
294    bucket->buckets[i] = p;
295    bucket->buckets_length[i] = pl;
296  }
297  else
298  {
299    i = 0;
300  }
301  bucket->buckets_used = i;
302  assume(pLength(p) == (int) pl);
303  kbTest(bucket);
304  return i;
305}
306
307void kBucketClear(kBucket_pt bucket, poly *p, int *length)
308{
309  int i = kBucketCanonicalize(bucket);
310  if (i > 0)
311  {
312    *p = bucket->buckets[i];
313    *length = bucket->buckets_length[i];
314    bucket->buckets[i] = NULL;
315    bucket->buckets_length[i] = 0;
316    bucket->buckets_used = 0;
317#ifdef USE_COEF_BUCKETS
318    bucket->coef[i]=NULL;
319#endif
320  }
321  else
322  {
323    *p = NULL;
324    *length = 0;
325  }
326}
327
328void kBucketSetLm(kBucket_pt bucket, poly lm)
329{
330  kBucketMergeLm(bucket);
331  pNext(lm) = NULL;
332  bucket->buckets[0] = lm;
333  bucket->buckets_length[0] = 1;
334}
335
336#else // HAVE_PSEUDO_BUCKETS
337
338void kBucketInit(kBucket_pt bucket, poly lm, int length)
339{
340  int i;
341
342  assume(bucket != NULL);
343  assume(length <= 0 || length == pLength(lm));
344
345  bucket->p = lm;
346  if (length <= 0) bucket->l = pLength(lm);
347  else bucket->l = length;
348
349}
350
351const poly kBucketGetLm(kBucket_pt bucket)
352{
353  return bucket->p;
354}
355
356poly kBucketExtractLm(kBucket_pt bucket)
357{
358  poly lm = bucket->p;
359  assume(pLength(bucket->p) == bucket->l);
360  pIter(bucket->p);
361  (bucket->l)--;
362  pNext(lm) = NULL;
363  return lm;
364}
365
366void kBucketClear(kBucket_pt bucket, poly *p, int *length)
367{
368  assume(pLength(bucket->p) == bucket->l);
369  *p = bucket->p;
370  *length = bucket->l;
371  bucket->p = NULL;
372  bucket->l = 0;
373}
374
375#endif // ! HAVE_PSEUDO_BUCKETS
376//////////////////////////////////////////////////////////////////////////
377///
378/// For changing the ring of the Bpoly to new_tailBin
379///
380void kBucketShallowCopyDelete(kBucket_pt bucket,
381                              ring new_tailRing, omBin new_tailBin,
382                              pShallowCopyDeleteProc p_shallow_copy_delete)
383{
384#ifndef HAVE_PSEUDO_BUCKETS
385  int i;
386
387  kBucketCanonicalize(bucket);
388  for (i=0; i<= bucket->buckets_used; i++)
389    if (bucket->buckets[i] != NULL)
390    {
391      MULTIPLY_BUCKET(bucket,i);
392      bucket->buckets[i] = p_shallow_copy_delete(bucket->buckets[i],
393                                                 bucket->bucket_ring,
394                                                 new_tailRing,
395                                                 new_tailBin);
396    }
397#else
398  bucket->p = p_shallow_copy_delete(p,
399                                    bucket_ring,
400                                    new_tailRing,
401                                    new_tailBin);
402#endif
403  bucket->bucket_ring = new_tailRing;
404}
405
406
407
408//////////////////////////////////////////////////////////////////////////
409///
410/// Multiply Bucket by number ,i.e. Bpoly == n*Bpoly
411///
412void kBucket_Mult_n(kBucket_pt bucket, number n)
413{
414#ifndef HAVE_PSEUDO_BUCKETS
415  kbTest(bucket);
416  ring r=bucket->bucket_ring;
417  int i;
418
419  for (i=0; i<= bucket->buckets_used; i++)
420  {
421    if (bucket->buckets[i] != NULL)
422    {
423#ifdef USE_COEF_BUCKETS
424      if (i<2)
425        bucket->buckets[i] = p_Mult_nn(bucket->buckets[i], n, r);
426      else
427      if (bucket->coef[i]!=NULL)
428      {
429        bucket->coef[i] = p_Mult_nn(bucket->coef[i],n,r);
430      }
431      else
432      {
433        bucket->coef[i] = p_NSet(n_Copy(n,bucket->bucket_ring),r);
434      }
435#else
436      bucket->buckets[i] = p_Mult_nn(bucket->buckets[i], n, r);
437#endif
438    }
439  }
440  kbTest(bucket);
441#else
442  bucket->p = p_Mult_nn(bucket->p, n, bucket->bucket_ring);
443#endif
444}
445
446
447//////////////////////////////////////////////////////////////////////////
448///
449/// Add to Bucket a poly ,i.e. Bpoly == n*Bpoly
450///
451void kBucket_Add_q(kBucket_pt bucket, poly q, int *l)
452{
453  if (q == NULL) return;
454  assume(*l <= 0 || pLength(q) == *l);
455
456  int i, l1;
457  ring r = bucket->bucket_ring;
458
459  if (*l <= 0)
460  {
461    l1 = pLength(q);
462    *l = l1;
463  }
464  else
465    l1 = *l;
466
467  kBucketMergeLm(bucket);
468  kbTest(bucket);
469  i = pLogLength(l1);
470
471  while (bucket->buckets[i] != NULL)
472  {
473    //MULTIPLY_BUCKET(bucket,i);
474  #ifdef USE_COEF_BUCKETS
475    if (bucket->coef[i]!=NULL)
476    {
477      q = p_Plus_mm_Mult_qq(q, bucket->coef[i], bucket->buckets[i],
478                 l1, bucket->buckets_length[i], r);
479      p_Delete(&bucket->coef[i],r);
480      p_Delete(&bucket->buckets[i],r);
481    }
482    else
483    q = p_Add_q(q, bucket->buckets[i],
484                 l1, bucket->buckets_length[i], r);
485  #else
486    q = p_Add_q(q, bucket->buckets[i],
487                 l1, bucket->buckets_length[i], r);
488  #endif
489    bucket->buckets[i] = NULL;
490    bucket->buckets_length[i] = 0;
491    i = pLogLength(l1);
492  }
493
494  bucket->buckets[i] = q;
495  bucket->buckets_length[i]=l1;
496  if (i >= bucket->buckets_used)
497    bucket->buckets_used = i;
498  else
499    kBucketAdjustBucketsUsed(bucket);
500  kbTest(bucket);
501}
502
503
504
505//////////////////////////////////////////////////////////////////////////
506///
507/// Bpoly == Bpoly - m*p; where m is a monom
508/// Does not destroy p and m
509/// assume (*l <= 0 || pLength(p) == *l)
510void kBucket_Minus_m_Mult_p(kBucket_pt bucket, poly m, poly p, int *l,
511                            poly spNoether)
512{
513  assume(*l <= 0 || pLength(p) == *l);
514  int i, l1;
515  poly p1 = p;
516  poly last;
517  ring r = bucket->bucket_ring;
518
519  if (*l <= 0)
520  {
521    l1 = pLength(p1);
522    *l = l1;
523  }
524  else
525    l1 = *l;
526
527  if (m == NULL || p == NULL) return;
528
529#ifndef HAVE_PSEUDO_BUCKETS
530  kBucketMergeLm(bucket);
531  kbTest(bucket);
532  i = pLogLength(l1);
533
534  if ((i <= bucket->buckets_used) && (bucket->buckets[i] != NULL))
535  {
536    assume(pLength(bucket->buckets[i])==bucket->buckets_length[i]);
537//#ifdef USE_COEF_BUCKETS
538//     if(bucket->coef[i]!=NULL)
539//     {
540//       poly mult=p_Mult_mm(bucket->coef[i],m,r);
541//       bucket->coef[i]=NULL;
542//       p1 = p_Minus_mm_Mult_qq(bucket->buckets[i], mult, p1,
543//                               bucket->buckets_length[i], l1,
544//                             spNoether, r);
545//     }
546//     else
547//#endif
548    MULTIPLY_BUCKET(bucket,i);
549    p1 = p_Minus_mm_Mult_qq(bucket->buckets[i], m, p1,
550                            bucket->buckets_length[i], l1,
551                            spNoether, r);
552    l1 = bucket->buckets_length[i];
553    bucket->buckets[i] = NULL;
554    bucket->buckets_length[i] = 0;
555    i = pLogLength(l1);
556  }
557  else
558  {
559    pSetCoeff0(m, nNeg(pGetCoeff(m)));
560    if (spNoether != NULL)
561    {
562      l1 = -1;
563      p1 = r->p_Procs->pp_Mult_mm_Noether(p1, m, spNoether, l1, r, last);
564      i = pLogLength(l1);
565    }
566    else
567      p1 = r->p_Procs->pp_Mult_mm(p1, m, r, last);
568    pSetCoeff0(m, nNeg(pGetCoeff(m)));
569  }
570
571  while (bucket->buckets[i] != NULL)
572  {
573    //kbTest(bucket);
574    MULTIPLY_BUCKET(bucket,i);
575    p1 = p_Add_q(p1, bucket->buckets[i],
576                 l1, bucket->buckets_length[i], r);
577    bucket->buckets[i] = NULL;
578    bucket->buckets_length[i] = 0;
579    i = pLogLength(l1);
580  }
581
582  bucket->buckets[i] = p1;
583  bucket->buckets_length[i]=l1;
584  if (i >= bucket->buckets_used)
585    bucket->buckets_used = i;
586  else
587    kBucketAdjustBucketsUsed(bucket);
588#else // HAVE_PSEUDO_BUCKETS
589  bucket->p = p_Minus_mm_Mult_qq(bucket->p, m,  p,
590                               bucket->l, l1,
591                               spNoether, r);
592#endif
593}
594
595//////////////////////////////////////////////////////////////////////////
596///
597/// Bpoly == Bpoly + m*p; where m is a monom
598/// Does not destroy p and m
599/// assume (l <= 0 || pLength(p) == l)
600void kBucket_Plus_mm_Mult_pp(kBucket_pt bucket, poly m, poly p, int l)
601{
602  assume(l <= 0 || pLength(p) == l);
603  int i, l1;
604  poly p1 = p;
605  poly last;
606  ring r = bucket->bucket_ring;
607
608  if (l <= 0)
609  {
610    l1 = pLength(p1);
611    l = l1;
612  }
613  else
614    l1 = l;
615
616  if (m == NULL || p == NULL) return;
617
618  kBucketMergeLm(bucket);
619  kbTest(bucket);
620  i = pLogLength(l1);
621
622  if (i <= bucket->buckets_used && bucket->buckets[i] != NULL)
623  {
624    MULTIPLY_BUCKET(bucket,i);
625    p1 = p_Plus_mm_Mult_qq(bucket->buckets[i], m, p1,
626                           bucket->buckets_length[i], l1, r);
627    l1 = bucket->buckets_length[i];
628    bucket->buckets[i] = NULL;
629    bucket->buckets_length[i] = 0;
630    i = pLogLength(l1);
631  }
632  else
633  {
634    p1 = r->p_Procs->pp_Mult_mm(p1, m, r, last);
635  }
636
637  while (bucket->buckets[i] != NULL)
638  {
639    MULTIPLY_BUCKET(bucket,i);
640    p1 = p_Add_q(p1, bucket->buckets[i],
641                 l1, bucket->buckets_length[i], r);
642    bucket->buckets[i] = NULL;
643    bucket->buckets_length[i] = 0;
644    i = pLogLength(l1);
645  }
646
647  bucket->buckets[i] = p1;
648  bucket->buckets_length[i]=l1;
649  if (i >= bucket->buckets_used)
650    bucket->buckets_used = i;
651  else
652    kBucketAdjustBucketsUsed(bucket);
653
654  kbTest(bucket);
655}
656
657poly kBucket_ExtractLarger(kBucket_pt bucket, poly q, poly append)
658{
659  if (q == NULL) return append;
660  poly lm;
661  loop
662  {
663    lm = kBucketGetLm(bucket);
664    if (lm == NULL) return append;
665    if (p_LmCmp(lm, q, bucket->bucket_ring) == 1)
666    {
667      lm = kBucketExtractLm(bucket);
668      pNext(append) = lm;
669      pIter(append);
670    }
671    else
672    {
673      return append;
674    }
675  }
676}
677
678/////////////////////////////////////////////////////////////////////////////
679//
680// Extract all monomials from bucket with component comp
681// Return as a polynomial *p with length *l
682// In other words, afterwards
683// Bpoly = Bpoly - (poly consisting of all monomials with component comp)
684// and components of monomials of *p are all 0
685//
686
687// Hmm... for now I'm too lazy to implement those independent of currRing
688// But better declare it extern than including polys.h
689extern void pTakeOutComp(poly *p, Exponent_t comp, poly *q, int *lq);
690void pDecrOrdTakeOutComp(poly *p, Exponent_t comp, Order_t order,
691                         poly *q, int *lq);
692
693void kBucketTakeOutComp(kBucket_pt bucket,
694                        Exponent_t comp,
695                        poly *r_p, int *l)
696{
697  poly p = NULL, q;
698  int i, lp = 0, lq;
699
700#ifndef HAVE_PSEUDO_BUCKETS
701  kBucketMergeLm(bucket);
702  for (i=1; i<=bucket->buckets_used; i++)
703  {
704    if (bucket->buckets[i] != NULL)
705    {
706      MULTIPLY_BUCKET(bucket,i);
707      pTakeOutComp(&(bucket->buckets[i]), comp, &q, &lq);
708      if (q != NULL)
709      {
710        assume(pLength(q) == lq);
711        bucket->buckets_length[i] -= lq;
712        assume(pLength(bucket->buckets[i]) == bucket->buckets_length[i]);
713        p = p_Add_q(p, q, lp, lq, bucket->bucket_ring);
714      }
715    }
716  }
717  kBucketAdjustBucketsUsed(bucket);
718#else
719  pTakeOutComp(&(bucket->p), comp, &p, &lp);
720  (bucket->l) -= lp;
721#endif
722  *r_p = p;
723  *l = lp;
724
725  kbTest(bucket);
726}
727
728void kBucketDecrOrdTakeOutComp(kBucket_pt bucket,
729                               Exponent_t comp, Order_t order,
730                               poly *r_p, int *l)
731{
732  poly p = NULL, q;
733  int i, lp = 0, lq;
734
735#ifndef HAVE_PSEUDO_BUCKETS
736  kBucketMergeLm(bucket);
737  for (i=1; i<=bucket->buckets_used; i++)
738  {
739    if (bucket->buckets[i] != NULL)
740    {
741      MULTIPLY_BUCKET(bucket,i);
742      pDecrOrdTakeOutComp(&(bucket->buckets[i]), comp, order, &q, &lq);
743      if (q != NULL)
744      {
745        bucket->buckets_length[i] -= lq;
746        p = p_Add_q(p, q, lp, lq, bucket->bucket_ring);
747      }
748    }
749  }
750  kBucketAdjustBucketsUsed(bucket);
751#else
752  pDecrOrdTakeOutComp(&(bucket->p), comp, order, &p, &lp);
753  (bucket->l) -= lp;
754#endif
755
756  *r_p = p;
757  *l = lp;
758}
759
760/////////////////////////////////////////////////////////////////////////////
761// Reduction of Bpoly with a given poly
762//
763
764extern int ksCheckCoeff(number *a, number *b);
765
766number kBucketPolyRed(kBucket_pt bucket,
767                      poly p1, int l1,
768                      poly spNoether)
769{
770  assume(p1 != NULL &&
771         p_DivisibleBy(p1,  kBucketGetLm(bucket), bucket->bucket_ring));
772  assume(pLength(p1) == (int) l1);
773
774  poly a1 = pNext(p1), lm = kBucketExtractLm(bucket);
775  BOOLEAN reset_vec=FALSE;
776  number rn;
777
778  if(a1==NULL)
779  {
780    p_DeleteLm(&lm, bucket->bucket_ring);
781    return nInit(1);
782  }
783
784  if (! nIsOne(pGetCoeff(p1)))
785  {
786    number an = pGetCoeff(p1), bn = pGetCoeff(lm);
787    int ct = ksCheckCoeff(&an, &bn);
788    p_SetCoeff(lm, bn, bucket->bucket_ring);
789    if ((ct == 0) || (ct == 2)) kBucket_Mult_n(bucket, an);
790    rn = an;
791  }
792  else
793  {
794    rn = nInit(1);
795  }
796
797  if (p_GetComp(p1, bucket->bucket_ring) != p_GetComp(lm, bucket->bucket_ring))
798  {
799    p_SetCompP(a1, p_GetComp(lm, bucket->bucket_ring), bucket->bucket_ring);
800    reset_vec = TRUE;
801    p_SetComp(lm, p_GetComp(p1, bucket->bucket_ring), bucket->bucket_ring);
802    p_Setm(lm, bucket->bucket_ring);
803  }
804
805  p_ExpVectorSub(lm,p1, bucket->bucket_ring);
806  l1--;
807
808  kBucket_Minus_m_Mult_p(bucket, lm, a1, &l1, spNoether);
809
810  p_DeleteLm(&lm, bucket->bucket_ring);
811  if (reset_vec) p_SetCompP(a1, 0, bucket->bucket_ring);
812  kbTest(bucket);
813  return rn;
814}
815
816
Note: See TracBrowser for help on using the repository browser.