Changeset b5ae52 in git

Timestamp:

Oct 15, 1997, 9:58:54 AM (27 years ago)

Author:

Hans Schönemann <hannes@…>

Branches:

(u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')

Children:

309f679293c6bbca5f6a90d4264f81251290c122

Parents:

499bdc5e258e4f3d05720339759579c6bf80618c

Message:

* hannes/pohl: degree bounded kbase: hdegree.cc iparith.cc stairc.h


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

Location:

Singular

Files:

• hdegree.cc (modified) (4 diffs)
• iparith.cc (modified) (4 diffs)
• stairc.h (modified) (3 diffs)

Singular/hdegree.cc

@@ -2 +2 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: hdegree.cc,v 1.4 1997-04-02 15:07:01 Singular Exp $ */
+/* $Id: hdegree.cc,v 1.5 1997-10-15 07:58:51 Singular Exp $ */
 /*
 *  ABSTRACT -  dimension, multiplicity, HC, kbase
@@ -16 +16 @@
 #include "polys.h"
 #include "intvec.h"
+#include "numbers.h"
 #include "hutil.h"
 #include "stairc.h"
@@ -1092 +1093 @@
 //  kbase
 
-static polyset Kbase;
-static int  count;
-
-static void scInKbase( poly p, int  start)
-{
-  int  i, j;
-  poly q;
-  scmon x;
-  for (i = 0; i < hNstc; i++)
-  {
-    x = hstc[i];
-    j = pVariables;
+static poly last;
+static scmon act;
+
+static void scElKbase()
+{
+  poly q = pNew();
+  pSetCoeff0(q,nInit(1));
+  pSetExpV(q,act);
+  pSetm(q);
+  pNext(q) = NULL;
+  last = pNext(last) = q;
+}
+
+static short scMax( int i, scfmon stc, int Nvar)
+{
+  short x, y=stc[0][Nvar];
+  for (; i;)
+  {
+    i--;
+    x = stc[i][Nvar];
+    if (x > y) y = x;
+  }
+  return y;
+}
+
+static short scMin( int i, scfmon stc, int Nvar)
+{
+  short x, y=stc[0][Nvar];
+  for (; i;)
+  {
+    i--;
+    x = stc[i][Nvar];
+    if (x < y) y = x;
+  }
+  return y;
+}
+
+static short scRestrict( int &Nstc, scfmon stc, int Nvar)
+{
+  unsigned short x, y;
+  int i, j, Istc = Nstc;
+
+  y = 0XFFFF;
+  for (i=Nstc-1; i>=0; i--)
+  {
+    j = Nvar-1;
     loop
     {
-      if (x[j] > p->exp[j])
+      if(stc[i][j] != 0) break;
+      j--;
+      if (j == 0)
+      {
+        Istc--;
+        x = stc[i][Nvar];
+        if (x < y) y = x;
+        stc[i] = NULL;
         break;
-      j--;
-      if (j==0)
-      {
-        pDelete1(&p);
-        return;
-      }
-    }
-  }
-  pSetm(p);
-  Kbase[count] = p;
-  count++;
-  for (i = start; i <= pVariables; i++)
-  {
-    q = pCopy(p);
-    q->exp[i]++;
-    scInKbase(q, i);
-  }
-}
-
-
-extern ideal scKBase(ideal s, ideal Q)
-{
-  int  i, a;
+      }
+    }
+  }
+  if (Istc < Nstc)
+  {
+    j = 0;
+    while (stc[j]) j++;
+    i = j+1;
+    for(; i<Nstc; i++)
+    {
+      if (stc[i])
+      {
+        stc[j] = stc[i];
+        j++;
+      }
+    }
+    Nstc = Istc;
+    return y;
+  }
+  else
+    return -1;
+}
+
+static void scAll( int Nvar, short deg)
+{
+  int i;
+  short d = deg;
+  if (d == 0)
+  {
+    for (i=Nvar; i; i--) act[i] = 0;
+    scElKbase();
+    return;
+  }
+  if (Nvar == 1)
+  {
+    act[1] = d;
+    scElKbase();
+    return;
+  }
+  do
+  {
+    act[Nvar] = d;
+    scAll(Nvar-1, deg-d);
+    d--;
+  } while (d >= 0);
+}
+
+static void scAllKbase( int Nvar, short ideg, short deg)
+{
+  do
+  {
+    act[Nvar] = ideg;
+    scAll(Nvar-1, deg-ideg);
+    ideg--;
+  } while (ideg >= 0);
+}
+
+static void scDegKbase( scfmon stc, int Nstc, int Nvar, short deg)
+{
+  int  Ivar, Istc, i, j;
+  scfmon sn;
+  short x, ideg;
+
+  if (deg == 0)
+  {
+    for (i=Nvar; i; i--) act[i] = 0;
+    scElKbase();
+    return;
+  }
+  if (Nvar == 1)
+  {
+    for (i=Nstc-1; i>=0; i--) if(deg >= stc[i][1]) return;
+    act[1] = deg;
+    scElKbase();
+    return;
+  }
+  Ivar = Nvar-1;
+  sn = hGetmem(Nstc, stc, stcmem[Ivar]);
+  x = scRestrict(Nstc, sn, Nvar);
+  if (x < 0) ideg = deg;
+  else
+  {
+    if (Nstc == 0)
+    {
+      if (deg >= x) return;
+      act[Nvar] = deg;
+      for (i=Ivar; i; i--) act[i] = 0;
+      scElKbase();
+      return;
+    }
+    if (deg < x) ideg = deg;
+    else ideg = x-1;
+  }
+  loop
+  {
+    x = scMax(Nstc, sn, Nvar);
+    while (ideg >= x)
+    {
+      act[Nvar] = ideg;
+      scDegKbase(sn, Nstc, Ivar, deg-ideg);
+      ideg--;
+    }
+    if (ideg < 0) return;
+    Istc = Nstc;
+    for (i=Nstc-1; i>=0; i--)
+    {
+      if (ideg < sn[i][Nvar])
+      {
+        Istc--;
+        sn[i] = NULL;
+      }
+    }
+    if (Istc == 0)
+    {
+      scAllKbase(Nvar, ideg, deg);
+      return;
+    }
+    j = 0;
+    while (sn[j]) j++;
+    i = j+1;
+    for (; i<Nstc; i++)
+    {
+      if (sn[i])
+      {
+        sn[j] = sn[i];
+        j++;
+      }
+    }
+    Nstc = Istc;
+  }
+}
+
+static void scInKbase( scfmon stc, int Nstc, int Nvar)
+{
+  int  Ivar, Istc, i, j;
+  scfmon sn;
+  short x, ideg;
+
+  if (Nvar == 1)
+  {
+    ideg = scMin(Nstc, stc, 1);
+    while (ideg > 0)
+    {
+      ideg--;
+      act[1] = ideg;
+      scElKbase();
+    }
+    return;
+  }
+  Ivar = Nvar-1;
+  sn = hGetmem(Nstc, stc, stcmem[Ivar]);
+  x = scRestrict(Nstc, sn, Nvar);
+  if (Nstc == 0)
+  {
+    if (x == 0) return;
+    for (i=Ivar; i; i--) act[i] = 0;
+    do
+    {
+      x--;
+      act[Nvar] = x;
+      scElKbase();
+    } while(x > 0);
+    return;
+  }
+  ideg = x-1;
+  loop
+  {
+    x = scMax(Nstc, sn, Nvar);
+    while (ideg >= x)
+    {
+      act[Nvar] = ideg;
+      scInKbase(sn, Nstc, Ivar);
+      ideg--;
+    }
+    if (ideg < 0) return;
+    Istc = Nstc;
+    for (i=Nstc-1; i>=0; i--)
+    {
+      if (ideg < sn[i][Nvar])
+      {
+        Istc--;
+        sn[i] = NULL;
+      }
+    }
+    j = 0;
+    while (sn[j]) j++;
+    i = j+1;
+    for (; i<Nstc; i++)
+    {
+      if (sn[i])
+      {
+        sn[j] = sn[i];
+        j++;
+      }
+    }
+    Nstc = Istc;
+  }
+}
+
+static ideal scIdKbase()
+{
+  polyset mm;
+  ideal res;
+  poly p, q = last;
+  int i = pLength(q);
+  res = idInit(i,1);
+  mm = res->m;
+  i = 0;
+  do
+  {
+    mm[i] = q;
+    i++;
+    p = pNext(q);
+    pNext(q) = NULL;
+    q = p;
+  } while (q);
+  return res;
+}
+
+extern ideal scKBase(int deg, ideal s, ideal Q)
+{
+  int  i, di;
   poly p;
-  ideal res;
-  a = scMult0Int(s, Q);
-  if (a <= 0)
-    return idInit(1,s->rank);
-  res = idInit(a,s->rank);
-  Kbase = res->m;
+
+  if (deg < 0)
+  {
+    di = scDimInt(s, Q);
+    if (di != 0)
+    {
+      Werror("KBase not finite");
+      return idInit(1,0);
+    }
+  }
+  stcmem = hCreate(pVariables - 1);
   hexist = hInit(s, Q, &hNexist);
-  count = 0;
+  p = last = pNew();
+  pNext(p) = NULL;
+  act = (scmon)Alloc((pVariables + 1) * sizeof(short));
+  *act = 0;
+  if (!hNexist)
+  {
+    scAll(pVariables, deg);
+    goto ende;
+  }
   if (!hisModule)
   {
-    hstc = hexist;
-    hNstc = hNexist;
-    p = pOne();
-    scInKbase(p, 1);
+    if (deg < 0) scInKbase(hexist, hNexist, pVariables);
+    else scDegKbase(hexist, hNexist, pVariables, deg);
   }
   else
@@ -1152 +1404 @@
     for (i = 1; i <= hisModule; i++)
     {
+      *act = i;
       hComp(hexist, hNexist, i, hstc, &hNstc);
       if (hNstc)
       {
-        p = pOne();
-        p->exp[0] = i;
-        scInKbase(p, 1);
-      }
+        if (deg < 0) scInKbase(hstc, hNstc, pVariables);
+        else scDegKbase(hstc, hNstc, pVariables, deg);
+      }
+      else
+        scAll(pVariables, deg);
     }
     Free((ADDRESS)hstc, hNexist * sizeof(scmon));
   }
+ende:
   Free((ADDRESS)hexist, hNexist * sizeof(scmon));
-  return res;
-}
-
-
+  Free((ADDRESS)act, (pVariables + 1) * sizeof(short));
+  hKill(stcmem, pVariables - 1);
+  pDelete1(&p);
+  if (p == NULL)
+    return idInit(1,0);
+  else
+  {
+    last = p;
+    return scIdKbase();
+  }
+}
+
+
+

Singular/iparith.cc

@@ -184 +184 @@
   { "jacob",       0, JACOB_CMD ,         CMD_1},
   { "jet",         0, JET_CMD ,           CMD_23},
-  { "kbase",       0, KBASE_CMD ,         CMD_1},
+  { "kbase",       0, KBASE_CMD ,         CMD_12},
   { "keepring",    0, KEEPRING_CMD ,      KEEPRING_CMD},
   { "kill",        0, KILL_CMD ,          KILL_CMD},
@@ -1538 +1538 @@
 {
   res->data = (char *)idJet((ideal)u->Data(),(int)v->Data());
+  return FALSE;
+}
+static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
+{
+  assumeStdFlag(u);
+  res->data = (char *)scKBase((int)v->Data(),
+                              (ideal)(u->Data()),currQuotient);
   return FALSE;
 }
@@ -2039 +2046 @@
 ,{jjJET_P,     JET_CMD,        VECTOR_CMD,     VECTOR_CMD, INT_CMD PROFILER}
 ,{jjJET_ID,    JET_CMD,        MODUL_CMD,      MODUL_CMD,  INT_CMD PROFILER}
+,{jjKBASE2,    KBASE_CMD,      IDEAL_CMD,      IDEAL_CMD,  INT_CMD PROFILER}
+,{jjKBASE2,    KBASE_CMD,      MODUL_CMD,      MODUL_CMD,  INT_CMD PROFILER}
 ,{atKILLATTR2, KILLATTR_CMD,   NONE,           IDHDL,      STRING_CMD PROFILER}
 ,{jjKoszul,    KOSZUL_CMD,     MATRIX_CMD,     INT_CMD,    INT_CMD PROFILER}
@@ -2449 +2458 @@
 {
   assumeStdFlag(v);
-  res->data = (char *)scKBase((ideal)(v->Data()),currQuotient);
+  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
   return FALSE;
 }

Singular/stairc.h

@@ -4 +4 @@
 *  Computer Algebra System SINGULAR     *
 ****************************************/
-/* $Id: stairc.h,v 1.3 1997-04-09 12:20:13 Singular Exp $ */
+/* $Id: stairc.h,v 1.4 1997-10-15 07:58:54 Singular Exp $ */
 /*
 * ABSTRACT
@@ -20 +20 @@
 void scDegree(ideal  s,ideal Q=NULL);
 
-ideal scKBase(ideal  s, ideal Q=NULL);
+ideal scKBase(int deg, ideal  s, ideal Q=NULL);
 //void scHilbertPoly(ideal  s,ideal Q=NULL);
 //intvec *scHilbert(ideal  s,ideal Q=NULL);
@@ -35 +35 @@
 #endif
 
+