source: git/kernel/GBEngine/khstd.cc @ 4f8fd1d

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