Changeset 5eb865 in git

Timestamp:

Jun 9, 2009, 8:21:50 PM (14 years ago)

Author:

Hans Schönemann <hannes@…>

Branches:

(u'spielwiese', '828514cf6e480e4bafc26df99217bf2a1ed1ef45')

Children:

e4be351ada16eebdaa1e48ce01115ffc5287dbd3

Parents:

b82abb0dc3349df20acd8231f648b8ff51bc61b6

Message:

*hannes: redtail for Z


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

Location:

kernel

Files:

• kInline.cc (modified) (2 diffs)
• kstd2.cc (modified) (5 diffs)
• kutil.cc (modified) (2 diffs)
• kutil.h (modified) (2 diffs)

kernel/kInline.cc

@@ -7 +7 @@
  *  Author:  obachman (Olaf Bachmann)
  *  Created: 8/00
- *  Version: $Id: kInline.cc,v 1.15 2009-03-18 16:56:02 Singular Exp $
+ *  Version: $Id: kInline.cc,v 1.16 2009-06-09 18:21:50 Singular Exp $
  *******************************************************************/
 #ifndef KINLINE_CC
@@ -1086 +1086 @@
 }
 
+#ifdef HAVE_RINGS
+KINLINE poly redtailBba_Z (poly p,int pos,kStrategy strat)
+{
+  LObject L(p, currRing, strat->tailRing);
+  return redtailBba_Z(&L, pos, strat);
+}
+#endif
+
 KINLINE poly redtailBba(TObject *T, int pos,kStrategy strat)
 {

kernel/kstd2.cc

@@ -2 +2 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: kstd2.cc,v 1.87 2009-06-04 08:15:45 Singular Exp $ */
+/* $Id: kstd2.cc,v 1.88 2009-06-09 18:21:50 Singular Exp $ */
 /*
 *  ABSTRACT -  Kernel: alg. of Buchberger
@@ -1221 +1221 @@
   if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
   {
-    BITSET save=test;
-    test &= ~Sy_bit(OPT_INTSTRATEGY);
     if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
-    p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
-    test=save;
+    #ifdef HAVE_RINGS
+    if (rField_is_Ring())
+    {
+      p = redtailBba_Z(p,max_ind,strat);
+    }
+    else
+    #endif
+    {
+      BITSET save=test;
+      test &= ~Sy_bit(OPT_INTSTRATEGY);
+      p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
+      test=save;
+    }
   }
   /*- release temp data------------------------------- -*/
@@ -1277 +1286 @@
   /*- compute------------------------------------------------------- -*/
   res=idInit(IDELEMS(q),si_max(q->rank,F->rank));
+  BITSET save=test;
+  test &= ~Sy_bit(OPT_INTSTRATEGY);
   for (i=IDELEMS(q)-1; i>=0; i--)
   {
@@ -1285 +1296 @@
       if ((p!=NULL)&&((lazyReduce & KSTD_NF_LAZY)==0))
       {
-        BITSET save=test;
-        test &= ~Sy_bit(OPT_INTSTRATEGY);
         if (TEST_OPT_PROT) { PrintS("t"); mflush(); }
-        p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
-        test=save;
+        #ifdef HAVE_RINGS
+        if (rField_is_Ring())
+        {
+          p = redtailBba_Z(p,max_ind,strat);
+        }
+        else
+        #endif
+        {
+          p = redtailBba(p,max_ind,strat,(lazyReduce & KSTD_NF_NONORM)==0);
+        }
       }
       res->m[i]=p;
@@ -1297 +1314 @@
   }
   /*- release temp data------------------------------- -*/
+  test=save;
   omfree(strat->sevS);
   omfree(strat->ecartS);

kernel/kutil.cc

@@ -2 +2 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: kutil.cc,v 1.143 2009-06-04 08:42:06 Singular Exp $ */
+/* $Id: kutil.cc,v 1.144 2009-06-09 18:21:50 Singular Exp $ */
 /*
 * ABSTRACT: kernel: utils for kStd
@@ -4596 +4596 @@
   return L->GetLmCurrRing();
 }
+
+#ifdef HAVE_RINGS
+poly redtailBba_Z (LObject* L, int pos, kStrategy strat )
+// normalize=FALSE, withT=FALSE, coeff=Z
+{
+  strat->redTailChange=FALSE;
+  if (strat->noTailReduction) return L->GetLmCurrRing();
+  poly h, p;
+  p = h = L->GetLmTailRing();
+  if ((h==NULL) || (pNext(h)==NULL))
+    return L->GetLmCurrRing();
+
+  TObject* With;
+  // placeholder in case strat->tl < 0
+  TObject  With_s(strat->tailRing);
+
+  LObject Ln(pNext(h), strat->tailRing);
+  Ln.pLength = L->GetpLength() - 1;
+
+  pNext(h) = NULL;
+  if (L->p != NULL) pNext(L->p) = NULL;
+  L->pLength = 1;
+
+  Ln.PrepareRed(strat->use_buckets);
+
+  int cnt=REDTAIL_CANONICALIZE;
+  while(!Ln.IsNull())
+  {
+    loop
+    {
+      Ln.SetShortExpVector();
+      With = kFindDivisibleByInS(strat, pos, &Ln, &With_s);
+      if (With == NULL) break;
+      cnt--;
+      if (cnt==0)
+      {
+        cnt=REDTAIL_CANONICALIZE;
+        poly tmp=Ln.CanonicalizeP();
+      }
+      // we are in Z, do not Ccall pNorm
+      strat->redTailChange=TRUE;
+      // test divisibility of coefs:
+      poly p_Ln=Ln.GetLmCurrRing();
+      poly p_With=With->GetLmCurrRing();
+      number z=nIntMod(pGetCoeff(p_Ln),pGetCoeff(p_With));
+      if (!nIsZero(z))
+      {
+        // subtract z*Ln, add z.Ln to L
+        poly m=pHead(p_Ln);
+        pSetCoeff(m,z);
+        poly mm=pHead(m);
+        pNext(h) = m;
+        pIter(h);
+        L->pLength++;
+        mm=pNeg(mm);
+        if (Ln.bucket!=NULL)
+        {
+          int dummy=1;
+          kBucket_Add_q(Ln.bucket,mm,&dummy);
+        }
+        else
+        {
+          if (Ln.p!=NULL) Ln.p=pAdd(Ln.p,mm);
+          else if (Ln.t_p!=NULL)  Ln.t_p=p_Add_q(Ln.t_p,mm,strat->tailRing);
+        }
+      }
+      else
+        nDelete(&z);
+
+      if (ksReducePolyTail(L, With, &Ln))
+      {
+        // reducing the tail would violate the exp bound
+        //  set a flag and hope for a retry (in bba)
+        strat->completeReduce_retry=TRUE;
+        do
+        {
+          pNext(h) = Ln.LmExtractAndIter();
+          pIter(h);
+          L->pLength++;
+        } while (!Ln.IsNull());
+        goto all_done;
+      }
+      if (Ln.IsNull()) goto all_done;
+      With_s.Init(currRing);
+    }
+    pNext(h) = Ln.LmExtractAndIter();
+    pIter(h);
+    pNormalize(h);
+    L->pLength++;
+  }
+
+  all_done:
+  Ln.Delete();
+  if (L->p != NULL) pNext(L->p) = pNext(p);
+
+  if (strat->redTailChange)
+  {
+    L->last = NULL;
+    L->length = 0;
+  }
+
+  //if (TEST_OPT_PROT) { PrintS("N"); mflush(); }
+  //L->Normalize(); // HANNES: should have a test
+  kTest_L(L);
+  return L->GetLmCurrRing();
+}
+#endif
 
 /*2

kernel/kutil.h

@@ -4 +4 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: kutil.h,v 1.44 2009-05-06 12:53:48 Singular Exp $ */
+/* $Id: kutil.h,v 1.45 2009-06-09 18:21:50 Singular Exp $ */
 /*
 * ABSTRACT: kernel: utils for kStd
@@ -401 +401 @@
              LObject* L,const kStrategy strat);
 KINLINE poly redtailBba (poly p,int pos,kStrategy strat,BOOLEAN normalize=FALSE);
+#ifdef HAVE_RINGS
+KINLINE poly redtailBba_Z (poly p,int pos,kStrategy strat);
+poly redtailBba_Z (LObject* L, int pos, kStrategy strat );
+#endif
 poly redtailBba (LObject *L, int pos,kStrategy strat,
                  BOOLEAN withT = FALSE,BOOLEAN normalize=FALSE);