source: git/Singular/walk.cc @ 71df1a

fieker-DuValspielwiese
Last change on this file since 71df1a was efd39d, checked in by Hans Schönemann <hannes@…>, 18 years ago
*hannes: removed unnneeded code git-svn-id: file:///usr/local/Singular/svn/trunk@9101 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 137.7 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/* $Id: walk.cc,v 1.11 2006-05-05 13:08:30 Singular Exp $ */
5/*
6* ABSTRACT: Implementation of the Groebner walk
7*/
8
9// define if the Buchberger alg should be used
10//   to compute a reduced GB of a omega-homogenoues ideal
11// default: we use the hilbert driven algorithm.
12#define BUCHBERGER_ALG  //we use the improved Buchberger alg.
13
14//#define UPPER_BOUND //for the original "Tran" algorithm
15//#define REPRESENTATION_OF_SIGMA //if one perturbs sigma in Tran
16
17//#define TEST_OVERFLOW
18//#define CHECK_IDEAL
19//#define CHECK_IDEAL_MWALK
20
21//#define NEXT_VECTORS_CC
22//#define PRINT_VECTORS //to print vectors (sigma, tau, omega)
23
24#define INVEPS_SMALL_IN_FRACTAL  //to choose the small invers of epsilon
25#define INVEPS_SMALL_IN_MPERTVECTOR  //to choose the small invers of epsilon
26#define INVEPS_SMALL_IN_TRAN  //to choose the small invers of epsilon
27
28#define FIRST_STEP_FRACTAL // to define the first step of the fractal
29//#define MSTDCC_FRACTAL // apply Buchberger alg to compute a red GB, if
30//                          tau doesn't stay in the correct cone
31
32//#define TIME_TEST // print the used time of each subroutine
33//#define ENDWALKS //print the size of the last omega-homogenoues Gröbner basis
34
35/* includes */
36
37#include <stdio.h>
38// === Zeit & System (Holger Croeni ===
39#include <time.h>
40#include <sys/time.h>
41#include <sys/stat.h>
42#include <unistd.h>
43#include <stdio.h>
44#include <float.h>
45#include <limits.h>
46#include <sys/types.h>
47
48
49#include "mod2.h"
50#include "intvec.h"
51#include "cntrlc.h"
52#include "math.h"
53#include "structs.h"
54#include "omalloc.h"
55#include "febase.h"
56#include "ipshell.h"
57#include "ipconv.h"
58#include "longalg.h"
59#include "ffields.h"
60#include "subexpr.h"
61#include "p_Procs.h"
62
63#include "maps.h"
64
65/* include Hilbert-function */
66#include "stairc.h"
67
68/** kstd2.cc */
69#include "kutil.h"
70#include "khstd.h"
71
72#include "walk.h"
73#include "polys.h"
74#include "ideals.h"
75#include "ipid.h"
76#include "tok.h"
77#include "febase.h"
78#include "numbers.h"
79#include "ipid.h"
80#include "ring.h"
81#include "kstd1.h"
82#include "matpol.h"
83#include "weight.h"
84#include "intvec.h"
85#include "syz.h"
86#include "lists.h"
87#include "prCopy.h"
88#include "string.h"
89#include "longalg.h"
90#ifdef HAVE_FACTORY
91#include "clapsing.h"
92#endif
93
94#include "mpr_complex.h"
95
96ideal Gnull = NULL;
97int nstep;
98
99extern BOOLEAN ErrorCheck();
100
101extern BOOLEAN pSetm_error;
102
103void Set_Error( BOOLEAN f) { pSetm_error=f; }
104
105BOOLEAN Overflow_Error =  FALSE;
106
107clock_t xtif, xtstd, xtlift, xtred, xtnw;
108clock_t xftostd, xtextra, xftinput, to;
109
110/*2
111*utilities for TSet, LSet
112*/
113inline static intset initec (int maxnr)
114{
115  return (intset)omAlloc(maxnr*sizeof(int));
116}
117
118inline static unsigned long* initsevS (int maxnr)
119{
120  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
121}
122inline static int* initS_2_R (int maxnr)
123{
124  return (int*)omAlloc0(maxnr*sizeof(int));
125}
126
127/*2
128*construct the set s from F u {P}
129*/
130static void initSSpecialCC (ideal F, ideal Q, ideal P,kStrategy strat)
131{
132  int   i,pos;
133
134  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
135  else i=setmaxT;
136
137  strat->ecartS=initec(i);
138  strat->sevS=initsevS(i);
139  strat->S_2_R=initS_2_R(i);
140  strat->fromQ=NULL;
141  strat->Shdl=idInit(i,F->rank);
142  strat->S=strat->Shdl->m;
143
144  /*- put polys into S -*/
145  if (Q!=NULL)
146  {
147    strat->fromQ=initec(i);
148    memset(strat->fromQ,0,i*sizeof(int));
149    for (i=0; i<IDELEMS(Q); i++)
150    {
151      if (Q->m[i]!=NULL)
152      {
153        LObject h;
154        h.p = pCopy(Q->m[i]);
155        //if (TEST_OPT_INTSTRATEGY)
156        //{
157        //  //pContent(h.p);
158        //  h.pCleardenom(); // also does a pContent
159        //}
160        //else
161        //{
162        //  h.pNorm();
163        //}
164        strat->initEcart(&h);
165        if (pOrdSgn==-1)
166        {
167          deleteHC(&h,strat);
168        }
169        if (h.p!=NULL)
170        {
171          if (strat->sl==-1)
172            pos =0;
173          else
174          {
175            pos = posInS(strat,strat->sl,h.p,h.ecart);
176          }
177          h.sev = pGetShortExpVector(h.p);
178          h.SetpFDeg();
179          strat->enterS(h,pos,strat, strat->tl+1);
180          enterT(h, strat);
181          strat->fromQ[pos]=1;
182        }
183      }
184    }
185  }
186  /*- put polys into S -*/
187  for (i=0; i<IDELEMS(F); i++)
188  {
189    if (F->m[i]!=NULL)
190    {
191      LObject h;
192      h.p = pCopy(F->m[i]);
193      if (pOrdSgn==1)
194      {
195        //h.p=redtailBba(h.p,strat->sl,strat);
196        h.p=redtailBba(h.p,strat->sl,strat);
197      }
198      strat->initEcart(&h);
199      if (pOrdSgn==-1)
200      {
201        deleteHC(&h,strat);
202      }
203      if (h.p!=NULL)
204      {
205        if (strat->sl==-1)
206          pos =0;
207        else
208          pos = posInS(strat,strat->sl,h.p,h.ecart);
209        h.sev = pGetShortExpVector(h.p);
210        strat->enterS(h,pos,strat, strat->tl+1);
211        h.length = pLength(h.p);
212        h.SetpFDeg();
213        enterT(h,strat);
214      }
215    }
216  }
217#ifdef INITSSPECIAL
218  for (i=0; i<IDELEMS(P); i++)
219  {
220    if (P->m[i]!=NULL)
221    {
222      LObject h;
223      h.p=pCopy(P->m[i]);
224      strat->initEcart(&h);
225      h.length = pLength(h.p);
226      if (TEST_OPT_INTSTRATEGY)
227      {
228        h.pCleardenom();
229      }
230      else
231      {
232        h.pNorm();
233      }
234      if(strat->sl>=0)
235      {
236        if (pOrdSgn==1)
237        {
238          h.p=redBba(h.p,strat->sl,strat);
239          if (h.p!=NULL)
240            h.p=redtailBba(h.p,strat->sl,strat);
241        }
242        else
243        {
244          h.p=redMora(h.p,strat->sl,strat);
245          strat->initEcart(&h);
246        }
247        if(h.p!=NULL)
248        {
249          if (TEST_OPT_INTSTRATEGY)
250          {
251            h.pCleardenom();
252          }
253          else
254          {
255            h.is_normalized = 0;
256            h.pNorm();
257          }
258          h.sev = pGetShortExpVector(h.p);
259          h.SetpFDeg();
260          pos = posInS(strat->S,strat->sl,h.p,h.ecart);
261          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
262          strat->enterS(h,pos,strat, strat->tl+1);
263          enterT(h,strat);
264        }
265      }
266      else
267      {
268        h.sev = pGetShortExpVector(h.p);
269        h.SetpFDeg();
270        strat->enterS(h,0,strat, strat->tl+1);
271        enterT(h,strat);
272      }
273    }
274  }
275#endif
276}
277
278/*2
279*interreduces F
280*/
281static ideal kInterRedCC(ideal F, ideal Q)
282{
283  int j;
284  kStrategy strat = new skStrategy;
285
286//  if (TEST_OPT_PROT)
287//  {
288//    writeTime("start InterRed:");
289//    mflush();
290//  }
291  //strat->syzComp     = 0;
292  strat->kHEdgeFound = ppNoether != NULL;
293  strat->kNoether=pCopy(ppNoether);
294  strat->ak = idRankFreeModule(F);
295  initBuchMoraCrit(strat);
296  strat->NotUsedAxis = (BOOLEAN *)omAlloc((pVariables+1)*sizeof(BOOLEAN));
297  for (j=pVariables; j>0; j--) strat->NotUsedAxis[j] = TRUE;
298  strat->enterS      = enterSBba;
299  strat->posInT      = posInT0;
300  strat->initEcart   = initEcartNormal;
301  strat->sl   = -1;
302  strat->tl          = -1;
303  strat->tmax        = setmaxT;
304  strat->T           = initT();
305  strat->R           = initR();
306  strat->sevT        = initsevT();
307  if (pOrdSgn == -1)   strat->honey = TRUE;
308
309
310  //initSCC(F,Q,strat);
311  initS(F,Q,strat);
312
313  /*
314  timetmp=clock();//22.01.02
315  initSSpecialCC(F,Q,NULL,strat);
316  tininitS=tininitS+clock()-timetmp;//22.01.02
317  */
318  if (TEST_OPT_REDSB)
319    strat->noTailReduction=FALSE;
320
321  updateS(TRUE,strat);
322
323  if (TEST_OPT_REDSB && TEST_OPT_INTSTRATEGY)
324    completeReduce(strat);
325  pDelete(&strat->kHEdge);
326  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
327  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
328  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
329  omFreeSize((ADDRESS)strat->NotUsedAxis,(pVariables+1)*sizeof(BOOLEAN));
330  omfree(strat->sevT);
331  omfree(strat->S_2_R);
332  omfree(strat->R);
333
334  if (strat->fromQ)
335  {
336    for (j=0;j<IDELEMS(strat->Shdl);j++)
337    {
338      if(strat->fromQ[j]) pDelete(&strat->Shdl->m[j]);
339    }
340    omFreeSize((ADDRESS)strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
341    strat->fromQ=NULL;
342  }
343//  if (TEST_OPT_PROT)
344//  {
345//    writeTime("end Interred:");
346//    mflush();
347//  }
348  ideal shdl=strat->Shdl;
349  idSkipZeroes(shdl);
350  delete(strat);
351
352  return shdl;
353}
354
355static void TimeString(clock_t tinput, clock_t tostd, clock_t tif,clock_t tstd,
356                       clock_t tlf,clock_t tred, clock_t tnw, int step)
357{
358  double totm = ((double) (clock() - tinput))/1000000;
359  double ostd,mostd, mif, mstd, mextra, mlf, mred, mnw, mxif,mxstd,mxlf,mxred,mxnw,tot;
360
361  Print("\n// total time = %.2f sec", totm);
362  Print("\n// tostd = %.2f sec = %.2f %", ostd=((double) tostd)/1000000,
363        mostd=((((double) tostd)/1000000)/totm)*100);
364  Print("\n// tif   = %.2f sec = %.2f %", ((double) tif)/1000000,
365        mif=((((double) tif)/1000000)/totm)*100);
366  Print("\n// std   = %.2f sec = %.2f %", ((double) tstd)/1000000,
367        mstd=((((double) tstd)/1000000)/totm)*100);
368  Print("\n// lift  = %.2f sec = %.2f %", ((double) tlf)/1000000,
369        mlf=((((double) tlf)/1000000)/totm)*100);
370  Print("\n// ired  = %.2f sec = %.2f %", ((double) tred)/1000000,
371        mred=((((double) tred)/1000000)/totm)*100);
372  Print("\n// nextw = %.2f sec = %.2f %", ((double) tnw)/1000000,
373        mnw=((((double) tnw)/1000000)/totm)*100);
374  PrintS("\n Time for the last step:");
375  Print("\n// xinfo = %.2f sec = %.2f %", ((double) xtif)/1000000,
376        mxif=((((double) xtif)/1000000)/totm)*100);
377  Print("\n// xstd  = %.2f sec = %.2f %", ((double) xtstd)/1000000,
378        mxstd=((((double) xtstd)/1000000)/totm)*100);
379  Print("\n// xlift = %.2f sec = %.2f %", ((double) xtlift)/1000000,
380        mxlf=((((double) xtlift)/1000000)/totm)*100);
381  Print("\n// xired = %.2f sec = %.2f %", ((double) xtred)/1000000,
382        mxred=((((double) xtred)/1000000)/totm)*100);
383  Print("\n// xnextw= %.2f sec = %.2f %", ((double) xtnw)/1000000,
384        mxnw=((((double) xtnw)/1000000)/totm)*100);
385
386  tot=mostd+mif+mstd+mlf+mred+mnw+mxif+mxstd+mxlf+mxred+mxnw;
387  double res = (double) 100 - tot;
388  Print("\n// &%d&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f(%.2f)\\ \\",
389        step, ostd, totm, mostd,mif,mstd,mlf,mred,mnw,mxif,mxstd,mxlf,mxred,mxnw,tot,res,
390        ((((double) xtextra)/1000000)/totm)*100);
391}
392
393static void TimeStringFractal(clock_t tinput, clock_t tostd, clock_t tif,clock_t tstd,
394                       clock_t textra, clock_t tlf,clock_t tred, clock_t tnw)
395{
396
397  double totm = ((double) (clock() - tinput))/1000000;
398  double ostd, mostd, mif, mstd, mextra, mlf, mred, mnw, tot, res;
399  Print("\n// total time = %.2f sec", totm);
400  Print("\n// tostd = %.2f sec = %.2f %", ostd=((double) tostd)/1000000,
401        mostd=((((double) tostd)/1000000)/totm)*100);
402  Print("\n// tif   = %.2f sec = %.2f %", ((double) tif)/1000000,
403        mif=((((double) tif)/1000000)/totm)*100);
404  Print("\n// std   = %.2f sec = %.2f %", ((double) tstd)/1000000,
405        mstd=((((double) tstd)/1000000)/totm)*100);
406  Print("\n// xstd  = %.2f sec = %.2f %", ((double) textra)/1000000,
407        mextra=((((double) textra)/1000000)/totm)*100);
408  Print("\n// lift  = %.2f sec = %.2f %", ((double) tlf)/1000000,
409        mlf=((((double) tlf)/1000000)/totm)*100);
410  Print("\n// ired  = %.2f sec = %.2f %", ((double) tred)/1000000,
411        mred=((((double) tred)/1000000)/totm)*100);
412  Print("\n// nextw = %.2f sec = %.2f %", ((double) tnw)/1000000,
413        mnw=((((double) tnw)/1000000)/totm)*100);
414  tot = mostd+mif+mstd+mextra+mlf+mred+mnw;
415  res = (double) 100.00-tot;
416  Print("\n// &%.2f &%.2f&%.2f &%.2f &%.2f &%.2f &%.2f &%.2f &%.2f&%.2f&%.2f\\ \\ ",
417        ostd,totm,mostd,mif,mstd,mextra,mlf,mred,mnw,tot,res);
418}
419
420static void idString(ideal L, char* st)
421{
422  int i, nL = IDELEMS(L);
423
424  Print("\n//  ideal %s =  ", st);
425  for(i=0; i<nL-1; i++)
426    Print(" %s, ", pString(L->m[i]));
427
428  Print(" %s;", pString(L->m[nL-1]));
429}
430
431static void headidString(ideal L, char* st)
432{
433  int i, nL = IDELEMS(L);
434
435  Print("\n//  ideal %s =  ", st);
436  for(i=0; i<nL-1; i++)
437    Print(" %s, ", pString(pHead(L->m[i])));
438
439  Print(" %s;", pString(pHead(L->m[nL-1])));
440}
441
442static void idElements(ideal L, char* st)
443{
444  int i, nL = IDELEMS(L);
445  int *K=(int *)omAlloc(nL*sizeof(int));
446
447  Print("\n//  #monoms of %s =  ", st);
448  for(i=0; i<nL; i++)
449    K[i] = pLength(L->m[i]);
450
451  int j, nsame, nk=0;
452  for(i=0; i<nL; i++)
453  {
454    if(K[i]!=0)
455    {
456      nsame = 1;
457      for(j=i+1; j<nL; j++){
458        if(K[j]==K[i]){
459          nsame ++;
460          K[j]=0;
461        }
462      }
463      if(nsame == 1)
464        Print("%d, ",K[i]);
465      else
466        Print("%d[%d], ", K[i], nsame);
467    }
468  }
469  omFree(K);
470}
471
472
473
474static void ivString(intvec* iv, char* ch)
475{
476  int nV = iv->length()-1;
477  //Print("\n// vector %s =  (", ch);
478  Print("\n// intvec %s =  ", ch);
479
480  for(int i=0; i<nV; i++)
481    Print("%d, ", (*iv)[i]);
482  Print("%d;", (*iv)[nV]);
483}
484
485static void MivString(intvec* iva, intvec* ivb, intvec* ivc)
486{
487  int nV = iva->length()-1;
488  int i;
489  PrintS("\n//  (");
490  for(i=0; i<nV; i++)
491    Print("%d, ", (*iva)[i]);
492  Print("%d) ==> (", (*iva)[nV]);
493
494  for(i=0; i<nV; i++)
495    Print("%d, ", (*ivb)[i]);
496  Print("%d) := (", (*ivb)[nV]);
497
498  for(i=0; i<nV; i++)
499    Print("%d, ", (*ivc)[i]);
500  Print("%d)", (*ivc)[nV]);
501}
502
503
504// returns gcd of integers a and b
505static inline long gcd(const long a, const long b)
506{
507  long r, p0 = a, p1 = b;
508  //assume(p0 >= 0 && p1 >= 0);
509  if(p0 < 0)
510    p0 = -p0;
511
512  if(p1 < 0)
513    p1 = -p1;
514
515  while(p1 != 0)
516  {
517    r = p0 % p1;
518    p0 = p1;
519    p1 = r;
520  }
521  return p0;
522}
523
524// cancel gcd of integers zaehler and nenner
525static void cancel(mpz_t zaehler, mpz_t nenner)
526{
527//  assume(zaehler >= 0 && nenner > 0);
528  mpz_t g;
529  mpz_init(g);
530  mpz_gcd(g, zaehler, nenner);
531
532  mpz_div(zaehler , zaehler, g);
533  mpz_div(nenner ,  nenner, g);
534
535  mpz_clear(g);
536}
537
538/* 23.07.03 */
539static int isVectorNeg(intvec* omega)
540{
541  int i;
542
543  for(i=omega->length(); i>=0; i--)
544    if((*omega)[i]<0)
545      return 1;
546
547  return 0;
548}
549
550/********************************************************************
551 * compute a weight degree of a monomial p w.r.t. a weight_vector   *
552 ********************************************************************/
553static inline int MLmWeightedDegree(const poly p, intvec* weight)
554{
555  /* 2147483647 is max. integer representation in SINGULAR */
556  mpz_t sing_int;
557  mpz_init_set_ui(sing_int,  2147483647);
558
559  int i, wgrad;
560
561  mpz_t zmul;
562  mpz_init(zmul);
563  mpz_t zvec;
564  mpz_init(zvec);
565  mpz_t zsum;
566  mpz_init(zsum);
567
568  for (i=pVariables; i>0; i--)
569  {
570    mpz_set_si(zvec, (*weight)[i-1]);
571    mpz_mul_ui(zmul, zvec, pGetExp(p, i));
572    mpz_add(zsum, zsum, zmul);
573  }
574
575  wgrad = mpz_get_ui(zsum);
576
577  if(mpz_cmp(zsum, sing_int)>0)
578  {
579    if(Overflow_Error ==  FALSE) {
580      PrintLn();
581      PrintS("\n// ** OVERFLOW in \"MwalkInitialForm\": ");
582      mpz_out_str( stdout, 10, zsum);
583      PrintS(" is greater than 2147483647 (max. integer representation)");
584      Overflow_Error = TRUE;
585    }
586  }
587
588  return wgrad;
589}
590
591/********************************************************************
592 * compute a weight degree of a polynomial p w.r.t. a weight_vector *
593 ********************************************************************/
594static inline int MwalkWeightDegree(poly p, intvec* weight_vector)
595{
596  assume(weight_vector->length() >= pVariables);
597  int max = 0, maxtemp;
598
599  while(p != NULL)
600  {
601    maxtemp = MLmWeightedDegree(p, weight_vector);
602    pIter(p);
603
604    if (maxtemp > max)
605      max = maxtemp;
606  }
607  return max;
608}
609
610
611/********************************************************************
612 * compute a weight degree of a monomial p w.r.t. a weight_vector *
613 ********************************************************************/
614static  void  MLmWeightedDegree_gmp(mpz_t result, const poly p, intvec* weight)
615{
616  /* 2147483647 is max. integer representation in SINGULAR */
617  mpz_t sing_int;
618  mpz_init_set_ui(sing_int,  2147483647);
619
620  int i, wgrad;
621
622  mpz_t zmul;
623  mpz_init(zmul);
624  mpz_t zvec;
625  mpz_init(zvec);
626  mpz_t ztmp;
627  mpz_init(ztmp);
628
629  for (i=pVariables; i>0; i--)
630  {
631    mpz_set_si(zvec, (*weight)[i-1]);
632    mpz_mul_ui(zmul, zvec, pGetExp(p, i));
633    mpz_add(ztmp, ztmp, zmul);
634  }
635  mpz_init_set(result, ztmp);
636  mpz_clear(ztmp);
637  mpz_clear(sing_int);
638  mpz_clear(zvec);
639  mpz_clear(zmul);
640}
641
642
643/*****************************************************************************
644 * return an initial form of the polynom g w.r.t. a weight vector curr_weight *
645 *****************************************************************************/
646static poly MpolyInitialForm(poly g, intvec* curr_weight)
647{
648  if(g == NULL)
649    return NULL;
650
651  mpz_t max; mpz_init(max);
652  mpz_t maxtmp; mpz_init(maxtmp);
653
654  poly hg, in_w_g = NULL;
655
656  while(g != NULL)
657  {
658    hg = g;
659    pIter(g);
660    MLmWeightedDegree_gmp(maxtmp, hg, curr_weight);
661
662    if(mpz_cmp(maxtmp, max)>0)
663    {
664      mpz_init_set(max, maxtmp);
665      pDelete(&in_w_g);
666      in_w_g = pHead(hg);
667    }
668    else {
669      if(mpz_cmp(maxtmp, max)==0)
670        in_w_g = pAdd(in_w_g, pHead(hg));
671    }
672  }
673  return in_w_g;
674}
675
676/************************************************************************
677 * compute the initial form of an ideal <G> w.r.t. a weight vector iva  *
678 ************************************************************************/
679ideal MwalkInitialForm(ideal G, intvec* ivw)
680{
681  BOOLEAN nError =  Overflow_Error;
682  Overflow_Error = FALSE;
683
684  int i, nG = IDELEMS(G);
685  ideal Gomega = idInit(nG, 1);
686
687  for(i=nG-1; i>=0; i--)
688    Gomega->m[i] = MpolyInitialForm(G->m[i], ivw);
689
690  if(Overflow_Error == FALSE)
691    Overflow_Error = nError;
692
693  return Gomega;
694}
695
696/************************************************************************
697 * test whether the weight vector iv is in the cone of the ideal G      *
698 *            i.e. are in(in_w(g)) =? in(g), for all g in G             *
699 ************************************************************************/
700
701static int test_w_in_ConeCC(ideal G, intvec* iv)
702{
703  if(G->m[0] == NULL)
704  {
705    PrintS("//** the result may be WRONG, i.e. 0!!\n");
706    return 0;
707  }
708
709  BOOLEAN nError =  Overflow_Error;
710  Overflow_Error = FALSE;
711
712  int i, nG = IDELEMS(G);
713  poly mi, gi;
714
715  for(i=nG-1; i>=0; i--)
716  {
717    mi = MpolyInitialForm(G->m[i], iv);
718    gi = G->m[i];
719
720    if(mi == NULL)
721    {
722      pDelete(&mi);
723
724      if(Overflow_Error == FALSE)
725        Overflow_Error = nError;
726
727      return 0;
728    }
729    if(!pLmEqual(mi, gi))
730    {
731      pDelete(&mi);
732
733      if(Overflow_Error == FALSE)
734        Overflow_Error = nError;
735
736      return 0;
737    }
738
739    pDelete(&mi);
740  }
741
742  if(Overflow_Error == FALSE)
743    Overflow_Error = nError;
744
745  return 1;
746}
747
748
749//compute a least common multiple of two integers
750static inline long Mlcm(long &i1, long &i2)
751{
752  long temp = gcd(i1, i2);
753  return ((i1 / temp)* i2);
754}
755
756
757/***************************************************
758 * return  the dot product of two intvecs a and b  *
759 ***************************************************/
760static inline long  MivDotProduct(intvec* a, intvec* b)
761{
762  assume( a->length() ==  b->length());
763  int i, n = a->length();
764  long result = 0;
765
766  for(i=n-1; i>=0; i--)
767    result += (*a)[i] * (*b)[i];
768
769  return result;
770}
771
772
773static intvec* MivSub(intvec* a, intvec* b)
774{
775  assume( a->length() ==  b->length());
776  int i, n = a->length();
777  intvec* result = new intvec(n);
778
779  for(i=n-1; i>=0; i--)
780    (*result)[i] = (*a)[i] - (*b)[i];
781
782  return result;
783}
784
785/**21.10.00*******************************************
786 * return the "intvec" lead exponent of a polynomial *
787 *****************************************************/
788static intvec* MExpPol(poly f)
789{
790  int i, nR = currRing->N;
791  intvec* result = new intvec(nR);
792
793  for(i=nR-1; i>=0; i--)
794    (*result)[i] = pGetExp(f,i+1);
795
796  return result;
797}
798
799/* return 1, if two given intvecs are the same, otherwise 0*/
800int MivSame(intvec* u , intvec* v)
801{
802  assume(u->length() == v->length());
803
804  int i, niv = u->length();
805
806  for (i=0; i<niv; i++)
807    if ((*u)[i] != (*v)[i])
808      return 0;
809
810  return 1;
811}
812
813int M3ivSame(intvec* temp, intvec* u , intvec* v)
814{
815  assume(temp->length() == u->length() && u->length() == v->length());
816
817  if((MivSame(temp, u)) == 1)
818    return 0;
819
820  if((MivSame(temp, v)) == 1)
821    return 1;
822
823  return 2;
824}
825
826
827/* compute a Groebner basis of an ideal */
828static ideal MstdCC(ideal G)
829{
830  int save_test=test;
831  test|=(Sy_bit(OPT_REDTAIL)|Sy_bit(OPT_REDSB));
832  ideal G1 = kStd(G, NULL, testHomog, NULL);
833  test=save_test;
834
835  idSkipZeroes(G1);
836  return G1;
837}
838
839
840/* compute a Groebner basis of a homogenoues ideal */
841static ideal MstdhomCC(ideal G)
842{
843  int save_test=test;
844  test|=(Sy_bit(OPT_REDTAIL)|Sy_bit(OPT_REDSB));
845  ideal G1 = kStd(G, NULL, isHomog, NULL);
846  test=save_test;
847
848  idSkipZeroes(G1);
849  return G1;
850}
851
852
853/*****************************************************************************
854* create a weight matrix order as intvec of an extra weight vector (a(iv),lp)*
855******************************************************************************/
856intvec* MivMatrixOrder(intvec* iv)
857{
858  int i,j, nR = iv->length();
859  intvec* ivm = new intvec(nR*nR);
860
861  for(i=0; i<nR; i++)
862    (*ivm)[i] = (*iv)[i];
863
864  for(i=1; i<nR; i++)
865    (*ivm)[i*nR+i-1] = 1;
866
867  return ivm;
868}
869
870/* return intvec = (1, ..., 1) */
871intvec* Mivdp(int nR)
872{
873  int i;
874  intvec* ivm = new intvec(nR);
875
876  for(i=nR-1; i>=0; i--)
877    (*ivm)[i] = 1;
878
879  return ivm;
880}
881
882/* return intvvec = (1,0, ..., 0) */
883intvec* Mivlp(int nR)
884{
885  int i;
886  intvec* ivm = new intvec(nR);
887  (*ivm)[0] = 1;
888
889  return ivm;
890}
891
892/**** 28.10.02  print the max total degree and the max coefficient of G***/
893static void checkComplexity(ideal G, char* cG)
894{
895  int nV = currRing->N;
896  int nG = IDELEMS(G);
897  intvec* ivUnit = Mivdp(nV);//19.02
898  int i,j, tmpdeg, maxdeg=0;
899  number tmpcoeff , maxcoeff=nNULL;
900  poly p;
901  for(i=nG-1; i>=0; i--)
902  {
903    tmpdeg = MwalkWeightDegree(G->m[i], ivUnit);
904    if (tmpdeg > maxdeg )
905      maxdeg = tmpdeg;
906  }
907
908  for(i=nG-1; i>=0; i--)
909  {
910    p = pCopy(G->m[i]);
911    while(p != NULL)
912    {
913      //tmpcoeff = pGetCoeff(pHead(p));
914      tmpcoeff = pGetCoeff(p);
915      if(nGreater(tmpcoeff,maxcoeff))
916         maxcoeff = nCopy(tmpcoeff);
917      pIter(p);
918    }
919    pDelete(&p);
920  }
921  p = pNSet(maxcoeff);
922  char* pStr = pString(p);
923  Print("// max total degree of %s = %d\n",cG, maxdeg);
924  Print("// max coefficient of %s  = %s", cG, pStr);//ing(p));
925  Print(" which consists of %d digits", strlen(pStr));
926  PrintLn();
927}
928
929
930
931/*****************************************************************************
932* If target_ord = intmat(A1, ..., An) then calculate the perturbation        *
933* vectors                                                                    *
934*   tau_p_dep = inveps^(p_deg-1)*A1 + inveps^(p_deg-2)*A2 +... + A_p_deg     *
935* where                                                                      *
936*      inveps > totaldegree(G)*(max(A2)+...+max(A_p_deg))                    *
937* intmat target_ord is an integer order matrix of the monomial ordering of   *
938* basering.                                                                  *
939* This programm computes a perturbated vector with a p_deg perturbation      *
940* degree which smaller than the numbers of variables                         *
941******************************************************************************/
942/* ivtarget is a matrix order of a degree reverse lex. order */
943intvec* MPertVectors(ideal G, intvec* ivtarget, int pdeg)
944{
945  int nV = currRing->N;
946  //assume(pdeg <= nV && pdeg >= 0);
947
948  int i, j, nG = IDELEMS(G);
949  intvec* v_null =  new intvec(nV);
950
951
952  //Checking that the perturbed degree is valid
953  if(pdeg > nV || pdeg <= 0)
954  {
955    WerrorS("//** The perturbed degree is wrong!!");
956    return v_null;
957  }
958  delete v_null;
959
960  if(pdeg == 1)
961    return ivtarget;
962
963  mpz_t *pert_vector=(mpz_t*)omAlloc(nV*sizeof(mpz_t));
964
965  for(i=0; i<nV; i++)
966    mpz_init_set_si(pert_vector[i], (*ivtarget)[i]);
967
968
969  // Calculate max1 = Max(A2)+Max(A3)+...+Max(Apdeg),
970  // where the Ai are the i-te rows of the matrix target_ord.
971
972  int ntemp, maxAi, maxA=0;
973  for(i=1; i<pdeg; i++)
974  {
975    maxAi = (*ivtarget)[i*nV];
976    if(maxAi<0) maxAi = -maxAi;
977
978    for(j=i*nV+1; j<(i+1)*nV; j++)
979    {
980      ntemp = (*ivtarget)[j];
981      if(ntemp < 0) ntemp = -ntemp;
982
983      if(ntemp > maxAi)
984        maxAi = ntemp;
985    }
986    maxA += maxAi;
987  }
988
989  // Calculate inveps = 1/eps, where 1/eps > totaldeg(p)*max1 for all p in G.
990
991  intvec* ivUnit = Mivdp(nV);
992
993  mpz_t tot_deg; mpz_init(tot_deg);
994  mpz_t maxdeg; mpz_init(maxdeg);
995  mpz_t inveps; mpz_init(inveps);
996
997
998  for(i=nG-1; i>=0; i--)
999  {
1000    mpz_set_ui(maxdeg, MwalkWeightDegree(G->m[i], ivUnit));
1001    if (mpz_cmp(maxdeg,  tot_deg) > 0 )
1002      mpz_set(tot_deg, maxdeg);
1003  }
1004
1005  delete ivUnit;
1006  mpz_mul_ui(inveps, tot_deg, maxA);
1007  mpz_add_ui(inveps, inveps, 1);
1008
1009
1010  //xx1.06.02 takes  "small" inveps
1011#ifdef INVEPS_SMALL_IN_MPERTVECTOR
1012  if(mpz_cmp_ui(inveps, pdeg)>0 && pdeg > 3)
1013  {
1014    /*
1015      Print("\n// choose the\"small\" inverse epsilon := %d / %d = ",
1016      mpz_get_si(inveps), pdeg);
1017    */
1018    mpz_fdiv_q_ui(inveps, inveps, pdeg);
1019    //mpz_out_str(stdout, 10, inveps);
1020  }
1021#else
1022  //PrintS("\n// the \"big\" inverse epsilon: ");
1023  mpz_out_str(stdout, 10, inveps);
1024#endif
1025
1026  // pert(A1) = inveps^(pdeg-1)*A1 + inveps^(pdeg-2)*A2+...+A_pdeg,
1027  // pert_vector := A1
1028  for ( i=1; i < pdeg; i++ )
1029    for(j=0; j<nV; j++)
1030    {
1031      mpz_mul(pert_vector[j], pert_vector[j], inveps);
1032      if((*ivtarget)[i*nV+j]<0)
1033        mpz_sub_ui(pert_vector[j], pert_vector[j],-(*ivtarget)[i*nV+j]);
1034      else
1035        mpz_add_ui(pert_vector[j], pert_vector[j],(*ivtarget)[i*nV+j]);
1036    }
1037
1038  mpz_t ztemp;
1039  mpz_init(ztemp);
1040  mpz_set(ztemp, pert_vector[0]);
1041  for(i=1; i<nV; i++)
1042  {
1043    mpz_gcd(ztemp, ztemp, pert_vector[i]);
1044    if(mpz_cmp_si(ztemp, 1)  == 0)
1045      break;
1046  }
1047  if(mpz_cmp_si(ztemp, 1) != 0)
1048    for(i=0; i<nV; i++)
1049      mpz_divexact(pert_vector[i], pert_vector[i], ztemp);
1050
1051  intvec* result = new intvec(nV);
1052  /* 2147483647 is max. integer representation in SINGULAR */
1053  mpz_t sing_int;
1054  mpz_init_set_ui(sing_int,  2147483647);
1055
1056  int ntrue=0;
1057  for(i=0; i<nV; i++)
1058  {
1059    (*result)[i] = mpz_get_si(pert_vector[i]);
1060
1061    if(mpz_cmp(pert_vector[i], sing_int)>=0)
1062    {
1063      ntrue++;
1064      if(Overflow_Error == FALSE)
1065      {
1066        Overflow_Error = TRUE;
1067        PrintS("\n// ** OVERFLOW in \"MPertvectors\": ");
1068        mpz_out_str( stdout, 10, pert_vector[i]);
1069        PrintS(" is greater than 2147483647 (max. integer representation)");
1070        Print("\n//  So vector[%d] := %d is wrong!!", i+1, (*result)[i]);
1071      }
1072    }
1073  }
1074
1075  if(Overflow_Error == TRUE)
1076  {
1077    ivString(result, "pert_vector");
1078    Print("\n// %d element(s) of it is overflow!!", ntrue);
1079  }
1080
1081  mpz_clear(ztemp);
1082  mpz_clear(sing_int);
1083  omFree(pert_vector);
1084  return result;
1085}
1086
1087
1088/* ivtarget is a matrix order of the lex. order */
1089intvec* MPertVectorslp(ideal G, intvec* ivtarget, int pdeg)
1090{
1091  int nV = currRing->N;
1092  //assume(pdeg <= nV && pdeg >= 0);
1093
1094  int i, j, nG = IDELEMS(G);
1095  intvec* pert_vector =  new intvec(nV);
1096
1097  //Checking that the perturbated degree is valid
1098  if(pdeg > nV || pdeg <= 0)
1099  {
1100    WerrorS("//** The perturbed degree is wrong!!");
1101    return pert_vector;
1102  }
1103  for(i=0; i<nV; i++)
1104    (*pert_vector)[i]=(*ivtarget)[i];
1105
1106  if(pdeg == 1)
1107    return pert_vector;
1108
1109  // Calculate max1 = Max(A2)+Max(A3)+...+Max(Apdeg),
1110  // where the Ai are the i-te rows of the matrix target_ord.
1111  int ntemp, maxAi, maxA=0;
1112  for(i=1; i<pdeg; i++)
1113  {
1114    maxAi = (*ivtarget)[i*nV];
1115    for(j=i*nV+1; j<(i+1)*nV; j++)
1116    {
1117      ntemp = (*ivtarget)[j];
1118      if(ntemp > maxAi)
1119        maxAi = ntemp;
1120    }
1121    maxA += maxAi;
1122  }
1123
1124  // Calculate inveps := 1/eps, where 1/eps > deg(p)*max1 for all p in G.
1125  int inveps, tot_deg = 0, maxdeg;
1126
1127  intvec* ivUnit = Mivdp(nV);//19.02
1128  for(i=nG-1; i>=0; i--)
1129  {
1130    //maxdeg = pTotaldegree(G->m[i], currRing); //it's wrong for ex1,2,rose
1131    maxdeg = MwalkWeightDegree(G->m[i], ivUnit);
1132    if (maxdeg > tot_deg )
1133      tot_deg = maxdeg;
1134  }
1135  delete ivUnit;
1136
1137  inveps = (tot_deg * maxA) + 1;
1138
1139  //9.10.01
1140#ifdef INVEPS_SMALL_IN_FRACTAL
1141  /*
1142    Print("\n// choose the\"small\" inverse epsilon := %d / %d = ",
1143    inveps, pdeg);
1144  */
1145  if(inveps > pdeg && pdeg > 3)
1146    inveps = inveps / pdeg;
1147
1148  //Print(" %d", inveps);
1149#else
1150  PrintS("\n// the \"big\" inverse epsilon %d", inveps);
1151#endif
1152
1153  // Pert(A1) = inveps^(pdeg-1)*A1 + inveps^(pdeg-2)*A2+...+A_pdeg,
1154  for ( i=1; i < pdeg; i++ )
1155    for(j=0; j<nV; j++)
1156      (*pert_vector)[j] = inveps*((*pert_vector)[j]) + (*ivtarget)[i*nV+j];
1157
1158  int temp = (*pert_vector)[0];
1159  for(i=1; i<nV; i++)
1160  {
1161    temp = gcd(temp, (*pert_vector)[i]);
1162    if(temp == 1)
1163      break;
1164  }
1165  if(temp != 1)
1166    for(i=0; i<nV; i++)
1167      (*pert_vector)[i] = (*pert_vector)[i] / temp;
1168
1169  intvec* result = pert_vector;
1170  pert_vector = NULL;
1171  return result;
1172}
1173
1174
1175/* define a lexicographic order matrix as intvec */
1176intvec* MivMatrixOrderlp(int nV)
1177{
1178  int i;
1179  intvec* ivM = new intvec(nV*nV);
1180
1181  for(i=0; i<nV; i++)
1182    (*ivM)[i*nV + i] = 1;
1183
1184  return(ivM);
1185}
1186
1187/* define a rlex order (dp) matrix as intvec */
1188intvec* MivMatrixOrderdp(int nV)
1189{
1190  int i;
1191  intvec* ivM = new intvec(nV*nV);
1192
1193  for(i=0; i<nV; i++)
1194    (*ivM)[i] = 1;
1195
1196  for(i=1; i<nV; i++)
1197    (*ivM)[(i+1)*nV - i] = -1;
1198
1199  return(ivM);
1200}
1201
1202//creates an intvec of the monomial order Wp(ivstart)
1203intvec* MivWeightOrderlp(intvec* ivstart)
1204{
1205  int i;
1206  int nV = ivstart->length();
1207  intvec* ivM = new intvec(nV*nV);
1208
1209  for(i=0; i<nV; i++)
1210    (*ivM)[i] = (*ivstart)[i];
1211
1212  for(i=1; i<nV; i++)
1213    (*ivM)[i*nV + i-1] = 1;
1214
1215  return(ivM);
1216}
1217
1218intvec* MivWeightOrderdp(intvec* ivstart)
1219{
1220  int i;
1221  int nV = ivstart->length();
1222  intvec* ivM = new intvec(nV*nV);
1223
1224  for(i=0; i<nV; i++)
1225    (*ivM)[i] = (*ivstart)[i];
1226
1227  for(i=0; i<nV; i++)
1228    (*ivM)[nV+i] = 1;
1229
1230  for(i=2; i<nV; i++)
1231    (*ivM)[(i+1)*nV - i] = -1;
1232
1233  return(ivM);
1234}
1235
1236static intvec* MatrixOrderdp(int nV)
1237{
1238  int i;
1239  intvec* ivM = new intvec(nV*nV);
1240
1241  for(i=0; i<nV; i++)
1242    (*ivM)[i] = 1;
1243
1244  for(i=1; i<nV; i++)
1245    (*ivM)[(i+1)*nV - i] = -1;
1246
1247  return(ivM);
1248}
1249
1250intvec* MivUnit(int nV)
1251{
1252  int i;
1253  intvec* ivM = new intvec(nV);
1254
1255  for(i=nV-1; i>=0; i--)
1256    (*ivM)[i] = 1;
1257
1258  return(ivM);
1259}
1260
1261
1262/************************************************************************
1263*  compute a perturbed weight vector of a matrix order w.r.t. an ideal  *
1264*************************************************************************/
1265int Xnlev;
1266
1267intvec* Mfpertvector(ideal G, intvec* ivtarget)
1268{
1269  int i, j, nG = IDELEMS(G);
1270  int nV = currRing->N;
1271  int niv = nV*nV;
1272
1273  // Calculate max1 = Max(A2) + Max(A3) + ... + Max(AnV),
1274  // where the Ai are the i-te rows of the matrix 'targer_ord'.
1275  int ntemp, maxAi, maxA=0;
1276  for(i=1; i<nV; i++)
1277  {
1278    maxAi = (*ivtarget)[i*nV];
1279    if(maxAi<0) maxAi = -maxAi;
1280
1281    for(j=i*nV+1; j<(i+1)*nV; j++)
1282    {
1283      ntemp = (*ivtarget)[j];
1284      if(ntemp < 0) ntemp = -ntemp;
1285
1286      if(ntemp > maxAi)
1287        maxAi = ntemp;
1288    }
1289    maxA = maxA + maxAi;
1290  }
1291  intvec* ivUnit = Mivdp(nV);
1292
1293  // Calculate inveps = 1/eps, where 1/eps > deg(p)*max1 for all p in G.
1294  mpz_t tot_deg; mpz_init(tot_deg);
1295  mpz_t maxdeg; mpz_init(maxdeg);
1296  mpz_t inveps; mpz_init(inveps);
1297
1298
1299  for(i=nG-1; i>=0; i--)
1300  {
1301    mpz_set_ui(maxdeg, MwalkWeightDegree(G->m[i], ivUnit));
1302    if (mpz_cmp(maxdeg,  tot_deg) > 0 )
1303      mpz_set(tot_deg, maxdeg);
1304  }
1305
1306  delete ivUnit;
1307  //inveps = (tot_deg * maxA) + 1;
1308  mpz_mul_ui(inveps, tot_deg, maxA);
1309  mpz_add_ui(inveps, inveps, 1);
1310
1311  //xx1.06.02 takes  "small" inveps
1312#ifdef INVEPS_SMALL_IN_FRACTAL
1313  if(mpz_cmp_ui(inveps, nV)>0 && nV > 3)
1314    mpz_cdiv_q_ui(inveps, inveps, nV);
1315
1316  //PrintS("\n// choose the \"small\" inverse epsilon!");
1317#endif
1318
1319  // PrintLn();  mpz_out_str(stdout, 10, inveps);
1320
1321  // Calculate the perturbed target orders:
1322  mpz_t *ivtemp=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
1323  mpz_t *pert_vector=(mpz_t *)omAlloc(niv*sizeof(mpz_t));
1324
1325  for(i=0; i<nV; i++)
1326  {
1327    mpz_init_set_si(ivtemp[i], (*ivtarget)[i]);
1328    mpz_init_set_si(pert_vector[i], (*ivtarget)[i]);
1329  }
1330
1331  mpz_t ztmp; mpz_init(ztmp);
1332  BOOLEAN isneg = FALSE;
1333
1334  for(i=1; i<nV; i++)
1335  {
1336    for(j=0; j<nV; j++)
1337    {
1338      mpz_mul(ztmp, inveps, ivtemp[j]);
1339
1340      if((*ivtarget)[i*nV+j]<0)
1341        mpz_sub_ui(ivtemp[j], ztmp, -(*ivtarget)[i*nV+j]);
1342      else
1343        mpz_add_ui(ivtemp[j], ztmp,(*ivtarget)[i*nV+j]);
1344    }
1345
1346    for(j=0; j<nV; j++)
1347      mpz_init_set(pert_vector[i*nV+j],ivtemp[j]);
1348  }
1349
1350  /* 2147483647 is max. integer representation in SINGULAR */
1351  mpz_t sing_int;
1352  mpz_init_set_ui(sing_int,  2147483647);
1353
1354  intvec* result = new intvec(niv);
1355  BOOLEAN nflow = FALSE;
1356
1357  // computes gcd
1358  mpz_set(ztmp, pert_vector[0]);
1359  for(i=0; i<niv; i++)
1360  {
1361    mpz_gcd(ztmp, ztmp, pert_vector[i]);
1362    if(mpz_cmp_si(ztmp, 1)==0)
1363      break;
1364  }
1365
1366  for(i=0; i<niv; i++)
1367  {
1368    mpz_divexact(pert_vector[i], pert_vector[i], ztmp);
1369    (* result)[i] = mpz_get_si(pert_vector[i]);
1370
1371    if(mpz_cmp(pert_vector[i], sing_int)>0)
1372      if(nflow == FALSE)
1373      {
1374        Xnlev = i / nV;
1375        nflow = TRUE;
1376        Overflow_Error = TRUE;
1377
1378        Print("\n// Xlev = %d and the %d-th element is", Xnlev,  i+1);
1379        PrintS("\n// ** OVERFLOW in \"Mfpertvector\": ");
1380        mpz_out_str( stdout, 10, pert_vector[i]);
1381        PrintS(" is greater than 2147483647 (max. integer representation)");
1382        Print("\n//  So vector[%d] := %d is wrong!!", i+1, (*result)[i]);
1383      }
1384  }
1385
1386  if(Overflow_Error == TRUE)
1387    ivString(result, "new_vector");
1388
1389  omFree(pert_vector);
1390  omFree(ivtemp);
1391  mpz_clear(ztmp);
1392
1393  return result;
1394}
1395
1396/****************************************************************
1397 * Multiplikation of two ideals by elementwise                  *
1398 * i.e. Let be A := (a_i) and B := (b_i), return C := (a_i*b_i) *
1399 *  destroy A, keeps B                                          *
1400 ****************************************************************/
1401static ideal MidMult(ideal A, ideal B)
1402{
1403  int mA = IDELEMS(A), mB = IDELEMS(B);
1404
1405  if(A==NULL || B==NULL)
1406    return NULL;
1407
1408  if(mB < mA)
1409    mA = mB;
1410
1411  ideal result = idInit(mA, 1);
1412
1413  int i, k=0;
1414  for(i=0; i<mA; i++)
1415    {
1416      result->m[k] = pMult(A->m[i], pCopy(B->m[i]));
1417      A->m[i]=NULL;
1418      if (result->m[k]!=NULL) k++;
1419    }
1420
1421  idDelete(&A);
1422  idSkipZeroes(result);
1423  return result;
1424}
1425
1426/*********************************************************************
1427 * G is a red. Groebner basis w.r.t. <_1                             *
1428 * Gomega is an initial form ideal of <G> w.r.t. a weight vector w   *
1429 * M is a subideal of <Gomega> and M selft is a red. Groebner basis  *
1430 *    of the ideal <Gomega> w.r.t. <_w                               *
1431 * Let m_i = h1.gw1 + ... + hs.gws for each m_i in M; gwi in Gomega  *
1432 * return F with n(F) = n(M) and f_i = h1.g1 + ... + hs.gs for each i*
1433 ********************************************************************/
1434static ideal MLifttwoIdeal(ideal Gw, ideal M, ideal G)
1435{
1436  ideal Mtmp = idLift(Gw, M, NULL, FALSE, TRUE, TRUE, NULL);
1437
1438  //3.12.02 Note: if Gw is a GB, then isSB = TRUE, otherwise FALSE
1439  //So, it is better, if one tests whether Gw is a GB
1440  //in ideals.cc:
1441  //idLift (ideal mod, ideal submod,ideal * rest, BOOLEAN goodShape,
1442  //           BOOLEAN isSB,BOOLEAN divide,matrix * unit)
1443
1444  /* Let be Mtmp = {m1,...,ms}, where mi=sum hij.in_gj, for all i=1,...,s
1445     We compute F = {f1,...,fs}, where fi=sum hij.gj */
1446  int i, j, nM = IDELEMS(Mtmp);
1447  ideal idpol, idLG;
1448  ideal F = idInit(nM, 1);
1449
1450  for(i=0; i<nM; i++)
1451  {
1452     idpol = idVec2Ideal(Mtmp->m[i]);
1453     idLG = MidMult(idpol, G);
1454     idpol = NULL;
1455     F->m[i] = NULL;
1456     for(j=IDELEMS(idLG)-1; j>=0; j--)
1457     {
1458       F->m[i] = pAdd(F->m[i], idLG->m[j]);
1459       idLG->m[j]=NULL;
1460     }
1461     idDelete(&idLG);
1462  }
1463  idDelete(&Mtmp);
1464  return F;
1465}
1466
1467
1468static void checkidealCC(ideal G, char* Ch)
1469{
1470  int i,nmon=0,ntmp;
1471  int nG = IDELEMS(G);
1472  int n = nG-1;
1473  Print("\n//** Ideal %s besteht aus %d Polynomen mit ", Ch, nG);
1474
1475  for(i=0; i<nG; i++)
1476  {
1477    ntmp =  pLength(G->m[i]);
1478    nmon += ntmp;
1479
1480    if(i != n)
1481      Print("%d, ", ntmp);
1482    else
1483      Print(" bzw. %d ", ntmp);
1484  }
1485  PrintS(" Monomen.\n");
1486  Print("//** %s besitzt %d Monome.", Ch, nmon);
1487  PrintLn();
1488}
1489
1490static void HeadidString(ideal L, char* st)
1491{
1492  int i, nL = IDELEMS(L)-1;
1493
1494  Print("//  The head terms of the ideal %s = ", st);
1495  for(i=0; i<nL; i++)
1496    Print(" %s, ", pString(pHead(L->m[i])));
1497
1498  Print(" %s;\n", pString(pHead(L->m[nL])));
1499}
1500
1501static inline int MivComp(intvec* iva, intvec* ivb)
1502{
1503  assume(iva->length() == ivb->length());
1504  int i;
1505
1506  for(i=iva->length()-1; i>=0; i--)
1507    if((*iva)[i] - (*ivb)[i] != 0)
1508      return 0;
1509
1510  return 1;
1511}
1512
1513
1514/*
1515  compute a next weight vector between curr_weight and target_weight
1516  with respect to an ideal G.
1517*/
1518static intvec* MwalkNextWeightCC(intvec* curr_weight, intvec* target_weight,
1519                                 ideal G)
1520{
1521  BOOLEAN nError = Overflow_Error;
1522  Overflow_Error = FALSE;
1523
1524  assume(currRing != NULL && curr_weight != NULL &&
1525         target_weight != NULL && G != NULL);
1526
1527  int nRing = currRing->N;
1528  int j, nG = IDELEMS(G);
1529  intvec* ivtemp;
1530
1531  mpz_t t_zaehler, t_nenner;
1532  mpz_init(t_zaehler);
1533  mpz_init(t_nenner);
1534
1535  mpz_t s_zaehler, s_nenner, temp, MwWd;
1536  mpz_init(s_zaehler);
1537  mpz_init(s_nenner);
1538  mpz_init(temp);
1539  mpz_init(MwWd);
1540
1541
1542  mpz_t deg_w0_p1, deg_d0_p1;
1543  mpz_init(deg_w0_p1);
1544  mpz_init(deg_d0_p1);
1545
1546  mpz_t sztn, sntz;
1547  mpz_init(sztn);
1548  mpz_init(sntz);
1549  mpz_t t_null;
1550  mpz_init(t_null);
1551
1552  mpz_t ggt;
1553
1554  int tn0, tn1, tz1, ncmp, gcd_tmp, ntmp;
1555  intvec* diff_weight = MivSub(target_weight, curr_weight);
1556
1557  poly g, gw;
1558  for (j=0; j<nG; j++)
1559  {
1560    g = G->m[j];
1561    if (g != NULL)
1562    {
1563      ivtemp = MExpPol(g);
1564      mpz_set_si(deg_w0_p1, MivDotProduct(ivtemp, curr_weight));
1565      mpz_set_si(deg_d0_p1, MivDotProduct(ivtemp, diff_weight));
1566      delete ivtemp;
1567
1568      pIter(g);
1569      while (g != NULL)
1570      {
1571        ivtemp = MExpPol(g);
1572        mpz_set_si(MwWd, MivDotProduct(ivtemp, curr_weight));
1573        mpz_sub(s_zaehler, deg_w0_p1, MwWd);
1574
1575        if(mpz_cmp(s_zaehler, t_null) != 0)
1576        {
1577          mpz_set_si(MwWd, MivDotProduct(ivtemp, diff_weight));
1578          mpz_sub(s_nenner, MwWd, deg_d0_p1);
1579
1580          // check for 0 < s <= 1
1581          if( (mpz_cmp(s_zaehler,t_null) > 0 &&
1582               mpz_cmp(s_nenner, s_zaehler)>=0) ||
1583              (mpz_cmp(s_zaehler, t_null) < 0 &&
1584               mpz_cmp(s_nenner, s_zaehler)<=0))
1585          {
1586            // make both positive
1587            if (mpz_cmp(s_zaehler, t_null) < 0)
1588            {
1589              mpz_neg(s_zaehler, s_zaehler);
1590              mpz_neg(s_nenner, s_nenner);
1591            }
1592
1593            //compute a simply fraction of s
1594            cancel(s_zaehler, s_nenner);
1595
1596            if(mpz_cmp(t_nenner, t_null) != 0)
1597            {
1598              mpz_mul(sztn, s_zaehler, t_nenner);
1599              mpz_mul(sntz, s_nenner, t_zaehler);
1600
1601              if(mpz_cmp(sztn,sntz) < 0)
1602              {
1603                mpz_add(t_nenner, t_null, s_nenner);
1604                mpz_add(t_zaehler,t_null, s_zaehler);
1605              }
1606            }
1607            else
1608            {
1609              mpz_add(t_nenner, t_null, s_nenner);
1610              mpz_add(t_zaehler,t_null, s_zaehler);
1611            }
1612          }
1613        }
1614        pIter(g);
1615        delete ivtemp;
1616      }
1617    }
1618  }
1619
1620  mpz_t *vec=(mpz_t*)omAlloc(nRing*sizeof(mpz_t));
1621
1622  /* there is no 0<t<1 and define the next weight vector that is equal to
1623     the current weight vector */
1624  if(mpz_cmp(t_nenner, t_null) == 0)
1625  {
1626    delete diff_weight;
1627    diff_weight = ivCopy(curr_weight);//take memory
1628    goto FINISH;
1629  }
1630
1631  /* define the target vector as the next weight vector, if t = 1 */
1632  if(mpz_cmp_si(t_nenner, 1)==0 && mpz_cmp_si(t_zaehler,1)==0)
1633  {
1634    delete diff_weight;
1635    diff_weight = ivCopy(target_weight); //this takes memory
1636    goto FINISH;
1637  }
1638
1639
1640  //14.08.03 simplify the both vectors  curr_weight and diff_weight (C-int)
1641  gcd_tmp = (*curr_weight)[0];
1642
1643  for (j=1; j<nRing; j++)
1644  {
1645    gcd_tmp = gcd(gcd_tmp, (*curr_weight)[j]);
1646    if(gcd_tmp == 1)
1647      break;
1648  }
1649
1650  if(gcd_tmp != 1)
1651    for (j=0; j<nRing; j++)
1652    {
1653      gcd_tmp = gcd(gcd_tmp, (*diff_weight)[j]);
1654      if(gcd_tmp == 1)
1655        break;
1656    }
1657
1658  if(gcd_tmp != 1)
1659    for (j=0; j<nRing; j++)
1660    {
1661      (*curr_weight)[j] =  (*curr_weight)[j]/gcd_tmp;
1662      (*diff_weight)[j] =  (*diff_weight)[j]/gcd_tmp;
1663    }
1664#ifdef  NEXT_VECTORS_CC
1665  Print("\n// gcd of the weight vectors (current and target) = %d", gcd_tmp);
1666  ivString(curr_weight, "new cw");
1667  ivString(diff_weight, "new dw");
1668
1669  PrintS("\n// t_zaehler: ");  mpz_out_str( stdout, 10, t_zaehler);
1670  PrintS(", t_nenner: ");  mpz_out_str( stdout, 10, t_nenner);
1671#endif
1672
1673  mpz_t ddf; mpz_init(ddf);
1674  mpz_t dcw; mpz_init(dcw);
1675  BOOLEAN isdwpos;
1676
1677  // construct a new weight vector
1678  for (j=0; j<nRing; j++)
1679  {
1680    mpz_set_si(dcw, (*curr_weight)[j]);
1681    mpz_mul(s_nenner, t_nenner, dcw);
1682
1683    if( (*diff_weight)[j]>0)
1684      mpz_mul_ui(s_zaehler, t_zaehler, (*diff_weight)[j]);
1685    else
1686    {
1687      mpz_mul_ui(s_zaehler, t_zaehler, -(*diff_weight)[j]);
1688      mpz_neg(s_zaehler, s_zaehler);
1689    }
1690
1691    mpz_add(sntz, s_nenner, s_zaehler);
1692
1693    mpz_init_set(vec[j], sntz);
1694
1695#ifdef NEXT_VECTORS_CC
1696    Print("\n//   j = %d ==> ", j);
1697    PrintS("(");
1698    mpz_out_str( stdout, 10, t_nenner);
1699    Print(" * %d)", (*curr_weight)[j]);
1700    Print(" + ("); mpz_out_str( stdout, 10, t_zaehler);
1701    Print(" * %d) =  ",  (*diff_weight)[j]);
1702    mpz_out_str( stdout, 10, s_nenner);
1703    PrintS(" + ");
1704    mpz_out_str( stdout, 10, s_zaehler);
1705    PrintS(" = "); mpz_out_str( stdout, 10, sntz);
1706    Print(" ==> vector[%d]: ", j); mpz_out_str(stdout, 10, vec[j]);
1707#endif
1708
1709    if(j==0)
1710      mpz_init_set(ggt, sntz);
1711    else
1712      if(mpz_cmp_si(ggt,1) != 0)
1713        mpz_gcd(ggt, ggt, sntz);
1714
1715  }
1716
1717#ifdef  NEXT_VECTORS_CC
1718  PrintS("\n// gcd of elements of the vector: ");
1719  mpz_out_str( stdout, 10, ggt);
1720#endif
1721
1722  mpz_t omega;
1723  mpz_t sing_int;
1724  mpz_init_set_ui(sing_int,  2147483647);
1725
1726  /* construct a new weight vector and check whether vec[j] is overflow!!
1727     i.e. vec[j] > 2^31.
1728     If vec[j] doesn't overflow, define a weight vector
1729     otherwise, report that overflow appears.
1730     In the second case test whether the defined new vector correct is
1731     plays an important rolle */
1732
1733  for (j=0; j<nRing; j++)
1734  {
1735    if(mpz_cmp_si(ggt,1)==0)
1736      (*diff_weight)[j] = mpz_get_si(vec[j]);
1737    else
1738    {
1739      mpz_divexact(vec[j], vec[j], ggt);
1740      (*diff_weight)[j] = mpz_get_si(vec[j]);
1741    }
1742
1743    if(mpz_cmp(vec[j], sing_int)>=0)
1744      if(Overflow_Error == FALSE)
1745      {
1746        Overflow_Error = TRUE;
1747
1748        PrintS("\n// ** OVERFLOW in \"NextVector\": ");
1749        mpz_out_str( stdout, 10, vec[j]);
1750        PrintS(" is greater than 2147483647 (max. integer representation)");
1751        Print("\n//  So vector[%d] := %d is wrong!!\n",j+1, (*diff_weight)[j]);
1752      }
1753  }
1754
1755 FINISH:
1756
1757   mpz_clear(t_zaehler);
1758   mpz_clear(t_nenner);
1759   mpz_clear(sntz);
1760   mpz_clear(sztn);
1761   mpz_clear(temp);
1762   mpz_clear(MwWd);
1763   mpz_clear(deg_w0_p1);
1764   mpz_clear(deg_d0_p1);
1765   omFree(vec);
1766
1767  if(Overflow_Error == FALSE)
1768    Overflow_Error = nError;
1769
1770   return diff_weight;
1771}
1772
1773/*
1774   compute an intermediate weight vector from iva to ivb w.r.t.
1775   the reduced Groebner basis G.
1776   Return NULL, if it is equal to iva or iva = avb.
1777*/
1778intvec* MkInterRedNextWeight(intvec* iva, intvec* ivb, ideal G)
1779{
1780  intvec* tmp = new intvec(iva->length());
1781  intvec* result;
1782
1783  if(G == NULL)
1784    return tmp;
1785
1786  if(MivComp(iva, ivb) == 1)
1787    return tmp;
1788
1789  result = MwalkNextWeightCC(iva, ivb, G);
1790
1791  if(MivComp(result, iva) == 1)
1792  {
1793    delete result;
1794    return tmp;
1795  }
1796
1797  delete tmp;
1798  return result;
1799}
1800
1801/* 01.11.01 */
1802/* define and execute a new ring which order is (a(va),lp,C) */
1803static void VMrDefault(intvec* va)
1804{
1805  idhdl tmp = enterid(IDID(currRingHdl),IDLEV(currRingHdl)+1,RING_CMD,&IDROOT,TRUE);
1806  //3.11.01
1807
1808  if (ppNoether!=NULL)
1809    pDelete(&ppNoether);
1810
1811  if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING)) ||
1812      ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
1813
1814  {
1815    sLastPrinted.CleanUp();
1816  }
1817
1818  ring r = IDRING(tmp);
1819  int i, nv = currRing->N;
1820
1821  r->ch  = currRing->ch;
1822  r->N   = currRing->N;
1823  int nb = rBlocks(currRing) + 1;//31.10.01 (+1)
1824
1825  /*names*/
1826  char* Q; //30.10.01 to avoid the corrupted memory, NOT change!!
1827  r->names = (char **) omAlloc0(nv * sizeof(char_ptr));
1828  for(i=0; i<nv; i++)
1829  {
1830    Q = currRing->names[i];
1831    r->names[i]  = omStrDup(Q);
1832  }
1833
1834  intvec* iva = va;  //why?
1835  /*weights: entries for 3 blocks: NULL Made:???*/
1836  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
1837  r->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
1838  for(i=0; i<nv; i++)
1839    r->wvhdl[0][i] = (*iva)[i];
1840
1841  /* order: a,lp,C,0 */
1842  r->order = (int *) omAlloc(nb * sizeof(int *));
1843  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
1844  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
1845
1846  /* ringorder a for the first block: var 1..nv */
1847  r->order[0]  = ringorder_a;
1848  r->block0[0] = 1;
1849  r->block1[0] = nv;
1850
1851  /* ringorder lp for the second block: var 1..nv */
1852  r->order[1]  = ringorder_lp;
1853  r->block0[1] = 1;
1854  r->block1[1] = nv;
1855
1856  /* ringorder C for the third block */
1857  // it is very important within "idLift",
1858  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
1859  // therefore, nb  must be (nBlocks(currRing)  + 1)
1860  r->order[2]  = ringorder_C;
1861
1862  /* the last block: everything is 0 */
1863  r->order[3]  = 0;
1864
1865  /*polynomial ring*/
1866  r->OrdSgn    = 1;
1867
1868  /* complete ring intializations */
1869  rComplete(r);
1870
1871  rChangeCurrRing(r);
1872  currRingHdl = tmp;
1873}
1874
1875/* 03.11.01 */
1876/* define and execute a new ring which order is  a lexicographic order */
1877static void VMrDefaultlp(void)
1878{
1879  idhdl tmp = enterid(IDID(currRingHdl),IDLEV(currRingHdl)+1,RING_CMD,&IDROOT,TRUE);
1880
1881
1882  if (ppNoether!=NULL)
1883    pDelete(&ppNoether);
1884
1885  if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING)) ||
1886      ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
1887
1888  {
1889    sLastPrinted.CleanUp();
1890  }
1891
1892  ring r = IDRING(tmp);
1893  int i, nv = currRing->N;
1894
1895  r->ch  = currRing->ch;
1896  r->N   = currRing->N;
1897  int nb = rBlocks(currRing) + 1;//31.10.01 (+1)
1898
1899  /*names*/
1900  char* Q; //30.10.01 to avoid the corrupted memory, NOT change!!
1901  r->names = (char **) omAlloc0(nv * sizeof(char_ptr));
1902  for(i=0; i<nv; i++)
1903  {
1904    Q = currRing->names[i];
1905    r->names[i]  = omStrDup(Q);
1906  }
1907
1908  /*weights: entries for 3 blocks: NULL Made:???*/
1909
1910  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
1911
1912  /* order: lp,C,0 */
1913  r->order = (int *) omAlloc(nb * sizeof(int *));
1914  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
1915  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
1916
1917  /* ringorder lp for the first block: var 1..nv */
1918  r->order[0]  = ringorder_lp;
1919  r->block0[0] = 1;
1920  r->block1[0] = nv;
1921
1922  /* ringorder C for the second block */
1923  r->order[1]  = ringorder_C;
1924
1925  /* the last block: everything is 0 */
1926  r->order[2]  = 0;
1927
1928  /*polynomial ring*/
1929  r->OrdSgn    = 1;
1930
1931  /* complete ring intializations */
1932  rComplete(r);
1933
1934  //rSetHdl(tmp);
1935
1936  rChangeCurrRing(r);
1937  currRingHdl = tmp;
1938}
1939
1940
1941/* define a ring with parameters und change to it */
1942/* DefRingPar and DefRingParlp corrupt still memory */
1943static void DefRingPar(intvec* va)
1944{
1945  int i, nv = currRing->N;
1946  int nb = rBlocks(currRing) + 1;
1947
1948  ring res=(ring)omAllocBin(ip_sring_bin);
1949
1950  memcpy4(res,currRing,sizeof(ip_sring));
1951
1952  res->VarOffset = NULL;
1953  res->ref=0;
1954  if (currRing->algring!=NULL)
1955    currRing->algring->ref++;
1956
1957  if (currRing->parameter!=NULL)
1958  {
1959    res->minpoly=nCopy(currRing->minpoly);
1960    int l=rPar(currRing);
1961    res->parameter=(char **)omAlloc(l*sizeof(char_ptr));
1962
1963    for(i=l-1;i>=0;i--)
1964      res->parameter[i]=omStrDup(currRing->parameter[i]);
1965  }
1966
1967  intvec* iva = va;
1968
1969  /*weights: entries for 3 blocks: NULL Made:???*/
1970  res->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
1971  res->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
1972  for(i=0; i<nv; i++)
1973    res->wvhdl[0][i] = (*iva)[i];
1974
1975  /* order: a,lp,C,0 */
1976  res->order = (int *) omAlloc(nb * sizeof(int *));
1977  res->block0 = (int *)omAlloc0(nb * sizeof(int *));
1978  res->block1 = (int *)omAlloc0(nb * sizeof(int *));
1979
1980  /* ringorder a for the first block: var 1..nv */
1981  res->order[0]  = ringorder_a;
1982  res->block0[0] = 1;
1983  res->block1[0] = nv;
1984
1985  /* ringorder lp for the second block: var 1..nv */
1986  res->order[1]  = ringorder_lp;
1987  res->block0[1] = 1;
1988  res->block1[1] = nv;
1989
1990  /* ringorder C for the third block */
1991  // it is very important within "idLift",
1992  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
1993  // therefore, nb  must be (nBlocks(currRing)  + 1)
1994  res->order[2]  = ringorder_C;
1995
1996  /* the last block: everything is 0 */
1997  res->order[3]  = 0;
1998
1999  /*polynomial ring*/
2000  res->OrdSgn    = 1;
2001
2002
2003  res->names   = (char **)omAlloc0(nv * sizeof(char_ptr));
2004  for (i=nv-1; i>=0; i--)
2005    res->names[i] = omStrDup(currRing->names[i]);
2006
2007  /* complete ring intializations */
2008   rComplete(res);
2009
2010
2011  // clean up history
2012  if (sLastPrinted.RingDependend())
2013  {
2014    sLastPrinted.CleanUp();
2015  }
2016
2017
2018  /* execute the created ring */
2019  rChangeCurrRing(res);
2020}
2021
2022
2023static void DefRingParlp(void)
2024{
2025  int i, nv = currRing->N;
2026
2027  ring r=(ring)omAllocBin(ip_sring_bin);
2028
2029  memcpy4(r,currRing,sizeof(ip_sring));
2030
2031  r->VarOffset = NULL;
2032  r->ref=0;
2033  if (currRing->algring!=NULL)
2034    currRing->algring->ref++;
2035
2036  if (currRing->parameter!=NULL)
2037  {
2038    r->minpoly=nCopy(currRing->minpoly);
2039    int l=rPar(currRing);
2040    r->parameter=(char **)omAlloc(l*sizeof(char_ptr));
2041
2042    for(i=l-1;i>=0;i--)
2043      r->parameter[i]=omStrDup(currRing->parameter[i]);
2044  }
2045
2046
2047  r->ch  = currRing->ch;
2048  r->N   = currRing->N;
2049  int nb = rBlocks(currRing) + 1;//31.10.01 (+1)
2050
2051  /*names*/
2052  char* Q;
2053  r->names = (char **) omAlloc0(nv * sizeof(char_ptr));
2054  for(i=nv-1; i>=0; i--)
2055  {
2056    Q = currRing->names[i];
2057    r->names[i]  = omStrDup(Q);
2058  }
2059
2060  /*weights: entries for 3 blocks: NULL Made:???*/
2061
2062  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2063
2064  /* order: lp,C,0 */
2065  r->order = (int *) omAlloc(nb * sizeof(int *));
2066  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2067  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2068
2069  /* ringorder lp for the first block: var 1..nv */
2070  r->order[0]  = ringorder_lp;
2071  r->block0[0] = 1;
2072  r->block1[0] = nv;
2073
2074  /* ringorder C for the second block */
2075  r->order[1]  = ringorder_C;
2076
2077  /* the last block: everything is 0 */
2078  r->order[2]  = 0;
2079
2080  /*polynomial ring*/
2081  r->OrdSgn    = 1;
2082
2083
2084  if (currRing->parameter!=NULL)
2085  {
2086    r->minpoly=nCopy(currRing->minpoly);
2087    int l=rPar(currRing);
2088    r->parameter=(char **)omAlloc(l*sizeof(char_ptr));
2089
2090    for(i=l-1;i>=0;i--)
2091      r->parameter[i]=omStrDup(currRing->parameter[i]);
2092  }
2093
2094  /* complete ring intializations */
2095  rComplete(r);
2096
2097  // clean up history
2098  if (sLastPrinted.RingDependend())
2099  {
2100    sLastPrinted.CleanUp();
2101  }
2102
2103  /* execute the created ring */
2104  rChangeCurrRing(r);
2105}
2106
2107/* check wheather one or more components of a vector are zero */
2108static int isNolVector(intvec* hilb)
2109{
2110  int i;
2111  for(i=hilb->length()-1; i>=0; i--)
2112    if((* hilb)[i]==0)
2113      return 1;
2114
2115  return 0;
2116}
2117
2118
2119/******************************  Februar 2002  ****************************
2120 * G is a Groebner basis w.r.t. (a(curr_weight),lp) and                   *
2121 * we compute a GB of <G> w.r.t. the lex. order by the perturbation walk  *
2122 * its perturbation degree is tp_deg                                      *
2123 * We call the following subfunction LastGB, if                           *
2124 *     the computed intermediate weight vector or                         *
2125 *     the perturbed target weight vector                                 *
2126 * does NOT in the correct cone.                                          *
2127 **************************************************************************/
2128
2129static ideal LastGB(ideal G, intvec* curr_weight,int tp_deg)
2130{
2131  BOOLEAN nError = Overflow_Error;
2132  Overflow_Error = FALSE;
2133
2134  int i, nV = currRing->N;
2135  int nwalk=0, endwalks=0, nnwinC=1;
2136  int nlast = 0;
2137  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
2138  ring newRing, oldRing, TargetRing;
2139  intvec* iv_M_lp;
2140  intvec* target_weight;
2141  intvec* iv_lp = Mivlp(nV); //define (1,0,...,0)
2142  intvec* pert_target_vector;
2143  intvec* ivNull = new intvec(nV);
2144  intvec* extra_curr_weight = new intvec(nV);
2145  intvec* hilb_func;
2146  intvec* next_weight;
2147
2148  /* to avoid (1,0,...,0) as the target vector */
2149  intvec* last_omega = new intvec(nV);
2150  for(i=nV-1; i>0; i--)
2151    (*last_omega)[i] = 1;
2152  (*last_omega)[0] = 10000;
2153
2154  ring EXXRing = currRing;
2155
2156  /* compute a pertubed weight vector of the target weight vector */
2157  if(tp_deg > 1 && tp_deg <= nV)
2158  {
2159    //..25.03.03 VMrDefaultlp();//    VMrDefault(target_weight);
2160    if (currRing->parameter != NULL)
2161      DefRingParlp();
2162    else
2163      VMrDefaultlp();
2164
2165    TargetRing = currRing;
2166    ssG = idrMoveR(G,EXXRing);
2167    iv_M_lp = MivMatrixOrderlp(nV);
2168    //target_weight = MPertVectorslp(ssG, iv_M_lp, tp_deg);
2169    target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
2170    delete iv_M_lp;
2171    pert_target_vector = target_weight;
2172
2173    rChangeCurrRing(EXXRing);
2174    G = idrMoveR(ssG, TargetRing);
2175  }
2176  else
2177    target_weight = Mivlp(nV);
2178
2179  //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2180
2181  while(1)
2182  {
2183    nwalk++;
2184    nstep++;
2185    to=clock();
2186    /* compute a next weight vector */
2187    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
2188    xtnw=xtnw+clock()-to;
2189#ifdef PRINT_VECTORS
2190    MivString(curr_weight, target_weight, next_weight);
2191#endif
2192
2193    if(Overflow_Error == TRUE){
2194      newRing = currRing;
2195      nnwinC = 0;
2196      if(tp_deg == 1)
2197        nlast = 1;
2198      delete next_weight;
2199
2200      //idElements(G, "G");
2201      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2202
2203      break;
2204    }
2205
2206    if(MivComp(next_weight, ivNull) == 1){
2207      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2208      newRing = currRing;
2209      delete next_weight;
2210      break;
2211    }
2212
2213    if(MivComp(next_weight, target_weight) == 1)
2214      endwalks = 1;
2215
2216    for(i=nV-1; i>=0; i--)
2217        (*extra_curr_weight)[i] = (*curr_weight)[i];
2218
2219    /* 06.11.01 NOT Changed */
2220    for(i=nV-1; i>=0; i--)
2221      (*curr_weight)[i] = (*next_weight)[i];
2222
2223    oldRing = currRing;
2224    to=clock();
2225    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
2226    Gomega = MwalkInitialForm(G, curr_weight);
2227    xtif=xtif+clock()-to;
2228
2229#ifdef ENDWALKS
2230    if(endwalks == 1){
2231      Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2232      idElements(Gomega, "Gw");
2233      headidString(Gomega, "Gw");
2234    }
2235#endif
2236
2237#ifndef  BUCHBERGER_ALG
2238    if(isNolVector(curr_weight) == 0)
2239      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
2240    else
2241      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
2242#endif // BUCHBERGER_ALG
2243
2244    /* define a new ring that its ordering is "(a(curr_weight),lp) */
2245    //..25.03.03 VMrDefault(curr_weight);
2246    if (currRing->parameter != NULL)
2247      DefRingPar(curr_weight);
2248    else
2249      VMrDefault(curr_weight);
2250
2251    newRing = currRing;
2252    Gomega1 = idrMoveR(Gomega, oldRing);
2253
2254    to=clock();
2255    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
2256#ifdef  BUCHBERGER_ALG
2257    M = MstdhomCC(Gomega1);
2258#else
2259    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
2260    delete hilb_func;
2261#endif // BUCHBERGER_ALG
2262    xtstd=xtstd+clock()-to;
2263    /* change the ring to oldRing */
2264    rChangeCurrRing(oldRing);
2265    M1 =  idrMoveR(M, newRing);
2266    Gomega2 =  idrMoveR(Gomega1, newRing);
2267
2268    to=clock();
2269    /* compute a reduced Groebner basis of <G> w.r.t. "newRing" */
2270    F = MLifttwoIdeal(Gomega2, M1, G);
2271    xtlift=xtlift+clock()-to;
2272
2273    idDelete(&M1);
2274    idDelete(&G);
2275
2276    /* change the ring to newRing */
2277    rChangeCurrRing(newRing);
2278    F1 = idrMoveR(F, oldRing);
2279
2280    to=clock();
2281    /* reduce the Groebner basis <G> w.r.t. new ring */
2282    G = kInterRedCC(F1, NULL);
2283    xtred=xtred+clock()-to;
2284    idDelete(&F1);
2285
2286    if(endwalks == 1){
2287      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2288      break;
2289    }
2290
2291    delete next_weight;
2292  }//while
2293
2294  delete ivNull;
2295
2296  if(tp_deg != 1)
2297  {
2298    //..25.03.03 VMrDefaultlp();//define and execute the ring "lp"
2299    if (currRing->parameter != NULL)
2300      DefRingParlp();
2301    else
2302      VMrDefaultlp();
2303
2304    F1 = idrMoveR(G, newRing);
2305
2306    if(nnwinC == 0 || test_w_in_ConeCC(F1, pert_target_vector) != 1)
2307    {
2308      oldRing = currRing;
2309      rChangeCurrRing(newRing);
2310      G = idrMoveR(F1, oldRing);
2311      Print("\n// takes %d steps and calls the recursion of level %d:",
2312             nwalk, tp_deg-1);
2313
2314      F1 = LastGB(G,curr_weight, tp_deg-1);
2315    }
2316
2317    TargetRing = currRing;
2318    rChangeCurrRing(EXXRing);
2319    result = idrMoveR(F1, TargetRing);
2320  }
2321  else
2322  {
2323    if(nlast == 1)
2324    {
2325      //OMEGA_OVERFLOW_LASTGB:
2326      /*
2327      if(MivSame(curr_weight, iv_lp) == 1)
2328        if (currRing->parameter != NULL)
2329          DefRingParlp();
2330        else
2331          VMrDefaultlp();
2332      else
2333        if (currRing->parameter != NULL)
2334          DefRingPar(curr_weight);
2335        else
2336          VMrDefault(curr_weight);
2337      */
2338
2339        //..25.03.03 VMrDefaultlp();//define and execute the ring "lp"
2340        if (currRing->parameter != NULL)
2341          DefRingParlp();
2342        else
2343          VMrDefaultlp();
2344
2345
2346      F1 = idrMoveR(G, newRing);
2347      //Print("\n// Apply \"std\" in ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
2348
2349      G = MstdCC(F1);
2350      idDelete(&F1);
2351      newRing = currRing;
2352    }
2353
2354    rChangeCurrRing(EXXRing);
2355    result = idrMoveR(G, newRing);
2356  }
2357  delete target_weight;
2358  delete last_omega;
2359  delete iv_lp;
2360
2361  if(Overflow_Error == FALSE)
2362    Overflow_Error = nError;
2363
2364  return(result);
2365}
2366
2367
2368/* check whether a polynomial of G has least 3 monomials */
2369static int lengthpoly(ideal G)
2370{
2371  int i;
2372  for(i=IDELEMS(G)-1; i>=0; i--)
2373#if 0
2374    if(pLength(G->m[i])>2)
2375      return 1;
2376#else
2377    if((G->m[i]!=NULL) /* len >=0 */
2378       && (G->m[i]->next!=NULL) /* len >=1 */
2379       && (G->m[i]->next->next!=NULL) /* len >=2 */
2380       && (G->m[i]->next->next->next!=NULL) /* len >=3 */
2381      //&& (G->m[i]->next->next->next->next!=NULL) /* len >=4 */
2382       ) return 1;
2383#endif
2384  return 0;
2385}
2386
2387/* check whether a polynomial of G has least 2 monomials */
2388static int islengthpoly2(ideal G)
2389{
2390  int i;
2391  for(i=IDELEMS(G)-1; i>=0; i--)
2392    if((G->m[i]!=NULL) /* len >=0 */
2393       && (G->m[i]->next!=NULL) /* len >=1 */
2394       && (G->m[i]->next->next!=NULL)) /* len >=2 */
2395      return 1;
2396
2397  return 0;
2398}
2399
2400
2401
2402/* Implementation of the improved Groebner walk algorithm which is written
2403   by Quoc-Nam Tran (2000).
2404   One perturbs the original target weight vector, only if
2405   the next intermediate weight vector is equal to the current target weight
2406   vector. This must be repeated until the wanted reduced Groebner basis
2407   to reach.
2408   If the numbers of variables is big enough, the representation of the origin
2409   weight vector may be very big. Therefore, it is possible the intermediate
2410   weight vector doesn't stay in the correct Groebner cone.
2411   In this case we have just a reduced Groebner basis of the given ideal
2412   with respect to another monomial order. Then we have to compute
2413   a wanted reduced Groebner basis of it with respect to the given order.
2414   At the following subroutine we use the improved Buchberger algorithm or
2415   the changed perturbation walk algorithm with a decrased degree.
2416 */
2417
2418/*2
2419* return the initial term of an ideal
2420*/
2421static ideal idHeadCC(ideal h)
2422{
2423  int i, nH =IDELEMS(h);
2424
2425  ideal m = idInit(nH,h->rank);
2426
2427  for (i=nH-1;i>=0; i--)
2428  {
2429    if (h->m[i]!=NULL)
2430      m->m[i]=pHead(h->m[i]);
2431  }
2432  return m;
2433}
2434
2435/* check whether two head-ideals are the same */
2436static inline int test_G_GB_walk(ideal H0, ideal H1)
2437{
2438  int i, nG = IDELEMS(H0);
2439
2440  if(nG != IDELEMS(H1))
2441    return 0;
2442
2443  for(i=nG-1; i>=0; i--)
2444  {
2445#if 0
2446    poly t;
2447    if((t=pSub(pCopy(H0->m[i]), pCopy(H1->m[i]))) != NULL)
2448    {
2449      pDelete(&t);
2450      return 0;
2451    }
2452    pDelete(&t);
2453#else
2454    if(!pEqualPolys(H0->m[i],H1->m[i]))
2455      return 0;
2456#endif
2457  }
2458
2459  return 1;
2460}
2461
2462/* 19.11.01 */
2463/* find the maximal total degree of polynomials in G */
2464static int Trandegreebound(ideal G)
2465{
2466  int i, nG = IDELEMS(G);
2467  int np=1, nV = currRing->N;
2468  int degtmp, result = 0;
2469  intvec* ivUnit = Mivdp(nV);
2470
2471  for(i=nG-1; i>=0; i--)
2472  {
2473    /* find the maximal total degree of the polynomial G[i] */
2474    degtmp = MwalkWeightDegree(G->m[i], ivUnit);
2475    if(degtmp > result)
2476      result = degtmp;
2477  }
2478  delete ivUnit;
2479  return result;
2480}
2481
2482/* perturb the weight vector iva w.r.t. the ideal G.
2483   the monomial order of the current ring is the w_1 weight lex. order.
2484   define w := d^(n-1)w_1+ d^(n-2)w_2, ...+ dw_(n-1)+ w_n
2485   where d := 1 + max{totdeg(g):g in G}*m, or
2486   d := (2*maxdeg*maxdeg + (nV+1)*maxdeg)*m;
2487*/
2488
2489//GMP
2490static intvec* TranPertVector(ideal G, intvec* iva)
2491{
2492  BOOLEAN nError = Overflow_Error;
2493  Overflow_Error = FALSE;
2494
2495  int i, j,  nG = IDELEMS(G);
2496  int nV = currRing->N;
2497
2498  // define the sequence which expresses the current monomial ordering
2499  // w_1 = iva; w_2 = (1,0,..,0); w_n = (0,...,0,1,0)
2500  intvec* ivMat = MivMatrixOrder(iva);
2501
2502  int  mtmp, m=(*iva)[0];
2503
2504  for(i=ivMat->length(); i>=0; i--)
2505  {
2506    mtmp = (*ivMat)[i];
2507
2508    if(mtmp <0) mtmp = -mtmp;
2509
2510    if(mtmp > m)
2511      m = mtmp;
2512  }
2513
2514  /* define the maximal total degree of polynomials of G */
2515  mpz_t ndeg;
2516  mpz_init(ndeg);
2517
2518 // 12 Juli 03
2519#ifndef UPPER_BOUND
2520  mpz_set_si(ndeg, Trandegreebound(G)+1);
2521#else
2522  mpz_t ztmp;
2523  mpz_init(ztmp);
2524
2525  mpz_t maxdeg;
2526  mpz_init_set_si(maxdeg, Trandegreebound(G));
2527
2528  //ndeg = (2*maxdeg*maxdeg + (nV+1)*maxdeg)*m;//Kalkbrenner (1999)
2529  mpz_pow_ui(ztmp, maxdeg, 2);
2530  mpz_mul_ui(ztmp, ztmp, 2);
2531  mpz_mul_ui(maxdeg, maxdeg, nV+1);
2532  mpz_add(ndeg, ztmp, maxdeg);
2533  mpz_mul_ui(ndeg, ndeg, m);
2534
2535  //PrintS("\n// with the new upper degree bound (2d^2+(n+1)d)*m ");
2536  //Print("\n//         where d = %d, n = %d and bound = %d", maxdeg, nV, ndeg);
2537#endif //UPPER_BOUND
2538
2539  /* 29.08.03*/
2540#ifdef INVEPS_SMALL_IN_TRAN
2541 if(mpz_cmp_ui(ndeg, nV)>0 && nV > 3)
2542    mpz_cdiv_q_ui(ndeg, ndeg, nV);
2543
2544 //PrintS("\n// choose the \"small\" inverse epsilon:");
2545 //mpz_out_str(stdout, 10, ndeg);
2546#endif
2547  mpz_t deg_tmp;
2548  mpz_init_set(deg_tmp, ndeg);
2549
2550  mpz_t *ivres=( mpz_t *) omAlloc(nV*sizeof(mpz_t));
2551  mpz_init_set_si(ivres[nV-1],1);
2552
2553  for(i=nV-2; i>=0; i--)
2554  {
2555    mpz_init_set(ivres[i], deg_tmp);
2556    mpz_mul(deg_tmp, deg_tmp, ndeg);
2557  }
2558
2559  mpz_t *ivtmp=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
2560  for(i=0; i<nV; i++)
2561    mpz_init(ivtmp[i]);
2562
2563  mpz_t sing_int;
2564  mpz_init_set_ui(sing_int,  2147483647);
2565
2566  intvec* repr_vector = new intvec(nV);
2567
2568  /* define ivtmp := ndeg^(n-1).w_1 + ndeg^(n-2).w_2 + ... + w_n */
2569  for(i=0; i<nV; i++)
2570    for(j=0; j<nV; j++)
2571    {
2572      if( (*ivMat)[i*nV+j] >= 0 )
2573        mpz_mul_ui(ivres[i], ivres[i], (*ivMat)[i*nV+j]);
2574      else
2575      {
2576        mpz_mul_ui(ivres[i], ivres[i], -(*ivMat)[i*nV+j]);
2577        mpz_neg(ivres[i], ivres[i]);
2578      }
2579      mpz_add(ivtmp[j], ivtmp[j], ivres[i]);
2580    }
2581
2582  delete ivMat;
2583
2584  int ntrue=0;
2585  for(i=0; i<nV; i++)
2586  {
2587    (*repr_vector)[i] = mpz_get_si(ivtmp[i]);
2588    if(mpz_cmp(ivtmp[i], sing_int)>=0)
2589    {
2590      ntrue++;
2591      if(Overflow_Error == FALSE)
2592      {
2593        Overflow_Error = TRUE;
2594
2595        PrintS("\n// ** OVERFLOW in \"Repr.Vector\": ");
2596        mpz_out_str( stdout, 10, ivtmp[i]);
2597        PrintS(" is greater than 2147483647 (max. integer representation)");
2598        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repr_vector)[i]);
2599      }
2600    }
2601  }
2602  if(Overflow_Error == TRUE)
2603  {
2604    ivString(repr_vector, "repvector");
2605    Print("\n// %d element(s) of it are overflow!!", ntrue);
2606  }
2607
2608  if(Overflow_Error == FALSE)
2609    Overflow_Error=nError;
2610
2611  omFree(ivres);
2612  omFree(ivtmp);
2613  return repr_vector;
2614}
2615
2616
2617
2618static intvec* TranPertVector_lp(ideal G)
2619{
2620  BOOLEAN nError = Overflow_Error;
2621  Overflow_Error = FALSE;
2622
2623  int i, j,  nG = IDELEMS(G);
2624  int nV = currRing->N;
2625
2626  /* define the maximal total degree of polynomials of G */
2627  mpz_t ndeg;
2628  mpz_init(ndeg);
2629
2630 // 12 Juli 03
2631#ifndef UPPER_BOUND
2632  mpz_set_si(ndeg, Trandegreebound(G)+1);
2633#else
2634  mpz_t ztmp;
2635  mpz_init(ztmp);
2636
2637  mpz_t maxdeg;
2638  mpz_init_set_si(maxdeg, Trandegreebound(G));
2639
2640  //ndeg = (2*maxdeg*maxdeg + (nV+1)*maxdeg);//Kalkbrenner (1999)
2641  mpz_pow_ui(ztmp, maxdeg, 2);
2642  mpz_mul_ui(ztmp, ztmp, 2);
2643  mpz_mul_ui(maxdeg, maxdeg, nV+1);
2644  mpz_add(ndeg, ztmp, maxdeg);
2645  /*
2646    PrintS("\n// with the new upper degree bound (2d^2+(n+1)d)*m ");
2647    Print("\n//         where d = %d, n = %d and bound = %d",
2648    mpz_get_si(maxdeg), nV, mpz_get_si(ndeg));
2649  */
2650#endif //UPPER_BOUND
2651
2652#ifdef INVEPS_SMALL_IN_TRAN
2653 if(mpz_cmp_ui(ndeg, nV)>0 && nV > 3)
2654    mpz_cdiv_q_ui(ndeg, ndeg, nV);
2655
2656 //PrintS("\n// choose the \"small\" inverse epsilon:");
2657 // mpz_out_str(stdout, 10, ndeg);
2658#endif
2659
2660  mpz_t deg_tmp;
2661  mpz_init_set(deg_tmp, ndeg);
2662
2663  mpz_t *ivres=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
2664  mpz_init_set_si(ivres[nV-1], 1);
2665
2666  for(i=nV-2; i>=0; i--)
2667  {
2668    mpz_init_set(ivres[i], deg_tmp);
2669    mpz_mul(deg_tmp, deg_tmp, ndeg);
2670  }
2671
2672  mpz_t sing_int;
2673  mpz_init_set_ui(sing_int,  2147483647);
2674
2675  intvec* repr_vector = new intvec(nV);
2676  int ntrue;
2677  for(i=0; i<nV; i++)
2678  {
2679    (*repr_vector)[i] = mpz_get_si(ivres[i]);
2680
2681    if(mpz_cmp(ivres[i], sing_int)>=0)
2682    {
2683      ntrue++;
2684      if(Overflow_Error == FALSE)
2685      {
2686        Overflow_Error = TRUE;
2687        PrintS("\n// ** OVERFLOW in \"Repr.Vector\": ");
2688        mpz_out_str( stdout, 10, ivres[i]);
2689        PrintS(" is greater than 2147483647 (max. integer representation)");
2690        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repr_vector)[i]);
2691      }
2692    }
2693  }
2694  if(Overflow_Error == TRUE)
2695  {
2696    ivString(repr_vector, "repvector");
2697    Print("\n// %d element(s) of it are overflow!!", ntrue);
2698  }
2699  if(Overflow_Error == FALSE)
2700    Overflow_Error = nError;
2701
2702  omFree(ivres);
2703  return repr_vector;
2704}
2705
2706
2707//GMP
2708static intvec* RepresentationMatrix_Dp(ideal G, intvec* M)
2709{
2710  BOOLEAN nError = Overflow_Error;
2711  Overflow_Error = FALSE;
2712
2713  int i, j;
2714  int nV = currRing->N;
2715
2716  intvec* ivUnit = Mivdp(nV);
2717  int degtmp, maxdeg = 0;
2718
2719  for(i=IDELEMS(G)-1; i>=0; i--)
2720  {
2721    /* find the maximal total degree of the polynomial G[i] */
2722    degtmp = MwalkWeightDegree(G->m[i], ivUnit);
2723    if(degtmp > maxdeg)
2724      maxdeg = degtmp;
2725  }
2726
2727  mpz_t ztmp;
2728  mpz_init_set_si(ztmp, maxdeg);
2729  mpz_t *ivres=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
2730  mpz_init_set_si(ivres[nV-1], 1); // (*ivres)[nV-1] = 1;
2731
2732  for(i=nV-2; i>=0; i--)
2733  {
2734    mpz_init_set(ivres[i], ztmp); //(*ivres)[i] = ztmp;
2735    mpz_mul_ui(ztmp, ztmp, maxdeg); //ztmp *=maxdeg;
2736  }
2737
2738  mpz_t *ivtmp=(mpz_t*)omAlloc(nV*sizeof(mpz_t));
2739  for(i=0; i<nV; i++)
2740    mpz_init(ivtmp[i]);
2741
2742  /* define ivtmp := ndeg^(n-1).w_1 + ndeg^(n-2).w_2 + ... + w_n */
2743  for(i=0; i<nV; i++)
2744    for(j=0; j<nV; j++)
2745    {
2746      if((*M)[i*nV+j] < 0)
2747      {
2748        mpz_mul_ui(ztmp, ivres[i], -(*M)[i*nV+j]);
2749        mpz_neg(ztmp, ztmp);
2750      }
2751      else
2752        mpz_mul_ui(ztmp, ivres[i], (*M)[i*nV+j]);
2753
2754      mpz_add(ivtmp[j], ivtmp[j], ztmp);
2755    }
2756
2757  mpz_t sing_int;
2758  mpz_init_set_ui(sing_int,  2147483647);
2759
2760  int ntrue;
2761  intvec* repvector = new intvec(nV);
2762  for(i=0; i<nV; i++)
2763  {
2764    (*repvector)[i] = mpz_get_si(ivtmp[i]);
2765    if(mpz_cmp(ivtmp[i], sing_int)>0)
2766    {
2767      ntrue++;
2768      if(Overflow_Error == FALSE)
2769      {
2770        Overflow_Error = TRUE;
2771        PrintS("\n// ** OVERFLOW in \"Repr.Matrix\": ");
2772        mpz_out_str( stdout, 10, ivtmp[i]);
2773        PrintS(" is greater than 2147483647 (max. integer representation)");
2774        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repvector)[i]);
2775      }
2776    }
2777  }
2778  if(Overflow_Error == TRUE)
2779  {
2780    ivString(repvector, "repvector");
2781    Print("\n// %d element(s) of it are overflow!!", ntrue);
2782  }
2783
2784  if(Overflow_Error == FALSE)
2785    Overflow_Error = nError;
2786
2787  mpz_clear(ztmp);
2788  omFree(ivtmp);
2789  omFree(ivres);
2790  return repvector;
2791}
2792
2793
2794
2795
2796
2797/* The following subroutine is the implementation of our first improved
2798   Groebner walk algorithm, i.e. the first altervative algorithm.
2799   First we use the Grobner walk algorithm and then we call the changed
2800   perturbation walk algorithm with decreased degree, if an intermediate
2801   weight vector is equal to the current target weight vector.
2802   This call will be only repeated until we get the wanted reduced Groebner
2803   basis or n times, where n is the numbers of variables.
2804*/
2805
2806// 19 Juni 2003
2807static int testnegintvec(intvec* v)
2808{
2809  int n = v->length();
2810  int i;
2811  for(i=0; i<n; i++){
2812    if((*v)[i]<0)
2813      return(1);
2814  }
2815  return(0);
2816}
2817
2818
2819/* 7 Februar 2002 */
2820/* npwinc = 0, if curr_weight doesn't stay in the correct Groebner cone */
2821static ideal Rec_LastGB(ideal G, intvec* curr_weight,
2822                        intvec* orig_target_weight, int tp_deg, int npwinc)
2823{
2824  BOOLEAN nError = Overflow_Error;
2825  Overflow_Error = FALSE;
2826  BOOLEAN nOverflow_Error = FALSE;
2827
2828  clock_t tproc=0;
2829  clock_t tinput = clock();
2830
2831  int i,  nV = currRing->N;
2832  int nwalk=0, endwalks=0, nnwinC=1;
2833  int nlast = 0;
2834  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
2835  ring newRing, oldRing, TargetRing;
2836  intvec* iv_M_lp;
2837  intvec* target_weight;
2838  intvec* ivNull = new intvec(nV); //define (0,...,0)
2839  ring EXXRing = currRing;
2840  int NEG=0; //19 juni 03
2841  intvec* extra_curr_weight = new intvec(nV);
2842  intvec* next_weight;
2843
2844  //08 Juli 03
2845  intvec* hilb_func;
2846  /* to avoid (1,0,...,0) as the target vector */
2847  intvec* last_omega = new intvec(nV);
2848  for(i=nV-1; i>0; i--)
2849    (*last_omega)[i] = 1;
2850  (*last_omega)[0] = 10000;
2851
2852  BOOLEAN isGB = FALSE;
2853
2854  /* compute a pertubed weight vector of the target weight vector */
2855  if(tp_deg > 1 && tp_deg <= nV) {
2856    ideal H0 = idHeadCC(G);
2857
2858    if (currRing->parameter != NULL)
2859      DefRingParlp();
2860    else
2861      VMrDefaultlp();
2862
2863    TargetRing = currRing;
2864    ssG = idrMoveR(G,EXXRing);
2865
2866    ideal H0_tmp = idrMoveR(H0,EXXRing);
2867    ideal H1 = idHeadCC(ssG);
2868
2869    /* Apply Lemma 2.2 in Collart et. al (1997) to check whether
2870       cone(k-1) is equal to cone(k) */
2871    if(test_G_GB_walk(H0_tmp,H1)==1) {
2872      idDelete(&H0_tmp);
2873      idDelete(&H1);
2874      G = ssG;
2875      ssG = NULL;
2876      newRing = currRing;
2877      delete ivNull;
2878
2879      if(npwinc != 0)
2880        goto LastGB_Finish;
2881      else {
2882        isGB = TRUE;
2883        goto KSTD_Finish;
2884      }
2885    }
2886    idDelete(&H0_tmp);
2887    idDelete(&H1);
2888
2889    iv_M_lp = MivMatrixOrderlp(nV);
2890    target_weight  = MPertVectors(ssG, iv_M_lp, tp_deg);
2891    delete iv_M_lp;
2892    //PrintS("\n// Input is not GB!!");
2893    rChangeCurrRing(EXXRing);
2894    G = idrMoveR(ssG, TargetRing);
2895
2896    if(Overflow_Error == TRUE)  {
2897      nOverflow_Error = Overflow_Error;
2898      NEG = 1;
2899      newRing = currRing;
2900      goto JUNI_STD;
2901    }
2902  }
2903
2904  while(1)
2905  {
2906    nwalk ++;
2907    nstep++;
2908
2909    if(nwalk==1)
2910      goto FIRST_STEP;
2911
2912    to=clock();
2913    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
2914    Gomega = MwalkInitialForm(G, curr_weight);
2915    xtif=xtif+clock()-to;
2916
2917#ifndef  BUCHBERGER_ALG
2918    if(isNolVector(curr_weight) == 0)
2919      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
2920    else
2921      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
2922#endif // BUCHBERGER_ALG
2923
2924    oldRing = currRing;
2925
2926    /* defiNe a new ring that its ordering is "(a(curr_weight),lp) */
2927    if (currRing->parameter != NULL)
2928      DefRingPar(curr_weight);
2929    else
2930      VMrDefault(curr_weight);
2931
2932    newRing = currRing;
2933    Gomega1 = idrMoveR(Gomega, oldRing);
2934    to=clock();
2935    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
2936#ifdef  BUCHBERGER_ALG
2937    M = MstdhomCC(Gomega1);
2938#else
2939    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
2940    delete hilb_func;
2941#endif // BUCHBERGER_ALG
2942    xtstd=xtstd+clock()-to;
2943    /* change the ring to oldRing */
2944    rChangeCurrRing(oldRing);
2945    M1 =  idrMoveR(M, newRing);
2946    Gomega2 =  idrMoveR(Gomega1, newRing);
2947
2948     to=clock();
2949    /* compute a reduced Groebner basis of <G> w.r.t. "newRing" by the
2950       lifting process*/
2951    F = MLifttwoIdeal(Gomega2, M1, G);
2952    xtlift=xtlift+clock()-to;
2953    idDelete(&M1);
2954    idDelete(&Gomega2);
2955    idDelete(&G);
2956
2957    /* change the ring to newRing */
2958    rChangeCurrRing(newRing);
2959    F1 = idrMoveR(F, oldRing);
2960
2961    to=clock();
2962    /* reduce the Groebner basis <G> w.r.t. new ring */
2963    G = kInterRedCC(F1, NULL);
2964    xtred=xtred+clock()-to;
2965    idDelete(&F1);
2966
2967    if(endwalks == 1)
2968      break;
2969
2970  FIRST_STEP:
2971    to=clock();
2972    Overflow_Error = FALSE;
2973    /* compute a next weight vector */
2974    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
2975    xtnw=xtnw+clock()-to;
2976#ifdef PRINT_VECTORS
2977    MivString(curr_weight, target_weight, next_weight);
2978#endif
2979
2980    if(Overflow_Error == TRUE) {
2981      //PrintS("\n// ** The next vector does NOT stay in Cone!!\n");
2982#ifdef TEST_OVERFLOW
2983      goto  LastGB_Finish;
2984#endif
2985
2986      nnwinC = 0;
2987      if(tp_deg == nV)
2988        nlast = 1;
2989
2990      delete next_weight;
2991      break;
2992    }
2993
2994    if(MivComp(next_weight, ivNull) == 1) {
2995      //newRing = currRing;
2996      delete next_weight;
2997      break;
2998    }
2999
3000    if(MivComp(next_weight, target_weight) == 1)  {
3001      if(tp_deg == nV)
3002        endwalks = 1;
3003      else {
3004      REC_LAST_GB_ALT2:
3005        nOverflow_Error = Overflow_Error;
3006        tproc=tproc+clock()-tinput;
3007        /*
3008          Print("\n// takes %d steps and calls \"Rec_LastGB\" (%d):",
3009          nwalk, tp_deg+1);
3010        */
3011        G = Rec_LastGB(G,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
3012        newRing = currRing;
3013        delete next_weight;
3014        break;
3015      }
3016    }
3017
3018    for(i=nV-1; i>=0; i--) {
3019      //(*extra_curr_weight)[i] = (*curr_weight)[i];
3020      (*curr_weight)[i] = (*next_weight)[i];
3021    }
3022    delete next_weight;
3023  }//while
3024
3025  delete ivNull;
3026
3027  if(tp_deg != nV) {
3028    newRing = currRing;
3029
3030    if (currRing->parameter != NULL)
3031      DefRingParlp();
3032    else
3033      VMrDefaultlp();
3034
3035    F1 = idrMoveR(G, newRing);
3036
3037    if(nnwinC == 0 || test_w_in_ConeCC(F1, target_weight) != 1 ) {
3038      nOverflow_Error = Overflow_Error;
3039      //Print("\n//  takes %d steps and calls \"Rec_LastGB (%d):", tp_deg+1);
3040      tproc=tproc+clock()-tinput;
3041      F1 = Rec_LastGB(F1,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
3042    }
3043    delete target_weight;
3044
3045    TargetRing = currRing;
3046    rChangeCurrRing(EXXRing);
3047    result = idrMoveR(F1, TargetRing);
3048  }
3049  else  {
3050    if(nlast == 1) {
3051      JUNI_STD:
3052
3053      newRing = currRing;
3054      if (currRing->parameter != NULL)
3055        DefRingParlp();
3056      else
3057        VMrDefaultlp();
3058
3059      KSTD_Finish:
3060      if(isGB == FALSE)
3061        F1 = idrMoveR(G, newRing);
3062      else
3063        F1 = G;
3064      to=clock();
3065      // Print("\n// apply the Buchberger's alg in ring = %s",rString(currRing));
3066      // idElements(F1, "F1");
3067      G = MstdCC(F1);
3068      xtextra=xtextra+clock()-to;
3069
3070
3071      idDelete(&F1);
3072      newRing = currRing;
3073    }
3074
3075    LastGB_Finish:
3076    rChangeCurrRing(EXXRing);
3077    result = idrMoveR(G, newRing);
3078  }
3079
3080  if(Overflow_Error == FALSE)
3081    Overflow_Error=nError;
3082  /*
3083  Print("\n// \"Rec_LastGB\" (%d) took %d steps and %.2f sec.Overflow_Error (%d)", tp_deg,
3084        nwalk, ((double) tproc)/1000000, nOverflow_Error);
3085  */
3086  return(result);
3087}
3088
3089/* The following subroutine is the implementation of our second improved
3090   Groebner walk algorithm, i.e. the second altervative algorithm.
3091   First we use the Grobner walk algorithm and then we call the changed
3092   perturbation walk algorithm with increased degree, if an intermediate
3093   weight vector is equal to the current target weight vector.
3094   This call will be only repeated until we get the wanted reduced Groebner
3095   basis or n times, where n is the numbers of variables.
3096*/
3097/* walk + recursive LastGB */
3098ideal MAltwalk2(ideal Go, intvec* curr_weight, intvec* target_weight)
3099{
3100  Set_Error(FALSE);
3101  Overflow_Error = FALSE;
3102  BOOLEAN nOverflow_Error = FALSE;
3103  //Print("// pSetm_Error = (%d)", ErrorCheck());
3104
3105  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
3106  xftinput = clock();
3107  clock_t tostd, tproc;
3108
3109  nstep = 0;
3110  int i, nV = currRing->N;
3111  int nwalk=0, endwalks=0, nhilb=1;
3112
3113  ideal Gomega, M, F, Gomega1, Gomega2, M1, F1, G, G1;
3114  ring endRing, newRing, oldRing;
3115  intvec* ivNull = new intvec(nV);
3116  intvec* next_weight;
3117  intvec* extra_curr_weight = new intvec(nV);
3118  intvec* hilb_func;
3119  intvec* exivlp = Mivlp(nV);
3120
3121  ring XXRing = currRing;
3122
3123  //Print("\n// ring r_input = %s;", rString(currRing));
3124  to = clock();
3125  /* compute the reduced Groebner basis of the given ideal w.r.t.
3126     a "fast" monomial order, e.g. degree reverse lex. order (dp) */
3127  G = MstdCC(Go);
3128  tostd=clock()-to;
3129
3130  /*
3131  Print("\n// Computation of the first std took = %.2f sec",
3132        ((double) tostd)/1000000);
3133  */
3134  if(currRing->order[0] == ringorder_a)
3135    goto NEXT_VECTOR;
3136
3137  while(1)
3138  {
3139    nwalk ++;
3140    nstep ++;
3141    to = clock();
3142    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
3143    Gomega = MwalkInitialForm(G, curr_weight);
3144    xtif=xtif+clock()-to;
3145#if 0
3146    if(Overflow_Error == TRUE)
3147    {
3148      for(i=nV-1; i>=0; i--)
3149        (*curr_weight)[i] = (*extra_curr_weight)[i];
3150      delete extra_curr_weight;
3151      goto LAST_GB_ALT2;
3152    }
3153#endif
3154    oldRing = currRing;
3155
3156    /* define a new ring that its ordering is "(a(curr_weight),lp) */
3157    if (currRing->parameter != NULL)
3158      DefRingPar(curr_weight);
3159    else
3160      VMrDefault(curr_weight);
3161
3162    newRing = currRing;
3163    Gomega1 = idrMoveR(Gomega, oldRing);
3164    to = clock();
3165    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
3166    M = MstdhomCC(Gomega1);
3167    xtstd=xtstd+clock()-to;
3168    /* change the ring to oldRing */
3169    rChangeCurrRing(oldRing);
3170    M1 =  idrMoveR(M, newRing);
3171    Gomega2 =  idrMoveR(Gomega1, newRing);
3172
3173    to = clock();
3174    /* compute the reduced Groebner basis of <G> w.r.t. "newRing"
3175       by the liftig process */
3176    F = MLifttwoIdeal(Gomega2, M1, G);
3177    xtlift=xtlift+clock()-to;
3178    idDelete(&M1);
3179    idDelete(&Gomega2);
3180    idDelete(&G);
3181
3182    /* change the ring to newRing */
3183    rChangeCurrRing(newRing);
3184    F1 = idrMoveR(F, oldRing);
3185
3186    to = clock();
3187    /* reduce the Groebner basis <G> w.r.t. newRing */
3188    G = kInterRedCC(F1, NULL);
3189    xtred=xtred+clock()-to;
3190    idDelete(&F1);
3191
3192    if(endwalks == 1)
3193      break;
3194
3195  NEXT_VECTOR:
3196    to = clock();
3197    /* compute a next weight vector */
3198    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
3199    xtnw=xtnw+clock()-to;
3200#ifdef PRINT_VECTORS
3201    MivString(curr_weight, target_weight, next_weight);
3202#endif
3203
3204    if(Overflow_Error == TRUE)
3205    {
3206      /*
3207        ivString(next_weight, "omega");
3208        PrintS("\n// ** The weight vector does NOT stay in Cone!!\n");
3209      */
3210#ifdef TEST_OVERFLOW
3211      goto  TEST_OVERFLOW_OI;
3212#endif
3213
3214
3215      newRing = currRing;
3216      if (currRing->parameter != NULL)
3217        DefRingPar(target_weight);
3218      else
3219        VMrDefault(target_weight);
3220
3221      F1 = idrMoveR(G, newRing);
3222      G = MstdCC(F1);
3223      idDelete(&F1);
3224      newRing = currRing;
3225      break;
3226    }
3227
3228    if(MivComp(next_weight, ivNull) == 1)
3229    {
3230      newRing = currRing;
3231      delete next_weight;
3232      break;
3233    }
3234
3235    if(MivComp(next_weight, target_weight) == 1)
3236    {
3237      if(MivSame(target_weight, exivlp)==1)
3238      {
3239      LAST_GB_ALT2:
3240        nOverflow_Error = Overflow_Error;
3241        tproc = clock()-xftinput;
3242        //Print("\n// takes %d steps and calls the recursion of level 2:",  nwalk);
3243        /* call the changed perturbation walk algorithm with degree 2 */
3244        G = Rec_LastGB(G, curr_weight, target_weight, 2,1);
3245        newRing = currRing;
3246        delete next_weight;
3247        break;
3248      }
3249      endwalks = 1;
3250    }
3251
3252    for(i=nV-1; i>=0; i--)
3253    {
3254      //(*extra_curr_weight)[i] = (*curr_weight)[i];
3255      (*curr_weight)[i] = (*next_weight)[i];
3256    }
3257    delete next_weight;
3258  }
3259 TEST_OVERFLOW_OI:
3260  rChangeCurrRing(XXRing);
3261  G = idrMoveR(G, newRing);
3262  delete ivNull;
3263  delete exivlp;
3264
3265#ifdef TIME_TEST
3266  Print("\n// \"Main procedure\"  took %d steps dnd %.2f sec. Overflow_Error (%d)", nwalk,
3267        ((double) tproc)/1000000, nOverflow_Error);
3268
3269  TimeStringFractal(xftinput, tostd, xtif, xtstd, xtextra,xtlift, xtred,xtnw);
3270
3271  Print("\n// pSetm_Error = (%d)", ErrorCheck());
3272  //Print("\n// Overflow_Error? (%d)", nOverflow_Error);
3273  Print("\n// Awalk2 took %d steps!!", nstep);
3274#endif
3275
3276  return(G);
3277}
3278
3279
3280/* 5.5.02 */
3281/* The implementation of the fractal walk algorithmus */
3282
3283/* The main procedur Mfwalk calls the recursive Subroutine
3284   rec_fractal_call to compute the wanted Gröbner basis.
3285   At the main procedur we compute the reduced Gröbner basis w.r.t. a "fast"
3286   order, e.g. "dp" and a sequence of weight vectors which are row vectors
3287   of a matrix. This matrix defines the given monomial order, e.g. "lp"
3288*/
3289
3290
3291
3292
3293/* perturb the matrix order of  "lex" */
3294static intvec* NewVectorlp(ideal I)
3295{
3296  int nV = currRing->N;
3297  intvec* iv_wlp =  MivMatrixOrderlp(nV);
3298  intvec* result = Mfpertvector(I, iv_wlp);
3299  delete iv_wlp;
3300  return result;
3301}
3302
3303int ngleich;
3304intvec* Xsigma;
3305intvec* Xtau;
3306int xn;
3307intvec* Xivinput;
3308intvec* Xivlp;
3309
3310
3311
3312/***********************************************************************
3313  The procedur REC_GB_Mwalk computes a GB for <G> w.r.t. the weight order
3314  otw, where G is a reduced GB w.r.t. the weight order cw.
3315  The new procedur Mwalk calls REC_GB.
3316************************************************************************/
3317static ideal REC_GB_Mwalk(ideal G, intvec* curr_weight, intvec* orig_target_weight,
3318                          int tp_deg, int npwinc)
3319{
3320  BOOLEAN nError = Overflow_Error;
3321  Overflow_Error = FALSE;
3322
3323  int i,  nV = currRing->N, ntwC,  npwinC;
3324  int nwalk=0, endwalks=0, nnwinC=1, nlast = 0;
3325  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
3326  ring newRing, oldRing, TargetRing;
3327  intvec* iv_M_lp;
3328  intvec* target_weight;
3329  intvec* ivNull = new intvec(nV);
3330  intvec* hilb_func;
3331  BOOLEAN isGB = FALSE;
3332
3333  /* to avoid (1,0,...,0) as the target vector */
3334  intvec* last_omega = new intvec(nV);
3335  for(i=nV-1; i>0; i--)
3336    (*last_omega)[i] = 1;
3337  (*last_omega)[0] = 10000;
3338
3339  ring EXXRing = currRing;
3340
3341  /* compute a pertubed weight vector of the target weight vector */
3342  if(tp_deg > 1 && tp_deg <= nV)
3343  {
3344    ideal H0 = idHeadCC(G);
3345    if (currRing->parameter != NULL)
3346      DefRingPar(orig_target_weight);
3347    else
3348      VMrDefault(orig_target_weight);
3349
3350    TargetRing = currRing;
3351    ssG = idrMoveR(G,EXXRing);
3352
3353    ideal H0_tmp = idrMoveR(H0,EXXRing);
3354    ideal H1 = idHeadCC(ssG);
3355    id_Delete(&H0,EXXRing);
3356
3357    if(test_G_GB_walk(H0_tmp,H1)==1)
3358    {
3359      //Print("//input in %d-th recursive is a GB",tp_deg);
3360      idDelete(&H0_tmp);idDelete(&H1);
3361      G = ssG;
3362      ssG = NULL;
3363      newRing = currRing;
3364      delete ivNull;
3365      if(npwinc == 0)
3366      {
3367        isGB = TRUE;
3368        goto KSTD_Finish;
3369      }
3370      else
3371        goto LastGB_Finish;
3372    }
3373    idDelete(&H0_tmp);   idDelete(&H1);
3374
3375    intvec* ivlp = Mivlp(nV);
3376    if( MivSame(orig_target_weight, ivlp)==1 )
3377      iv_M_lp = MivMatrixOrderlp(nV);
3378    else
3379      iv_M_lp = MivMatrixOrder(orig_target_weight);
3380
3381    //target_weight  = MPertVectorslp(ssG, iv_M_lp, tp_deg);
3382    target_weight  = MPertVectors(ssG, iv_M_lp, tp_deg);
3383
3384    delete ivlp;
3385    delete iv_M_lp;
3386
3387    rChangeCurrRing(EXXRing);
3388    G = idrMoveR(ssG, TargetRing);
3389  }
3390
3391  while(1)
3392  {
3393    nwalk ++;
3394    nstep++;
3395    if(nwalk == 1)
3396      goto NEXT_STEP;
3397
3398    //Print("\n// Entering the %d-th step in the %d-th recursive:",nwalk,tp_deg);
3399    to = clock();
3400    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
3401    Gomega = MwalkInitialForm(G, curr_weight);
3402    xtif = xtif + clock()-to;
3403
3404#ifndef  BUCHBERGER_ALG
3405    if(isNolVector(curr_weight) == 0)
3406      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
3407    else
3408      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
3409#endif // BUCHBERGER_ALG
3410
3411    oldRing = currRing;
3412
3413    /* define a new ring that its ordering is "(a(curr_weight),lp) */
3414    if (currRing->parameter != NULL)
3415      DefRingPar(curr_weight);
3416    else
3417      VMrDefault(curr_weight);
3418
3419    newRing = currRing;
3420    Gomega1 = idrMoveR(Gomega, oldRing);
3421
3422    to = clock();
3423    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
3424#ifdef  BUCHBERGER_ALG
3425    M = MstdhomCC(Gomega1);
3426#else
3427    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
3428    delete hilb_func;
3429#endif // BUCHBERGER_ALG
3430    xtstd = xtstd + clock() - to;
3431
3432    /* change the ring to oldRing */
3433    rChangeCurrRing(oldRing);
3434
3435    M1 =  idrMoveR(M, newRing);
3436    Gomega2 =  idrMoveR(Gomega1, newRing);
3437
3438    to = clock();
3439    F = MLifttwoIdeal(Gomega2, M1, G);
3440    xtlift = xtlift + clock() -to;
3441
3442    idDelete(&M1);
3443    idDelete(&Gomega2);
3444    idDelete(&G);
3445
3446
3447    /* change the ring to newRing */
3448    rChangeCurrRing(newRing);
3449    F1 = idrMoveR(F, oldRing);
3450
3451    to = clock();
3452    /* reduce the Groebner basis <G> w.r.t. new ring */
3453    G = kInterRedCC(F1, NULL);
3454    xtred = xtred + clock() -to;
3455
3456    idDelete(&F1);
3457
3458    if(endwalks == 1)
3459      break;
3460
3461  NEXT_STEP:
3462    to = clock();
3463    /* compute a next weight vector */
3464    intvec* next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
3465    xtnw = xtnw + clock() - to;
3466
3467#ifdef PRINT_VECTORS
3468    MivString(curr_weight, target_weight, next_weight);
3469#endif
3470
3471    /*check whether the computed vector does in the correct cone */
3472    //ntwC = test_w_in_ConeCC(G, next_weight);
3473    //if(ntwC != 1)
3474    if(Overflow_Error == TRUE)
3475    {
3476      PrintS("\n// ** The computed vector does NOT stay in Cone!!\n");
3477      nnwinC = 0;
3478      if(tp_deg == nV)
3479        nlast = 1;
3480      delete next_weight;
3481      break;
3482    }
3483    if(MivComp(next_weight, ivNull) == 1)
3484    {
3485      newRing = currRing;
3486      delete next_weight;
3487      break;
3488    }
3489
3490    if(MivComp(next_weight, target_weight) == 1)
3491    {
3492      if(tp_deg == nV)
3493        endwalks = 1;
3494      else {
3495        G = REC_GB_Mwalk(G,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
3496        newRing = currRing;
3497        delete next_weight;
3498        break;
3499      }
3500    }
3501
3502    /* 06.11.01 NOT Changed */
3503    for(i=nV-1; i>=0; i--)
3504      (*curr_weight)[i] = (*next_weight)[i];
3505
3506    delete next_weight;
3507  }//while
3508
3509  delete ivNull;
3510
3511  if(tp_deg != nV)
3512  {
3513    //28.07.03
3514    newRing = currRing;
3515
3516    if (currRing->parameter != NULL)
3517      //  DefRingParlp(); //
3518      DefRingPar(orig_target_weight);
3519    else
3520      VMrDefault(orig_target_weight);
3521
3522
3523    F1 = idrMoveR(G, newRing);
3524
3525    if(nnwinC == 0)
3526      F1 = REC_GB_Mwalk(F1,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
3527    else
3528      if(test_w_in_ConeCC(F1, target_weight) != 1)
3529        F1 = REC_GB_Mwalk(F1,curr_weight, orig_target_weight,tp_deg+1,nnwinC);
3530
3531    delete target_weight;
3532
3533    TargetRing = currRing;
3534    rChangeCurrRing(EXXRing);
3535    result = idrMoveR(F1, TargetRing);
3536  }
3537  else
3538  {
3539    if(nlast == 1)
3540    {
3541      if (currRing->parameter != NULL)
3542        DefRingPar(orig_target_weight);
3543      else
3544        VMrDefault(orig_target_weight);
3545
3546
3547    KSTD_Finish:
3548      if(isGB == FALSE)
3549        F1 = idrMoveR(G, newRing);
3550      else
3551        F1 = G;
3552      to=clock();
3553      /* apply Buchberger alg to compute a red. GB of F1 */
3554      G = MstdCC(F1);
3555      xtextra=clock()-to;
3556      idDelete(&F1);
3557      newRing = currRing;
3558    }
3559
3560  LastGB_Finish:
3561    rChangeCurrRing(EXXRing);
3562    result = idrMoveR(G, newRing);
3563  }
3564
3565  if(Overflow_Error == FALSE)
3566    Overflow_Error = nError;
3567
3568  return(result);
3569}
3570
3571
3572/* 08.09.02 */
3573/******** THE NEW GRÖBNER WALK ALGORITHM **********/
3574/* Gröbnerwalk with a recursive "second" alternative GW, REC_GB_Mwalk
3575   that only computes the last reduced GB */
3576ideal Mwalk(ideal Go, intvec* curr_weight, intvec* target_weight)
3577{
3578  Set_Error(FALSE);
3579  Overflow_Error = FALSE;
3580  //Print("// pSetm_Error = (%d)", ErrorCheck());
3581
3582  clock_t tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
3583  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
3584  tinput = clock();
3585  clock_t tim;
3586  nstep=0;
3587  int i, nV = currRing->N;
3588  int nwalk=0, endwalks=0;
3589
3590  ideal Gomega, M, F, Gomega1, Gomega2, M1, F1, G, G1;
3591  ring endRing, newRing, oldRing;
3592  intvec* ivNull = new intvec(nV);
3593  intvec* exivlp = Mivlp(nV);
3594  intvec* hilb_func;
3595
3596  intvec* tmp_weight = new intvec(nV);
3597  for(i=nV-1; i>=0; i--)
3598    (*tmp_weight)[i] = (*curr_weight)[i];
3599
3600   /* to avoid (1,0,...,0) as the target vector */
3601  intvec* last_omega = new intvec(nV);
3602  for(i=nV-1; i>0; i--)
3603    (*last_omega)[i] = 1;
3604  (*last_omega)[0] = 10000;
3605
3606  ring XXRing = currRing;
3607
3608  to = clock();
3609  /* the monomial ordering of this current ring would be "dp" */
3610  G = MstdCC(Go);
3611  tostd = clock()-to;
3612
3613  if(currRing->order[0] == ringorder_a)
3614    goto NEXT_VECTOR;
3615
3616  while(1)
3617  {
3618    nwalk ++;
3619    nstep ++;
3620    to = clock();
3621    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
3622    Gomega = MwalkInitialForm(G, curr_weight);
3623    tif = tif + clock()-to;
3624    oldRing = currRing;
3625
3626    if(endwalks == 1)
3627    {
3628      /* compute a reduced Groebner basis of Gomega w.r.t. >>_cw by
3629         the recursive changed perturbation walk alg. */
3630      tim = clock();
3631      /*
3632        Print("\n// **** Gröbnerwalk took %d steps and ", nwalk);
3633        PrintS("\n// **** call the rec. Pert. Walk to compute a red GB of:");
3634        idElements(Gomega, "G_omega");
3635      */
3636
3637      if(MivSame(exivlp, target_weight)==1)
3638        M = REC_GB_Mwalk(idCopy(Gomega), tmp_weight, curr_weight, 2,1);
3639      else
3640        goto NORMAL_GW;
3641      /*
3642        Print("\n//  time for the last std(Gw)  = %.2f sec",
3643        ((double) (clock()-tim)/1000000));
3644        PrintS("\n// ***************************************************\n");
3645      */
3646#ifdef CHECK_IDEAL_MWALK
3647      idElements(Gomega, "G_omega");
3648      headidString(Gomega, "Gw");
3649      idElements(M, "M");
3650      //headidString(M, "M");
3651#endif
3652      to = clock();
3653      F = MLifttwoIdeal(Gomega, M, G);
3654      xtlift = xtlift + clock() - to;
3655
3656      idDelete(&Gomega);
3657      idDelete(&M);
3658      idDelete(&G);
3659
3660      oldRing = currRing;
3661
3662      /* create a new ring newRing */
3663       if (currRing->parameter != NULL)
3664         DefRingPar(curr_weight);
3665       else
3666         VMrDefault(curr_weight);
3667
3668      newRing = currRing;
3669      F1 = idrMoveR(F, oldRing);
3670    }
3671    else
3672    {
3673    NORMAL_GW:
3674#ifndef  BUCHBERGER_ALG
3675      if(isNolVector(curr_weight) == 0)
3676        hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
3677      else
3678        hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
3679#endif // BUCHBERGER_ALG
3680
3681      /* define a new ring that its ordering is "(a(curr_weight),lp) */
3682      if (currRing->parameter != NULL)
3683        DefRingPar(curr_weight);
3684      else
3685        VMrDefault(curr_weight);
3686
3687      newRing = currRing;
3688      Gomega1 = idrMoveR(Gomega, oldRing);
3689
3690      to = clock();
3691      /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
3692#ifdef  BUCHBERGER_ALG
3693      M = MstdhomCC(Gomega1);
3694#else
3695      M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
3696      delete hilb_func;
3697#endif // BUCHBERGER_ALG
3698      tstd = tstd + clock() - to;
3699
3700      /* change the ring to oldRing */
3701      rChangeCurrRing(oldRing);
3702      M1 =  idrMoveR(M, newRing);
3703      Gomega2 =  idrMoveR(Gomega1, newRing);
3704
3705      to = clock();
3706      /* compute a representation of the generators of submod (M)
3707         with respect to those of mod (Gomega).
3708         Gomega is a reduced Groebner basis w.r.t. the current ring */
3709      F = MLifttwoIdeal(Gomega2, M1, G);
3710      tlift = tlift + clock() - to;
3711
3712      idDelete(&M1);
3713      idDelete(&Gomega2);
3714      idDelete(&G);
3715
3716      /* change the ring to newRing */
3717      rChangeCurrRing(newRing);
3718      F1 = idrMoveR(F, oldRing);
3719    }
3720
3721    to = clock();
3722    /* reduce the Groebner basis <G> w.r.t. new ring */
3723    G = kInterRedCC(F1, NULL);
3724    if(endwalks != 1)
3725      tred = tred + clock() - to;
3726    else
3727      xtred = xtred + clock() - to;
3728
3729    idDelete(&F1);
3730    if(endwalks == 1)
3731      break;
3732
3733  NEXT_VECTOR:
3734    to = clock();
3735    /* compute a next weight vector */
3736    intvec* next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
3737    tnw = tnw + clock() - to;
3738#ifdef PRINT_VECTORS
3739    MivString(curr_weight, target_weight, next_weight);
3740#endif
3741
3742    //if(test_w_in_ConeCC(G, next_weight) != 1)
3743    if(Overflow_Error == TRUE)
3744    {
3745      newRing = currRing;
3746      PrintS("\n// ** The computed vector does NOT stay in Cone!!\n");
3747
3748      if (currRing->parameter != NULL)
3749        DefRingPar(target_weight);
3750      else
3751        VMrDefault(target_weight);
3752
3753      F1 = idrMoveR(G, newRing);
3754      G = MstdCC(F1);
3755      idDelete(&F1);
3756
3757      newRing = currRing;
3758      break;
3759    }
3760
3761    if(MivComp(next_weight, ivNull) == 1)
3762    {
3763      newRing = currRing;
3764      delete next_weight;
3765      break;
3766    }
3767    if(MivComp(next_weight, target_weight) == 1)
3768      endwalks = 1;
3769
3770    for(i=nV-1; i>=0; i--) {
3771      (*tmp_weight)[i] = (*curr_weight)[i];
3772      (*curr_weight)[i] = (*next_weight)[i];
3773    }
3774    delete next_weight;
3775  }
3776  rChangeCurrRing(XXRing);
3777  G = idrMoveR(G, newRing);
3778
3779  delete tmp_weight;
3780  delete ivNull;
3781  delete exivlp;
3782
3783#ifdef TIME_TEST
3784  TimeString(tinput, tostd, tif, tstd, tlift, tred, tnw, nstep);
3785
3786  Print("\n// pSetm_Error = (%d)", ErrorCheck());
3787  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
3788#endif
3789  return(G);
3790}
3791
3792  /* 2.12.02*/
3793ideal Mwalk_tst(ideal Go, intvec* curr_weight, intvec* target_weight)
3794{
3795  clock_t tinput=clock();
3796  //idString(Go,"Ginp");
3797  int i, nV = currRing->N;
3798  int nwalk=0, endwalks=0;
3799
3800  ideal Gomega, M, F, Gomega1, Gomega2, M1, F1, G, G1;
3801  ring endRing, newRing, oldRing;
3802  intvec* ivNull = new intvec(nV);
3803  ring XXRing = currRing;
3804
3805  intvec* tmp_weight = new intvec(nV);
3806  for(i=nV-1; i>=0; i--)
3807    (*tmp_weight)[i] = (*curr_weight)[i];
3808
3809  /* the monomial ordering of this current ring would be "dp" */
3810  G = MstdCC(Go);
3811
3812  intvec* hilb_func;
3813
3814  /* to avoid (1,0,...,0) as the target vector */
3815  intvec* last_omega = new intvec(nV);
3816  for(i=nV-1; i>0; i--)
3817    (*last_omega)[i] = 1;
3818  (*last_omega)[0] = 10000;
3819
3820  while(1)
3821  {
3822    nwalk ++;
3823    //Print("\n// Entering the %d-th step:", nwalk);
3824    //Print("\n// ring r[%d] = %s;", nwalk, rString(currRing));
3825    idString(G,"G");
3826    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
3827    Gomega = MwalkInitialForm(G, curr_weight);
3828    //ivString(curr_weight, "omega");
3829    idString(Gomega,"Gw");
3830
3831#ifndef  BUCHBERGER_ALG
3832    if(isNolVector(curr_weight) == 0)
3833      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
3834    else
3835      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
3836#endif // BUCHBERGER_ALG
3837
3838
3839    oldRing = currRing;
3840
3841    /* define a new ring that its ordering is "(a(curr_weight),lp) */
3842    VMrDefault(curr_weight);
3843    newRing = currRing;
3844
3845    Gomega1 = idrMoveR(Gomega, oldRing);
3846
3847    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
3848#ifdef  BUCHBERGER_ALG
3849    M = MstdhomCC(Gomega1);
3850#else
3851    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
3852    delete hilb_func;
3853#endif // BUCHBERGER_ALG
3854
3855    idString(M,"M");
3856
3857      /* change the ring to oldRing */
3858    rChangeCurrRing(oldRing);
3859    M1 =  idrMoveR(M, newRing);
3860    Gomega2 =  idrMoveR(Gomega1, newRing);
3861
3862      /* compute a representation of the generators of submod (M)
3863         with respect to those of mod (Gomega).
3864         Gomega is a reduced Groebner basis w.r.t. the current ring */
3865    F = MLifttwoIdeal(Gomega2, M1, G);
3866    idDelete(&M1);
3867    idDelete(&Gomega2);
3868    idDelete(&G);
3869    idString(F,"F");
3870
3871    /* change the ring to newRing */
3872    rChangeCurrRing(newRing);
3873    F1 = idrMoveR(F, oldRing);
3874
3875    /* reduce the Groebner basis <G> w.r.t. new ring */
3876    G = kInterRedCC(F1, NULL);
3877    //idSkipZeroes(G);//done by kInterRed
3878    idDelete(&F1);
3879    idString(G,"G");
3880    if(endwalks == 1)
3881      break;
3882
3883    /* compute a next weight vector */
3884    intvec* next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
3885#ifdef PRINT_VECTORS
3886    MivString(curr_weight, target_weight, next_weight);
3887#endif
3888
3889    if(MivComp(next_weight, ivNull) == 1)
3890    {
3891      delete next_weight;
3892      break;
3893    }
3894    if(MivComp(next_weight, target_weight) == 1)
3895      endwalks = 1;
3896
3897    for(i=nV-1; i>=0; i--)
3898      (*tmp_weight)[i] = (*curr_weight)[i];
3899
3900    /* 06.11.01 to free the memory: NOT Changed!!*/
3901    for(i=nV-1; i>=0; i--)
3902      (*curr_weight)[i] = (*next_weight)[i];
3903    delete next_weight;
3904  }
3905  rChangeCurrRing(XXRing);
3906  G = idrMoveR(G, newRing);
3907
3908  delete tmp_weight;
3909  delete ivNull;
3910  PrintLn();
3911  return(G);
3912}
3913
3914
3915
3916/**************************************************************/
3917/*     Implementation of the perturbation walk algorithm      */
3918/**************************************************************/
3919/* If the perturbed target weight vector or an intermediate weight vector
3920   doesn't stay in the correct Groebner cone, we have only
3921   a reduced Groebner basis for the given ideal with respect to
3922   a monomial order which differs to the given order.
3923   Then we have to compute the wanted  reduced Groebner basis for it.
3924   For this, we can use
3925   1) the improved Buchberger algorithm or
3926   2) the changed perturbation walk algorithm with a decreased degree.
3927*/
3928/* use kStd, if nP = 0, else call LastGB */
3929ideal Mpwalk(ideal Go, int op_deg, int tp_deg,intvec* curr_weight,
3930             intvec* target_weight, int nP)
3931{
3932  Set_Error(FALSE  );
3933  Overflow_Error = FALSE;
3934  //Print("// pSetm_Error = (%d)", ErrorCheck());
3935
3936  clock_t  tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
3937  xtextra=0;
3938  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
3939  tinput = clock();
3940
3941  clock_t tim;
3942
3943  nstep = 0;
3944  int i, ntwC=1, ntestw=1,  nV = currRing->N, op_tmp = op_deg;
3945  int endwalks=0, nhilb=0, ntestomega=0;
3946
3947  ideal Gomega, M, F, G, Gomega1, Gomega2, M1,F1,Eresult,ssG;
3948  ring newRing, oldRing, TargetRing;
3949  intvec* iv_M_dp;
3950  intvec* iv_M_lp;
3951  intvec* exivlp = Mivlp(nV);
3952  intvec* orig_target = target_weight;
3953  intvec* pert_target_vector = target_weight;
3954  intvec* ivNull = new intvec(nV);
3955  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
3956  intvec* cw_tmp = curr_weight;
3957  intvec* hilb_func;
3958  intvec* next_weight;
3959  intvec* extra_curr_weight = new intvec(nV);
3960
3961  /* to avoid (1,0,...,0) as the target vector */
3962  intvec* last_omega = new intvec(nV);
3963  for(i=nV-1; i>0; i--)
3964    (*last_omega)[i] = 1;
3965  (*last_omega)[0] = 10000;
3966
3967  ring XXRing = currRing;
3968
3969
3970  to = clock();
3971  /* perturbs the original vector */
3972  if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) := "dp"
3973  {
3974    G = MstdCC(Go);
3975    tostd = clock()-to;
3976    if(op_deg != 1){
3977      iv_M_dp = MivMatrixOrderdp(nV);
3978      //ivString(iv_M_dp, "iv_M_dp");
3979      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
3980    }
3981  }
3982  else
3983  {
3984    //ring order := (a(curr_weight),lp);
3985    if (currRing->parameter != NULL)
3986      DefRingPar(curr_weight);
3987    else
3988      VMrDefault(curr_weight);
3989
3990    G = idrMoveR(Go, XXRing);
3991    G = MstdCC(G);
3992    tostd = clock()-to;
3993    if(op_deg != 1){
3994      iv_M_dp = MivMatrixOrder(curr_weight);
3995      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
3996    }
3997  }
3998  delete iv_dp;
3999  if(op_deg != 1) delete iv_M_dp;
4000
4001  ring HelpRing = currRing;
4002
4003  /* perturbs the target weight vector */
4004  if(tp_deg > 1 && tp_deg <= nV)
4005  {
4006    if (currRing->parameter != NULL)
4007      DefRingPar(target_weight);
4008    else
4009      VMrDefault(target_weight);
4010
4011    TargetRing = currRing;
4012    ssG = idrMoveR(G,HelpRing);
4013    if(MivSame(target_weight, exivlp) == 1)
4014    {
4015      iv_M_lp = MivMatrixOrderlp(nV);
4016      //ivString(iv_M_lp, "iv_M_lp");
4017      //target_weight = MPertVectorslp(ssG, iv_M_lp, tp_deg);
4018      target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
4019    }
4020    else
4021    {
4022      iv_M_lp = MivMatrixOrder(target_weight);
4023      //target_weight = MPertVectorslp(ssG, iv_M_lp, tp_deg);
4024      target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
4025    }
4026    delete iv_M_lp;
4027    pert_target_vector = target_weight; //vor 19. mai 2003//test 19 Junu 03
4028    rChangeCurrRing(HelpRing);
4029    G = idrMoveR(ssG, TargetRing);
4030  }
4031  /*
4032    Print("\n// Perturbationwalkalg. vom Gradpaar (%d,%d):",op_deg,tp_deg);
4033    ivString(curr_weight, "new sigma");
4034    ivString(target_weight, "new tau");
4035  */
4036  while(1)
4037  {
4038    nstep ++;
4039    to = clock();
4040    /* compute an initial form ideal of <G> w.r.t. the weight vector
4041       "curr_weight" */
4042    Gomega = MwalkInitialForm(G, curr_weight);
4043
4044
4045#ifdef ENDWALKS
4046    if(endwalks == 1){
4047      Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
4048      idElements(G, "G");
4049      // idElements(Gomega, "Gw");
4050      headidString(G, "G");
4051      //headidString(Gomega, "Gw");
4052    }
4053#endif
4054
4055    tif = tif + clock()-to;
4056
4057#ifndef  BUCHBERGER_ALG
4058    if(isNolVector(curr_weight) == 0)
4059      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
4060    else
4061      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
4062#endif // BUCHBERGER_ALG
4063
4064    oldRing = currRing;
4065
4066    /* define a new ring that its ordering is "(a(curr_weight),lp) */
4067    if (currRing->parameter != NULL)
4068      DefRingPar(curr_weight);
4069    else
4070      VMrDefault(curr_weight);
4071
4072    newRing = currRing;
4073    Gomega1 = idrMoveR(Gomega, oldRing);
4074
4075#ifdef ENDWALKS
4076    if(endwalks==1)
4077    {
4078      Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
4079      idElements(Gomega1, "Gw");
4080      headidString(Gomega1, "headGw");
4081      PrintS("\n// compute a rGB of Gw:\n");
4082
4083#ifndef  BUCHBERGER_ALG
4084      ivString(hilb_func, "w");
4085#endif
4086    }
4087#endif
4088
4089    tim = clock();
4090    to = clock();
4091    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
4092#ifdef  BUCHBERGER_ALG
4093    M = MstdhomCC(Gomega1);
4094#else
4095    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
4096    delete hilb_func;
4097#endif // BUCHBERGER_ALG
4098
4099    if(endwalks == 1){
4100      xtstd = xtstd+clock()-to;
4101#ifdef ENDWALKS
4102      Print("\n// time for the last std(Gw)  = %.2f sec\n",
4103            ((double) clock())/1000000 -((double)tim) /1000000);
4104#endif
4105    }
4106    else
4107      tstd=tstd+clock()-to;
4108
4109    /* change the ring to oldRing */
4110    rChangeCurrRing(oldRing);
4111    M1 =  idrMoveR(M, newRing);
4112    Gomega2 =  idrMoveR(Gomega1, newRing);
4113
4114    //if(endwalks==1)  PrintS("\n// Lifting is working:..");
4115
4116    to=clock();
4117    /* compute a representation of the generators of submod (M)
4118       with respect to those of mod (Gomega).
4119       Gomega is a reduced Groebner basis w.r.t. the current ring */
4120    F = MLifttwoIdeal(Gomega2, M1, G);
4121    if(endwalks != 1)
4122      tlift = tlift+clock()-to;
4123    else
4124      xtlift=clock()-to;
4125
4126    idDelete(&M1);
4127    idDelete(&Gomega2);
4128    idDelete(&G);
4129
4130    /* change the ring to newRing */
4131    rChangeCurrRing(newRing);
4132    F1 = idrMoveR(F, oldRing);
4133
4134    //if(endwalks==1)PrintS("\n// InterRed is working now:");
4135
4136    to=clock();
4137    /* reduce the Groebner basis <G> w.r.t. new ring */
4138    G = kInterRedCC(F1, NULL);
4139    if(endwalks != 1)
4140      tred = tred+clock()-to;
4141    else
4142      xtred=clock()-to;
4143
4144    idDelete(&F1);
4145
4146    if(endwalks == 1)
4147      break;
4148
4149    to=clock();
4150    /* compute a next weight vector */
4151    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
4152    tnw=tnw+clock()-to;
4153#ifdef PRINT_VECTORS
4154    MivString(curr_weight, target_weight, next_weight);
4155#endif
4156
4157    if(Overflow_Error == TRUE)
4158    {
4159      ntwC = 0;
4160      ntestomega = 1;
4161      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
4162      //idElements(G, "G");
4163      delete next_weight;
4164      goto FINISH_160302;
4165    }
4166    if(MivComp(next_weight, ivNull) == 1){
4167      newRing = currRing;
4168      delete next_weight;//16.03.02
4169      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
4170      break;
4171    }
4172    if(MivComp(next_weight, target_weight) == 1)
4173      endwalks = 1;
4174
4175    for(i=nV-1; i>=0; i--)
4176      (*curr_weight)[i] = (*next_weight)[i];
4177
4178    delete next_weight;
4179  }//while
4180
4181  if(tp_deg != 1)
4182  {
4183  FINISH_160302://16.03.02
4184    if(MivSame(orig_target, exivlp) == 1)
4185      if (currRing->parameter != NULL)
4186        DefRingParlp();
4187      else
4188        VMrDefaultlp();
4189    else
4190      if (currRing->parameter != NULL)
4191        DefRingPar(orig_target);
4192      else
4193        VMrDefault(orig_target);
4194
4195    TargetRing=currRing;
4196    F1 = idrMoveR(G, newRing);
4197#ifdef CHECK_IDEAL
4198      headidString(G, "G");
4199#endif
4200
4201
4202    // check whether the pertubed target vector stays in the correct cone
4203    if(ntwC != 0){
4204      ntestw = test_w_in_ConeCC(F1, pert_target_vector);
4205    }
4206
4207    if( ntestw != 1 || ntwC == 0)
4208    {
4209      /*
4210      if(ntestw != 1){
4211        ivString(pert_target_vector, "tau");
4212        PrintS("\n// ** perturbed target vector doesn't stay in cone!!");
4213        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
4214        idElements(F1, "G");
4215      }
4216      */
4217      /* LastGB is "better" than the kStd subroutine */
4218      to=clock();
4219      ideal eF1;
4220      if(nP == 0 || tp_deg == 1 || MivSame(orig_target, exivlp) != 1){
4221        // PrintS("\n// ** calls \"std\" to compute a GB");
4222        eF1 = MstdCC(F1);
4223        idDelete(&F1);
4224      }
4225      else {
4226        // PrintS("\n// ** calls \"LastGB\" to compute a GB");
4227        rChangeCurrRing(newRing);
4228        ideal F2 = idrMoveR(F1, TargetRing);
4229        eF1 = LastGB(F2, curr_weight, tp_deg-1);
4230        F2=NULL;
4231      }
4232      xtextra=clock()-to;
4233      ring exTargetRing = currRing;
4234
4235      rChangeCurrRing(XXRing);
4236      Eresult = idrMoveR(eF1, exTargetRing);
4237    }
4238    else{
4239      rChangeCurrRing(XXRing);
4240      Eresult = idrMoveR(F1, TargetRing);
4241    }
4242  }
4243  else {
4244    rChangeCurrRing(XXRing);
4245    Eresult = idrMoveR(G, newRing);
4246  }
4247  delete ivNull;
4248  if(tp_deg != 1)
4249    delete target_weight;
4250
4251  if(op_deg != 1 )
4252    delete curr_weight;
4253
4254  delete exivlp;
4255  delete last_omega;
4256
4257#ifdef TIME_TEST
4258  TimeStringFractal(tinput, tostd, tif+xtif, tstd+xtstd,0, tlift+xtlift, tred+xtred,
4259             tnw+xtnw);
4260
4261  Print("\n// pSetm_Error = (%d)", ErrorCheck());
4262  Print("\n// It took %d steps and Overflow_Error? (%d)\n", nstep,  Overflow_Error);
4263#endif
4264  return(Eresult);
4265}
4266
4267intvec* XivNull;
4268
4269/* define a matrix (1 ... 1) */
4270intvec* MMatrixone(int nV)
4271{
4272  int i,j;
4273  intvec* ivM = new intvec(nV*nV);
4274
4275  for(i=0; i<nV; i++)
4276    for(j=0; j<nV; j++)
4277    (*ivM)[i*nV + j] = 1;
4278
4279  return(ivM);
4280}
4281
4282int nnflow;
4283int Xcall;
4284int Xngleich;
4285
4286/* 27.07.03 */
4287/* Perturb the start weight vector at the top level, i.e. nlev = 1 */
4288static ideal rec_fractal_call(ideal G, int nlev, intvec* omtmp)
4289{
4290  Overflow_Error =  FALSE;
4291  //Print("\n\n// Entering the %d-th recursion:", nlev);
4292
4293  int i, nV = currRing->N;
4294  ring new_ring, testring, extoRing;
4295  ideal Gomega, Gomega1, Gomega2, F, F1, Gresult, Gresult1, G1, Gt;
4296  int nwalks = 0;
4297  intvec* Mwlp;
4298  intvec* hilb_func;
4299  intvec* extXtau;
4300  intvec* next_vect;
4301  intvec* omega2 = new intvec(nV);
4302  intvec* altomega = new intvec(nV);
4303
4304  BOOLEAN isnewtarget = FALSE;
4305
4306  /* to avoid (1,0,...,0) as the target vector (Hans) */
4307  intvec* last_omega = new intvec(nV);
4308  for(i=nV-1; i>0; i--)
4309    (*last_omega)[i] = 1;
4310  (*last_omega)[0] = 10000;
4311
4312  intvec* omega = new intvec(nV);
4313  for(i=0; i<nV; i++) {
4314    if(Xsigma->length() == nV)
4315      (*omega)[i] =  (*Xsigma)[i];
4316    else
4317      (*omega)[i] = (*Xsigma)[(nV*(nlev-1))+i];
4318
4319    (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
4320  }
4321
4322   if(nlev == 1)  Xcall = 1;
4323   else Xcall = 0;
4324
4325  ring oRing = currRing;
4326
4327  while(1)
4328  {
4329#ifdef FIRST_STEP_FRACTAL
4330    // perturb the current weight vector only on the top level or
4331    // after perturbation of the both vectors, nlev = 2 as the top level
4332    if((nlev == 1 && Xcall == 0) || (nlev == 2 && Xngleich == 1))
4333      if(islengthpoly2(G) == 1)
4334      {
4335        Mwlp = MivWeightOrderlp(omega);
4336        Xsigma = Mfpertvector(G, Mwlp);
4337        delete Mwlp;
4338        Overflow_Error = FALSE;
4339      }
4340#endif
4341    nwalks ++;
4342    NEXT_VECTOR_FRACTAL:
4343    to=clock();
4344    /* determine the next border */
4345    next_vect = MkInterRedNextWeight(omega,omega2,G);
4346    xtnw=xtnw+clock()-to;
4347#ifdef PRINT_VECTORS
4348    MivString(omega, omega2, next_vect);
4349#endif
4350    oRing = currRing;
4351
4352    /* We only perturb the current target vector at the recursion  level 1 */
4353    if(Xngleich == 0 && nlev == 1) //(ngleich == 0) important, e.g. ex2, ex3
4354      if (MivComp(next_vect, omega2) == 1)
4355      {
4356        /* to dispense with taking initial (and lifting/interreducing
4357           after the call of recursion */
4358        //Print("\n\n// ** Perturb the both vectors with degree %d with",nlev);
4359        //idElements(G, "G");
4360
4361        Xngleich = 1;
4362        nlev +=1;
4363
4364        if (currRing->parameter != NULL)
4365          DefRingPar(omtmp);
4366        else
4367          VMrDefault(omtmp);
4368
4369        testring = currRing;
4370        Gt = idrMoveR(G, oRing);
4371
4372        /* perturb the original target vector w.r.t. the current GB */
4373        delete Xtau;
4374        Xtau = NewVectorlp(Gt);
4375
4376        rChangeCurrRing(oRing);
4377        G = idrMoveR(Gt, testring);
4378
4379        /* perturb the current vector w.r.t. the current GB */
4380        Mwlp = MivWeightOrderlp(omega);
4381        Xsigma = Mfpertvector(G, Mwlp);
4382        delete Mwlp;
4383
4384        for(i=nV-1; i>=0; i--) {
4385          (*omega2)[i] = (*Xtau)[nV+i];
4386          (*omega)[i] = (*Xsigma)[nV+i];
4387        }
4388
4389        delete next_vect;
4390        to=clock();
4391
4392        /* to avoid the value of Overflow_Error that occur in Mfpertvector*/
4393        Overflow_Error = FALSE;
4394
4395        next_vect = MkInterRedNextWeight(omega,omega2,G);
4396        xtnw=xtnw+clock()-to;
4397
4398#ifdef PRINT_VECTORS
4399        MivString(omega, omega2, next_vect);
4400#endif
4401      }
4402
4403
4404    /* check whether the the computed vector is in the correct cone */
4405    /* If no, the reduced GB of an omega-homogeneous ideal will be
4406       computed by Buchberger algorithm and stop this recursion step*/
4407    //if(test_w_in_ConeCC(G, next_vect) != 1) //e.g. Example s7, cyc6
4408    if(Overflow_Error == TRUE)
4409    {
4410      delete next_vect;
4411
4412    OVERFLOW_IN_NEXT_VECTOR:
4413      if (currRing->parameter != NULL)
4414        DefRingPar(omtmp);
4415      else
4416        VMrDefault(omtmp);
4417
4418#ifdef TEST_OVERFLOW
4419      Gt = idrMoveR(G, oRing);
4420      Gt = NULL; return(Gt);
4421#endif
4422
4423      //Print("\n\n// apply BB's alg. in ring r = %s;", rString(currRing));
4424      to=clock();
4425      Gt = idrMoveR(G, oRing);
4426      G1 = MstdCC(Gt);
4427      xtextra=xtextra+clock()-to;
4428      Gt = NULL;
4429
4430      delete omega2;
4431      delete altomega;
4432
4433      //Print("\n// Leaving the %d-th recursion with %d steps", nlev, nwalks);
4434      //Print("  ** Overflow_Error? (%d)", Overflow_Error);
4435      nnflow ++;
4436
4437      Overflow_Error = FALSE;
4438      return (G1);
4439    }
4440
4441
4442    /* If the perturbed target vector stays in the correct cone,
4443       return the current GB,
4444       otherwise, return the computed  GB by the Buchberger-algorithm.
4445       Then we update the perturbed target vectors w.r.t. this GB. */
4446
4447    /* the computed vector is equal to the origin vector, since
4448       t is not defined */
4449    if (MivComp(next_vect, XivNull) == 1)
4450    {
4451      if (currRing->parameter != NULL)
4452        DefRingPar(omtmp);
4453      else
4454        VMrDefault(omtmp);
4455
4456      testring = currRing;
4457      Gt = idrMoveR(G, oRing);
4458
4459      if(test_w_in_ConeCC(Gt, omega2) == 1) {
4460        delete omega2;
4461        delete next_vect;
4462        delete altomega;
4463        //Print("\n// Leaving the %d-th recursion with %d steps ",nlev, nwalks);
4464        //Print(" ** Overflow_Error? (%d)", Overflow_Error);
4465
4466        return (Gt);
4467      }
4468      else
4469      {
4470        //ivString(omega2, "tau'");
4471        //Print("\n//  tau' doesn't stay in the correct cone!!");
4472
4473#ifndef  MSTDCC_FRACTAL
4474        //07.08.03
4475        //ivString(Xtau, "old Xtau");
4476        intvec* Xtautmp = Mfpertvector(Gt, MivMatrixOrder(omtmp));
4477#ifdef TEST_OVERFLOW
4478      if(Overflow_Error == TRUE)
4479      Gt = NULL; return(Gt);
4480#endif
4481
4482        if(MivSame(Xtau, Xtautmp) == 1)
4483        {
4484          //PrintS("\n// Update vectors are equal to the old vectors!!");
4485          delete Xtautmp;
4486          goto FRACTAL_MSTDCC;
4487        }
4488
4489        Xtau = Xtautmp;
4490        Xtautmp = NULL;
4491        //ivString(Xtau, "new  Xtau");
4492
4493        for(i=nV-1; i>=0; i--)
4494          (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
4495
4496        //Print("\n//  ring tau = %s;", rString(currRing));
4497        rChangeCurrRing(oRing);
4498        G = idrMoveR(Gt, testring);
4499
4500        goto NEXT_VECTOR_FRACTAL;
4501#endif
4502
4503      FRACTAL_MSTDCC:
4504        //Print("\n//  apply BB-Alg in ring = %s;", rString(currRing));
4505        to=clock();
4506        G = MstdCC(Gt);
4507        xtextra=xtextra+clock()-to;
4508
4509        oRing = currRing;
4510
4511        // update the original target vector w.r.t. the current GB
4512        if(MivSame(Xivinput, Xivlp) == 1)
4513          if (currRing->parameter != NULL)
4514            DefRingParlp();
4515          else
4516            VMrDefaultlp();
4517        else
4518          if (currRing->parameter != NULL)
4519            DefRingPar(Xivinput);
4520          else
4521            VMrDefault(Xivinput);
4522
4523        testring = currRing;
4524        Gt = idrMoveR(G, oRing);
4525
4526        delete Xtau;
4527        Xtau = NewVectorlp(Gt);
4528
4529        rChangeCurrRing(oRing);
4530        G = idrMoveR(Gt, testring);
4531
4532        delete omega2;
4533        delete next_vect;
4534        delete altomega;
4535        /*
4536          Print("\n// Leaving the %d-th recursion with %d steps,", nlev,nwalks);
4537          Print(" ** Overflow_Error? (%d)", Overflow_Error);
4538        */
4539        if(Overflow_Error == TRUE)
4540          nnflow ++;
4541
4542        Overflow_Error = FALSE;
4543        return(G);
4544      }
4545    }
4546
4547    for(i=nV-1; i>=0; i--) {
4548      (*altomega)[i] = (*omega)[i];
4549      (*omega)[i] = (*next_vect)[i];
4550    }
4551    delete next_vect;
4552
4553    to=clock();
4554    /* Take the initial form of <G> w.r.t. omega */
4555    Gomega = MwalkInitialForm(G, omega);
4556    xtif=xtif+clock()-to;
4557
4558#ifndef  BUCHBERGER_ALG
4559    if(isNolVector(omega) == 0)
4560      hilb_func = hFirstSeries(Gomega,NULL,NULL,omega,currRing);
4561    else
4562      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
4563#endif // BUCHBERGER_ALG
4564
4565    if (currRing->parameter != NULL)
4566      DefRingPar(omega);
4567    else
4568      VMrDefault(omega);
4569
4570    Gomega1 = idrMoveR(Gomega, oRing);
4571
4572    /* Maximal recursion depth, to compute a red. GB */
4573    /* Fractal walk with the alternative recursion */
4574    /* alternative recursion */
4575    // if(nlev == nV || lengthpoly(Gomega1) == 0)
4576    if(nlev == Xnlev || lengthpoly(Gomega1) == 0)
4577      //if(nlev == nV) // blind recursion
4578    {
4579      /*
4580      if(Xnlev != nV)
4581      {
4582        Print("\n// ** Xnlev = %d", Xnlev);
4583        ivString(Xtau, "Xtau");
4584      }
4585      */
4586      to=clock();
4587#ifdef  BUCHBERGER_ALG
4588      Gresult = MstdhomCC(Gomega1);
4589#else
4590      Gresult =kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,omega);
4591      delete hilb_func;
4592#endif // BUCHBERGER_ALG
4593      xtstd=xtstd+clock()-to;
4594    }
4595    else {
4596      rChangeCurrRing(oRing);
4597      Gomega1 = idrMoveR(Gomega1, oRing);
4598      Gresult = rec_fractal_call(idCopy(Gomega1),nlev+1,omega);
4599    }
4600
4601    //convert a Groebner basis from a ring to another ring,
4602    new_ring = currRing;
4603
4604    rChangeCurrRing(oRing);
4605    Gresult1 = idrMoveR(Gresult, new_ring);
4606    Gomega2 = idrMoveR(Gomega1, new_ring);
4607
4608    to=clock();
4609    /* Lifting process */
4610    F = MLifttwoIdeal(Gomega2, Gresult1, G);
4611    xtlift=xtlift+clock()-to;
4612    idDelete(&Gresult1);
4613    idDelete(&Gomega2);
4614    idDelete(&G);
4615
4616    rChangeCurrRing(new_ring);
4617    F1 = idrMoveR(F, oRing);
4618
4619    to=clock();
4620    /* Interreduce G */
4621    G = kInterRedCC(F1, NULL);
4622    xtred=xtred+clock()-to;
4623    idDelete(&F1);
4624  }
4625}
4626
4627ideal Mfwalk(ideal G, intvec* ivstart, intvec* ivtarget)
4628{
4629  Set_Error(FALSE);
4630  Overflow_Error = FALSE;
4631  //Print("// pSetm_Error = (%d)", ErrorCheck());
4632  //Print("\n// ring ro = %s;", rString(currRing));
4633
4634  nnflow = 0;
4635  Xngleich = 0;
4636  Xcall = 0;
4637  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
4638  xftinput = clock();
4639
4640  ring  oldRing = currRing;
4641  int i, nV = currRing->N;
4642  XivNull = new intvec(nV);
4643  Xivinput = ivtarget;
4644  ngleich = 0;
4645  to=clock();
4646  ideal I = MstdCC(G);
4647  G = NULL;
4648  xftostd=clock()-to;
4649  Xsigma = ivstart;
4650
4651  Xnlev=nV;
4652
4653#ifdef FIRST_STEP_FRACTAL
4654  ideal Gw = MwalkInitialForm(I, ivstart);
4655  for(i=IDELEMS(Gw)-1; i>=0; i--)
4656  {
4657    if((Gw->m[i]!=NULL) /* len >=0 */
4658    && (Gw->m[i]->next!=NULL) /* len >=1 */
4659    && (Gw->m[i]->next->next!=NULL)) /* len >=2 */
4660    {
4661      intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
4662      intvec* Mdp;
4663
4664      if(MivSame(ivstart, iv_dp) != 1)
4665        Mdp = MivWeightOrderdp(ivstart);
4666      else
4667        Mdp = MivMatrixOrderdp(nV);
4668
4669      Xsigma = Mfpertvector(I, Mdp);
4670      Overflow_Error = FALSE;
4671
4672      delete Mdp;
4673      delete iv_dp;
4674      break;
4675    }
4676  }
4677  idDelete(&Gw);
4678#endif
4679
4680  ideal I1;
4681  intvec* Mlp;
4682  Xivlp = Mivlp(nV);
4683
4684  if(MivComp(ivtarget, Xivlp)  != 1)
4685  {
4686    if (currRing->parameter != NULL)
4687      DefRingPar(ivtarget);
4688    else
4689      VMrDefault(ivtarget);
4690
4691    I1 = idrMoveR(I, oldRing);
4692    Mlp = MivWeightOrderlp(ivtarget);
4693    Xtau = Mfpertvector(I1, Mlp);
4694  }
4695  else
4696  {
4697    if (currRing->parameter != NULL)
4698      DefRingParlp();
4699    else
4700      VMrDefaultlp();
4701
4702    I1 = idrMoveR(I, oldRing);
4703    Mlp =  MivMatrixOrderlp(nV);
4704    Xtau = Mfpertvector(I1, Mlp);
4705  }
4706  delete Mlp;
4707  Overflow_Error = FALSE;
4708
4709  //ivString(Xsigma, "Xsigma");
4710  //ivString(Xtau, "Xtau");
4711
4712  id_Delete(&I, oldRing);
4713  ring tRing = currRing;
4714
4715  if (currRing->parameter != NULL)
4716    DefRingPar(ivstart);
4717  else
4718    VMrDefault(ivstart);
4719
4720  I = idrMoveR(I1,tRing);
4721  to=clock();
4722  ideal J = MstdCC(I);
4723  idDelete(&I);
4724  xftostd=xftostd+clock()-to;
4725
4726  ideal resF;
4727  ring helpRing = currRing;
4728
4729  J = rec_fractal_call(J, 1, ivtarget);
4730
4731  rChangeCurrRing(oldRing);
4732  resF = idrMoveR(J, helpRing);
4733  idSkipZeroes(resF);
4734
4735  delete Xivlp;
4736  delete Xsigma;
4737  delete Xtau;
4738  delete XivNull;
4739
4740#ifdef TIME_TEST
4741  TimeStringFractal(xftinput, xftostd, xtif, xtstd, xtextra,
4742                    xtlift, xtred, xtnw);
4743
4744
4745  Print("\n// pSetm_Error = (%d)", ErrorCheck());
4746  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
4747  Print("\n// the numbers of Overflow_Error (%d)", nnflow);
4748#endif
4749
4750  return(resF);
4751}
4752
4753/* Tran algorithm */
4754/* use kStd, if nP = 0, else call Ab_Rec_Pert (LastGB) */
4755ideal TranMImprovwalk(ideal G,intvec* curr_weight,intvec* target_tmp, int nP)
4756{
4757  clock_t mtim = clock();
4758  Set_Error(FALSE  );
4759  Overflow_Error =  FALSE;
4760  //Print("// pSetm_Error = (%d)", ErrorCheck());
4761  //Print("\n// ring ro = %s;", rString(currRing));
4762
4763  clock_t tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0, textra=0;
4764  clock_t tinput = clock();
4765
4766  int nsteppert=0, i, nV = currRing->N, nwalk=0, npert_tmp=0;
4767  int *npert=(int*)omAlloc(2*nV*sizeof(int));
4768  ideal Gomega, M,F,  G1, Gomega1, Gomega2, M1, F1;
4769  ring endRing, newRing, oldRing, lpRing;
4770  intvec* next_weight;
4771  intvec* ivNull = new intvec(nV); //define (0,...,0)
4772  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
4773  intvec* iv_lp = Mivlp(nV); //define (1,0,...,0)
4774  ideal H0, H1, H2, Glp;
4775  int nGB, endwalks = 0,  nwalkpert=0,  npertstep=0;
4776  intvec* Mlp =  MivMatrixOrderlp(nV);
4777  intvec* vector_tmp = new intvec(nV);
4778  intvec* hilb_func;
4779
4780  /* to avoid (1,0,...,0) as the target vector */
4781  intvec* last_omega = new intvec(nV);
4782  for(i=nV-1; i>0; i--)
4783    (*last_omega)[i] = 1;
4784  (*last_omega)[0] = 10000;
4785
4786  //  intvec* extra_curr_weight = new intvec(nV);
4787  intvec* target_weight = new intvec(nV);
4788  for(i=nV-1; i>=0; i--)
4789    (*target_weight)[i] = (*target_tmp)[i];
4790
4791  ring XXRing = currRing;
4792  newRing = currRing;
4793
4794  to=clock();
4795  /* compute a red. GB w.r.t. the help ring */
4796  if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) = "dp"
4797    G = MstdCC(G);
4798  else
4799  {
4800    //rOrdStr(currRing) = (a(.c_w..),lp,C)
4801    if (currRing->parameter != NULL)
4802      DefRingPar(curr_weight);
4803    else
4804      VMrDefault(curr_weight);
4805    G = idrMoveR(G, XXRing);
4806    G = MstdCC(G);
4807  }
4808  tostd=clock()-to;
4809
4810#ifdef REPRESENTATION_OF_SIGMA
4811  ideal Gw = MwalkInitialForm(G, curr_weight);
4812
4813  if(islengthpoly2(Gw)==1)
4814  {
4815    intvec* MDp;
4816    if(MivComp(curr_weight, iv_dp) == 1)
4817      MDp = MatrixOrderdp(nV); //MivWeightOrderlp(iv_dp);
4818    else
4819      MDp = MivWeightOrderlp(curr_weight);
4820
4821    curr_weight = RepresentationMatrix_Dp(G, MDp);
4822
4823    delete MDp;
4824
4825    ring exring = currRing;
4826
4827    if (currRing->parameter != NULL)
4828      DefRingPar(curr_weight);
4829    else
4830      VMrDefault(curr_weight);
4831    to=clock();
4832    Gw = idrMoveR(G, exring);
4833    G = MstdCC(Gw);
4834    Gw = NULL;
4835    tostd=tostd+clock()-to;
4836    //ivString(curr_weight,"rep. sigma");
4837    goto COMPUTE_NEW_VECTOR;
4838  }
4839
4840  idDelete(&Gw);
4841  delete iv_dp;
4842#endif
4843
4844
4845  while(1)
4846  {
4847    to=clock();
4848    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
4849    Gomega = MwalkInitialForm(G, curr_weight);
4850    tif=tif+clock()-to;
4851
4852#ifndef  BUCHBERGER_ALG
4853    if(isNolVector(curr_weight) == 0)
4854      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
4855    else
4856      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
4857#endif // BUCHBERGER_ALG
4858
4859    oldRing = currRing;
4860
4861    /* define a new ring that its ordering is "(a(curr_weight),lp) */
4862    if (currRing->parameter != NULL)
4863      DefRingPar(curr_weight);
4864    else
4865      VMrDefault(curr_weight);
4866
4867    newRing = currRing;
4868    Gomega1 = idrMoveR(Gomega, oldRing);
4869
4870    to=clock();
4871    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
4872#ifdef  BUCHBERGER_ALG
4873    M = MstdhomCC(Gomega1);
4874#else
4875    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
4876    delete hilb_func;
4877#endif // BUCHBERGER_ALG
4878    tstd=tstd+clock()-to;
4879
4880    /* change the ring to oldRing */
4881    rChangeCurrRing(oldRing);
4882    M1 =  idrMoveR(M, newRing);
4883    Gomega2 =  idrMoveR(Gomega1, newRing);
4884
4885    to=clock();
4886    /* compute a representation of the generators of submod (M)
4887       with respect to those of mod (Gomega).
4888       Gomega is a reduced Groebner basis w.r.t. the current ring */
4889    F = MLifttwoIdeal(Gomega2, M1, G);
4890    tlift=tlift+clock()-to;
4891
4892    idDelete(&M1);
4893    idDelete(&Gomega2);
4894    idDelete(&G);
4895
4896    /* change the ring to newRing */
4897    rChangeCurrRing(newRing);
4898    F1 = idrMoveR(F, oldRing);
4899
4900    to=clock();
4901    /* reduce the Groebner basis <G> w.r.t. new ring */
4902    G = kInterRedCC(F1, NULL);
4903    tred=tred+clock()-to;
4904    idDelete(&F1);
4905
4906
4907  COMPUTE_NEW_VECTOR:
4908    newRing = currRing;
4909    nwalk++;
4910    nwalkpert++;
4911    to=clock();
4912    /* compute a next weight vector */
4913    next_weight = MwalkNextWeightCC(curr_weight,target_weight, G);
4914    tnw=tnw+clock()-to;
4915#ifdef PRINT_VECTORS
4916    MivString(curr_weight, target_weight, next_weight);
4917#endif
4918
4919
4920    /* check whether the computed intermediate weight vector in
4921       the correct cone is, since sometimes it is very big e.g. s7, cyc7.
4922       If it is NOT in the cone, then one has directly to compute
4923       a reduced Groebner basis with respect to the lexicographic ordering
4924       for the known Groebner basis that it is computed in the last step.
4925    */
4926    //if(test_w_in_ConeCC(G, next_weight) != 1)
4927    if(Overflow_Error == TRUE)
4928    {
4929    OMEGA_OVERFLOW_TRAN_NEW:
4930      //Print("\n//  takes %d steps!", nwalk-1);
4931      //Print("\n//ring lastRing = %s;", rString(currRing));
4932#ifdef TEST_OVERFLOW
4933      goto  BE_FINISH;
4934#endif
4935
4936#ifdef CHECK_IDEAL_MWALK
4937      idElements(G, "G");
4938      //headidString(G, "G");
4939#endif
4940
4941      if(MivSame(target_tmp, iv_lp) == 1)
4942        if (currRing->parameter != NULL)
4943          DefRingParlp();
4944        else
4945          VMrDefaultlp();
4946      else
4947        if (currRing->parameter != NULL)
4948          DefRingPar(target_tmp);
4949        else
4950          VMrDefault(target_tmp);
4951
4952      lpRing = currRing;
4953      G1 = idrMoveR(G, newRing);
4954
4955      to=clock();
4956      /*apply kStd or LastGB to compute  a lex. red. Groebner basis of <G>*/
4957      if(nP == 0 || MivSame(target_tmp, iv_lp) == 0){
4958        //Print("\n\n// calls \"std in ring r_%d = %s;", nwalk, rString(currRing));
4959        G = MstdCC(G1);//no result for qnt1
4960      }
4961      else {
4962        rChangeCurrRing(newRing);
4963        G1 = idrMoveR(G1, lpRing);
4964
4965        //Print("\n\n// calls \"LastGB\" (%d) to compute a GB", nV-1);
4966        G = LastGB(G1, curr_weight, nV-1); //no result for kats7
4967
4968        rChangeCurrRing(lpRing);
4969        G = idrMoveR(G, newRing);
4970      }
4971      textra=clock()-to;
4972      npert[endwalks]=nwalk-npert_tmp;
4973      npert_tmp = nwalk;
4974      endwalks ++;
4975      break;
4976    }
4977
4978    /* check whether the computed Groebner basis a really Groebner basis is.
4979       if no, we perturb the target vector with the maximal "perturbation"
4980       degree.*/
4981    if(MivComp(next_weight, target_weight) == 1 ||
4982       MivComp(next_weight, curr_weight) == 1 )
4983    {
4984      //Print("\n//ring r_%d = %s;", nwalk, rString(currRing));
4985
4986
4987      //compute the number of perturbations and its step
4988      npert[endwalks]=nwalk-npert_tmp;
4989      npert_tmp = nwalk;
4990
4991      endwalks ++;
4992
4993      /*it is very important if the walk only uses one step, e.g. Fate, liu*/
4994      if(endwalks == 1 && MivComp(next_weight, curr_weight) == 1){
4995        rChangeCurrRing(XXRing);
4996        G = idrMoveR(G, newRing);
4997        goto FINISH;
4998      }
4999      H0 = idHead(G);
5000
5001      if(MivSame(target_tmp, iv_lp) == 1)
5002        if (currRing->parameter != NULL)
5003          DefRingParlp();
5004        else
5005          VMrDefaultlp();
5006      else
5007        if (currRing->parameter != NULL)
5008          DefRingPar(target_tmp);
5009        else
5010          VMrDefault(target_tmp);
5011
5012      lpRing = currRing;
5013      Glp = idrMoveR(G, newRing);
5014      H2 = idrMoveR(H0, newRing);
5015
5016      /* Apply Lemma 2.2 in Collart et. al (1997) to check whether
5017         cone(k-1) is equal to cone(k) */
5018      nGB = 1;
5019      for(i=IDELEMS(Glp)-1; i>=0; i--)
5020      {
5021        poly t;
5022        if((t=pSub(pHead(Glp->m[i]), pCopy(H2->m[i]))) != NULL)
5023        {
5024          pDelete(&t);
5025          idDelete(&H2);//5.5.02
5026          nGB = 0; //i.e. Glp is no reduced Groebner basis
5027          break;
5028        }
5029        pDelete(&t);
5030      }
5031
5032      idDelete(&H2);//5.5.02
5033
5034      if(nGB == 1)
5035      {
5036        G = Glp;
5037        Glp = NULL;
5038        break;
5039      }
5040
5041       /* perturb the target weight vector, if the vector target_tmp
5042          stays in many cones */
5043      poly p;
5044      BOOLEAN plength3 = FALSE;
5045      for(i=IDELEMS(Glp)-1; i>=0; i--)
5046      {
5047        p = MpolyInitialForm(Glp->m[i], target_tmp);
5048        if(p->next != NULL &&
5049           p->next->next != NULL &&
5050           p->next->next->next != NULL)
5051        {
5052          Overflow_Error = FALSE;
5053
5054          for(i=0; i<nV; i++)
5055            (*vector_tmp)[i] = (*target_weight)[i];
5056
5057          delete target_weight;
5058          target_weight = MPertVectors(Glp, Mlp, nV);
5059
5060          if(MivComp(vector_tmp, target_weight)==1)
5061          {
5062            //PrintS("\n// The old and new representaion vector are the same!!");
5063            G = Glp;
5064            newRing = currRing;
5065            goto OMEGA_OVERFLOW_TRAN_NEW;
5066           }
5067
5068          if(Overflow_Error == TRUE)
5069          {
5070            rChangeCurrRing(newRing);
5071            G = idrMoveR(Glp, lpRing);
5072            goto OMEGA_OVERFLOW_TRAN_NEW;
5073          }
5074
5075          plength3 = TRUE;
5076          pDelete(&p);
5077          break;
5078        }
5079        pDelete(&p);
5080      }
5081
5082      if(plength3 == FALSE)
5083      {
5084        rChangeCurrRing(newRing);
5085        G = idrMoveR(Glp, lpRing);
5086        goto TRAN_LIFTING;
5087      }
5088
5089
5090      npertstep = nwalk;
5091      nwalkpert = 1;
5092      nsteppert ++;
5093
5094      /*
5095      Print("\n// Subroutine needs (%d) steps.", nwalk);
5096      idElements(Glp, "last G in walk:");
5097      PrintS("\n//****************************************");
5098      Print("\n// Perturb the original target vector (%d): ", nsteppert);
5099      ivString(target_weight, "new target");
5100      PrintS("\n//****************************************\n");
5101      */
5102      rChangeCurrRing(newRing);
5103      G = idrMoveR(Glp, lpRing);
5104
5105      delete next_weight;
5106
5107      //Print("\n// ring rNEW = %s;", rString(currRing));
5108      goto COMPUTE_NEW_VECTOR;
5109    }
5110
5111  TRAN_LIFTING:
5112    for(i=nV-1; i>=0; i--)
5113      (*curr_weight)[i] = (*next_weight)[i];
5114
5115    delete next_weight;
5116  }//while
5117
5118 BE_FINISH:
5119  rChangeCurrRing(XXRing);
5120  G = idrMoveR(G, lpRing);
5121
5122 FINISH:
5123  delete ivNull;
5124  delete next_weight;
5125  delete iv_lp;
5126  omFree(npert);
5127
5128#ifdef TIME_TEST
5129  Print("\n// Computation took %d steps and %.2f sec",
5130        nwalk, ((double) (clock()-mtim)/1000000));
5131
5132  TimeStringFractal(tinput, tostd, tif, tstd, textra, tlift, tred, tnw);
5133
5134  Print("\n// pSetm_Error = (%d)", ErrorCheck());
5135  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
5136#endif
5137
5138  return(G);
5139}
5140
5141
5142/* compute the reduced Gröbner basis of an ideal <Go> w.r.t. lp */
5143static ideal Mpwalk_MAltwalk1(ideal Go, intvec* curr_weight, int tp_deg)
5144{
5145  Overflow_Error = FALSE;
5146  BOOLEAN nOverflow_Error = FALSE;
5147  clock_t tproc=0;
5148  clock_t tinput=clock();
5149  int i, nV = currRing->N;
5150  int nwalk=0, endwalks=0, ntestwinC=1;
5151  int tp_deg_tmp = tp_deg;
5152  ideal Gomega, M, F, G, M1, F1, Gomega1, Gomega2, G1;
5153  ring endRing, newRing, oldRing, TargetRing;
5154  intvec* next_weight;
5155  intvec* ivNull = new intvec(nV);
5156  intvec* extra_curr_weight = new intvec(nV);
5157
5158  ring YXXRing = currRing;
5159
5160  intvec* iv_M_dpp = MivMatrixOrderlp(nV);
5161  intvec* target_weight;// = Mivlp(nV);
5162  ideal ssG;
5163
5164  /* perturb the target vector */
5165  while(1)
5166  {
5167    if(Overflow_Error == FALSE)
5168    {
5169      if (currRing->parameter != NULL)
5170        DefRingParlp();
5171      else
5172        VMrDefaultlp();
5173
5174      TargetRing = currRing;
5175      ssG = idrMoveR(Go,YXXRing);
5176    }
5177    Overflow_Error = FALSE;
5178    if(tp_deg != 1)
5179      target_weight = MPertVectors(ssG, iv_M_dpp, tp_deg);
5180    else
5181    {
5182      target_weight = Mivlp(nV);
5183      break;
5184    }
5185    if(Overflow_Error == FALSE)
5186      break;
5187
5188    Overflow_Error = TRUE;
5189    tp_deg --;
5190  }
5191  if(tp_deg != tp_deg_tmp)
5192  {
5193    Overflow_Error = TRUE;
5194    nOverflow_Error = TRUE;
5195  }
5196
5197  //  Print("\n// tp_deg = %d", tp_deg);
5198  // ivString(target_weight, "pert target");
5199
5200  delete iv_M_dpp;
5201  intvec* hilb_func;
5202
5203  /* to avoid (1,0,...,0) as the target vector */
5204  intvec* last_omega = new intvec(nV);
5205  for(i=nV-1; i>0; i--)
5206    (*last_omega)[i] = 1;
5207  (*last_omega)[0] = 10000;
5208
5209  rChangeCurrRing(YXXRing);
5210  G = idrMoveR(ssG, TargetRing);
5211
5212  while(1)
5213  {
5214    nwalk ++;
5215    nstep ++;
5216
5217    if(nwalk==1)
5218      goto FIRST_STEP;
5219
5220    to=clock();
5221    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
5222    Gomega = MwalkInitialForm(G, curr_weight);
5223    xtif=xtif+clock()-to;
5224#if 0
5225    if(Overflow_Error == TRUE)
5226    {
5227      for(i=nV-1; i>=0; i--)
5228        (*curr_weight)[i] = (*extra_curr_weight)[i];
5229      delete extra_curr_weight;
5230      goto LASTGB_ALT1;
5231    }
5232#endif
5233#ifndef  BUCHBERGER_ALG
5234    if(isNolVector(curr_weight) == 0)
5235      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
5236    else
5237      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
5238#endif // BUCHBERGER_ALG
5239
5240    oldRing = currRing;
5241
5242    /* define a new ring that its ordering is "(a(curr_weight),lp) */
5243    if (currRing->parameter != NULL)
5244      DefRingPar(curr_weight);
5245    else
5246      VMrDefault(curr_weight);
5247
5248    newRing = currRing;
5249    Gomega1 = idrMoveR(Gomega, oldRing);
5250
5251#ifdef ENDWALKS
5252    if(endwalks == 1)
5253    {
5254      Print("\n//  it is  %d-th step!!", nwalk);
5255      idElements(Gomega1, "Gw");
5256      PrintS("\n//  compute a rGB of Gw:");
5257    }
5258#endif
5259
5260    to=clock();
5261    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
5262#ifdef  BUCHBERGER_ALG
5263    M = MstdhomCC(Gomega1);
5264#else
5265    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
5266    delete hilb_func;
5267#endif // BUCHBERGER_ALG
5268    xtstd=xtstd+clock()-to;
5269
5270    /* change the ring to oldRing */
5271    rChangeCurrRing(oldRing);
5272    M1 =  idrMoveR(M, newRing);
5273    Gomega2 =  idrMoveR(Gomega1, newRing);
5274    to=clock();
5275
5276    // if(endwalks == 1) PrintS("\n//  Lifting is still working:");
5277
5278    /* compute a reduced Groebner basis of <G> w.r.t. "newRing" by the
5279     lifting process */
5280    F = MLifttwoIdeal(Gomega2, M1, G);
5281    xtlift=xtlift+clock()-to;
5282
5283    idDelete(&M1);
5284    idDelete(&Gomega2);
5285    idDelete(&G);
5286
5287    /* change the ring to newRing */
5288    rChangeCurrRing(newRing);
5289    F1 = idrMoveR(F, oldRing);
5290    to=clock();
5291    //if(endwalks == 1) PrintS("\n//  InterRed is still working:");
5292    /* reduce the Groebner basis <G> w.r.t. the new ring */
5293    G = kInterRedCC(F1, NULL);
5294    xtred=xtred+clock()-to;
5295    idDelete(&F1);
5296
5297    if(endwalks == 1)
5298      break;
5299
5300  FIRST_STEP:
5301    Overflow_Error=FALSE;
5302    to=clock();
5303    /* compute a next weight vector */
5304    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
5305    xtnw=xtnw+clock()-to;
5306#ifdef PRINT_VECTORS
5307    MivString(curr_weight, target_weight, next_weight);
5308#endif
5309
5310    if(Overflow_Error == TRUE)
5311    {
5312      delete next_weight;
5313
5314      LASTGB_ALT1:
5315      if(tp_deg > 1){
5316        nOverflow_Error = Overflow_Error;
5317        tproc = tproc+clock()-tinput;
5318        /*
5319          Print("\n// A subroutine takes %d steps and calls \"Mpwalk\" (1,%d):",
5320          nwalk, tp_deg-1);
5321        */
5322        G1 = Mpwalk_MAltwalk1(G, curr_weight, tp_deg-1);
5323        goto MPW_Finish;
5324      }
5325      else {
5326        newRing = currRing;
5327        ntestwinC = 0;
5328        break;
5329      }
5330    }
5331
5332    if(MivComp(next_weight, ivNull) == 1)
5333    {
5334      newRing = currRing;
5335      delete next_weight;
5336      break;
5337    }
5338    if(MivComp(next_weight, target_weight) == 1)
5339      endwalks = 1;
5340
5341    for(i=nV-1; i>=0; i--)
5342    {
5343      //(*extra_curr_weight)[i] = (*curr_weight)[i];
5344      (*curr_weight)[i] = (*next_weight)[i];
5345    }
5346    delete next_weight;
5347  }//while
5348
5349  /* check wheather the pertubed target vector is correct */
5350
5351  //define and execute ring with lex. order
5352  if (currRing->parameter != NULL)
5353    DefRingParlp();
5354  else
5355    VMrDefaultlp();
5356
5357  G1 = idrMoveR(G, newRing);
5358
5359  if( test_w_in_ConeCC(G1, target_weight) != 1 || ntestwinC == 0)
5360  {
5361    PrintS("\n// The perturbed target vector doesn't STAY in the correct cone!!");
5362    if(tp_deg == 1){
5363      //Print("\n// subroutine takes %d steps and applys \"std\"", nwalk);
5364      to=clock();
5365      ideal G2 = MstdCC(G1);
5366      xtextra=xtextra+clock()-to;
5367      idDelete(&G1);
5368      G1 = G2;
5369      G2 = NULL;
5370    }
5371    else {
5372      nOverflow_Error = Overflow_Error;
5373      tproc = tproc+clock()-tinput;
5374      /*
5375        Print("\n// B subroutine takes %d steps and calls \"Mpwalk\" (1,%d) :",
5376            nwalk,  tp_deg-1);
5377      */
5378      G1 = Mpwalk_MAltwalk1(G1, curr_weight, tp_deg-1);
5379    }
5380  }
5381
5382 MPW_Finish:
5383  newRing = currRing;
5384  rChangeCurrRing(YXXRing);
5385  ideal result = idrMoveR(G1, newRing);
5386
5387  delete ivNull;
5388  delete target_weight;
5389
5390  /*
5391  Print("\n// \"Mpwalk\" (1,%d) took %d steps and %.2f sec. Overflow_Error (%d)", tp_deg,
5392        nwalk, ((double) clock()-tinput)/1000000, nOverflow_Error);
5393  */
5394
5395  return(result);
5396}
5397
5398/* August 2003 */
5399ideal MAltwalk1(ideal Go, int op_deg, int tp_deg, intvec* curr_weight,
5400                intvec* target_weight)
5401{
5402  Set_Error(FALSE  );
5403  Overflow_Error = FALSE;
5404  BOOLEAN nOverflow_Error = FALSE;
5405  // Print("// pSetm_Error = (%d)", ErrorCheck());
5406
5407  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
5408  xftinput = clock();
5409  clock_t tostd, tproc;
5410
5411  nstep = 0;
5412  int i, nV = currRing->N;
5413  int nwalk=0, endwalks=0;
5414  int op_tmp = op_deg;
5415  ideal Gomega, M, F, G, G1, Gomega1, Gomega2, M1, F1;
5416  ring endRing, newRing, oldRing, TargetRing;
5417  intvec* next_weight;
5418  intvec* iv_M_dp;
5419  intvec* ivNull = new intvec(nV);
5420  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
5421  intvec* exivlp = Mivlp(nV);
5422  intvec* extra_curr_weight = new intvec(nV);
5423  intvec* hilb_func;
5424
5425  intvec* cw_tmp = curr_weight;
5426
5427  /* to avoid (1,0,...,0) as the target vector */
5428  intvec* last_omega = new intvec(nV);
5429  for(i=nV-1; i>0; i--)
5430    (*last_omega)[i] = 1;
5431  (*last_omega)[0] = 10000;
5432
5433  ring XXRing = currRing;
5434
5435  to=clock();
5436  /* compute a pertubed weight vector of the original weight vector.
5437     The perturbation degree is recursive decrease until that vector
5438     stays inn the correct cone. */
5439  while(1)
5440  {
5441    if(Overflow_Error == FALSE)
5442    {
5443      if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) = "dp"
5444        if(op_tmp == op_deg) {
5445          G = MstdCC(Go);
5446          if(op_deg != 1)
5447            iv_M_dp = MivMatrixOrderdp(nV);
5448        }
5449    }
5450    else
5451    {
5452      if(op_tmp == op_deg) {
5453        //rOrdStr(currRing) = (a(...),lp,C)
5454        if (currRing->parameter != NULL)
5455          DefRingPar(cw_tmp);
5456        else
5457          VMrDefault(cw_tmp);
5458
5459        G = idrMoveR(Go, XXRing);
5460        G = MstdCC(G);
5461        if(op_deg != 1)
5462          iv_M_dp = MivMatrixOrder(cw_tmp);
5463      }
5464    }
5465    Overflow_Error = FALSE;
5466    if(op_deg != 1)
5467      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
5468    else {
5469      curr_weight =  cw_tmp;
5470      break;
5471    }
5472    if(Overflow_Error == FALSE)
5473      break;
5474
5475    Overflow_Error = TRUE;
5476    op_deg --;
5477  }
5478  tostd=clock()-to;
5479
5480  if(op_tmp != 1 )
5481    delete iv_M_dp;
5482  delete iv_dp;
5483
5484  if(currRing->order[0] == ringorder_a)
5485    goto NEXT_VECTOR;
5486
5487  while(1)
5488  {
5489    nwalk ++;
5490    nstep ++;
5491
5492    to = clock();
5493    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
5494    Gomega = MwalkInitialForm(G, curr_weight);
5495    xtif=xtif+clock()-to;
5496#if 0
5497    if(Overflow_Error == TRUE)
5498    {
5499      for(i=nV-1; i>=0; i--)
5500        (*curr_weight)[i] = (*extra_curr_weight)[i];
5501      delete extra_curr_weight;
5502
5503      newRing = currRing;
5504      goto MSTD_ALT1;
5505    }
5506#endif
5507#ifndef  BUCHBERGER_ALG
5508    if(isNolVector(curr_weight) == 0)
5509      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
5510    else
5511      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
5512#endif // BUCHBERGER_ALG
5513
5514    oldRing = currRing;
5515
5516    /* define a new ring which ordering is "(a(curr_weight),lp) */
5517    if (currRing->parameter != NULL)
5518      DefRingPar(curr_weight);
5519    else
5520      VMrDefault(curr_weight);
5521
5522    newRing = currRing;
5523    Gomega1 = idrMoveR(Gomega, oldRing);
5524
5525    to=clock();
5526    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
5527#ifdef  BUCHBERGER_ALG
5528    M = MstdhomCC(Gomega1);
5529#else
5530    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
5531    delete hilb_func;
5532#endif // BUCHBERGER_ALG
5533    xtstd=xtstd+clock()-to;
5534
5535    /* change the ring to oldRing */
5536    rChangeCurrRing(oldRing);
5537    M1 =  idrMoveR(M, newRing);
5538    Gomega2 =  idrMoveR(Gomega1, newRing);
5539
5540    to=clock();
5541    /* compute a reduced Groebner basis of <G> w.r.t. "newRing" by the
5542     lifting process */
5543    F = MLifttwoIdeal(Gomega2, M1, G);
5544    xtlift=xtlift+clock()-to;
5545
5546    idDelete(&M1);
5547    idDelete(&Gomega2);
5548    idDelete(&G);
5549
5550   /* change the ring to newRing */
5551    rChangeCurrRing(newRing);
5552    F1 = idrMoveR(F, oldRing);
5553
5554    to=clock();
5555    /* reduce the Groebner basis <G> w.r.t. new ring */
5556    G = kInterRedCC(F1, NULL);
5557    xtred=xtred+clock()-to;
5558    idDelete(&F1);
5559
5560    if(endwalks == 1)
5561      break;
5562
5563  NEXT_VECTOR:
5564    to=clock();
5565    /* compute a next weight vector */
5566    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
5567    xtnw=xtnw+clock()-to;
5568#ifdef PRINT_VECTORS
5569    MivString(curr_weight, target_weight, next_weight);
5570#endif
5571
5572    if(Overflow_Error == TRUE)
5573    {
5574      newRing = currRing;
5575
5576      if (currRing->parameter != NULL)
5577        DefRingPar(target_weight);
5578      else
5579        VMrDefault(target_weight);
5580
5581      F1 = idrMoveR(G, newRing);
5582      G = MstdCC(F1);
5583      idDelete(&F1);
5584      newRing = currRing;
5585      break; //for while
5586    }
5587
5588
5589    /* G is the wanted Groebner basis if next_weight == curr_weight */
5590    if(MivComp(next_weight, ivNull) == 1)
5591    {
5592      newRing = currRing;
5593      delete next_weight;
5594      break; //for while
5595    }
5596
5597    if(MivComp(next_weight, target_weight) == 1)
5598    {
5599      if(tp_deg == 1 || MivSame(target_weight, exivlp) == 0)
5600        endwalks = 1;
5601      else
5602      {
5603        MSTD_ALT1:
5604        nOverflow_Error = Overflow_Error;
5605        tproc = clock()-xftinput;
5606        /*
5607        Print("\n//  main routine takes %d steps and calls \"Mpwalk\" (1,%d):",
5608              nwalk,  tp_deg);
5609        */
5610        // compute the red. GB of <G> w.r.t. the lex order by
5611        // the "recursive-modified" perturbation walk alg (1,tp_deg)
5612        G = Mpwalk_MAltwalk1(G, curr_weight, tp_deg);
5613        delete next_weight;
5614        break; // for while
5615      }
5616    }
5617
5618    /* 06.11.01 NOT Changed, to free memory*/
5619    for(i=nV-1; i>=0; i--)
5620    {
5621      //(*extra_curr_weight)[i] = (*curr_weight)[i];
5622      (*curr_weight)[i] = (*next_weight)[i];
5623    }
5624    delete next_weight;
5625  }//while
5626
5627  rChangeCurrRing(XXRing);
5628  ideal result = idrMoveR(G, newRing);
5629  id_Delete(&G, newRing);
5630
5631  delete ivNull;
5632  if(op_deg != 1 )
5633    delete curr_weight;
5634
5635  delete exivlp;
5636#ifdef TIME_TEST
5637
5638  Print("\n// \"Main procedure\"  took %d steps, %.2f sec. and Overflow_Error(%d)",
5639        nwalk, ((double) tproc)/1000000, nOverflow_Error);
5640
5641  TimeStringFractal(xftinput, tostd, xtif, xtstd,xtextra, xtlift, xtred, xtnw);
5642
5643  Print("\n// pSetm_Error = (%d)", ErrorCheck());
5644  Print("\n// Overflow_Error? (%d)", Overflow_Error);
5645  Print("\n// Awalk1 took %d steps.\n", nstep);
5646#endif
5647  return(result);
5648}
5649
Note: See TracBrowser for help on using the repository browser.