[35aab3] | 1 | /**************************************** |
---|
| 2 | * Computer Algebra System SINGULAR * |
---|
| 3 | ****************************************/ |
---|
[56fba1] | 4 | /* $Id: khstd.cc,v 1.4 2008-09-24 15:55:19 Singular Exp $ */ |
---|
[35aab3] | 5 | /* |
---|
| 6 | * ABSTRACT:utils for hilbert driven kStd |
---|
| 7 | */ |
---|
| 8 | |
---|
| 9 | #include "mod2.h" |
---|
| 10 | #include "structs.h" |
---|
| 11 | #include "febase.h" |
---|
| 12 | #include "polys.h" |
---|
| 13 | #include "intvec.h" |
---|
| 14 | #include "kutil.h" |
---|
| 15 | #include "stairc.h" |
---|
| 16 | #include "kstd1.h" |
---|
| 17 | #include "khstd.h" |
---|
| 18 | |
---|
| 19 | |
---|
| 20 | /*2 |
---|
| 21 | * compare the given hilbert series with the current one, |
---|
| 22 | * delete not needed pairs (if possible) |
---|
| 23 | */ |
---|
| 24 | void khCheck( ideal Q, intvec *w, intvec *hilb, int &eledeg, int &count, |
---|
| 25 | kStrategy strat) |
---|
| 26 | /* ideal S=strat->Shdl, poly p=strat->P.p */ |
---|
| 27 | /* |
---|
| 28 | * compute the number eledeg of elements with a degree >= deg(p) going into kStd, |
---|
| 29 | * p is already in S and for all further q going into S yields deg(q) >= deg(p), |
---|
| 30 | * the real computation is only done if the degree has changed, |
---|
| 31 | * then we have eledeg == 0 on this degree and we make: |
---|
| 32 | * - compute the Hilbert series newhilb from S |
---|
| 33 | * (hilb is the final Hilbert series) |
---|
[56fba1] | 34 | * - in module case: check that all comp up to strat->ak are used |
---|
[35aab3] | 35 | * - compute the eledeg from newhilb-hilb for the first degree deg with |
---|
| 36 | * newhilb-hilb != 0 |
---|
| 37 | * (Remark: consider the Hilbert series with coeff. up to infinity) |
---|
| 38 | * - clear the set L for degree < deg |
---|
| 39 | * the number count is only for statistics (in the caller initialise count = 0), |
---|
| 40 | * in order to get a first computation, initialise eledeg = 1 in the caller. |
---|
| 41 | * The weights w are needed in the module case, otherwise NULL. |
---|
| 42 | */ |
---|
| 43 | { |
---|
| 44 | intvec *newhilb; |
---|
| 45 | int deg,l,ln,mw; |
---|
| 46 | pFDegProc degp; |
---|
| 47 | |
---|
| 48 | eledeg--; |
---|
| 49 | if (eledeg == 0) |
---|
| 50 | { |
---|
| 51 | degp=pFDeg; |
---|
| 52 | // if weights for variables were given to std computations, |
---|
| 53 | // then pFDeg == degp == kHomModDeg (see kStd) |
---|
| 54 | if ((degp!=kModDeg) && (degp!=kHomModDeg)) degp=pTotaldegree; |
---|
| 55 | // degp = pWDegree; |
---|
| 56 | l = hilb->length()-1; |
---|
| 57 | mw = (*hilb)[l]; |
---|
| 58 | newhilb = hHstdSeries(strat->Shdl,w,strat->kHomW,Q,strat->tailRing); |
---|
| 59 | ln = newhilb->length()-1; |
---|
[b130fb] | 60 | deg = degp(strat->P.p,currRing)-mw; |
---|
[35aab3] | 61 | loop // compare the series in degree deg, try to increase deg ----------- |
---|
| 62 | { |
---|
| 63 | if (deg < ln) // deg may be out of range |
---|
| 64 | { |
---|
| 65 | if (deg < l) |
---|
| 66 | eledeg = (*newhilb)[deg]-(*hilb)[deg]; |
---|
| 67 | else |
---|
| 68 | eledeg = (*newhilb)[deg]; |
---|
| 69 | } |
---|
| 70 | else |
---|
| 71 | { |
---|
| 72 | if (deg < l) |
---|
| 73 | eledeg = -(*hilb)[deg]; |
---|
| 74 | else // we have newhilb = hilb |
---|
| 75 | { |
---|
[56fba1] | 76 | if (strat->ak>0) |
---|
| 77 | { |
---|
| 78 | char *used_comp=(char*)omAlloc0(strat->ak+1); |
---|
| 79 | int i; |
---|
| 80 | for(i=strat->sl;i>0;i--) |
---|
| 81 | used_comp[pGetComp(strat->S[i])]='\1'; |
---|
| 82 | for(i=strat->ak;i>0;i--) |
---|
| 83 | { |
---|
| 84 | if(used_comp[i]=='\0') |
---|
| 85 | { |
---|
| 86 | omFree((ADDRESS)used_comp); |
---|
| 87 | delete newhilb; |
---|
| 88 | return; |
---|
| 89 | } |
---|
| 90 | } |
---|
| 91 | omFree((ADDRESS)used_comp); |
---|
| 92 | } |
---|
[35aab3] | 93 | while (strat->Ll>=0) |
---|
| 94 | { |
---|
| 95 | count++; |
---|
| 96 | if(TEST_OPT_PROT) |
---|
| 97 | { |
---|
| 98 | PrintS("h"); |
---|
| 99 | mflush(); |
---|
| 100 | } |
---|
| 101 | deleteInL(strat->L,&strat->Ll,strat->Ll,strat); |
---|
| 102 | } |
---|
| 103 | delete newhilb; |
---|
| 104 | return; |
---|
| 105 | } |
---|
| 106 | } |
---|
[d969cb] | 107 | if (eledeg > 0) // elements to delete |
---|
[35aab3] | 108 | break; |
---|
[d969cb] | 109 | else if (eledeg <0) // strange....see bug_43 |
---|
| 110 | return; |
---|
[35aab3] | 111 | deg++; |
---|
| 112 | } /* loop */ |
---|
| 113 | delete newhilb; |
---|
[b130fb] | 114 | while ((strat->Ll>=0) && (degp(strat->L[strat->Ll].p,currRing)-mw < deg)) // the essential step |
---|
[35aab3] | 115 | { |
---|
| 116 | count++; |
---|
| 117 | if(TEST_OPT_PROT) |
---|
| 118 | { |
---|
| 119 | PrintS("h"); |
---|
| 120 | mflush(); |
---|
| 121 | } |
---|
| 122 | deleteInL(strat->L,&strat->Ll,strat->Ll,strat); |
---|
| 123 | } |
---|
| 124 | } |
---|
| 125 | } |
---|