# source:git/kernel/GBEngine/khstd.cc@922890

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