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
RevLine 
[35aab3]1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT:utils for hilbert driven kStd
6*/
7
[89f4843]8#include "kernel/mod2.h"
[9f7665]9
[89f4843]10#include "misc/options.h"
11#include "misc/intvec.h"
[9f7665]12
[89f4843]13#include "polys/simpleideals.h"
[9f7665]14
[89f4843]15#include "kernel/combinatorics/stairc.h"
16#include "kernel/combinatorics/hilb.h"
[3ed6cb7]17
[89f4843]18#include "kernel/GBEngine/kutil.h"
19#include "kernel/GBEngine/kstd1.h"
20#include "kernel/GBEngine/khstd.h"
[a4771e1]21
[89f4843]22#include "kernel/polys.h"
[a4771e1]23
[35aab3]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)
[56fba1]38*   - in module case: check that all comp up to strat->ak are used
[35aab3]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{
[0b39b7]48  intvec *newhilb,*new1;
[35aab3]49  int deg,l,ln,mw;
50  pFDegProc degp;
51
52  eledeg--;
53  if (eledeg == 0)
54  {
[5a5e050]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    }
[630dad]73    degp=currRing->pFDeg;
[35aab3]74    // if weights for variables were given to std computations,
75    // then pFDeg == degp == kHomModDeg (see kStd)
[99bdcf]76    if ((degp!=kModDeg) && (degp!=kHomModDeg)) degp=p_Totaldegree;
[35aab3]77    // degp = pWDegree;
78    l = hilb->length()-1;
79    mw = (*hilb)[l];
[762afe1]80    newhilb =hFirstSeries(strat->Shdl,w,Q,strat->kHomW);
[35aab3]81    ln = newhilb->length()-1;
[b130fb]82    deg = degp(strat->P.p,currRing)-mw;
[35aab3]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      }
[d969cb]112      if (eledeg > 0) // elements to delete
[35aab3]113        break;
[d969cb]114      else if (eledeg <0) // strange....see bug_43
115        return;
[35aab3]116      deg++;
117    } /* loop */
118    delete newhilb;
[b130fb]119    while ((strat->Ll>=0) && (degp(strat->L[strat->Ll].p,currRing)-mw < deg)) // the essential step
[35aab3]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}
[3ed6cb7]131
132
133void khCheckLocInhom(ideal Q, intvec *w, intvec *hilb, int &count,
134             kStrategy strat)
[a9c298]135
[3ed6cb7]136/*
[4f8fd1d]137This will be used for the local orderings in the case of the inhomogeneous ideals.
[3ed6cb7]138Assume f1,...,fs are already in the standard basis. Test if hilb(LM(f1),...,LM(fs),1)
[4f8fd1d]139is equal to the inputted one.
[3ed6cb7]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{
[0318fe]145  ideal Lm;
[0b39b7]146  intvec *newhilb,*new1;
[3ed6cb7]147
[0318fe]148  Lm = id_Head(strat->Shdl,currRing);
[3ed6cb7]149
[762afe1]150  newhilb =hFirstSeries(Lm,w,Q,strat->kHomW);
[3ed6cb7]151
[0318fe]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);
[3ed6cb7]168}
Note: See TracBrowser for help on using the repository browser.