source: git/kernel/GBEngine/khstd.cc @ a4771e1

spielwiese
Last change on this file since a4771e1 was a4771e1, checked in by Oleksandr Motsak <motsak@…>, 10 years ago
Separation of hilbert function into kernel/combinatorics/hilb.h + include cleanup
  • Property mode set to 100644
File size: 5.0 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT:utils for hilbert driven kStd
6*/
7
8
9
10
11
12#include <kernel/mod2.h>
13
14#include <misc/options.h>
15#include <misc/intvec.h>
16
17#include <polys/simpleideals.h>
18
19#include <kernel/combinatorics/stairc.h>
20#include <kernel/combinatorics/hilb.h>
21
22#include <kernel/GBEngine/kutil.h>
23#include <kernel/GBEngine/kstd1.h>
24#include <kernel/GBEngine/khstd.h>
25
26#include <kernel/polys.h>
27
28#define ADIDEBUG 0
29
30
31/*2
32* compare the given hilbert series with the current one,
33* delete not needed pairs (if possible)
34*/
35void khCheck( ideal Q, intvec *w, intvec *hilb, int &eledeg, int &count,
36              kStrategy strat)
37  /* ideal S=strat->Shdl, poly p=strat->P.p */
38/*
39* compute the number eledeg of elements with a degree >= deg(p) going into kStd,
40* p is already in S and for all further q going into S yields deg(q) >= deg(p),
41* the real computation is only done if the degree has changed,
42* then we have eledeg == 0 on this degree and we make:
43*   - compute the Hilbert series newhilb from S
44*     (hilb is the final Hilbert series)
45*   - in module case: check that all comp up to strat->ak are used
46*   - compute the eledeg from newhilb-hilb for the first degree deg with
47*     newhilb-hilb != 0
48*     (Remark: consider the Hilbert series with coeff. up to infinity)
49*   - clear the set L for degree < deg
50* the number count is only for statistics (in the caller initialise count = 0),
51* in order to get a first computation, initialise eledeg = 1 in the caller.
52* The weights w are needed in the module case, otherwise NULL.
53*/
54{
55  intvec *newhilb;
56  int deg,l,ln,mw;
57  pFDegProc degp;
58
59  eledeg--;
60  if (eledeg == 0)
61  {
62    if (strat->ak>0)
63    {
64      char *used_comp=(char*)omAlloc0(strat->ak+1);
65      int i;
66      for(i=strat->sl;i>0;i--)
67      {
68        used_comp[pGetComp(strat->S[i])]='\1';
69      }
70      for(i=strat->ak;i>0;i--)
71      {
72        if(used_comp[i]=='\0')
73        {
74          omFree((ADDRESS)used_comp);
75          return;
76        }
77      }
78      omFree((ADDRESS)used_comp);
79    }
80    degp=currRing->pFDeg;
81    // if weights for variables were given to std computations,
82    // then pFDeg == degp == kHomModDeg (see kStd)
83    if ((degp!=kModDeg) && (degp!=kHomModDeg)) degp=p_Totaldegree;
84    // degp = pWDegree;
85    l = hilb->length()-1;
86    mw = (*hilb)[l];
87    newhilb = hHstdSeries(strat->Shdl,w,strat->kHomW,Q,strat->tailRing);
88    ln = newhilb->length()-1;
89    deg = degp(strat->P.p,currRing)-mw;
90    loop // compare the series in degree deg, try to increase deg -----------
91    {
92      if (deg < ln) // deg may be out of range
93      {
94        if (deg < l)
95          eledeg = (*newhilb)[deg]-(*hilb)[deg];
96        else
97          eledeg = (*newhilb)[deg];
98      }
99      else
100      {
101        if (deg < l)
102          eledeg = -(*hilb)[deg];
103        else // we have newhilb = hilb
104        {
105          while (strat->Ll>=0)
106          {
107            count++;
108            if(TEST_OPT_PROT)
109            {
110              PrintS("h");
111              mflush();
112            }
113            deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
114          }
115          delete newhilb;
116          return;
117        }
118      }
119      if (eledeg > 0) // elements to delete
120        break;
121      else if (eledeg <0) // strange....see bug_43
122        return;
123      deg++;
124    } /* loop */
125    delete newhilb;
126    while ((strat->Ll>=0) && (degp(strat->L[strat->Ll].p,currRing)-mw < deg)) // the essential step
127    {
128      count++;
129      if(TEST_OPT_PROT)
130      {
131        PrintS("h");
132        mflush();
133      }
134      deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
135    }
136  }
137}
138
139
140void khCheckLocInhom(ideal Q, intvec *w, intvec *hilb, int &count,
141             kStrategy strat)
142
143/*
144This will be used for the local orderings in the case of the inhomogenous ideals.
145Assume f1,...,fs are already in the standard basis. Test if hilb(LM(f1),...,LM(fs),1)
146is equal to the inputed one.
147If no, do nothing.
148If Yes, we know that all polys that we need are already in the standard basis
149so delete all the remaining pairs
150*/
151{
152int i;
153ideal Lm;
154intvec *newhilb;
155
156Lm = id_Head(strat->Shdl,currRing);
157
158newhilb =hHstdSeries(Lm,w,strat->kHomW,Q,currRing);
159
160#if ADIDEBUG
161PrintS("\nOriginal\n");
162int   i, j, l, k;
163  if (hilb == NULL)
164    return;
165  l = hilb->length()-1;
166  k = (*hilb)[l];
167  for (i = 0; i < l; i++)
168  {
169    j = (*hilb)[i];
170    if (j != 0)
171    {
172      Print("//  %8d t^%d\n", j, i+k);
173    }
174  }
175  PrintS("\nActual\n");
176  if (newhilb == NULL)
177    return;
178  l = newhilb->length()-1;
179  k = (*newhilb)[l];
180  for (i = 0; i < l; i++)
181  {
182    j = (*newhilb)[i];
183    if (j != 0)
184    {
185      Print("//  %8d t^%d\n", j, i+k);
186    }
187  }
188#endif
189
190if(newhilb->compare(hilb) == 0)
191        {
192                while (strat->Ll>=0)
193          {
194            count++;
195            if(TEST_OPT_PROT)
196            {
197              PrintS("h");
198              mflush();
199            }
200            deleteInL(strat->L,&strat->Ll,strat->Ll,strat);
201          }
202          delete newhilb;
203          return;
204   }
205
206id_Delete(&Lm,currRing);
207       
208}
Note: See TracBrowser for help on using the repository browser.