source: git/kernel/khstd.cc @ d11734

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