source: git/Singular/walk.cc @ 90f715

spielwiese
Last change on this file since 90f715 was 90f715, checked in by Hans Schoenemann <hannes@…>, 7 years ago
change: use rRingOrder_t instead of int
  • Property mode set to 100644
File size: 238.9 KB
Line 
1/*****************************************
2*  Computer Algebra System SINGULAR      *
3*****************************************/
4/*
5* ABSTRACT: Implementation of the Groebner walk
6*/
7
8// define if the Buchberger alg should be used
9//   to compute a reduced GB of a omega-homogenoues ideal
10// default: we use the hilbert driven algorithm.
11#define BUCHBERGER_ALG  //we use the improved Buchberger alg.
12
13//#define UPPER_BOUND //for the original "Tran" algorithm
14//#define REPRESENTATION_OF_SIGMA //if one perturbs sigma in Tran
15
16//#define TEST_OVERFLOW
17
18#define CHECK_IDEAL_MWALK //to print intermediate results
19
20//#define NEXT_VECTORS_CC
21//#define PRINT_VECTORS //to print weight vectors
22
23#define INVEPS_SMALL_IN_FRACTAL  //to choose the small invers of epsilon
24#define INVEPS_SMALL_IN_MPERTVECTOR  //to choose the small invers of epsilon
25#define INVEPS_SMALL_IN_TRAN  //to choose the small invers of epsilon
26
27#define FIRST_STEP_FRACTAL // to define the first step of the fractal
28#define MSTDCC_FRACTAL // apply Buchberger alg to compute a red GB, if tau doesn't stay in the correct cone
29
30//#define TIME_TEST // print the used time of each subroutine
31//#define ENDWALKS //print the size of the last omega-homogenoues Groebner basis
32
33/* includes */
34
35#include <kernel/mod2.h>
36#include <misc/intvec.h>
37#include <Singular/cntrlc.h>
38#include <misc/options.h>
39#include <omalloc/omalloc.h>
40#include <Singular/ipshell.h>
41#include <Singular/ipconv.h>
42#include <coeffs/ffields.h>
43#include <coeffs/coeffs.h>
44#include <Singular/subexpr.h>
45#include <polys/templates/p_Procs.h>
46
47#include <polys/monomials/maps.h>
48
49/* include Hilbert-function */
50#include <kernel/combinatorics/stairc.h>
51
52/** kstd2.cc */
53#include <kernel/GBEngine/kutil.h>
54#include <kernel/GBEngine/khstd.h>
55
56#include <Singular/walk.h>
57#include <kernel/polys.h>
58#include <kernel/ideals.h>
59#include <Singular/ipid.h>
60#include <Singular/tok.h>
61#include <coeffs/numbers.h>
62#include <Singular/ipid.h>
63#include <polys/monomials/ring.h>
64#include <kernel/GBEngine/kstd1.h>
65#include <polys/matpol.h>
66#include <polys/weight.h>
67#include <misc/intvec.h>
68#include <kernel/GBEngine/syz.h>
69#include <Singular/lists.h>
70#include <polys/prCopy.h>
71#include <polys/monomials/ring.h>
72//#include <polys/ext_fields/longalg.h>
73#include <polys/clapsing.h>
74
75#include <coeffs/mpr_complex.h>
76
77#include <stdio.h>
78// === Zeit & System (Holger Croeni ===
79#include <time.h>
80#include <sys/time.h>
81#include <math.h>
82#include <sys/stat.h>
83#include <unistd.h>
84#include <float.h>
85#include <misc/mylimits.h>
86#include <sys/types.h>
87
88int nstep;
89
90extern BOOLEAN ErrorCheck();
91
92extern BOOLEAN pSetm_error;
93
94void Set_Error( BOOLEAN f) { pSetm_error=f; }
95
96BOOLEAN Overflow_Error =  FALSE;
97
98#ifdef TIME_TEST
99clock_t xtif, xtstd, xtlift, xtred, xtnw;
100clock_t xftostd, xtextra, xftinput, to;
101#endif
102
103/****************************
104 * utilities for TSet, LSet *
105 ****************************/
106inline static intset initec (int maxnr)
107{
108  return (intset)omAlloc(maxnr*sizeof(int));
109}
110
111inline static unsigned long* initsevS (int maxnr)
112{
113  return (unsigned long*)omAlloc0(maxnr*sizeof(unsigned long));
114}
115inline static int* initS_2_R (int maxnr)
116{
117  return (int*)omAlloc0(maxnr*sizeof(int));
118}
119
120/************************************
121 * construct the set s from F u {P} *
122 ************************************/
123// unused
124/*
125static void initSSpecialCC (ideal F, ideal Q, ideal P,kStrategy strat)
126{
127  int   i,pos;
128
129  if (Q!=NULL) i=((IDELEMS(Q)+(setmaxTinc-1))/setmaxTinc)*setmaxTinc;
130  else i=setmaxT;
131
132  strat->ecartS=initec(i);
133  strat->sevS=initsevS(i);
134  strat->S_2_R=initS_2_R(i);
135  strat->fromQ=NULL;
136  strat->Shdl=idInit(i,F->rank);
137  strat->S=strat->Shdl->m;
138
139  // - put polys into S -
140  if (Q!=NULL)
141  {
142    strat->fromQ=initec(i);
143    memset(strat->fromQ,0,i*sizeof(int));
144    for (i=0; i<IDELEMS(Q); i++)
145    {
146      if (Q->m[i]!=NULL)
147      {
148        LObject h;
149        h.p = pCopy(Q->m[i]);
150        //if (TEST_OPT_INTSTRATEGY)
151        //{
152        //  //pContent(h.p);
153        //  h.pCleardenom(); // also does a pContent
154        //}
155        //else
156        //{
157        //  h.pNorm();
158        //}
159        strat->initEcart(&h);
160        if (rHasLocalOrMixedOrdering_currRing())
161        {
162          deleteHC(&h,strat);
163        }
164        if (h.p!=NULL)
165        {
166          if (strat->sl==-1)
167            pos =0;
168          else
169          {
170            pos = posInS(strat,strat->sl,h.p,h.ecart);
171          }
172          h.sev = pGetShortExpVector(h.p);
173          h.SetpFDeg();
174          strat->enterS(h,pos,strat, strat->tl+1);
175          enterT(h, strat);
176          strat->fromQ[pos]=1;
177        }
178      }
179    }
180  }
181  //- put polys into S -
182  for (i=0; i<IDELEMS(F); i++)
183  {
184    if (F->m[i]!=NULL)
185    {
186      LObject h;
187      h.p = pCopy(F->m[i]);
188      if (rHasGlobalOrdering(currRing))
189      {
190        //h.p=redtailBba(h.p,strat->sl,strat);
191        h.p=redtailBba(h.p,strat->sl,strat);
192      }
193      else
194      {
195        deleteHC(&h,strat);
196      }
197      strat->initEcart(&h);
198      if (h.p!=NULL)
199      {
200        if (strat->sl==-1)
201          pos =0;
202        else
203          pos = posInS(strat,strat->sl,h.p,h.ecart);
204        h.sev = pGetShortExpVector(h.p);
205        strat->enterS(h,pos,strat, strat->tl+1);
206        h.length = pLength(h.p);
207        h.SetpFDeg();
208        enterT(h,strat);
209      }
210    }
211  }
212#ifdef INITSSPECIAL
213  for (i=0; i<IDELEMS(P); i++)
214  {
215    if (P->m[i]!=NULL)
216    {
217      LObject h;
218      h.p=pCopy(P->m[i]);
219      strat->initEcart(&h);
220      h.length = pLength(h.p);
221      if (TEST_OPT_INTSTRATEGY)
222      {
223        h.pCleardenom();
224      }
225      else
226      {
227        h.pNorm();
228      }
229      if(strat->sl>=0)
230      {
231        if (rHasGlobalOrdering(currRing))
232        {
233          h.p=redBba(h.p,strat->sl,strat);
234          if (h.p!=NULL)
235            h.p=redtailBba(h.p,strat->sl,strat);
236        }
237        else
238        {
239          h.p=redMora(h.p,strat->sl,strat);
240          strat->initEcart(&h);
241        }
242        if(h.p!=NULL)
243        {
244          if (TEST_OPT_INTSTRATEGY)
245          {
246            h.pCleardenom();
247          }
248          else
249          {
250            h.is_normalized = 0;
251            h.pNorm();
252          }
253          h.sev = pGetShortExpVector(h.p);
254          h.SetpFDeg();
255          pos = posInS(strat->S,strat->sl,h.p,h.ecart);
256          enterpairsSpecial(h.p,strat->sl,h.ecart,pos,strat,strat->tl+1);
257          strat->enterS(h,pos,strat, strat->tl+1);
258          enterT(h,strat);
259        }
260      }
261      else
262      {
263        h.sev = pGetShortExpVector(h.p);
264        h.SetpFDeg();
265        strat->enterS(h,0,strat, strat->tl+1);
266        enterT(h,strat);
267      }
268    }
269  }
270#endif
271}
272*/
273
274/*****************
275 *interreduce F  *
276 *****************/
277static ideal kInterRedCC(ideal F, ideal Q)
278{
279  int j;
280  kStrategy strat = new skStrategy;
281/*
282  if (TEST_OPT_PROT)
283  {
284    writeTime("start InterRed:");
285    mflush();
286  }
287  strat->syzComp     = 0;
288*/
289  strat->kHEdgeFound = (currRing->ppNoether) != NULL;
290  strat->kNoether=pCopy((currRing->ppNoether));
291  strat->ak = id_RankFreeModule(F, currRing);
292  initBuchMoraCrit(strat);
293  strat->NotUsedAxis = (BOOLEAN *)omAlloc((currRing->N+1)*sizeof(BOOLEAN));
294  for(j=currRing->N; j>0; j--)
295  {
296    strat->NotUsedAxis[j] = TRUE;
297  }
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(rHasLocalOrMixedOrdering_currRing())
308  {
309    strat->honey = TRUE;
310  }
311
312  //initSCC(F,Q,strat);
313  initS(F,Q,strat);
314
315  /*
316  timetmp=clock();//22.01.02
317  initSSpecialCC(F,Q,NULL,strat);
318  tininitS=tininitS+clock()-timetmp;//22.01.02
319  */
320  if(TEST_OPT_REDSB)
321  {
322    strat->noTailReduction=FALSE;
323  }
324  updateS(TRUE,strat);
325
326  if(TEST_OPT_REDSB && TEST_OPT_INTSTRATEGY)
327  {
328    completeReduce(strat);
329  }
330  pDelete(&strat->kHEdge);
331  omFreeSize((ADDRESS)strat->T,strat->tmax*sizeof(TObject));
332  omFreeSize((ADDRESS)strat->ecartS,IDELEMS(strat->Shdl)*sizeof(int));
333  omFreeSize((ADDRESS)strat->sevS,IDELEMS(strat->Shdl)*sizeof(unsigned long));
334  omFreeSize((ADDRESS)strat->NotUsedAxis,(currRing->N+1)*sizeof(BOOLEAN));
335  omfree(strat->sevT);
336  omfree(strat->S_2_R);
337  omfree(strat->R);
338
339  if(strat->fromQ)
340  {
341    for(j=0; j<IDELEMS(strat->Shdl); j++)
342    {
343      if(strat->fromQ[j])
344      {
345        pDelete(&strat->Shdl->m[j]);
346      }
347    }
348    omFreeSize((ADDRESS)strat->fromQ,IDELEMS(strat->Shdl)*sizeof(int));
349    strat->fromQ = NULL;
350  }
351/*
352  if (TEST_OPT_PROT)
353  {
354    writeTime("end Interred:");
355    mflush();
356  }
357*/
358  ideal shdl=strat->Shdl;
359  idSkipZeroes(shdl);
360  delete(strat);
361
362  return shdl;
363}
364
365#ifdef TIME_TEST
366static void TimeString(clock_t tinput, clock_t tostd, clock_t tif,clock_t tstd,
367                       clock_t tlf,clock_t tred, clock_t tnw, int step)
368{
369  double totm = ((double) (clock() - tinput))/1000000;
370  double ostd,mostd, mif, mstd, mlf, mred, mnw, mxif,mxstd,mxlf,mxred,mxnw,tot;
371  // double mextra
372  Print("\n// total time = %.2f sec", totm);
373  Print("\n// tostd = %.2f sec = %.2f", ostd=((double) tostd)/1000000,
374        mostd=((((double) tostd)/1000000)/totm)*100);
375  Print("\n// tif   = %.2f sec = %.2f", ((double) tif)/1000000,
376        mif=((((double) tif)/1000000)/totm)*100);
377  Print("\n// std   = %.2f sec = %.2f", ((double) tstd)/1000000,
378        mstd=((((double) tstd)/1000000)/totm)*100);
379  Print("\n// lift  = %.2f sec = %.2f", ((double) tlf)/1000000,
380        mlf=((((double) tlf)/1000000)/totm)*100);
381  Print("\n// ired  = %.2f sec = %.2f", ((double) tred)/1000000,
382        mred=((((double) tred)/1000000)/totm)*100);
383  Print("\n// nextw = %.2f sec = %.2f", ((double) tnw)/1000000,
384        mnw=((((double) tnw)/1000000)/totm)*100);
385  PrintS("\n Time for the last step:");
386  Print("\n// xinfo = %.2f sec = %.2f", ((double) xtif)/1000000,
387        mxif=((((double) xtif)/1000000)/totm)*100);
388  Print("\n// xstd  = %.2f sec = %.2f", ((double) xtstd)/1000000,
389        mxstd=((((double) xtstd)/1000000)/totm)*100);
390  Print("\n// xlift = %.2f sec = %.2f", ((double) xtlift)/1000000,
391        mxlf=((((double) xtlift)/1000000)/totm)*100);
392  Print("\n// xired = %.2f sec = %.2f", ((double) xtred)/1000000,
393        mxred=((((double) xtred)/1000000)/totm)*100);
394  Print("\n// xnextw= %.2f sec = %.2f", ((double) xtnw)/1000000,
395        mxnw=((((double) xtnw)/1000000)/totm)*100);
396
397  tot=mostd+mif+mstd+mlf+mred+mnw+mxif+mxstd+mxlf+mxred+mxnw;
398  double res = (double) 100 - tot;
399  Print("\n// &%d&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f&%.2f(%.2f)\\ \\",
400        step, ostd, totm, mostd,mif,mstd,mlf,mred,mnw,mxif,mxstd,mxlf,mxred,mxnw,tot,res,
401        ((((double) xtextra)/1000000)/totm)*100);
402}
403
404static void TimeStringFractal(clock_t tinput, clock_t tostd, clock_t tif,clock_t tstd,
405                       clock_t textra, clock_t tlf,clock_t tred, clock_t tnw)
406{
407
408  double totm = ((double) (clock() - tinput))/1000000;
409  double ostd, mostd, mif, mstd, mextra, mlf, mred, mnw, tot, res;
410  Print("\n// total time = %.2f sec", totm);
411  Print("\n// tostd = %.2f sec = %.2f", ostd=((double) tostd)/1000000,
412        mostd=((((double) tostd)/1000000)/totm)*100);
413  Print("\n// tif   = %.2f sec = %.2f", ((double) tif)/1000000,
414        mif=((((double) tif)/1000000)/totm)*100);
415  Print("\n// std   = %.2f sec = %.2f", ((double) tstd)/1000000,
416        mstd=((((double) tstd)/1000000)/totm)*100);
417  Print("\n// xstd  = %.2f sec = %.2f", ((double) textra)/1000000,
418        mextra=((((double) textra)/1000000)/totm)*100);
419  Print("\n// lift  = %.2f sec = %.2f", ((double) tlf)/1000000,
420        mlf=((((double) tlf)/1000000)/totm)*100);
421  Print("\n// ired  = %.2f sec = %.2f", ((double) tred)/1000000,
422        mred=((((double) tred)/1000000)/totm)*100);
423  Print("\n// nextw = %.2f sec = %.2f", ((double) tnw)/1000000,
424        mnw=((((double) tnw)/1000000)/totm)*100);
425  tot = mostd+mif+mstd+mextra+mlf+mred+mnw;
426  res = (double) 100.00-tot;
427  Print("\n// &%.2f &%.2f&%.2f &%.2f &%.2f &%.2f &%.2f &%.2f &%.2f&%.2f&%.2f\\ \\ ",
428        ostd,totm,mostd,mif,mstd,mextra,mlf,mred,mnw,tot,res);
429}
430#endif
431
432#ifdef CHECK_IDEAL_MWALK
433static void idString(ideal L, const char* st)
434{
435  int i, nL = IDELEMS(L);
436
437  Print("\n//  ideal %s =  ", st);
438  for(i=0; i<nL-1; i++)
439  {
440    Print(" %s, ", pString(L->m[i]));
441  }
442  Print(" %s;", pString(L->m[nL-1]));
443}
444#endif
445/*
446#if defined(CHECK_IDEAL_MWALK) || defined(ENDWALKS)
447static void headidString(ideal L, char* st)
448{
449  int i, nL = IDELEMS(L);
450
451  Print("\n//  ideal %s =  ", st);
452  for(i=0; i<nL-1; i++)
453  {
454    Print(" %s, ", pString(pHead(L->m[i])));
455  }
456  Print(" %s;", pString(pHead(L->m[nL-1])));
457}
458#endif
459
460#if defined(CHECK_IDEAL_MWALK) || defined(ENDWALKS)
461static void idElements(ideal L, char* st)
462{
463  int i, nL = IDELEMS(L);
464  int *K=(int *)omAlloc(nL*sizeof(int));
465
466  Print("\n//  #monoms of %s =  ", st);
467  for(i=0; i<nL; i++)
468  {
469    K[i] = pLength(L->m[i]);
470  }
471  int j, nsame;
472  // int  nk=0;
473  for(i=0; i<nL; i++)
474  {
475    if(K[i]!=0)
476    {
477      nsame = 1;
478      for(j=i+1; j<nL; j++)
479      {
480        if(K[j]==K[i])
481        {
482          nsame ++;
483          K[j]=0;
484        }
485      }
486      if(nsame == 1)
487      {
488        Print("%d, ",K[i]);
489      }
490      else
491      {
492        Print("%d[%d], ", K[i], nsame);
493      }
494    }
495  }
496  omFree(K);
497}
498#endif
499*/
500
501static void ivString(intvec* iv, const char* ch)
502{
503  int nV = iv->length()-1;
504  Print("\n// intvec %s =  ", ch);
505
506  for(int i=0; i<nV; i++)
507  {
508    Print("%d, ", (*iv)[i]);
509  }
510  Print("%d;", (*iv)[nV]);
511}
512
513#ifdef PRINT_VECTORS
514static void MivString(intvec* iva, intvec* ivb, intvec* ivc)
515{
516  int nV = iva->length()-1;
517  int i;
518  PrintS("\n//  (");
519  for(i=0; i<nV; i++)
520  {
521    Print("%d, ", (*iva)[i]);
522  }
523  Print("%d) ==> (", (*iva)[nV]);
524  for(i=0; i<nV; i++)
525  {
526    Print("%d, ", (*ivb)[i]);
527  }
528  Print("%d) := (", (*ivb)[nV]);
529
530  for(i=0; i<nV; i++)
531  {
532    Print("%d, ", (*ivc)[i]);
533  }
534  Print("%d)", (*ivc)[nV]);
535}
536#endif
537
538/********************************************************************
539 * returns gcd of integers a and b                                  *
540 ********************************************************************/
541static inline long gcd(const long a, const long b)
542{
543  long r, p0 = a, p1 = b;
544  //assume(p0 >= 0 && p1 >= 0);
545  if(p0 < 0)
546  {
547    p0 = -p0;
548  }
549  if(p1 < 0)
550  {
551    p1 = -p1;
552  }
553  while(p1 != 0)
554  {
555    r = p0 % p1;
556    p0 = p1;
557    p1 = r;
558  }
559  return p0;
560}
561
562/*****************************************************************************
563 * compute the gcd of the entries of the vectors curr_weight and diff_weight *
564 *****************************************************************************/
565/* unused:
566static int simplify_gcd(intvec* curr_weight, intvec* diff_weight)
567{
568  int j;
569  int nRing = currRing->N;
570  int gcd_tmp = (*curr_weight)[0];
571  for (j=1; j<nRing; j++)
572  {
573    gcd_tmp = gcd(gcd_tmp, (*curr_weight)[j]);
574    if(gcd_tmp == 1)
575    {
576      break;
577    }
578  }
579  if(gcd_tmp != 1)
580  {
581    for (j=0; j<nRing; j++)
582    {
583    gcd_tmp = gcd(gcd_tmp, (*diff_weight)[j]);
584    if(gcd_tmp == 1)
585      {
586        break;
587      }
588    }
589  }
590  return gcd_tmp;
591}
592*/
593
594/*********************************************
595 * cancel gcd of integers zaehler and nenner *
596 *********************************************/
597static void cancel(mpz_t zaehler, mpz_t nenner)
598{
599//  assume(zaehler >= 0 && nenner > 0);
600  mpz_t g;
601  mpz_init(g);
602  mpz_gcd(g, zaehler, nenner);
603
604  mpz_div(zaehler , zaehler, g);
605  mpz_div(nenner ,  nenner, g);
606
607  mpz_clear(g);
608}
609
610//unused
611#if 0
612static int isVectorNeg(intvec* omega)
613{
614  int i;
615
616  for(i=omega->length(); i>=0; i--)
617  {
618    if((*omega)[i]<0)
619    {
620      return 1;
621    }
622  }
623  return 0;
624}
625#endif
626
627/********************************************************************
628 * compute a weight degree of a monomial p w.r.t. a weight_vector   *
629 ********************************************************************/
630static inline int MLmWeightedDegree(const poly p, intvec* weight)
631{
632  /* 2147483647 is max. integer representation in SINGULAR */
633  mpz_t sing_int;
634  mpz_init_set_ui(sing_int,  2147483647);
635
636  int i, wgrad;
637
638  mpz_t zmul;
639  mpz_init(zmul);
640  mpz_t zvec;
641  mpz_init(zvec);
642  mpz_t zsum;
643  mpz_init(zsum);
644
645  for (i=currRing->N; i>0; i--)
646  {
647    mpz_set_si(zvec, (*weight)[i-1]);
648    mpz_mul_ui(zmul, zvec, pGetExp(p, i));
649    mpz_add(zsum, zsum, zmul);
650  }
651
652  wgrad = mpz_get_ui(zsum);
653
654  if(mpz_cmp(zsum, sing_int)>0)
655  {
656    if(Overflow_Error ==  FALSE)
657    {
658      PrintLn();
659      PrintS("\n// ** OVERFLOW in \"MwalkInitialForm\": ");
660      mpz_out_str( stdout, 10, zsum);
661      PrintS(" is greater than 2147483647 (max. integer representation)");
662      Overflow_Error = TRUE;
663    }
664  }
665
666  mpz_clear(zmul);
667  mpz_clear(zvec);
668  mpz_clear(zsum);
669  mpz_clear(sing_int);
670
671  return wgrad;
672}
673
674/********************************************************************
675 * compute a weight degree of a polynomial p w.r.t. a weight_vector *
676 ********************************************************************/
677static inline int MwalkWeightDegree(poly p, intvec* weight_vector)
678{
679  assume(weight_vector->length() >= currRing->N);
680  int max = 0, maxtemp;
681
682  while(p != NULL)
683  {
684    maxtemp = MLmWeightedDegree(p, weight_vector);
685    pIter(p);
686
687    if (maxtemp > max)
688    {
689      max = maxtemp;
690    }
691  }
692  return max;
693}
694
695
696/********************************************************************
697 * compute a weight degree of a monomial p w.r.t. a weight_vector   *
698 ********************************************************************/
699static  void  MLmWeightedDegree_gmp(mpz_t result, const poly p, intvec* weight)
700{
701  /* 2147483647 is max. integer representation in SINGULAR */
702  mpz_t sing_int;
703  mpz_init_set_ui(sing_int,  2147483647);
704
705  int i;
706
707  mpz_t zmul;
708  mpz_init(zmul);
709  mpz_t zvec;
710  mpz_init(zvec);
711  mpz_t ztmp;
712  mpz_init(ztmp);
713
714  for (i=currRing->N; i>0; i--)
715  {
716    mpz_set_si(zvec, (*weight)[i-1]);
717    mpz_mul_ui(zmul, zvec, pGetExp(p, i));
718    mpz_add(ztmp, ztmp, zmul);
719  }
720  mpz_init_set(result, ztmp);
721  mpz_clear(ztmp);
722  mpz_clear(sing_int);
723  mpz_clear(zvec);
724  mpz_clear(zmul);
725}
726
727
728/*****************************************************************************
729 * return an initial form of the polynom g w.r.t. a weight vector curr_weight *
730 *****************************************************************************/
731static poly MpolyInitialForm(poly g, intvec* curr_weight)
732{
733  if(g == NULL)
734  {
735    return NULL;
736  }
737  mpz_t max; mpz_init(max);
738  mpz_t maxtmp; mpz_init(maxtmp);
739
740  poly hg, in_w_g = NULL;
741
742  while(g != NULL)
743  {
744    hg = g;
745    pIter(g);
746    MLmWeightedDegree_gmp(maxtmp, hg, curr_weight);
747
748    if(mpz_cmp(maxtmp, max)>0)
749    {
750      mpz_set(max, maxtmp);
751      if (in_w_g!=NULL) pDelete(&in_w_g);
752      in_w_g = pHead(hg);
753    }
754    else
755    {
756      if(mpz_cmp(maxtmp, max)==0)
757      {
758        in_w_g = pAdd(in_w_g, pHead(hg));
759      }
760    }
761  }
762  mpz_clear(maxtmp);
763  mpz_clear(max);
764  return in_w_g;
765}
766
767/************************************************************************
768 * compute the initial form of an ideal <G> w.r.t. a weight vector iva  *
769 ************************************************************************/
770ideal MwalkInitialForm(ideal G, intvec* ivw)
771{
772  BOOLEAN nError =  Overflow_Error;
773  Overflow_Error = FALSE;
774
775  int i, nG = IDELEMS(G);
776  ideal Gomega = idInit(nG, 1);
777
778  for(i=nG-1; i>=0; i--)
779  {
780    Gomega->m[i] = MpolyInitialForm(G->m[i], ivw);
781  }
782  if(Overflow_Error == FALSE)
783  {
784    Overflow_Error = nError;
785  }
786  return Gomega;
787}
788
789/************************************************************************
790 * test whether the weight vector iv is in the cone of the ideal G      *
791 *     i.e. test whether in(in_w(g)) = in(g) for all g in G             *
792 ************************************************************************/
793
794static int test_w_in_ConeCC(ideal G, intvec* iv)
795{
796  if(G->m[0] == NULL)
797  {
798    PrintS("//** the result may be WRONG, i.e. 0!!\n");
799    return 0;
800  }
801
802  BOOLEAN nError =  Overflow_Error;
803  Overflow_Error = FALSE;
804
805  int i, nG = IDELEMS(G);
806  poly mi, gi;
807
808  for(i=nG-1; i>=0; i--)
809  {
810    mi = MpolyInitialForm(G->m[i], iv);
811    //Print("\n **// test_w_in_ConeCC: lm(initial)= %s \n",pString(mi));
812    gi = G->m[i];
813    //Print("\n **// test_w_in_ConeCC: lm(ideal)= %s \n",pString(gi));
814    if(mi == NULL)
815    {
816      if(Overflow_Error == FALSE)
817      {
818        Overflow_Error = nError;
819      }
820      return 0;
821    }
822    if(!pLmEqual(mi, gi))
823    {
824      pDelete(&mi);
825      if(Overflow_Error == FALSE)
826      {
827        Overflow_Error = nError;
828      }
829      return 0;
830    }
831    pDelete(&mi);
832  }
833
834  if(Overflow_Error == FALSE)
835  {
836    Overflow_Error = nError;
837  }
838  return 1;
839}
840
841/***************************************************
842 * compute a least common multiple of two integers *
843 ***************************************************/
844static inline long Mlcm(long &i1, long &i2)
845{
846  long temp = gcd(i1, i2);
847  return ((i1 / temp)* i2);
848}
849
850
851/***************************************************
852 * return  the dot product of two intvecs a and b  *
853 ***************************************************/
854static inline long  MivDotProduct(intvec* a, intvec* b)
855{
856  assume( a->length() ==  b->length());
857  int i, n = a->length();
858  long result = 0;
859
860  for(i=n-1; i>=0; i--)
861    {
862    result += (*a)[i] * (*b)[i];
863    }
864  return result;
865}
866
867/*****************************************************
868 * Substract two given intvecs componentwise         *
869 *****************************************************/
870static intvec* MivSub(intvec* a, intvec* b)
871{
872  assume( a->length() ==  b->length());
873  int i, n = a->length();
874  intvec* result = new intvec(n);
875
876  for(i=n-1; i>=0; i--)
877  {
878    (*result)[i] = (*a)[i] - (*b)[i];
879  }
880  return result;
881}
882
883/*****************************************************
884 * return the "intvec" lead exponent of a polynomial *
885 *****************************************************/
886static intvec* MExpPol(poly f)
887{
888  int i, nR = currRing->N;
889  intvec* result = new intvec(nR);
890
891  for(i=nR-1; i>=0; i--)
892  {
893    (*result)[i] = pGetExp(f,i+1);
894  }
895  return result;
896}
897
898/*****************************************************
899 * Compare two given intvecs and return 1, if they   *
900 * are the same, otherwise 0                         *
901 *****************************************************/
902int MivSame(intvec* u , intvec* v)
903{
904  assume(u->length() == v->length());
905
906  int i, niv = u->length();
907
908  for (i=0; i<niv; i++)
909  {
910    if ((*u)[i] != (*v)[i])
911    {
912      return 0;
913    }
914  }
915  return 1;
916}
917
918/******************************************************
919 * Compare 3 given intvecs and return 0, if the first *
920 * and the second are the same. Return 1, if the      *
921 * the second and the third are the same, otherwise 2 *
922 ******************************************************/
923int M3ivSame(intvec* temp, intvec* u , intvec* v)
924{
925  assume(temp->length() == u->length() && u->length() == v->length());
926
927  if((MivSame(temp, u)) == 1)
928  {
929    return 0;
930  }
931  if((MivSame(temp, v)) == 1)
932  {
933    return 1;
934  }
935  return 2;
936}
937
938/*****************************************************
939 * compute a Groebner basis of an ideal              *
940 *****************************************************/
941static ideal MstdCC(ideal G)
942{
943  BITSET save1,save2;
944  SI_SAVE_OPT(save1,save2);
945  si_opt_1|=(Sy_bit(OPT_REDTAIL)|Sy_bit(OPT_REDSB));
946  ideal G1 = kStd(G, NULL, testHomog, NULL);
947  SI_RESTORE_OPT(save1,save2);
948
949  idSkipZeroes(G1);
950  return G1;
951}
952
953/*****************************************************
954 * compute a Groebner basis of an homogeneous ideal  *
955 *****************************************************/
956static ideal MstdhomCC(ideal G)
957{
958  BITSET save1,save2;
959  SI_SAVE_OPT(save1,save2);
960  si_opt_1|=(Sy_bit(OPT_REDTAIL)|Sy_bit(OPT_REDSB));
961  ideal G1 = kStd(G, NULL, isHomog, NULL);
962  SI_RESTORE_OPT(save1,save2);
963
964  idSkipZeroes(G1);
965  return G1;
966}
967
968
969/*****************************************************************************
970* create a weight matrix order as intvec of an extra weight vector (a(iv),lp)*
971******************************************************************************/
972intvec* MivMatrixOrder(intvec* iv)
973{
974  int i, nR = iv->length();
975
976  intvec* ivm = new intvec(nR*nR);
977
978  for(i=0; i<nR; i++)
979  {
980    (*ivm)[i] = (*iv)[i];
981  }
982  for(i=1; i<nR; i++)
983  {
984    (*ivm)[i*nR+i-1] = 1;
985  }
986  return ivm;
987}
988
989/*********************************************************************************
990* create a weight matrix order as intvec of an extra weight vector (a(iv),M(iw)) *
991**********************************************************************************/
992intvec* MivMatrixOrderRefine(intvec* iv, intvec* iw)
993{
994  assume((iv->length())*(iv->length()) == iw->length());
995  int i,j, nR = iv->length();
996
997  intvec* ivm = new intvec(nR*nR);
998
999  for(i=0; i<nR; i++)
1000  {
1001    (*ivm)[i] = (*iv)[i];
1002  }
1003  for(i=1; i<nR; i++)
1004  {
1005    for(j=0; j<nR; j++)
1006    {
1007      (*ivm)[j+i*nR] = (*iw)[j+i*nR];
1008    }
1009  }
1010  return ivm;
1011}
1012
1013/*******************************
1014 * return intvec = (1, ..., 1) *
1015 *******************************/
1016intvec* Mivdp(int nR)
1017{
1018  int i;
1019  intvec* ivm = new intvec(nR);
1020
1021  for(i=nR-1; i>=0; i--)
1022  {
1023    (*ivm)[i] = 1;
1024  }
1025  return ivm;
1026}
1027
1028/**********************************
1029 * return intvvec = (1,0, ..., 0) *
1030 **********************************/
1031intvec* Mivlp(int nR)
1032{
1033  intvec* ivm = new intvec(nR);
1034  (*ivm)[0] = 1;
1035
1036  return ivm;
1037}
1038
1039//unused
1040/*****************************************************************************
1041 * print the max total degree and the max coefficient of G                   *
1042 *****************************************************************************/
1043/*
1044static void checkComplexity(ideal G, char* cG)
1045{
1046  int nV = currRing->N;
1047  int nG = IDELEMS(G);
1048  intvec* ivUnit = Mivdp(nV);
1049  int i, tmpdeg, maxdeg=0;
1050  number tmpcoeff , maxcoeff=currRing->cf->nNULL;
1051  poly p;
1052  for(i=nG-1; i>=0; i--)
1053  {
1054    tmpdeg = MwalkWeightDegree(G->m[i], ivUnit);
1055    if(tmpdeg > maxdeg )
1056    {
1057      maxdeg = tmpdeg;
1058    }
1059  }
1060
1061  for(i=nG-1; i>=0; i--)
1062  {
1063    p = pCopy(G->m[i]);
1064    while(p != NULL)
1065    {
1066      //tmpcoeff = pGetCoeff(pHead(p));
1067      tmpcoeff = pGetCoeff(p);
1068      if(nGreater(tmpcoeff,maxcoeff))
1069      {
1070         maxcoeff = nCopy(tmpcoeff);
1071      }
1072      pIter(p);
1073    }
1074    pDelete(&p);
1075  }
1076  p = pNSet(maxcoeff);
1077  char* pStr = pString(p);
1078  delete ivUnit;
1079  Print("// max total degree of %s = %d\n",cG, maxdeg);
1080  Print("// max coefficient of %s  = %s", cG, pStr);//ing(p));
1081  Print(" which consists of %d digits", (int)strlen(pStr));
1082  PrintLn();
1083}
1084*/
1085
1086/*****************************************************************************
1087* If target_ord = intmat(A1, ..., An) then calculate the perturbation        *
1088* vectors                                                                    *
1089*   tau_p_dep = inveps^(p_deg-1)*A1 + inveps^(p_deg-2)*A2 +... + A_p_deg     *
1090* where                                                                      *
1091*      inveps > totaldegree(G)*(max(A2)+...+max(A_p_deg))                    *
1092* intmat target_ord is an integer order matrix of the monomial ordering of   *
1093* basering.                                                                  *
1094* This programm computes a perturbated vector with a p_deg perturbation      *
1095* degree which smaller than the numbers of variables                         *
1096******************************************************************************/
1097intvec* MPertVectors(ideal G, intvec* ivtarget, int pdeg)
1098{
1099  // ivtarget is a matrix order of a degree reverse lex. order
1100  int nV = currRing->N;
1101  //assume(pdeg <= nV && pdeg >= 0);
1102
1103  int i, j, nG = IDELEMS(G);
1104  intvec* v_null =  new intvec(nV);
1105
1106  // Check that the perturbed degree is valid
1107  if(pdeg > nV || pdeg <= 0)
1108  {
1109    WerrorS("//** The perturbed degree is wrong!!");
1110    return v_null;
1111  }
1112  delete v_null;
1113
1114  if(pdeg == 1)
1115  {
1116    return ivtarget;
1117  }
1118  mpz_t *pert_vector = (mpz_t*)omAlloc(nV*sizeof(mpz_t));
1119  mpz_t *pert_vector1 = (mpz_t*)omAlloc(nV*sizeof(mpz_t));
1120
1121  for(i=0; i<nV; i++)
1122  {
1123    mpz_init_set_si(pert_vector[i], (*ivtarget)[i]);
1124    mpz_init_set_si(pert_vector1[i], (*ivtarget)[i]);
1125  }
1126  // Calculate max1 = Max(A2)+Max(A3)+...+Max(Apdeg),
1127  // where the Ai are the i-te rows of the matrix target_ord.
1128  int ntemp, maxAi, maxA=0;
1129  for(i=1; i<pdeg; i++)
1130  {
1131    maxAi = (*ivtarget)[i*nV];
1132    if(maxAi<0)
1133    {
1134      maxAi = -maxAi;
1135    }
1136    for(j=i*nV+1; j<(i+1)*nV; j++)
1137    {
1138      ntemp = (*ivtarget)[j];
1139      if(ntemp < 0)
1140      {
1141        ntemp = -ntemp;
1142      }
1143      if(ntemp > maxAi)
1144      {
1145        maxAi = ntemp;
1146      }
1147    }
1148    maxA += maxAi;
1149  }
1150
1151  // Calculate inveps = 1/eps, where 1/eps > totaldeg(p)*max1 for all p in G.
1152
1153  intvec* ivUnit = Mivdp(nV);
1154
1155  mpz_t tot_deg; mpz_init(tot_deg);
1156  mpz_t maxdeg; mpz_init(maxdeg);
1157  mpz_t inveps; mpz_init(inveps);
1158
1159
1160  for(i=nG-1; i>=0; i--)
1161  {
1162     mpz_set_ui(maxdeg, MwalkWeightDegree(G->m[i], ivUnit));
1163     if (mpz_cmp(maxdeg,  tot_deg) > 0 )
1164     {
1165       mpz_set(tot_deg, maxdeg);
1166     }
1167  }
1168
1169  delete ivUnit;
1170  mpz_mul_ui(inveps, tot_deg, maxA);
1171  mpz_add_ui(inveps, inveps, 1);
1172
1173
1174  // takes  "small" inveps
1175#ifdef INVEPS_SMALL_IN_MPERTVECTOR
1176  if(mpz_cmp_ui(inveps, pdeg)>0 && pdeg > 3)
1177  {
1178    //  Print("\n// choose the\"small\" inverse epsilon := %d / %d = ", mpz_get_si(inveps), pdeg);
1179    mpz_fdiv_q_ui(inveps, inveps, pdeg);
1180    // mpz_out_str(stdout, 10, inveps);
1181  }
1182#else
1183  // PrintS("\n// the \"big\" inverse epsilon: ");
1184  mpz_out_str(stdout, 10, inveps);
1185#endif
1186
1187  // pert(A1) = inveps^(pdeg-1)*A1 + inveps^(pdeg-2)*A2+...+A_pdeg,
1188  // pert_vector := A1
1189  for( i=1; i < pdeg; i++ )
1190  {
1191    for(j=0; j<nV; j++)
1192    {
1193      mpz_mul(pert_vector[j], pert_vector[j], inveps);
1194      if((*ivtarget)[i*nV+j]<0)
1195      {
1196        mpz_sub_ui(pert_vector[j], pert_vector[j],-(*ivtarget)[i*nV+j]);
1197      }
1198      else
1199      {
1200        mpz_add_ui(pert_vector[j], pert_vector[j],(*ivtarget)[i*nV+j]);
1201      }
1202    }
1203  }
1204
1205  // 2147483647 is max. integer representation in SINGULAR
1206  mpz_t sing_int;
1207  mpz_init_set_ui(sing_int,  2147483647);
1208
1209  mpz_t check_int;
1210  mpz_init_set_ui(check_int,  100000);
1211
1212  mpz_t ztemp;
1213  mpz_init(ztemp);
1214  mpz_set(ztemp, pert_vector[0]);
1215  for(i=1; i<nV; i++)
1216  {
1217    mpz_gcd(ztemp, ztemp, pert_vector[i]);
1218    if(mpz_cmp_si(ztemp, 1)  == 0)
1219    {
1220      break;
1221    }
1222  }
1223  if(mpz_cmp_si(ztemp, 1) != 0)
1224  {
1225    for(i=0; i<nV; i++)
1226    {
1227      mpz_divexact(pert_vector[i], pert_vector[i], ztemp);
1228    }
1229  }
1230
1231  for(i=0; i<nV; i++)
1232  {
1233    if(mpz_cmp(pert_vector[i], check_int)>=0)
1234    {
1235      for(j=0; j<nV; j++)
1236      {
1237        mpz_fdiv_q_ui(pert_vector1[j], pert_vector[j], 100);
1238      }
1239    }
1240  }
1241
1242  intvec* result = new intvec(nV);
1243
1244  int ntrue=0;
1245
1246  for(i=0; i<nV; i++)
1247  {
1248    (*result)[i] = mpz_get_si(pert_vector1[i]);
1249    if(mpz_cmp(pert_vector1[i], sing_int)>=0)
1250    {
1251      ntrue++;
1252    }
1253  }
1254  if(ntrue > 0 || test_w_in_ConeCC(G,result)==0)
1255  {
1256    ntrue=0;
1257    for(i=0; i<nV; i++)
1258    {
1259      (*result)[i] = mpz_get_si(pert_vector[i]);
1260      if(mpz_cmp(pert_vector[i], sing_int)>=0)
1261      {
1262        ntrue++;
1263        if(Overflow_Error == FALSE)
1264        {
1265          Overflow_Error = TRUE;
1266          PrintS("\n// ** OVERFLOW in \"MPertvectors\": ");
1267          mpz_out_str( stdout, 10, pert_vector[i]);
1268          PrintS(" is greater than 2147483647 (max. integer representation)");
1269          Print("\n//  So vector[%d] := %d is wrong!!", i+1, (*result)[i]);
1270        }
1271      }
1272    }
1273
1274    if(Overflow_Error == TRUE)
1275    {
1276      ivString(result, "pert_vector");
1277      Print("\n// %d element(s) of it is overflow!!", ntrue);
1278    }
1279  }
1280
1281  mpz_clear(ztemp);
1282  mpz_clear(sing_int);
1283  mpz_clear(check_int);
1284  omFree(pert_vector);
1285  omFree(pert_vector1);
1286  mpz_clear(tot_deg);
1287  mpz_clear(maxdeg);
1288  mpz_clear(inveps);
1289
1290  rComplete(currRing);
1291  for(j=0; j<IDELEMS(G); j++)
1292  {
1293    poly p=G->m[j];
1294    while(p!=NULL)
1295    {
1296      p_Setm(p,currRing); pIter(p);
1297    }
1298  }
1299  return result;
1300}
1301
1302/*****************************************************************************
1303 * The following procedure returns                                           *
1304 *     Pert(A1) = 1/eps^(pdeg-1)*A_1 + 1/eps^(pdeg-2)*A_2+...+A_pdeg,        *
1305 * where the A_i are the i-th rows of the matrix target_ord and              *
1306 *     1/eps > deg(p)*(max(A_2) + max(A_3)+...+max(A_pdeg))                  *
1307 *****************************************************************************/
1308intvec* MPertVectorslp(ideal G, intvec* ivtarget, int pdeg)
1309{
1310  // ivtarget is a matrix order of the lex. order
1311  int nV = currRing->N;
1312  //assume(pdeg <= nV && pdeg >= 0);
1313
1314  int i, j, nG = IDELEMS(G);
1315  intvec* pert_vector =  new intvec(nV);
1316
1317  //Checking that the perturbated degree is valid
1318  if(pdeg > nV || pdeg <= 0)
1319  {
1320    WerrorS("//** The perturbed degree is wrong!!");
1321    return pert_vector;
1322  }
1323  for(i=0; i<nV; i++)
1324  {
1325    (*pert_vector)[i]=(*ivtarget)[i];
1326  }
1327  if(pdeg == 1)
1328  {
1329    return pert_vector;
1330  }
1331  // Calculate max1 = Max(A2)+Max(A3)+...+Max(Apdeg),
1332  // where the Ai are the i-te rows of the matrix target_ord.
1333  int ntemp, maxAi, maxA=0;
1334  for(i=1; i<pdeg; i++)
1335  {
1336    maxAi = (*ivtarget)[i*nV];
1337    for(j=i*nV+1; j<(i+1)*nV; j++)
1338    {
1339      ntemp = (*ivtarget)[j];
1340      if(ntemp > maxAi)
1341      {
1342        maxAi = ntemp;
1343      }
1344    }
1345    maxA += maxAi;
1346  }
1347
1348  // Calculate inveps := 1/eps, where 1/eps > deg(p)*max1 for all p in G.
1349  int inveps, tot_deg = 0, maxdeg;
1350
1351  intvec* ivUnit = Mivdp(nV);//19.02
1352  for(i=nG-1; i>=0; i--)
1353  {
1354    // maxdeg = pTotaldegree(G->m[i], currRing); //it's wrong for ex1,2,rose
1355    maxdeg = MwalkWeightDegree(G->m[i], ivUnit);
1356    if (maxdeg > tot_deg )
1357    {
1358      tot_deg = maxdeg;
1359    }
1360  }
1361  delete ivUnit;
1362
1363  inveps = (tot_deg * maxA) + 1;
1364
1365#ifdef INVEPS_SMALL_IN_FRACTAL
1366  //  Print("\n// choose the\"small\" inverse epsilon := %d / %d = ", inveps, pdeg);
1367  if(inveps > pdeg && pdeg > 3)
1368  {
1369    inveps = inveps / pdeg;
1370  }
1371  // Print(" %d", inveps);
1372#else
1373  PrintS("\n// the \"big\" inverse epsilon %d", inveps);
1374#endif
1375
1376  // Pert(A1) = inveps^(pdeg-1)*A1 + inveps^(pdeg-2)*A2+...+A_pdeg
1377  for ( i=1; i < pdeg; i++ )
1378  {
1379    for(j=0; j<nV; j++)
1380    {
1381      (*pert_vector)[j] = inveps*((*pert_vector)[j]) + (*ivtarget)[i*nV+j];
1382    }
1383  }
1384
1385  int temp = (*pert_vector)[0];
1386  for(i=1; i<nV; i++)
1387  {
1388    temp = gcd(temp, (*pert_vector)[i]);
1389    if(temp == 1)
1390    {
1391      break;
1392    }
1393  }
1394  if(temp != 1)
1395  {
1396    for(i=0; i<nV; i++)
1397    {
1398      (*pert_vector)[i] = (*pert_vector)[i] / temp;
1399    }
1400  }
1401
1402  intvec* result = pert_vector;
1403  delete pert_vector;
1404  return result;
1405}
1406
1407/*****************************************************************************
1408 * define a lexicographic order matrix as intvec                             *
1409 *****************************************************************************/
1410intvec* MivMatrixOrderlp(int nV)
1411{
1412  int i;
1413  intvec* ivM = new intvec(nV*nV);
1414
1415  for(i=0; i<nV; i++)
1416  {
1417    (*ivM)[i*nV + i] = 1;
1418  }
1419  return(ivM);
1420}
1421
1422
1423/*****************************************************************************
1424 * define a reverse lexicographic order (dp) matrix as intvec                *
1425 *****************************************************************************/
1426intvec* MivMatrixOrderdp(int nV)
1427{
1428  int i;
1429  intvec* ivM = new intvec(nV*nV);
1430
1431  for(i=0; i<nV; i++)
1432  {
1433    (*ivM)[i] = 1;
1434  }
1435  for(i=1; i<nV; i++)
1436  {
1437    (*ivM)[(i+1)*nV - i] = -1;
1438  }
1439  return(ivM);
1440}
1441
1442/*****************************************************************************
1443 * creates an intvec of the monomial order Wp(ivstart)                       *
1444 *****************************************************************************/
1445intvec* MivWeightOrderlp(intvec* ivstart)
1446{
1447  int i;
1448  int nV = ivstart->length();
1449  intvec* ivM = new intvec(nV*nV);
1450
1451  for(i=0; i<nV; i++)
1452  {
1453    (*ivM)[i] = (*ivstart)[i];
1454  }
1455  for(i=1; i<nV; i++)
1456  {
1457    (*ivM)[i*nV + i-1] = 1;
1458  }
1459  return(ivM);
1460}
1461
1462/*****************************************************************************
1463 * creates an intvec of the monomial order dp(ivstart)                       *
1464 *****************************************************************************/
1465intvec* MivWeightOrderdp(intvec* ivstart)
1466{
1467  int i;
1468  int nV = ivstart->length();
1469  intvec* ivM = new intvec(nV*nV);
1470
1471  for(i=0; i<nV; i++)
1472  {
1473    (*ivM)[i] = (*ivstart)[i];
1474  }
1475  for(i=0; i<nV; i++)
1476  {
1477    (*ivM)[nV+i] = 1;
1478  }
1479  for(i=2; i<nV; i++)
1480  {
1481    (*ivM)[(i+1)*nV - i] = -1;
1482  }
1483  return(ivM);
1484}
1485
1486//unused
1487/*
1488static intvec* MatrixOrderdp(int nV)
1489{
1490  int i;
1491  intvec* ivM = new intvec(nV*nV);
1492
1493  for(i=0; i<nV; i++)
1494  {
1495    (*ivM)[i] = 1;
1496  }
1497  for(i=1; i<nV; i++)
1498  {
1499    (*ivM)[(i+1)*nV - i] = -1;
1500  }
1501  return(ivM);
1502}
1503*/
1504
1505intvec* MivUnit(int nV)
1506{
1507  int i;
1508  intvec* ivM = new intvec(nV);
1509  for(i=nV-1; i>=0; i--)
1510  {
1511    (*ivM)[i] = 1;
1512  }
1513  return(ivM);
1514}
1515
1516
1517/************************************************************************
1518*  compute a perturbed weight vector of a matrix order w.r.t. an ideal  *
1519*************************************************************************/
1520int Xnlev;
1521intvec* Mfpertvector(ideal G, intvec* ivtarget)
1522{
1523  int i, j, nG = IDELEMS(G);
1524  int nV = currRing->N;
1525  int niv = nV*nV;
1526
1527
1528  // Calculate maxA = Max(A2) + Max(A3) + ... + Max(AnV),
1529  // where the Ai are the i-te rows of the matrix 'targer_ord'.
1530  int ntemp, maxAi, maxA=0;
1531  for(i=1; i<nV; i++)
1532  {
1533    maxAi = (*ivtarget)[i*nV];
1534    if(maxAi<0)
1535    {
1536      maxAi = -maxAi;
1537    }
1538    for(j=i*nV+1; j<(i+1)*nV; j++)
1539    {
1540      ntemp = (*ivtarget)[j];
1541      if(ntemp < 0)
1542      {
1543        ntemp = -ntemp;
1544      }
1545      if(ntemp > maxAi)
1546      {
1547        maxAi = ntemp;
1548      }
1549    }
1550    maxA = maxA + maxAi;
1551  }
1552  intvec* ivUnit = Mivdp(nV);
1553
1554  // Calculate inveps = 1/eps, where 1/eps > deg(p)*maxA for all p in G.
1555  mpz_t tot_deg; mpz_init(tot_deg);
1556  mpz_t maxdeg; mpz_init(maxdeg);
1557  mpz_t inveps; mpz_init(inveps);
1558
1559
1560  for(i=nG-1; i>=0; i--)
1561  {
1562    mpz_set_ui(maxdeg, MwalkWeightDegree(G->m[i], ivUnit));
1563    if (mpz_cmp(maxdeg,  tot_deg) > 0 )
1564    {
1565      mpz_set(tot_deg, maxdeg);
1566    }
1567  }
1568
1569  delete ivUnit;
1570  //inveps = (tot_deg * maxA) + 1;
1571  mpz_mul_ui(inveps, tot_deg, maxA);
1572  mpz_add_ui(inveps, inveps, 1);
1573
1574  // takes  "small" inveps
1575#ifdef INVEPS_SMALL_IN_FRACTAL
1576  if(mpz_cmp_ui(inveps, nV)>0 && nV > 3)
1577  {
1578    mpz_cdiv_q_ui(inveps, inveps, nV);
1579  }
1580  // choose the small inverse epsilon
1581#endif
1582
1583  // PrintLn();  mpz_out_str(stdout, 10, inveps);
1584
1585  // Calculate the perturbed target orders:
1586  mpz_t *ivtemp=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
1587  mpz_t *pert_vector=(mpz_t *)omAlloc(niv*sizeof(mpz_t));
1588
1589  for(i=0; i < nV; i++)
1590  {
1591    mpz_init_set_si(ivtemp[i], (*ivtarget)[i]);
1592    mpz_init_set_si(pert_vector[i], (*ivtarget)[i]);
1593  }
1594
1595  mpz_t ztmp; mpz_init(ztmp);
1596  // BOOLEAN isneg = FALSE;
1597
1598  for(i=1; i<nV; i++)
1599  {
1600    for(j=0; j<nV; j++)
1601    {
1602      mpz_mul(ztmp, inveps, ivtemp[j]);
1603      if((*ivtarget)[i*nV+j]<0)
1604      {
1605        mpz_sub_ui(ivtemp[j], ztmp, -(*ivtarget)[i*nV+j]);
1606      }
1607      else
1608      {
1609        mpz_add_ui(ivtemp[j], ztmp,(*ivtarget)[i*nV+j]);
1610      }
1611    }
1612
1613    for(j=0; j<nV; j++)
1614    {
1615      mpz_init_set(pert_vector[i*nV+j],ivtemp[j]);
1616    }
1617  }
1618
1619  // 2147483647 is max. integer representation in SINGULAR
1620  mpz_t sing_int;
1621  mpz_init_set_ui(sing_int,  2147483647);
1622
1623  intvec* result = new intvec(niv);
1624  BOOLEAN nflow = FALSE;
1625
1626  // computes gcd
1627  mpz_set(ztmp, pert_vector[0]);
1628  for(i=0; i<niv; i++)
1629  {
1630    mpz_gcd(ztmp, ztmp, pert_vector[i]);
1631    if(mpz_cmp_si(ztmp, 1)==0)
1632    {
1633      break;
1634    }
1635  }
1636
1637  for(i=0; i<niv; i++)
1638  {
1639    mpz_divexact(pert_vector[i], pert_vector[i], ztmp);
1640    (* result)[i] = mpz_get_si(pert_vector[i]);
1641  }
1642
1643  CHECK_OVERFLOW:
1644
1645  for(i=0; i<niv; i++)
1646  {
1647    if(mpz_cmp(pert_vector[i], sing_int)>0)
1648    {
1649      if(nflow == FALSE)
1650      {
1651        Xnlev = i / nV;
1652        nflow = TRUE;
1653        Overflow_Error = TRUE;
1654        Print("\n// Xlev = %d and the %d-th element is", Xnlev,  i+1);
1655        PrintS("\n// ** OVERFLOW in \"Mfpertvector\": ");
1656        mpz_out_str( stdout, 10, pert_vector[i]);
1657        PrintS(" is greater than 2147483647 (max. integer representation)");
1658        Print("\n//  So vector[%d] := %d is wrong!!", i+1, (*result)[i]);
1659      }
1660    }
1661  }
1662  if(Overflow_Error == TRUE)
1663  {
1664    ivString(result, "new_vector");
1665  }
1666  omFree(pert_vector);
1667  omFree(ivtemp);
1668  mpz_clear(ztmp);
1669  mpz_clear(tot_deg);
1670  mpz_clear(maxdeg);
1671  mpz_clear(inveps);
1672  mpz_clear(sing_int);
1673
1674  rComplete(currRing);
1675  for(j=0; j<IDELEMS(G); j++)
1676  {
1677    poly p=G->m[j];
1678    while(p!=NULL)
1679    {
1680      p_Setm(p,currRing);
1681      pIter(p);
1682    }
1683  }
1684  return result;
1685}
1686
1687/****************************************************************
1688 * Multiplication of two ideals element by element              *
1689 * i.e. Let be A := (a_i) and B := (b_i), return C := (a_i*b_i) *
1690 *  destroy A, keeps B                                          *
1691 ****************************************************************/
1692static ideal MidMult(ideal A, ideal B)
1693{
1694  int mA = IDELEMS(A), mB = IDELEMS(B);
1695
1696  if(A==NULL || B==NULL)
1697  {
1698    return NULL;
1699  }
1700  if(mB < mA)
1701  {
1702    mA = mB;
1703  }
1704  ideal result = idInit(mA, 1);
1705
1706  int i, k=0;
1707  for(i=0; i<mA; i++)
1708    {
1709      result->m[k] = pMult(A->m[i], pCopy(B->m[i]));
1710      A->m[i]=NULL;
1711      if (result->m[k]!=NULL)
1712      {
1713        k++;
1714      }
1715    }
1716
1717  idDelete(&A);
1718  idSkipZeroes(result);
1719  return result;
1720}
1721
1722/*********************************************************************
1723 * G is a red. Groebner basis w.r.t. <_1                             *
1724 * Gomega is an initial form ideal of <G> w.r.t. a weight vector w   *
1725 * M is a subideal of <Gomega> and M selft is a red. Groebner basis  *
1726 *    of the ideal <Gomega> w.r.t. <_w                               *
1727 * Let m_i = h1.gw1 + ... + hs.gws for each m_i in M; gwi in Gomega  *
1728 * return F with n(F) = n(M) and f_i = h1.g1 + ... + hs.gs for each i*
1729 ********************************************************************/
1730static ideal MLifttwoIdeal(ideal Gw, ideal M, ideal G)
1731{
1732  ideal Mtmp = idLift(Gw, M, NULL, FALSE, TRUE, TRUE, NULL);
1733
1734  // If Gw is a GB, then isSB = TRUE, otherwise FALSE
1735  // So, it is better, if one tests whether Gw is a GB
1736  // in ideals.cc:
1737  // idLift (ideal mod, ideal submod,ideal * rest, BOOLEAN goodShape,
1738  //           BOOLEAN isSB,BOOLEAN divide,matrix * unit)
1739
1740  // Let be Mtmp = {m1,...,ms}, where mi=sum hij.in_gj, for all i=1,...,s
1741  // We compute F = {f1,...,fs}, where fi=sum hij.gj
1742  int i, j, nM = IDELEMS(Mtmp);
1743  ideal idpol, idLG;
1744  ideal F = idInit(nM, 1);
1745
1746  for(i=0; i<nM; i++)
1747  {
1748     idpol = idVec2Ideal(Mtmp->m[i]);
1749     idLG = MidMult(idpol, G);
1750     idpol = NULL;
1751     F->m[i] = NULL;
1752     for(j=IDELEMS(idLG)-1; j>=0; j--)
1753     {
1754       F->m[i] = pAdd(F->m[i], idLG->m[j]);
1755       idLG->m[j]=NULL;
1756     }
1757     idDelete(&idLG);
1758  }
1759  idDelete(&Mtmp);
1760  return F;
1761}
1762
1763//unused
1764/*
1765static void checkidealCC(ideal G, char* Ch)
1766{
1767  int i,nmon=0,ntmp;
1768  int nG = IDELEMS(G);
1769  int n = nG-1;
1770  Print("\n// ** Ideal %s besteht aus %d Polynomen mit ", Ch, nG);
1771
1772  for(i=0; i<nG; i++)
1773  {
1774    ntmp =  pLength(G->m[i]);
1775    nmon += ntmp;
1776
1777    if(i != n)
1778    {
1779      Print("%d, ", ntmp);
1780    }
1781    else
1782    {
1783      Print(" bzw. %d ", ntmp);
1784    }
1785  }
1786  PrintS(" Monomen.\n");
1787  Print("// ** %s besitzt %d Monome.", Ch, nmon);
1788  PrintLn();
1789}
1790*/
1791
1792//unused
1793/*
1794static void HeadidString(ideal L, char* st)
1795{
1796  int i, nL = IDELEMS(L)-1;
1797
1798  Print("//  The head terms of the ideal %s = ", st);
1799  for(i=0; i<nL; i++)
1800  {
1801    Print(" %s, ", pString(pHead(L->m[i])));
1802  }
1803  Print(" %s;\n", pString(pHead(L->m[nL])));
1804}
1805
1806*/
1807static inline int MivComp(intvec* iva, intvec* ivb)
1808{
1809  assume(iva->length() == ivb->length());
1810  int i;
1811  for(i=iva->length()-1; i>=0; i--)
1812  {
1813    if((*iva)[i] - (*ivb)[i] != 0)
1814    {
1815      return 0;
1816    }
1817  }
1818  return 1;
1819}
1820
1821/**********************************************
1822 * Look for the smallest absolut value in vec *
1823 **********************************************/
1824static int MivAbsMax(intvec* vec)
1825{
1826  int i,k;
1827  if((*vec)[0] < 0)
1828  {
1829    k = -(*vec)[0];
1830  }
1831  else
1832  {
1833    k = (*vec)[0];
1834  }
1835  for(i=1; i < (vec->length()); i++)
1836  {
1837    if((*vec)[i] < 0)
1838    {
1839      if(-(*vec)[i] > k)
1840      {
1841        k = -(*vec)[i];
1842      }
1843    }
1844    else
1845    {
1846      if((*vec)[i] > k)
1847      {
1848        k = (*vec)[i];
1849      }
1850    }
1851  }
1852  return k;
1853}
1854
1855
1856/**************************************************************
1857 * Look for the position of the smallest absolut value in vec *
1858 **************************************************************/
1859static int MivAbsMaxArg(intvec* vec)
1860{
1861  int k = MivAbsMax(vec);
1862  int i=0;
1863  while(1)
1864  {
1865    if((*vec)[i] == k || (*vec)[i] == -k)
1866    {
1867      break;
1868    }
1869    i++;
1870  }
1871  return i;
1872}
1873
1874
1875/**********************************************************************
1876 * Compute a next weight vector between curr_weight and target_weight *
1877 * with respect to an ideal <G>.                                      *
1878**********************************************************************/
1879/*
1880static intvec* MwalkNextWeightCC(intvec* curr_weight, intvec* target_weight,
1881                                 ideal G)
1882{
1883  BOOLEAN nError = Overflow_Error;
1884  Overflow_Error = FALSE;
1885
1886  assume(currRing != NULL && curr_weight != NULL &&
1887         target_weight != NULL && G != NULL);
1888
1889  int nRing = currRing->N;
1890  int checkRed, j, nG = IDELEMS(G);
1891  intvec* ivtemp;
1892
1893  mpz_t t_zaehler, t_nenner;
1894  mpz_init(t_zaehler);
1895  mpz_init(t_nenner);
1896
1897  mpz_t s_zaehler, s_nenner, temp, MwWd;
1898  mpz_init(s_zaehler);
1899  mpz_init(s_nenner);
1900  mpz_init(temp);
1901  mpz_init(MwWd);
1902
1903  mpz_t sing_int;
1904  mpz_init(sing_int);
1905  mpz_set_si(sing_int,  2147483647);
1906
1907  mpz_t sing_int_half;
1908  mpz_init(sing_int_half);
1909  mpz_set_si(sing_int_half,  3*(1073741824/2));
1910
1911  mpz_t deg_w0_p1, deg_d0_p1;
1912  mpz_init(deg_w0_p1);
1913  mpz_init(deg_d0_p1);
1914
1915  mpz_t sztn, sntz;
1916  mpz_init(sztn);
1917  mpz_init(sntz);
1918
1919  mpz_t t_null;
1920  mpz_init(t_null);
1921
1922  mpz_t ggt;
1923  mpz_init(ggt);
1924
1925  mpz_t dcw;
1926  mpz_init(dcw);
1927
1928  int gcd_tmp;
1929  intvec* diff_weight = MivSub(target_weight, curr_weight);
1930
1931  intvec* diff_weight1 = MivSub(target_weight, curr_weight);
1932  poly g;
1933
1934  for (j=0; j<nG; j++)
1935  {
1936    g = G->m[j];
1937    if (g != NULL)
1938    {
1939      ivtemp = MExpPol(g);
1940      mpz_set_si(deg_w0_p1, MivDotProduct(ivtemp, curr_weight));
1941      mpz_set_si(deg_d0_p1, MivDotProduct(ivtemp, diff_weight));
1942      delete ivtemp;
1943
1944      pIter(g);
1945      while (g != NULL)
1946      {
1947        ivtemp = MExpPol(g);
1948        mpz_set_si(MwWd, MivDotProduct(ivtemp, curr_weight));
1949        mpz_sub(s_zaehler, deg_w0_p1, MwWd);
1950        if(mpz_cmp(s_zaehler, t_null) != 0)
1951        {
1952          mpz_set_si(MwWd, MivDotProduct(ivtemp, diff_weight));
1953          mpz_sub(s_nenner, MwWd, deg_d0_p1);
1954          // check for 0 < s <= 1
1955          if( (mpz_cmp(s_zaehler,t_null) > 0 &&
1956               mpz_cmp(s_nenner, s_zaehler)>=0) ||
1957              (mpz_cmp(s_zaehler, t_null) < 0 &&
1958               mpz_cmp(s_nenner, s_zaehler)<=0))
1959          {
1960            // make both positive
1961            if (mpz_cmp(s_zaehler, t_null) < 0)
1962            {
1963              mpz_neg(s_zaehler, s_zaehler);
1964              mpz_neg(s_nenner, s_nenner);
1965            }
1966
1967            //compute a simple fraction of s
1968            cancel(s_zaehler, s_nenner);
1969
1970            if(mpz_cmp(t_nenner, t_null) != 0)
1971            {
1972              mpz_mul(sztn, s_zaehler, t_nenner);
1973              mpz_mul(sntz, s_nenner, t_zaehler);
1974
1975              if(mpz_cmp(sztn,sntz) < 0)
1976              {
1977                mpz_add(t_nenner, t_null, s_nenner);
1978                mpz_add(t_zaehler,t_null, s_zaehler);
1979              }
1980            }
1981            else
1982            {
1983              mpz_add(t_nenner, t_null, s_nenner);
1984              mpz_add(t_zaehler,t_null, s_zaehler);
1985            }
1986          }
1987        }
1988        pIter(g);
1989        delete ivtemp;
1990      }
1991    }
1992  }
1993  //Print("\n// Alloc Size = %d \n", nRing*sizeof(mpz_t));
1994  mpz_t *vec=(mpz_t*)omAlloc(nRing*sizeof(mpz_t));
1995
1996
1997  // there is no 0<t<1 and define the next weight vector that is equal
1998  // to the current weight vector
1999  if(mpz_cmp(t_nenner, t_null) == 0)
2000  {
2001#ifndef SING_NDEBUG
2002    PrintS("\n//MwalkNextWeightCC: t_nenner=0\n");
2003#endif
2004    delete diff_weight;
2005    diff_weight = ivCopy(curr_weight);//take memory
2006    goto FINISH;
2007  }
2008
2009  // define the target vector as the next weight vector, if t = 1
2010  if(mpz_cmp_si(t_nenner, 1)==0 && mpz_cmp_si(t_zaehler,1)==0)
2011  {
2012    delete diff_weight;
2013    diff_weight = ivCopy(target_weight); //this takes memory
2014    goto FINISH;
2015  }
2016
2017   checkRed = 0;
2018
2019  SIMPLIFY_GCD:
2020
2021  // simplify the vectors curr_weight and diff_weight (C-int)
2022  gcd_tmp = (*curr_weight)[0];
2023
2024  for (j=1; j<nRing; j++)
2025  {
2026    gcd_tmp = gcd(gcd_tmp, (*curr_weight)[j]);
2027    if(gcd_tmp == 1)
2028    {
2029      break;
2030    }
2031  }
2032  if(gcd_tmp != 1)
2033  {
2034    for (j=0; j<nRing; j++)
2035    {
2036      gcd_tmp = gcd(gcd_tmp, (*diff_weight)[j]);
2037      if(gcd_tmp == 1)
2038      {
2039        break;
2040      }
2041    }
2042  }
2043  if(gcd_tmp != 1)
2044  {
2045    for (j=0; j<nRing; j++)
2046    {
2047      (*curr_weight)[j] =  (*curr_weight)[j]/gcd_tmp;
2048      (*diff_weight)[j] =  (*diff_weight)[j]/gcd_tmp;
2049    }
2050  }
2051  if(checkRed > 0)
2052  {
2053    for (j=0; j<nRing; j++)
2054    {
2055      mpz_set_si(vec[j], (*diff_weight)[j]);
2056    }
2057    goto TEST_OVERFLOW;
2058  }
2059
2060#ifdef  NEXT_VECTORS_CC
2061  Print("\n// gcd of the weight vectors (current and target) = %d", gcd_tmp);
2062  ivString(curr_weight, "new cw");
2063  ivString(diff_weight, "new dw");
2064
2065  PrintS("\n// t_zaehler: ");  mpz_out_str( stdout, 10, t_zaehler);
2066  PrintS(", t_nenner: ");  mpz_out_str( stdout, 10, t_nenner);
2067#endif
2068
2069// construct a new weight vector and check whether vec[j] is overflow,
2070// i.e. vec[j] > 2^31.
2071// If vec[j] doesn't overflow, define a weight vector. Otherwise,
2072// report that overflow appears. In the second case, test whether the
2073// the correctness of the new vector plays an important role
2074
2075  for (j=0; j<nRing; j++)
2076  {
2077    mpz_set_si(dcw, (*curr_weight)[j]);
2078    mpz_mul(s_nenner, t_nenner, dcw);
2079
2080    if( (*diff_weight)[j]>0)
2081    {
2082      mpz_mul_ui(s_zaehler, t_zaehler, (*diff_weight)[j]);
2083    }
2084    else
2085    {
2086      mpz_mul_ui(s_zaehler, t_zaehler, -(*diff_weight)[j]);
2087      mpz_neg(s_zaehler, s_zaehler);
2088    }
2089    mpz_add(sntz, s_nenner, s_zaehler);
2090    mpz_init_set(vec[j], sntz);
2091
2092#ifdef NEXT_VECTORS_CC
2093    Print("\n//   j = %d ==> ", j);
2094    PrintS("(");
2095    mpz_out_str( stdout, 10, t_nenner);
2096    Print(" * %d)", (*curr_weight)[j]);
2097    PrintS(" + ("); mpz_out_str( stdout, 10, t_zaehler);
2098    Print(" * %d) =  ",  (*diff_weight)[j]);
2099    mpz_out_str( stdout, 10, s_nenner);
2100    PrintS(" + ");
2101    mpz_out_str( stdout, 10, s_zaehler);
2102    PrintS(" = "); mpz_out_str( stdout, 10, sntz);
2103    Print(" ==> vector[%d]: ", j); mpz_out_str(stdout, 10, vec[j]);
2104#endif
2105
2106    if(j==0)
2107    {
2108      mpz_set(ggt, sntz);
2109    }
2110    else
2111    {
2112      if(mpz_cmp_si(ggt,1) != 0)
2113      {
2114        mpz_gcd(ggt, ggt, sntz);
2115      }
2116    }
2117  }
2118  // reduce the vector with the gcd
2119  if(mpz_cmp_si(ggt,1) != 0)
2120  {
2121    for (j=0; j<nRing; j++)
2122    {
2123      mpz_divexact(vec[j], vec[j], ggt);
2124    }
2125  }
2126#ifdef  NEXT_VECTORS_CC
2127  PrintS("\n// gcd of elements of the vector: ");
2128  mpz_out_str( stdout, 10, ggt);
2129#endif
2130
2131  for(j=0; j<nRing; j++)
2132  {
2133    if(mpz_cmp(vec[j], sing_int_half) >= 0)
2134    {
2135      goto REDUCTION;
2136    }
2137  }
2138  checkRed = 1;
2139  for (j=0; j<nRing; j++)
2140    {
2141      (*diff_weight)[j] = mpz_get_si(vec[j]);
2142    }
2143  goto SIMPLIFY_GCD;
2144
2145  REDUCTION:
2146  checkRed = 1;
2147  for (j=0; j<nRing; j++)
2148  {
2149    (*diff_weight1)[j] = mpz_get_si(vec[j]);
2150  }
2151  while(test_w_in_ConeCC(G,diff_weight1))
2152  {
2153    for(j=0; j<nRing; j++)
2154    {
2155      (*diff_weight)[j] = (*diff_weight1)[j];
2156      mpz_set_si(vec[j], (*diff_weight)[j]);
2157    }
2158    for(j=0; j<nRing; j++)
2159    {
2160      (*diff_weight1)[j] = floor(0.1*(*diff_weight)[j] + 0.5);
2161    }
2162  }
2163  if(MivAbsMax(diff_weight)>10000)
2164  {
2165    for(j=0; j<nRing; j++)
2166    {
2167      (*diff_weight1)[j] = (*diff_weight)[j];
2168    }
2169    j = 0;
2170    while(test_w_in_ConeCC(G,diff_weight1))
2171    {
2172      (*diff_weight)[j] = (*diff_weight1)[j];
2173      mpz_set_si(vec[j], (*diff_weight)[j]);
2174      j = MivAbsMaxArg(diff_weight1);
2175      (*diff_weight1)[j] = floor(0.1*(*diff_weight1)[j] + 0.5);
2176    }
2177    goto SIMPLIFY_GCD;
2178  }
2179
2180 TEST_OVERFLOW:
2181
2182  for (j=0; j<nRing; j++)
2183  {
2184    if(mpz_cmp(vec[j], sing_int)>=0)
2185    {
2186      if(Overflow_Error == FALSE)
2187      {
2188        Overflow_Error = TRUE;
2189        PrintS("\n// ** OVERFLOW in \"MwalkNextWeightCC\": ");
2190        mpz_out_str( stdout, 10, vec[j]);
2191        PrintS(" is greater than 2147483647 (max. integer representation)\n");
2192        //Print("//  So vector[%d] := %d is wrong!!\n",j+1, vec[j]);// vec[j] is mpz_t
2193      }
2194    }
2195  }
2196
2197 FINISH:
2198   delete diff_weight1;
2199   mpz_clear(t_zaehler);
2200   mpz_clear(t_nenner);
2201   mpz_clear(s_zaehler);
2202   mpz_clear(s_nenner);
2203   mpz_clear(sntz);
2204   mpz_clear(sztn);
2205   mpz_clear(temp);
2206   mpz_clear(MwWd);
2207   mpz_clear(deg_w0_p1);
2208   mpz_clear(deg_d0_p1);
2209   mpz_clear(ggt);
2210   omFree(vec);
2211   mpz_clear(sing_int_half);
2212   mpz_clear(sing_int);
2213   mpz_clear(dcw);
2214   mpz_clear(t_null);
2215
2216  if(Overflow_Error == FALSE)
2217  {
2218    Overflow_Error = nError;
2219  }
2220  rComplete(currRing);
2221  for(j=0; j<IDELEMS(G); j++)
2222  {
2223    poly p=G->m[j];
2224    while(p!=NULL)
2225    {
2226      p_Setm(p,currRing);
2227      pIter(p);
2228    }
2229  }
2230return diff_weight;
2231}
2232*/
2233/**********************************************************************
2234 * Compute a next weight vector between curr_weight and target_weight *
2235 * with respect to an ideal <G>.                                      *
2236**********************************************************************/
2237static intvec* MwalkNextWeightCC(intvec* curr_weight, intvec* target_weight,
2238                                 ideal G)
2239{
2240  BOOLEAN nError = Overflow_Error;
2241  Overflow_Error = FALSE;
2242
2243  assume(currRing != NULL && curr_weight != NULL &&
2244         target_weight != NULL && G != NULL);
2245
2246  int nRing = currRing->N;
2247  int j, nG = IDELEMS(G);
2248  intvec* ivtemp;
2249
2250  mpz_t t_zaehler, t_nenner;
2251  mpz_init(t_zaehler);
2252  mpz_init(t_nenner);
2253
2254  mpz_t s_zaehler, s_nenner, temp, MwWd;
2255  mpz_init(s_zaehler);
2256  mpz_init(s_nenner);
2257  mpz_init(temp);
2258  mpz_init(MwWd);
2259
2260  mpz_t sing_int;
2261  mpz_init(sing_int);
2262  mpz_set_si(sing_int,  2147483647);
2263
2264  mpz_t sing_int_half;
2265  mpz_init(sing_int_half);
2266  mpz_set_si(sing_int_half,  3*(1073741824/2));
2267
2268  mpz_t deg_w0_p1, deg_d0_p1;
2269  mpz_init(deg_w0_p1);
2270  mpz_init(deg_d0_p1);
2271
2272  mpz_t sztn, sntz;
2273  mpz_init(sztn);
2274  mpz_init(sntz);
2275
2276  mpz_t t_null;
2277  mpz_init(t_null);
2278
2279  mpz_t ggt;
2280  mpz_init(ggt);
2281
2282  mpz_t dcw;
2283  mpz_init(dcw);
2284
2285  int gcd_tmp;
2286  //intvec* diff_weight = MivSub(target_weight, curr_weight);
2287
2288  intvec* diff_weight1 = new intvec(nRing); //MivSub(target_weight, curr_weight);
2289  poly g;
2290
2291  // reduce the size of the entries of the current weight vector
2292  if(TEST_OPT_REDSB)
2293  {
2294    for (j=0; j<nRing; j++)
2295    {
2296      (*diff_weight1)[j] = (*curr_weight)[j];
2297    }
2298    while(MivAbsMax(diff_weight1)>10000 && test_w_in_ConeCC(G,diff_weight1)==1)
2299    {
2300      for(j=0; j<nRing; j++)
2301      {
2302        (*curr_weight)[j] = (*diff_weight1)[j];
2303      }
2304      for(j=0; j<nRing; j++)
2305      {
2306        (*diff_weight1)[j] = floor(0.1*(*diff_weight1)[j] + 0.5);
2307      }
2308    }
2309
2310    if(MivAbsMax(curr_weight)>100000)
2311    {
2312      for(j=0; j<nRing; j++)
2313      {
2314        (*diff_weight1)[j] = (*curr_weight)[j];
2315      }
2316      j = 0;
2317      while(test_w_in_ConeCC(G,diff_weight1)==1 && MivAbsMax(diff_weight1)>1000)
2318      {
2319        (*curr_weight)[j] = (*diff_weight1)[j];
2320        j = MivAbsMaxArg(diff_weight1);
2321        (*diff_weight1)[j] = floor(0.1*(*diff_weight1)[j] + 0.5);
2322      }
2323    }
2324
2325  }
2326  intvec* diff_weight = MivSub(target_weight, curr_weight);
2327
2328  // compute a suitable next weight vector
2329  for (j=0; j<nG; j++)
2330  {
2331    g = G->m[j];
2332    if (g != NULL)
2333    {
2334      ivtemp = MExpPol(g);
2335      mpz_set_si(deg_w0_p1, MivDotProduct(ivtemp, curr_weight));
2336      mpz_set_si(deg_d0_p1, MivDotProduct(ivtemp, diff_weight));
2337      delete ivtemp;
2338
2339      pIter(g);
2340      while (g != NULL)
2341      {
2342        ivtemp = MExpPol(g);
2343        mpz_set_si(MwWd, MivDotProduct(ivtemp, curr_weight));
2344        mpz_sub(s_zaehler, deg_w0_p1, MwWd);
2345        if(mpz_cmp(s_zaehler, t_null) != 0)
2346        {
2347          mpz_set_si(MwWd, MivDotProduct(ivtemp, diff_weight));
2348          mpz_sub(s_nenner, MwWd, deg_d0_p1);
2349          // check for 0 < s <= 1
2350          if( (mpz_cmp(s_zaehler,t_null) > 0 &&
2351               mpz_cmp(s_nenner, s_zaehler)>=0) ||
2352              (mpz_cmp(s_zaehler, t_null) < 0 &&
2353               mpz_cmp(s_nenner, s_zaehler)<=0))
2354          {
2355            // make both positive
2356            if (mpz_cmp(s_zaehler, t_null) < 0)
2357            {
2358              mpz_neg(s_zaehler, s_zaehler);
2359              mpz_neg(s_nenner, s_nenner);
2360            }
2361
2362            //compute a simple fraction of s
2363            cancel(s_zaehler, s_nenner);
2364
2365            if(mpz_cmp(t_nenner, t_null) != 0)
2366            {
2367              mpz_mul(sztn, s_zaehler, t_nenner);
2368              mpz_mul(sntz, s_nenner, t_zaehler);
2369
2370              if(mpz_cmp(sztn,sntz) < 0)
2371              {
2372                mpz_add(t_nenner, t_null, s_nenner);
2373                mpz_add(t_zaehler,t_null, s_zaehler);
2374              }
2375            }
2376            else
2377            {
2378              mpz_add(t_nenner, t_null, s_nenner);
2379              mpz_add(t_zaehler,t_null, s_zaehler);
2380            }
2381          }
2382        }
2383        pIter(g);
2384        delete ivtemp;
2385      }
2386    }
2387  }
2388  //Print("\n// Alloc Size = %d \n", nRing*sizeof(mpz_t));
2389  mpz_t *vec=(mpz_t*)omAlloc(nRing*sizeof(mpz_t));
2390
2391
2392  // there is no 0<t<1 and define the next weight vector that is equal
2393  // to the current weight vector
2394  if(mpz_cmp(t_nenner, t_null) == 0)
2395  {
2396#ifndef SING_NDEBUG
2397    PrintS("\n//MwalkNextWeightCC: t_nenner=0\n");
2398#endif
2399    delete diff_weight;
2400    diff_weight = ivCopy(curr_weight);//take memory
2401    goto FINISH;
2402  }
2403
2404  // define the target vector as the next weight vector, if t = 1
2405  if(mpz_cmp_si(t_nenner, 1)==0 && mpz_cmp_si(t_zaehler,1)==0)
2406  {
2407    delete diff_weight;
2408    diff_weight = ivCopy(target_weight); //this takes memory
2409    goto FINISH;
2410  }
2411
2412  SIMPLIFY_GCD:
2413
2414  // simplify the vectors curr_weight and diff_weight (C-int)
2415  gcd_tmp = (*curr_weight)[0];
2416
2417  for (j=1; j<nRing; j++)
2418  {
2419    gcd_tmp = gcd(gcd_tmp, (*curr_weight)[j]);
2420    if(gcd_tmp == 1)
2421    {
2422      break;
2423    }
2424  }
2425  if(gcd_tmp != 1)
2426  {
2427    for (j=0; j<nRing; j++)
2428    {
2429      gcd_tmp = gcd(gcd_tmp, (*diff_weight)[j]);
2430      if(gcd_tmp == 1)
2431      {
2432        break;
2433      }
2434    }
2435  }
2436  if(gcd_tmp != 1)
2437  {
2438    for (j=0; j<nRing; j++)
2439    {
2440      (*curr_weight)[j] =  (*curr_weight)[j]/gcd_tmp;
2441      (*diff_weight)[j] =  (*diff_weight)[j]/gcd_tmp;
2442    }
2443  }
2444
2445#ifdef  NEXT_VECTORS_CC
2446  Print("\n// gcd of the weight vectors (current and target) = %d", gcd_tmp);
2447  ivString(curr_weight, "new cw");
2448  ivString(diff_weight, "new dw");
2449
2450  PrintS("\n// t_zaehler: ");  mpz_out_str( stdout, 10, t_zaehler);
2451  PrintS(", t_nenner: ");  mpz_out_str( stdout, 10, t_nenner);
2452#endif
2453
2454// construct a new weight vector and check whether vec[j] is overflow, i.e. vec[j] > 2^31.
2455// If vec[j] doesn't overflow, define a weight vector. Otherwise, report that overflow
2456// appears. In the second case, test whether the the correctness of the new vector plays
2457// an important role
2458
2459  for (j=0; j<nRing; j++)
2460  {
2461    mpz_set_si(dcw, (*curr_weight)[j]);
2462    mpz_mul(s_nenner, t_nenner, dcw);
2463
2464    if( (*diff_weight)[j]>0)
2465    {
2466      mpz_mul_ui(s_zaehler, t_zaehler, (*diff_weight)[j]);
2467    }
2468    else
2469    {
2470      mpz_mul_ui(s_zaehler, t_zaehler, -(*diff_weight)[j]);
2471      mpz_neg(s_zaehler, s_zaehler);
2472    }
2473    mpz_add(sntz, s_nenner, s_zaehler);
2474    mpz_init_set(vec[j], sntz);
2475
2476#ifdef NEXT_VECTORS_CC
2477    Print("\n//   j = %d ==> ", j);
2478    PrintS("(");
2479    mpz_out_str( stdout, 10, t_nenner);
2480    Print(" * %d)", (*curr_weight)[j]);
2481    PrintS(" + ("); mpz_out_str( stdout, 10, t_zaehler);
2482    Print(" * %d) =  ",  (*diff_weight)[j]);
2483    mpz_out_str( stdout, 10, s_nenner);
2484    PrintS(" + ");
2485    mpz_out_str( stdout, 10, s_zaehler);
2486    PrintS(" = "); mpz_out_str( stdout, 10, sntz);
2487    Print(" ==> vector[%d]: ", j); mpz_out_str(stdout, 10, vec[j]);
2488#endif
2489
2490    if(j==0)
2491    {
2492      mpz_set(ggt, sntz);
2493    }
2494    else
2495    {
2496      if(mpz_cmp_si(ggt,1) != 0)
2497      {
2498        mpz_gcd(ggt, ggt, sntz);
2499      }
2500    }
2501  }
2502  // reduce the vector with the gcd
2503  if(mpz_cmp_si(ggt,1) != 0)
2504  {
2505    for (j=0; j<nRing; j++)
2506    {
2507      mpz_divexact(vec[j], vec[j], ggt);
2508    }
2509  }
2510#ifdef  NEXT_VECTORS_CC
2511  PrintS("\n// gcd of elements of the vector: ");
2512  mpz_out_str( stdout, 10, ggt);
2513#endif
2514
2515  for (j=0; j<nRing; j++)
2516  {
2517    (*diff_weight)[j] = mpz_get_si(vec[j]);
2518  }
2519
2520 TEST_OVERFLOW:
2521
2522  for (j=0; j<nRing; j++)
2523  {
2524    if(mpz_cmp(vec[j], sing_int)>=0)
2525    {
2526      if(Overflow_Error == FALSE)
2527      {
2528        Overflow_Error = TRUE;
2529        PrintS("\n// ** OVERFLOW in \"MwalkNextWeightCC\": ");
2530        mpz_out_str( stdout, 10, vec[j]);
2531        PrintS(" is greater than 2147483647 (max. integer representation)\n");
2532        //Print("//  So vector[%d] := %d is wrong!!\n",j+1, vec[j]);// vec[j] is mpz_t
2533      }
2534    }
2535  }
2536
2537 FINISH:
2538   delete diff_weight1;
2539   mpz_clear(t_zaehler);
2540   mpz_clear(t_nenner);
2541   mpz_clear(s_zaehler);
2542   mpz_clear(s_nenner);
2543   mpz_clear(sntz);
2544   mpz_clear(sztn);
2545   mpz_clear(temp);
2546   mpz_clear(MwWd);
2547   mpz_clear(deg_w0_p1);
2548   mpz_clear(deg_d0_p1);
2549   mpz_clear(ggt);
2550   omFree(vec);
2551   mpz_clear(sing_int_half);
2552   mpz_clear(sing_int);
2553   mpz_clear(dcw);
2554   mpz_clear(t_null);
2555
2556  if(Overflow_Error == FALSE)
2557  {
2558    Overflow_Error = nError;
2559  }
2560  rComplete(currRing);
2561  for(j=0; j<IDELEMS(G); j++)
2562  {
2563    poly p=G->m[j];
2564    while(p!=NULL)
2565    {
2566      p_Setm(p,currRing);
2567      pIter(p);
2568    }
2569  }
2570return diff_weight;
2571}
2572
2573
2574/**********************************************************************
2575* Compute an intermediate weight vector from iva to ivb w.r.t.        *
2576* the reduced Groebner basis G.                                       *
2577* Return NULL, if it is equal to iva or iva = avb.                    *
2578**********************************************************************/
2579intvec* MkInterRedNextWeight(intvec* iva, intvec* ivb, ideal G)
2580{
2581  intvec* tmp = new intvec(iva->length());
2582  intvec* result;
2583
2584  if(G == NULL)
2585  {
2586    return tmp;
2587  }
2588  if(MivComp(iva, ivb) == 1)
2589  {
2590    return tmp;
2591  }
2592  result = MwalkNextWeightCC(iva, ivb, G);
2593
2594  if(MivComp(result, iva) == 1)
2595  {
2596    delete result;
2597    return tmp;
2598  }
2599
2600  delete tmp;
2601  return result;
2602}
2603
2604/********************************************************************
2605 * define and execute a new ring which order is (a(vb),a(va),lp,C)  *
2606 * ******************************************************************/
2607/*static ring VMrHomogeneous(intvec* va, intvec* vb)
2608{
2609
2610  if ((currRing->ppNoether)!=NULL)
2611  {
2612    pDelete(&(currRing->ppNoether));
2613  }
2614  if (((sLastPrinted.rtyp>BEGIN_RING) && (sLastPrinted.rtyp<END_RING)) ||
2615      ((sLastPrinted.rtyp==LIST_CMD)&&(lRingDependend((lists)sLastPrinted.data))))
2616  {
2617    sLastPrinted.CleanUp();
2618  }
2619
2620  ring r = (ring) omAlloc0Bin(sip_sring_bin);
2621  int i, nv = currRing->N;
2622
2623  r->cf  = currRing->cf;
2624  r->N   = currRing->N;
2625  int nb = 4;
2626
2627
2628  //names
2629  char* Q; // In order to avoid the corrupted memory, do not change.
2630  r->names = (char **) omAlloc0(nv * sizeof(char_ptr));
2631  for(i=0; i<nv; i++)
2632  {
2633    Q = currRing->names[i];
2634    r->names[i]  = omStrDup(Q);
2635  }
2636
2637  //weights: entries for 3 blocks: NULL Made:???
2638  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2639  r->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
2640  r->wvhdl[1] = (int*) omAlloc((nv)*sizeof(int));
2641
2642  for(i=0; i<nv; i++)
2643  {
2644    r->wvhdl[1][i] = (*vb)[i];
2645    r->wvhdl[0][i] = (*va)[i];
2646  }
2647  r->wvhdl[0][nv] = (*va)[nv];
2648
2649  // order: (1..1),a,lp,C
2650  r->order = (int *) omAlloc(nb * sizeof(int *));
2651  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2652  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2653
2654  // ringorder a for the first block: var 1..nv
2655  r->order[0]  = ringorder_a;
2656  r->block0[0] = 1;
2657  r->block1[0] = nv;
2658
2659 // ringorder a for the second block: var 2..nv
2660  r->order[1]  = ringorder_a;
2661  r->block0[1] = 1;
2662  r->block1[1] = nv;
2663
2664  // ringorder lp for the third block: var 2..nv
2665  r->order[2]  = ringorder_lp;
2666  r->block0[2] = 1;
2667  r->block1[2] = nv;
2668
2669  // ringorder C for the 4th block
2670  // it is very important within "idLift",
2671  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
2672  // therefore, nb  must be (nBlocks(currRing)  + 1)
2673  r->order[3]  = ringorder_C;
2674
2675  // polynomial ring
2676  r->OrdSgn    = 1;
2677
2678  // complete ring intializations
2679
2680  rComplete(r);
2681  return r;
2682  //rChangeCurrRing(r);
2683}
2684*/
2685
2686/**************************************************************
2687 * define and execute a new ring which order is (a(va),lp,C)  *
2688 * ************************************************************/
2689static ring VMrDefault(intvec* va)
2690{
2691
2692  ring r = rCopy0(currRing,FALSE,FALSE);
2693  int i, nv = currRing->N;
2694
2695  int nb = 4;
2696
2697  /*weights: entries for 3 blocks: NULL Made:???*/
2698  omFree(r->wvhdl);
2699  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2700  r->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
2701  for(i=0; i<nv; i++)
2702    r->wvhdl[0][i] = (*va)[i];
2703
2704  /* order: a,lp,C,0 */
2705  omFree(r->order);
2706  r->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
2707  omFree(r->block0);
2708  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2709  omFree(r->block1);
2710  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2711
2712  // ringorder a for the first block: var 1..nv
2713  r->order[0]  = ringorder_a;
2714  r->block0[0] = 1;
2715  r->block1[0] = nv;
2716
2717  // ringorder lp for the second block: var 1..nv
2718  r->order[1]  = ringorder_lp;
2719  r->block0[1] = 1;
2720  r->block1[1] = nv;
2721
2722  // ringorder C for the third block
2723  // it is very important within "idLift",
2724  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
2725  // therefore, nb  must be (nBlocks(currRing)  + 1)
2726  r->order[2]  = ringorder_C;
2727
2728  // the last block: everything is 0
2729  r->order[3]  = (rRingOrder_t)0;
2730
2731  // polynomial ring
2732  r->OrdSgn    = 1;
2733
2734  // complete ring intializations
2735
2736  rComplete(r);
2737  return r;
2738  //rChangeCurrRing(r);
2739}
2740
2741/****************************************************************
2742 * define and execute a new ring with ordering (a(va),Wp(vb),C) *
2743 * **************************************************************/
2744static ring VMrRefine(intvec* va, intvec* vb)
2745{
2746
2747  ring r = rCopy0(currRing,FALSE,FALSE);
2748  int i, nv = currRing->N;
2749
2750  int nb = 5;
2751
2752  //weights: entries for 3 blocks: NULL Made:???
2753  omFree(r->wvhdl);
2754  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2755  r->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
2756  r->wvhdl[1] = (int*) omAlloc(nv*sizeof(int));
2757
2758  for(i=0; i<nv; i++)
2759  {
2760    r->wvhdl[0][i] = (*vb)[i];
2761    r->wvhdl[1][i] = (*va)[i];
2762  }
2763
2764  // order: (1..1),a,lp,C
2765  omFree(r->order);
2766  r->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
2767  omFree(r->block0);
2768  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2769  omFree(r->block1);
2770  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2771
2772  // ringorder a for the first block: var 1..nv
2773  r->order[0]  = ringorder_a;
2774  r->block0[0] = 1;
2775  r->block1[0] = nv;
2776
2777 // ringorder Wp for the second block: var 1..nv
2778  r->order[1]  = ringorder_a;
2779  r->block0[1] = 1;
2780  r->block1[1] = nv;
2781
2782  // ringorder lp for the third block: var 1..nv
2783  r->order[2]  = ringorder_lp;
2784  r->block0[2] = 1;
2785  r->block1[2] = nv;
2786
2787  // ringorder C for the 4th block
2788  // it is very important within "idLift",
2789  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
2790  // therefore, nb  must be (nBlocks(currRing)  + 1)
2791  r->order[3]  = ringorder_C;
2792
2793  // the last block: everything is 0
2794  r->order[4]  = (rRingOrder_t)0;
2795
2796  // complete ring intializations
2797
2798  rComplete(r);
2799
2800  //rChangeCurrRing(r);
2801  return r;
2802}
2803
2804/*****************************************************
2805 * define and execute a new ring with ordering (M,C) *
2806 *****************************************************/
2807static ring VMatrDefault(intvec* va)
2808{
2809
2810  ring r = rCopy0(currRing,FALSE,FALSE);
2811  int i, nv = currRing->N;
2812
2813  int nb = 4;
2814
2815  /*weights: entries for 3 blocks: NULL Made:???*/
2816  omFree(r->wvhdl);
2817  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2818  r->wvhdl[0] = (int*) omAlloc(nv*nv*sizeof(int));
2819  r->wvhdl[1] =NULL; // (int*) omAlloc(nv*sizeof(int));
2820  r->wvhdl[2]=NULL;
2821  r->wvhdl[3]=NULL;
2822  for(i=0; i<nv*nv; i++)
2823    r->wvhdl[0][i] = (*va)[i];
2824
2825  /* order: a,lp,C,0 */
2826  omFree(r->order);
2827  r->order = (rRingOrder_t*) omAlloc(nb * sizeof(rRingOrder_t*));
2828  omFree(r->block0);
2829  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2830  omFree(r->block1);
2831  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2832
2833  // ringorder a for the first block: var 1..nv
2834  r->order[0]  = ringorder_M;
2835  r->block0[0] = 1;
2836  r->block1[0] = nv;
2837
2838  // ringorder C for the second block
2839  r->order[1]  = ringorder_C;
2840  r->block0[1] = 1;
2841  r->block1[1] = nv;
2842
2843// ringorder C for the third block: var 1..nv
2844  r->order[2]  = ringorder_C;
2845  r->block0[2] = 1;
2846  r->block1[2] = nv;
2847
2848  // the last block: everything is 0
2849  r->order[3]  = (rRingOrder_t)0;
2850
2851  // complete ring intializations
2852
2853  rComplete(r);
2854
2855  //rChangeCurrRing(r);
2856  return r;
2857}
2858
2859/***********************************************************
2860 * define and execute a new ring with ordering (a(vb),M,C) *
2861 ***********************************************************/
2862static ring VMatrRefine(intvec* va, intvec* vb)
2863{
2864
2865  ring r = rCopy0(currRing,FALSE,FALSE);
2866  int i, nv = currRing->N;
2867  int nvs = nv*nv;
2868
2869  int nb = 4;
2870
2871  /*weights: entries for 3 blocks: NULL Made:???*/
2872  omFree(r->wvhdl);
2873  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2874  r->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
2875  r->wvhdl[1] = (int*) omAlloc(nvs*sizeof(int));
2876  r->wvhdl[2]=NULL;
2877  r->wvhdl[3]=NULL;
2878  for(i=0; i<nvs; i++)
2879  {
2880    r->wvhdl[1][i] = (*va)[i];
2881  }
2882  for(i=0; i<nv; i++)
2883  {
2884    r->wvhdl[0][i] = (*vb)[i];
2885  }
2886  /* order: a,lp,C,0 */
2887  omFree(r->order);
2888  r->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
2889  omFree(r->block0);
2890  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2891  omFree(r->block1);
2892  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2893
2894  // ringorder a for the first block: var 1..nv
2895  r->order[0]  = ringorder_a;
2896  r->block0[0] = 1;
2897  r->block1[0] = nv;
2898
2899  // ringorder M for the second block: var 1..nv
2900  r->order[1]  = ringorder_M;
2901  r->block0[1] = 1;
2902  r->block1[1] = nv;
2903
2904  // ringorder C for the third block: var 1..nv
2905  r->order[2]  = ringorder_C;
2906  r->block0[2] = 1;
2907  r->block1[2] = nv;
2908
2909  // the last block: everything is 0
2910  r->order[3]  = (rRingOrder_t)0;
2911
2912  // complete ring intializations
2913
2914  rComplete(r);
2915
2916  //rChangeCurrRing(r);
2917  return r;
2918}
2919
2920/**********************************************************************
2921* define and execute a new ring which order is  a lexicographic order *
2922***********************************************************************/
2923static void VMrDefaultlp(void)
2924{
2925  ring r = rCopy0(currRing,FALSE,FALSE);
2926  int nv = currRing->N;
2927
2928  int nb = rBlocks(currRing) + 1;
2929
2930  /*weights: entries for 3 blocks: NULL Made:???*/
2931
2932 omFree(r->wvhdl);
2933  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2934
2935  /* order: lp,C,0 */
2936 omFree(r->order);
2937  r->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
2938 omFree(r->block0);
2939  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
2940 omFree(r->block1);
2941  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
2942
2943  /* ringorder lp for the first block: var 1..nv */
2944  r->order[0]  = ringorder_lp;
2945  r->block0[0] = 1;
2946  r->block1[0] = nv;
2947
2948  /* ringorder C for the second block */
2949  r->order[1]  = ringorder_C;
2950
2951  /* the last block: everything is 0 */
2952  r->order[2]  = (rRingOrder_t)0;
2953
2954  /*polynomial ring*/
2955  r->OrdSgn    = 1;
2956
2957  /* complete ring intializations */
2958
2959  rComplete(r);
2960
2961  rChangeCurrRing(r);
2962}
2963
2964/***************************************************
2965* define a ring with parameters und change to it   *
2966* DefRingPar and DefRingParlp corrupt still memory *
2967****************************************************/
2968static void DefRingPar(intvec* va)
2969{
2970  int nv = currRing->N;
2971  int nb = rBlocks(currRing) + 1;
2972
2973  ring res=rCopy0(currRing,FALSE,FALSE);
2974
2975  /*weights: entries for 3 blocks: NULL Made:???*/
2976  omFree(res->wvhdl);
2977  res->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
2978  res->wvhdl[0] = (int*) omAlloc(nv*sizeof(int));
2979  for(int i=0; i<nv; i++)
2980    res->wvhdl[0][i] = (*va)[i];
2981
2982  /* order: a,lp,C,0 */
2983
2984  omFree(res->order);
2985  res->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
2986  omFree(res->block0);
2987  res->block0 = (int *)omAlloc0(nb * sizeof(int *));
2988  omFree(res->block1);
2989  res->block1 = (int *)omAlloc0(nb * sizeof(int *));
2990
2991  // ringorder a for the first block: var 1..nv
2992  res->order[0]  = ringorder_a;
2993  res->block0[0] = 1;
2994  res->block1[0] = nv;
2995
2996  // ringorder lp for the second block: var 1..nv
2997  res->order[1]  = ringorder_lp;
2998  res->block0[1] = 1;
2999  res->block1[1] = nv;
3000
3001  // ringorder C for the third block
3002  // it is very important within "idLift",
3003  // especially, by ring syz_ring=rCurrRingAssure_SyzComp();
3004  // therefore, nb  must be (nBlocks(currRing)  + 1)
3005  res->order[2]  = ringorder_C;
3006
3007  // the last block: everything is 0
3008  res->order[3]  = (rRingOrder_t)0;
3009
3010  // polynomial ring
3011  res->OrdSgn    = 1;
3012
3013
3014  // complete ring intializations
3015  rComplete(res);
3016
3017  // execute the created ring
3018  rChangeCurrRing(res);
3019}
3020
3021static void DefRingParlp(void)
3022{
3023  int nv = currRing->N;
3024
3025  ring r=rCopy0(currRing,FALSE,FALSE);
3026
3027  int nb = rBlocks(currRing) + 1;
3028
3029  /*weights: entries for 3 blocks: NULL Made:???*/
3030
3031  omFree(r->wvhdl);
3032  r->wvhdl = (int **)omAlloc0(nb * sizeof(int_ptr));
3033
3034  /* order: lp,C,0 */
3035  omFree(r->order);
3036  r->order = (rRingOrder_t *) omAlloc(nb * sizeof(rRingOrder_t *));
3037  omFree(r->block0);
3038  r->block0 = (int *)omAlloc0(nb * sizeof(int *));
3039  omFree(r->block1);
3040  r->block1 = (int *)omAlloc0(nb * sizeof(int *));
3041
3042  /* ringorder lp for the first block: var 1..nv */
3043  r->order[0]  = ringorder_lp;
3044  r->block0[0] = 1;
3045  r->block1[0] = nv;
3046
3047  /* ringorder C for the second block */
3048  r->order[1]  = ringorder_C;
3049
3050  /* the last block: everything is 0 */
3051  r->order[2]  = (rRingOrder_t)0;
3052
3053  /*polynomial ring*/
3054  r->OrdSgn    = 1;
3055
3056
3057//   if (rParameter(currRing)!=NULL)
3058//   {
3059//     r->cf->extRing->qideal->m[0]=p_Copy(currRing->cf->extRing->qideal->m[0], currRing->cf->extRing);
3060//     int l=rPar(currRing);
3061//     r->cf->extRing->names=(char **)omAlloc(l*sizeof(char_ptr));
3062//
3063//     for(int i=l-1;i>=0;i--)
3064//     {
3065//       rParameter(r)[i]=omStrDup(rParameter(currRing)[i]);
3066//     }
3067//   }
3068
3069  // complete ring intializations
3070
3071  rComplete(r);
3072
3073  // execute the created ring
3074  rChangeCurrRing(r);
3075}
3076
3077/*************************************************************
3078 * check whether one or more components of a vector are zero *
3079 *************************************************************/
3080/* unused:
3081static int isNolVector(intvec* hilb)
3082{
3083  int i;
3084  for(i=hilb->length()-1; i>=0; i--)
3085  {
3086    if((* hilb)[i]==0)
3087    {
3088      return 1;
3089    }
3090  }
3091  return 0;
3092}
3093*/
3094
3095/*************************************************************
3096 * check whether one or more components of a vector are <= 0 *
3097 *************************************************************/
3098static int isNegNolVector(intvec* hilb)
3099{
3100  int i;
3101  for(i=hilb->length()-1; i>=0; i--)
3102  {
3103    if((* hilb)[i]<=0)
3104    {
3105      return 1;
3106    }
3107  }
3108  return 0;
3109}
3110
3111/**************************************************************************
3112* Gomega is the initial ideal of G w. r. t. the current weight vector     *
3113* curr_weight. Check whether curr_weight lies on a border of the Groebner *
3114* cone, i. e. check whether a monomial is divisible by a leading monomial *
3115***************************************************************************/
3116static ideal middleOfCone(ideal G, ideal Gomega)
3117{
3118  BOOLEAN middle = FALSE;
3119  int i,j,N = IDELEMS(Gomega);
3120  poly p,lm,factor1,factor2;
3121
3122  ideal Go = idCopy(G);
3123
3124  // check whether leading monomials of G and Gomega coincide
3125  // and return NULL if not
3126  for(i=0; i<N; i++)
3127  {
3128    if(!pIsConstant(pSub(pCopy(Gomega->m[i]),pCopy(pHead(G->m[i])))))
3129    {
3130      idDelete(&Go);
3131      return NULL;
3132    }
3133  }
3134  for(i=0; i<N; i++)
3135  {
3136    for(j=0; j<N; j++)
3137    {
3138      if(i!=j)
3139      {
3140        p = pCopy(Gomega->m[i]);
3141        lm = pCopy(Gomega->m[j]);
3142        pIter(p);
3143        while(p!=NULL)
3144        {
3145          if(pDivisibleBy(lm,p))
3146          {
3147            if(middle == FALSE)
3148            {
3149              middle = TRUE;
3150            }
3151            factor1 = singclap_pdivide(pHead(p),lm,currRing);
3152            factor2 = pMult(pCopy(factor1),pCopy(Go->m[j]));
3153            pDelete(&factor1);
3154            Go->m[i] = pAdd((Go->m[i]),pNeg(pCopy(factor2)));
3155            pDelete(&factor2);
3156          }
3157          pIter(p);
3158        }
3159        pDelete(&lm);
3160        pDelete(&p);
3161      }
3162    }
3163  }
3164
3165  if(middle == TRUE)
3166  {
3167    return Go;
3168  }
3169  idDelete(&Go);
3170  return NULL;
3171}
3172
3173/******************************  Februar 2002  ****************************
3174 * G is a Groebner basis w.r.t. (a(curr_weight),lp) and                   *
3175 * we compute a GB of <G> w.r.t. the lex. order by the perturbation walk  *
3176 * its perturbation degree is tp_deg                                      *
3177 * We call the following subfunction LastGB, if                           *
3178 * the computed intermediate weight vector or                             *
3179 * if the perturbed target weight vector does NOT lie n the correct cone  *
3180 **************************************************************************/
3181
3182static ideal LastGB(ideal G, intvec* curr_weight,int tp_deg)
3183{
3184  BOOLEAN nError = Overflow_Error;
3185  Overflow_Error = FALSE;
3186
3187  int i, nV = currRing->N;
3188  int nwalk=0, endwalks=0, nnwinC=1;
3189  int nlast = 0;
3190  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
3191  ring newRing, oldRing, TargetRing;
3192  intvec* iv_M_lp;
3193  intvec* target_weight;
3194  intvec* iv_lp = Mivlp(nV); //define (1,0,...,0)
3195  intvec* pert_target_vector;
3196  intvec* ivNull = new intvec(nV);
3197  intvec* extra_curr_weight = new intvec(nV);
3198  intvec* next_weight;
3199
3200#ifndef  BUCHBERGER_ALG
3201  intvec* hilb_func;
3202#endif
3203
3204  // to avoid (1,0,...,0) as the target vector
3205  intvec* last_omega = new intvec(nV);
3206  for(i=nV-1; i>0; i--)
3207  {
3208    (*last_omega)[i] = 1;
3209  }
3210  (*last_omega)[0] = 10000;
3211
3212  ring EXXRing = currRing;
3213
3214  // compute a pertubed weight vector of the target weight vector
3215  if(tp_deg > 1 && tp_deg <= nV)
3216  {
3217    //..25.03.03 VMrDefaultlp();//    VMrDefault(target_weight);
3218    if (rParameter (currRing) != NULL)
3219    {
3220      DefRingParlp();
3221    }
3222    else
3223    {
3224      VMrDefaultlp();
3225    }
3226    TargetRing = currRing;
3227    ssG = idrMoveR(G,EXXRing,currRing);
3228    iv_M_lp = MivMatrixOrderlp(nV);
3229    //target_weight = MPertVectorslp(ssG, iv_M_lp, tp_deg);
3230    target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
3231    delete iv_M_lp;
3232    pert_target_vector = target_weight;
3233
3234    rChangeCurrRing(EXXRing);
3235    G = idrMoveR(ssG, TargetRing,currRing);
3236  }
3237  else
3238  {
3239    target_weight = Mivlp(nV);
3240  }
3241  //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3242
3243  while(1)
3244  {
3245    nwalk++;
3246    nstep++;
3247#ifdef TIME_TEST
3248    to=clock();
3249#endif
3250   // compute a next weight vector
3251    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
3252#ifdef TIME_TEST
3253    xtnw=xtnw+clock()-to;
3254#endif
3255
3256#ifdef PRINT_VECTORS
3257    MivString(curr_weight, target_weight, next_weight);
3258#endif
3259
3260    if(Overflow_Error == TRUE)
3261    {
3262      newRing = currRing;
3263      nnwinC = 0;
3264      if(tp_deg == 1)
3265      {
3266        nlast = 1;
3267      }
3268      delete next_weight;
3269
3270      //idElements(G, "G");
3271      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3272
3273      break;
3274    }
3275
3276    if(MivComp(next_weight, ivNull) == 1)
3277    {
3278      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3279      newRing = currRing;
3280      delete next_weight;
3281      break;
3282    }
3283
3284    if(MivComp(next_weight, target_weight) == 1)
3285      endwalks = 1;
3286
3287    for(i=nV-1; i>=0; i--)
3288    {
3289      (*extra_curr_weight)[i] = (*curr_weight)[i];
3290    }
3291    /* 06.11.01 NOT Changed */
3292    for(i=nV-1; i>=0; i--)
3293    {
3294      (*curr_weight)[i] = (*next_weight)[i];
3295    }
3296    oldRing = currRing;
3297#ifdef TIME_TEST
3298    to=clock();
3299#endif
3300    // compute an initial form ideal of <G> w.r.t. "curr_vector"
3301    Gomega = MwalkInitialForm(G, curr_weight);
3302#ifdef TIME_TEST
3303    xtif=xtif+clock()-to;
3304#endif
3305
3306#ifdef ENDWALKS
3307    if(endwalks == 1)
3308    {
3309      Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3310/*
3311      idElements(Gomega, "Gw");
3312      headidString(Gomega, "Gw");
3313*/
3314    }
3315#endif
3316
3317#ifndef  BUCHBERGER_ALG
3318    if(isNolVector(curr_weight) == 0)
3319    {
3320      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
3321    }
3322    else
3323    {
3324      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
3325    }
3326#endif // BUCHBERGER_ALG
3327
3328    /* define a new ring that its ordering is "(a(curr_weight),lp) */
3329    //..25.03.03 VMrDefault(curr_weight);
3330    if (rParameter (currRing) != NULL)
3331    {
3332      DefRingPar(curr_weight);
3333    }
3334    else
3335    {
3336      rChangeCurrRing(VMrDefault(curr_weight));
3337    }
3338    newRing = currRing;
3339    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
3340
3341#ifdef TIME_TEST
3342    to=clock();
3343#endif
3344    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
3345#ifdef  BUCHBERGER_ALG
3346    M = MstdhomCC(Gomega1);
3347#else
3348    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
3349    delete hilb_func;
3350#endif // BUCHBERGER_ALG
3351#ifdef TIME_TEST
3352    xtstd=xtstd+clock()-to;
3353#endif
3354    /* change the ring to oldRing */
3355    rChangeCurrRing(oldRing);
3356    M1 =  idrMoveR(M, newRing,currRing);
3357    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
3358
3359#ifdef TIME_TEST
3360    to=clock();
3361#endif
3362    /* compute a reduced Groebner basis of <G> w.r.t. "newRing" */
3363    F = MLifttwoIdeal(Gomega2, M1, G);
3364#ifdef TIME_TEST
3365    xtlift=xtlift+clock()-to;
3366#endif
3367
3368    idDelete(&M1);
3369    idDelete(&G);
3370
3371    /* change the ring to newRing */
3372    rChangeCurrRing(newRing);
3373    F1 = idrMoveR(F, oldRing,currRing);
3374
3375#ifdef TIME_TEST
3376    to=clock();
3377#endif
3378    /* reduce the Groebner basis <G> w.r.t. new ring */
3379    G = kInterRedCC(F1, NULL);
3380#ifdef TIME_TEST
3381    xtred=xtred+clock()-to;
3382#endif
3383    idDelete(&F1);
3384
3385    if(endwalks == 1)
3386    {
3387      //Print("\n// ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3388      break;
3389    }
3390
3391    delete next_weight;
3392  }//while
3393
3394  delete ivNull;
3395
3396  if(tp_deg != 1)
3397  {
3398    //..25.03.03 VMrDefaultlp();//define and execute the ring "lp"
3399    if (rParameter (currRing) != NULL)
3400    {
3401      DefRingParlp();
3402    }
3403    else
3404    {
3405      VMrDefaultlp();
3406    }
3407    F1 = idrMoveR(G, newRing,currRing);
3408
3409    if(nnwinC == 0 || test_w_in_ConeCC(F1, pert_target_vector) != 1)
3410    {
3411      oldRing = currRing;
3412      rChangeCurrRing(newRing);
3413      G = idrMoveR(F1, oldRing,currRing);
3414      Print("\n// takes %d steps and calls the recursion of level %d:",
3415             nwalk, tp_deg-1);
3416
3417      F1 = LastGB(G,curr_weight, tp_deg-1);
3418    }
3419
3420    TargetRing = currRing;
3421    rChangeCurrRing(EXXRing);
3422    result = idrMoveR(F1, TargetRing,currRing);
3423  }
3424  else
3425  {
3426    if(nlast == 1)
3427    {
3428      //OMEGA_OVERFLOW_LASTGB:
3429      /*
3430      if(MivSame(curr_weight, iv_lp) == 1)
3431        if (rParameter(currRing) != NULL)
3432          DefRingParlp();
3433        else
3434          VMrDefaultlp();
3435      else
3436        if (rParameter(currRing) != NULL)
3437          DefRingPar(curr_weight);
3438        else
3439          VMrDefault(curr_weight);
3440      */
3441
3442        //..25.03.03 VMrDefaultlp();//define and execute the ring "lp"
3443        if (rParameter (currRing) != NULL)
3444        {
3445          DefRingParlp();
3446        }
3447        else
3448        {
3449          VMrDefaultlp();
3450        }
3451
3452      F1 = idrMoveR(G, newRing,currRing);
3453      //Print("\n// Apply \"std\" in ring r%d_%d = %s;\n", tp_deg, nwalk, rString(currRing));
3454
3455      G = MstdCC(F1);
3456      idDelete(&F1);
3457      newRing = currRing;
3458    }
3459
3460    rChangeCurrRing(EXXRing);
3461    result = idrMoveR(G, newRing,currRing);
3462  }
3463  delete target_weight;
3464  delete last_omega;
3465  delete iv_lp;
3466
3467  if(Overflow_Error == FALSE)
3468  {
3469    Overflow_Error = nError;
3470  }
3471  return(result);
3472}
3473
3474/**********************************************************
3475 * check whether a polynomial of G has least 4 monomials  *
3476 **********************************************************/
3477static int lengthpoly(ideal G)
3478{
3479  int i;
3480  for(i=IDELEMS(G)-1; i>=0; i--)
3481  {
3482    if((G->m[i]!=NULL) /* len >=0 */
3483       && (G->m[i]->next!=NULL) /* len >=1 */
3484       && (G->m[i]->next->next!=NULL) /* len >=2 */
3485       && (G->m[i]->next->next->next!=NULL) /* len >=3 */
3486       && (G->m[i]->next->next->next->next!=NULL) /* len >=4*/ )
3487    {
3488      return 1;
3489    }
3490  }
3491  return 0;
3492}
3493
3494/*****************************************
3495 * return maximal polynomial length of G *
3496 *****************************************/
3497static int maxlengthpoly(ideal G)
3498{
3499  int i,k,length=0;
3500  for(i=IDELEMS(G)-1; i>=0; i--)
3501  {
3502    k = pLength(G->m[i]);
3503    if(k>length)
3504    {
3505      length = k;
3506    }
3507  }
3508  return length;
3509}
3510
3511/*********************************************************
3512 * check whether a polynomial of G has least 2 monomials *
3513**********************************************************/
3514static int islengthpoly2(ideal G)
3515{
3516  int i;
3517  for(i=IDELEMS(G)-1; i>=0; i--)
3518  {
3519    if((G->m[i]!=NULL) /* len >=0 */
3520       && (G->m[i]->next!=NULL) /* len >=1 */
3521       && (G->m[i]->next->next!=NULL)) /* len >=2 */
3522    {
3523      return 1;
3524    }
3525  }
3526  return 0;
3527}
3528
3529
3530
3531/* Implementation of the improved Groebner walk algorithm which is written
3532   by Quoc-Nam Tran (2000).
3533   One perturbs the original target weight vector, only if
3534   the next intermediate weight vector is equal to the current target weight
3535   vector. This must be repeated until the wanted reduced Groebner basis
3536   to reach.
3537   If the numbers of variables is big enough, the representation of the origin
3538   weight vector may be very big. Therefore, it is possible the intermediate
3539   weight vector doesn't stay in the correct Groebner cone.
3540   In this case we have just a reduced Groebner basis of the given ideal
3541   with respect to another monomial order. Then we have to compute
3542   a wanted reduced Groebner basis of it with respect to the given order.
3543   At the following subroutine we use the improved Buchberger algorithm or
3544   the changed perturbation walk algorithm with a decrased degree.
3545 */
3546
3547/***************************************
3548 * return the initial term of an ideal *
3549 ***************************************/
3550static ideal idHeadCC(ideal h)
3551{
3552  int i, nH =IDELEMS(h);
3553
3554  ideal m = idInit(nH,h->rank);
3555
3556  for (i=nH-1;i>=0; i--)
3557  {
3558    if (h->m[i]!=NULL)
3559    {
3560      m->m[i]=pHead(h->m[i]);
3561    }
3562  }
3563  return m;
3564}
3565
3566/**********************************************
3567 * check whether two head-ideals are the same *
3568 **********************************************/
3569static inline int test_G_GB_walk(ideal H0, ideal H1)
3570{
3571  int i, nG = IDELEMS(H0);
3572
3573  if(nG != IDELEMS(H1))
3574  {
3575    return 0;
3576  }
3577  for(i=nG-1; i>=0; i--)
3578  {
3579/*
3580    poly t;
3581    if((t=pSub(pCopy(H0->m[i]), pCopy(H1->m[i]))) != NULL)
3582    {
3583      pDelete(&t);
3584      return 0;
3585    }
3586    pDelete(&t);
3587*/
3588    if(!pEqualPolys(H0->m[i],H1->m[i]))
3589    {
3590      return 0;
3591    }
3592  }
3593  return 1;
3594}
3595
3596//unused
3597/*****************************************************
3598 * find the maximal total degree of polynomials in G *
3599 *****************************************************/
3600/*
3601static int Trandegreebound(ideal G)
3602{
3603  int i, nG = IDELEMS(G);
3604  // int np=1;
3605  int nV = currRing->N;
3606  int degtmp, result = 0;
3607  intvec* ivUnit = Mivdp(nV);
3608
3609  for(i=nG-1; i>=0; i--)
3610  {
3611    // find the maximal total degree of the polynomial G[i]
3612    degtmp = MwalkWeightDegree(G->m[i], ivUnit);
3613    if(degtmp > result)
3614    {
3615      result = degtmp;
3616    }
3617  }
3618  delete ivUnit;
3619  return result;
3620}
3621*/
3622
3623//unused
3624/************************************************************************
3625 * perturb the weight vector iva w.r.t. the ideal G.                    *
3626 *  the monomial order of the current ring is the w_1 weight lex. order *
3627 *  define w := d^(n-1)w_1+ d^(n-2)w_2, ...+ dw_(n-1)+ w_n              *
3628 *  where d := 1 + max{totdeg(g):g in G}*m, or                          *
3629 *  d := (2*maxdeg*maxdeg + (nV+1)*maxdeg)*m;                           *
3630 ************************************************************************/
3631#if 0
3632static intvec* TranPertVector(ideal G, intvec* iva)
3633{
3634  BOOLEAN nError = Overflow_Error;
3635  Overflow_Error = FALSE;
3636
3637  int i, j;
3638  // int nG = IDELEMS(G);
3639  int nV = currRing->N;
3640
3641  // define the sequence which expresses the current monomial ordering
3642  // w_1 = iva; w_2 = (1,0,..,0); w_n = (0,...,0,1,0)
3643  intvec* ivMat = MivMatrixOrder(iva);
3644
3645  int  mtmp, m=(*iva)[0];
3646
3647  for(i=ivMat->length(); i>=0; i--)
3648  {
3649    mtmp = (*ivMat)[i];
3650    if(mtmp <0)
3651    {
3652      mtmp = -mtmp;
3653    }
3654    if(mtmp > m)
3655    {
3656      m = mtmp;
3657    }
3658  }
3659
3660  // define the maximal total degree of polynomials of G
3661  mpz_t ndeg;
3662  mpz_init(ndeg);
3663
3664 // 12 Juli 03
3665#ifndef UPPER_BOUND
3666  mpz_set_si(ndeg, Trandegreebound(G)+1);
3667#else
3668  mpz_t ztmp;
3669  mpz_init(ztmp);
3670
3671  mpz_t maxdeg;
3672  mpz_init_set_si(maxdeg, Trandegreebound(G));
3673
3674  //ndeg = (2*maxdeg*maxdeg + (nV+1)*maxdeg)*m;//Kalkbrenner (1999)
3675  mpz_pow_ui(ztmp, maxdeg, 2);
3676  mpz_mul_ui(ztmp, ztmp, 2);
3677  mpz_mul_ui(maxdeg, maxdeg, nV+1);
3678  mpz_add(ndeg, ztmp, maxdeg);
3679  mpz_mul_ui(ndeg, ndeg, m);
3680
3681  mpz_clear(ztmp);
3682
3683  //PrintS("\n// with the new upper degree bound (2d^2+(n+1)d)*m ");
3684  //Print("\n//         where d = %d, n = %d and bound = %d", maxdeg, nV, ndeg);
3685#endif //UPPER_BOUND
3686
3687#ifdef INVEPS_SMALL_IN_TRAN
3688  if(mpz_cmp_ui(ndeg, nV)>0 && nV > 3)
3689  {
3690    mpz_cdiv_q_ui(ndeg, ndeg, nV);
3691  }
3692 //PrintS("\n// choose the \"small\" inverse epsilon:");
3693 //mpz_out_str(stdout, 10, ndeg);
3694#endif
3695  mpz_t deg_tmp;
3696  mpz_init_set(deg_tmp, ndeg);
3697
3698  mpz_t *ivres=( mpz_t *) omAlloc(nV*sizeof(mpz_t));
3699  mpz_init_set_si(ivres[nV-1],1);
3700
3701  for(i=nV-2; i>=0; i--)
3702  {
3703    mpz_init_set(ivres[i], deg_tmp);
3704    mpz_mul(deg_tmp, deg_tmp, ndeg);
3705  }
3706
3707  mpz_t *ivtmp=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
3708  for(i=0; i<nV; i++)
3709  {
3710    mpz_init(ivtmp[i]);
3711  }
3712  mpz_t sing_int;
3713  mpz_init_set_ui(sing_int,  2147483647);
3714
3715  intvec* repr_vector = new intvec(nV);
3716
3717  // define ivtmp := ndeg^(n-1).w_1 + ndeg^(n-2).w_2 + ... + w_n
3718  for(i=0; i<nV; i++)
3719  {
3720    for(j=0; j<nV; j++)
3721    {
3722      if( (*ivMat)[i*nV+j] >= 0 )
3723      {
3724        mpz_mul_ui(ivres[i], ivres[i], (*ivMat)[i*nV+j]);
3725      }
3726      else
3727      {
3728        mpz_mul_ui(ivres[i], ivres[i], -(*ivMat)[i*nV+j]);
3729        mpz_neg(ivres[i], ivres[i]);
3730      }
3731      mpz_add(ivtmp[j], ivtmp[j], ivres[i]);
3732    }
3733  }
3734  delete ivMat;
3735
3736  int ntrue=0;
3737  for(i=0; i<nV; i++)
3738  {
3739    (*repr_vector)[i] = mpz_get_si(ivtmp[i]);
3740    if(mpz_cmp(ivtmp[i], sing_int)>=0)
3741    {
3742      ntrue++;
3743      if(Overflow_Error == FALSE)
3744      {
3745        Overflow_Error = TRUE;
3746
3747        PrintS("\n// ** OVERFLOW in \"Repr.Vector\": ");
3748        mpz_out_str( stdout, 10, ivtmp[i]);
3749        PrintS(" is greater than 2147483647 (max. integer representation)");
3750        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repr_vector)[i]);
3751      }
3752    }
3753  }
3754  if(Overflow_Error == TRUE)
3755  {
3756    ivString(repr_vector, "repvector");
3757    Print("\n// %d element(s) of it are overflow!!", ntrue);
3758  }
3759
3760  if(Overflow_Error == FALSE)
3761    Overflow_Error=nError;
3762
3763  omFree(ivres);
3764  omFree(ivtmp);
3765
3766  mpz_clear(sing_int);
3767  mpz_clear(deg_tmp);
3768  mpz_clear(ndeg);
3769
3770  return repr_vector;
3771}
3772#endif
3773
3774//unused
3775#if 0
3776static intvec* TranPertVector_lp(ideal G)
3777{
3778  BOOLEAN nError = Overflow_Error;
3779  Overflow_Error = FALSE;
3780  // int j, nG = IDELEMS(G);
3781  int i;
3782  int nV = currRing->N;
3783
3784  // define the maximal total degree of polynomials of G
3785  mpz_t ndeg;
3786  mpz_init(ndeg);
3787
3788 // 12 Juli 03
3789#ifndef UPPER_BOUND
3790  mpz_set_si(ndeg, Trandegreebound(G)+1);
3791#else
3792  mpz_t ztmp;
3793  mpz_init(ztmp);
3794
3795  mpz_t maxdeg;
3796  mpz_init_set_si(maxdeg, Trandegreebound(G));
3797
3798  //ndeg = (2*maxdeg*maxdeg + (nV+1)*maxdeg);//Kalkbrenner (1999)
3799  mpz_pow_ui(ztmp, maxdeg, 2);
3800  mpz_mul_ui(ztmp, ztmp, 2);
3801  mpz_mul_ui(maxdeg, maxdeg, nV+1);
3802  mpz_add(ndeg, ztmp, maxdeg);
3803  // PrintS("\n// with the new upper degree bound (2d^2+(n+1)d)*m ");
3804  // Print("\n//         where d = %d, n = %d and bound = %d",
3805  // mpz_get_si(maxdeg), nV, mpz_get_si(ndeg));
3806
3807 mpz_clear(ztmp);
3808
3809#endif
3810
3811#ifdef INVEPS_SMALL_IN_TRAN
3812 if(mpz_cmp_ui(ndeg, nV)>0 && nV > 3)
3813    mpz_cdiv_q_ui(ndeg, ndeg, nV);
3814
3815 //PrintS("\n// choose the \"small\" inverse epsilon:");
3816 // mpz_out_str(stdout, 10, ndeg);
3817#endif
3818
3819  mpz_t deg_tmp;
3820  mpz_init_set(deg_tmp, ndeg);
3821
3822  mpz_t *ivres=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
3823  mpz_init_set_si(ivres[nV-1], 1);
3824
3825  for(i=nV-2; i>=0; i--)
3826  {
3827    mpz_init_set(ivres[i], deg_tmp);
3828    mpz_mul(deg_tmp, deg_tmp, ndeg);
3829  }
3830
3831  mpz_t sing_int;
3832  mpz_init_set_ui(sing_int,  2147483647);
3833
3834  intvec* repr_vector = new intvec(nV);
3835  int ntrue=0;
3836  for(i=0; i<nV; i++)
3837  {
3838    (*repr_vector)[i] = mpz_get_si(ivres[i]);
3839
3840    if(mpz_cmp(ivres[i], sing_int)>=0)
3841    {
3842      ntrue++;
3843      if(Overflow_Error == FALSE)
3844      {
3845        Overflow_Error = TRUE;
3846        PrintS("\n// ** OVERFLOW in \"Repr.Vector\": ");
3847        mpz_out_str( stdout, 10, ivres[i]);
3848        PrintS(" is greater than 2147483647 (max. integer representation)");
3849        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repr_vector)[i]);
3850      }
3851    }
3852  }
3853  if(Overflow_Error == TRUE)
3854  {
3855    ivString(repr_vector, "repvector");
3856    Print("\n// %d element(s) of it are overflow!!", ntrue);
3857  }
3858  if(Overflow_Error == FALSE)
3859    Overflow_Error = nError;
3860
3861  omFree(ivres);
3862
3863  mpz_clear(ndeg);
3864  mpz_clear(sing_int);
3865
3866  return repr_vector;
3867}
3868#endif
3869
3870//unused
3871#if 0
3872static intvec* RepresentationMatrix_Dp(ideal G, intvec* M)
3873{
3874  BOOLEAN nError = Overflow_Error;
3875  Overflow_Error = FALSE;
3876
3877  int i, j;
3878  int nV = currRing->N;
3879
3880  intvec* ivUnit = Mivdp(nV);
3881  int degtmp, maxdeg = 0;
3882
3883  for(i=IDELEMS(G)-1; i>=0; i--)
3884  {
3885    // find the maximal total degree of the polynomial G[i]
3886    degtmp = MwalkWeightDegree(G->m[i], ivUnit);
3887    if(degtmp > maxdeg)
3888      maxdeg = degtmp;
3889  }
3890
3891  mpz_t ztmp;
3892  mpz_init_set_si(ztmp, maxdeg);
3893  mpz_t *ivres=(mpz_t *)omAlloc(nV*sizeof(mpz_t));
3894  mpz_init_set_si(ivres[nV-1], 1); // (*ivres)[nV-1] = 1;
3895
3896  for(i=nV-2; i>=0; i--)
3897  {
3898    mpz_init_set(ivres[i], ztmp); //(*ivres)[i] = ztmp;
3899    mpz_mul_ui(ztmp, ztmp, maxdeg); //ztmp *=maxdeg;
3900  }
3901
3902  mpz_t *ivtmp=(mpz_t*)omAlloc(nV*sizeof(mpz_t));
3903  for(i=0; i<nV; i++)
3904    mpz_init(ivtmp[i]);
3905
3906  // define ivtmp := ndeg^(n-1).w_1 + ndeg^(n-2).w_2 + ... + w_n
3907  for(i=0; i<nV; i++)
3908    for(j=0; j<nV; j++)
3909    {
3910      if((*M)[i*nV+j] < 0)
3911      {
3912        mpz_mul_ui(ztmp, ivres[i], -(*M)[i*nV+j]);
3913        mpz_neg(ztmp, ztmp);
3914      }
3915      else
3916        mpz_mul_ui(ztmp, ivres[i], (*M)[i*nV+j]);
3917
3918      mpz_add(ivtmp[j], ivtmp[j], ztmp);
3919    }
3920  delete ivres;
3921  mpz_t sing_int;
3922  mpz_init_set_ui(sing_int,  2147483647);
3923
3924  int ntrue=0;
3925  intvec* repvector = new intvec(nV);
3926  for(i=0; i<nV; i++)
3927  {
3928    (*repvector)[i] = mpz_get_si(ivtmp[i]);
3929    if(mpz_cmp(ivtmp[i], sing_int)>0)
3930    {
3931      ntrue++;
3932      if(Overflow_Error == FALSE)
3933      {
3934        Overflow_Error = TRUE;
3935        PrintS("\n// ** OVERFLOW in \"Repr.Matrix\": ");
3936        mpz_out_str( stdout, 10, ivtmp[i]);
3937        PrintS(" is greater than 2147483647 (max. integer representation)");
3938        Print("\n//  So vector[%d] := %d is wrong!!\n",i+1,(*repvector)[i]);
3939      }
3940    }
3941  }
3942  if(Overflow_Error == TRUE)
3943  {
3944    ivString(repvector, "repvector");
3945    Print("\n// %d element(s) of it are overflow!!", ntrue);
3946  }
3947
3948  if(Overflow_Error == FALSE)
3949    Overflow_Error = nError;
3950
3951  mpz_clear(sing_int);
3952  mpz_clear(ztmp);
3953  omFree(ivtmp);
3954  omFree(ivres);
3955  return repvector;
3956}
3957#endif
3958
3959/*****************************************************************************
3960 * The following subroutine is the implementation of our first improved      *
3961 * Groebner walk algorithm, i.e. the first altervative algorithm.            *
3962 * First we use the Grobner walk algorithm and then we call the changed      *
3963 * perturbation walk algorithm with decreased degree, if an intermediate     *
3964 * weight vector is equal to the current target weight vector.               *
3965 * This call will be only repeated until we get the wanted reduced Groebner  *
3966 * basis or n times, where n is the numbers of variables.                    *
3967 *****************************************************************************/
3968
3969// npwinc = 0, if curr_weight doesn't stay in the correct Groebner cone
3970static ideal Rec_LastGB(ideal G, intvec* curr_weight,
3971                        intvec* orig_target_weight, int tp_deg, int npwinc)
3972{
3973  BOOLEAN nError = Overflow_Error;
3974  Overflow_Error = FALSE;
3975  // BOOLEAN nOverflow_Error = FALSE;
3976
3977#ifdef TIME_TEST
3978  clock_t tproc=0;
3979  clock_t tinput = clock();
3980#endif
3981
3982  int i,  nV = currRing->N;
3983  int nwalk=0, endwalks=0, nnwinC=1;
3984  int nlast = 0;
3985  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
3986  ring newRing, oldRing, TargetRing;
3987  intvec* iv_M_lp;
3988  intvec* target_weight;
3989  intvec* ivNull = new intvec(nV); //define (0,...,0)
3990  ring EXXRing = currRing;
3991  //int NEG=0; //19 juni 03
3992  intvec* next_weight;
3993#ifndef  BUCHBERGER_ALG
3994  //08 Juli 03
3995  intvec* hilb_func;
3996#endif
3997  // to avoid (1,0,...,0) as the target vector
3998  intvec* last_omega = new intvec(nV);
3999  for(i=nV-1; i>0; i--)
4000    (*last_omega)[i] = 1;
4001  (*last_omega)[0] = 10000;
4002
4003  BOOLEAN isGB = FALSE;
4004
4005  // compute a pertubed weight vector of the target weight vector
4006  if(tp_deg > 1 && tp_deg <= nV)
4007  {
4008    ideal H0 = idHeadCC(G);
4009
4010    if (rParameter (currRing) != NULL)
4011    {
4012      DefRingParlp();
4013    }
4014    else
4015    {
4016      VMrDefaultlp();
4017    }
4018    TargetRing = currRing;
4019    ssG = idrMoveR(G,EXXRing,currRing);
4020
4021    ideal H0_tmp = idrMoveR(H0,EXXRing,currRing);
4022    ideal H1 = idHeadCC(ssG);
4023
4024    // Apply Lemma 2.2 in Collart et. al (1997) to check whether cone(k-1) is equal to cone(k)
4025    if(test_G_GB_walk(H0_tmp,H1)==1)
4026    {
4027      idDelete(&H0_tmp);
4028      idDelete(&H1);
4029      G = ssG;
4030      ssG = NULL;
4031      newRing = currRing;
4032      delete ivNull;
4033
4034      if(npwinc != 0)
4035      {
4036        goto LastGB_Finish;
4037      }
4038      else
4039      {
4040        isGB = TRUE;
4041        goto KSTD_Finish;
4042      }
4043    }
4044    idDelete(&H0_tmp);
4045    idDelete(&H1);
4046
4047    iv_M_lp = MivMatrixOrderlp(nV);
4048    target_weight  = MPertVectors(ssG, iv_M_lp, tp_deg);
4049    delete iv_M_lp;
4050    //PrintS("\n// Input is not GB!!");
4051    rChangeCurrRing(EXXRing);
4052    G = idrMoveR(ssG, TargetRing,currRing);
4053
4054    if(Overflow_Error == TRUE)
4055    {
4056      //nOverflow_Error = Overflow_Error;
4057      //NEG = 1;
4058      newRing = currRing;
4059      goto JUNI_STD;
4060    }
4061  }
4062
4063  while(1)
4064  {
4065    nwalk ++;
4066    nstep++;
4067
4068    if(nwalk==1)
4069    {
4070      goto FIRST_STEP;
4071    }
4072#ifdef TIME_TEST
4073    to=clock();
4074#endif
4075    // compute an initial form ideal of <G> w.r.t. "curr_vector"
4076    Gomega = MwalkInitialForm(G, curr_weight);
4077#ifdef TIME_TEST
4078    xtif=xtif+clock()-to;
4079#endif
4080
4081#ifndef  BUCHBERGER_ALG
4082    if(isNolVector(curr_weight) == 0)
4083    {
4084      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
4085    }
4086    else
4087    {
4088      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
4089    }
4090#endif // BUCHBERGER_ALG
4091
4092    oldRing = currRing;
4093
4094    // defiNe a new ring that its ordering is "(a(curr_weight),lp)
4095    if (rParameter(currRing) != NULL)
4096    {
4097      DefRingPar(curr_weight);
4098    }
4099    else
4100    {
4101      rChangeCurrRing(VMrDefault(curr_weight));
4102    }
4103    newRing = currRing;
4104    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
4105#ifdef TIME_TEST
4106    to=clock();
4107#endif
4108    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
4109#ifdef  BUCHBERGER_ALG
4110    M = MstdhomCC(Gomega1);
4111#else
4112    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
4113    delete hilb_func;
4114#endif // BUCHBERGER_ALG
4115#ifdef TIME_TEST
4116    xtstd=xtstd+clock()-to;
4117#endif
4118    // change the ring to oldRing
4119    rChangeCurrRing(oldRing);
4120    M1 =  idrMoveR(M, newRing,currRing);
4121    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
4122
4123#ifdef TIME_TEST
4124     to=clock();
4125#endif
4126    // compute a reduced Groebner basis of <G> w.r.t. "newRing" by the lifting process
4127    F = MLifttwoIdeal(Gomega2, M1, G);
4128#ifdef TIME_TEST
4129    xtlift=xtlift+clock()-to;
4130#endif
4131    idDelete(&M1);
4132    idDelete(&Gomega2);
4133    idDelete(&G);
4134
4135    // change the ring to newRing
4136    rChangeCurrRing(newRing);
4137    F1 = idrMoveR(F, oldRing,currRing);
4138
4139#ifdef TIME_TEST
4140    to=clock();
4141#endif
4142    // reduce the Groebner basis <G> w.r.t. new ring
4143    G = kInterRedCC(F1, NULL);
4144#ifdef TIME_TEST
4145    xtred=xtred+clock()-to;
4146#endif
4147    idDelete(&F1);
4148
4149    if(endwalks == 1)
4150    {
4151      break;
4152    }
4153  FIRST_STEP:
4154#ifdef TIME_TEST
4155    to=clock();
4156#endif
4157    Overflow_Error = FALSE;
4158    // compute a next weight vector
4159    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
4160#ifdef TIME_TEST
4161    xtnw=xtnw+clock()-to;
4162#endif
4163#ifdef PRINT_VECTORS
4164    MivString(curr_weight, target_weight, next_weight);
4165#endif
4166    if(Overflow_Error == TRUE)
4167    {
4168      //PrintS("\n// ** The next vector does NOT stay in Cone!!\n");
4169#ifdef TEST_OVERFLOW
4170      goto  LastGB_Finish;
4171#endif
4172
4173      nnwinC = 0;
4174      if(tp_deg == nV)
4175      {
4176        nlast = 1;
4177      }
4178      delete next_weight;
4179      break;
4180    }
4181
4182    if(MivComp(next_weight, ivNull) == 1)
4183    {
4184      //newRing = currRing;
4185      delete next_weight;
4186      break;
4187    }
4188
4189    if(MivComp(next_weight, target_weight) == 1)
4190    {
4191      if(tp_deg == nV)
4192      {
4193        endwalks = 1;
4194      }
4195      else
4196      {
4197        // REC_LAST_GB_ALT2:
4198        //nOverflow_Error = Overflow_Error;
4199#ifdef TIME_TEST
4200        tproc=tproc+clock()-tinput;
4201#endif
4202
4203        /*Print("\n// takes %d steps and calls \"Rec_LastGB\" (%d):",
4204        nwalk, tp_deg+1);
4205        */
4206        G = Rec_LastGB(G,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
4207        newRing = currRing;
4208        delete next_weight;
4209        break;
4210      }
4211    }
4212
4213    for(i=nV-1; i>=0; i--)
4214    {
4215      (*curr_weight)[i] = (*next_weight)[i];
4216    }
4217    delete next_weight;
4218  }//while
4219
4220  delete ivNull;
4221
4222  if(tp_deg != nV)
4223  {
4224    newRing = currRing;
4225
4226    if (rParameter(currRing) != NULL)
4227    {
4228      DefRingParlp();
4229    }
4230    else
4231    {
4232      VMrDefaultlp();
4233    }
4234    F1 = idrMoveR(G, newRing,currRing);
4235
4236    if(nnwinC == 0 || test_w_in_ConeCC(F1, target_weight) != 1 )
4237    {
4238      // nOverflow_Error = Overflow_Error;
4239      //Print("\n//  takes %d steps and calls \"Rec_LastGB (%d):", tp_deg+1);
4240#ifdef TIME_TEST
4241      tproc=tproc+clock()-tinput;
4242#endif
4243      F1 = Rec_LastGB(F1,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
4244    }
4245    delete target_weight;
4246
4247    TargetRing = currRing;
4248    rChangeCurrRing(EXXRing);
4249    result = idrMoveR(F1, TargetRing,currRing);
4250  }
4251  else
4252  {
4253    if(nlast == 1)
4254    {
4255      JUNI_STD:
4256
4257      newRing = currRing;
4258      if (rParameter(currRing) != NULL)
4259      {
4260        DefRingParlp();
4261      }
4262      else
4263      {
4264        VMrDefaultlp();
4265      }
4266      KSTD_Finish:
4267      if(isGB == FALSE)
4268      {
4269        F1 = idrMoveR(G, newRing,currRing);
4270      }
4271      else
4272      {
4273        F1 = G;
4274      }
4275#ifdef TIME_TEST
4276      to=clock();
4277#endif
4278      // Print("\n// apply the Buchberger's alg in ring = %s",rString(currRing));
4279      // idElements(F1, "F1");
4280      G = MstdCC(F1);
4281#ifdef TIME_TEST
4282      xtextra=xtextra+clock()-to;
4283#endif
4284
4285
4286      idDelete(&F1);
4287      newRing = currRing;
4288    }
4289
4290    LastGB_Finish:
4291    rChangeCurrRing(EXXRing);
4292    result = idrMoveR(G, newRing,currRing);
4293  }
4294
4295  if(Overflow_Error == FALSE)
4296    {
4297    Overflow_Error=nError;
4298    }
4299#ifdef TIME_TEST
4300   //Print("\n// \"Rec_LastGB\" (%d) took %d steps and %.2f sec.Overflow_Error (%d)", tp_deg, nwalk, ((double) tproc)/1000000, nOverflow_Error);
4301#endif
4302  return(result);
4303}
4304
4305/* The following subroutine is the implementation of our second improved
4306   Groebner walk algorithm, i.e. the second altervative algorithm.
4307   First we use the Grobner walk algorithm and then we call the changed
4308   perturbation walk algorithm with increased degree, if an intermediate
4309   weight vector is equal to the current target weight vector.
4310   This call will be only repeated until we get the wanted reduced Groebner
4311   basis or n times, where n is the numbers of variables.
4312*/
4313
4314/******************************
4315 * walk + recursive LastGB    *
4316 ******************************/
4317ideal MAltwalk2(ideal Go, intvec* curr_weight, intvec* target_weight)
4318{
4319  Set_Error(FALSE);
4320  Overflow_Error = FALSE;
4321  //BOOLEAN nOverflow_Error = FALSE;
4322  //Print("// pSetm_Error = (%d)", ErrorCheck());
4323#ifdef TIME_TEST
4324  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
4325  xftinput = clock();
4326  clock_t tostd, tproc;
4327#endif
4328  nstep = 0;
4329  int i, nV = currRing->N;
4330  int nwalk=0, endwalks=0;
4331  // int nhilb = 1;
4332  ideal Gomega, M, F, Gomega1, Gomega2, M1, F1, G;
4333  //ideal  G1;
4334  //ring endRing;
4335  ring newRing, oldRing;
4336  intvec* ivNull = new intvec(nV);
4337  intvec* next_weight;
4338  //intvec* extra_curr_weight = new intvec(nV);
4339  //intvec* hilb_func;
4340  intvec* exivlp = Mivlp(nV);
4341  ring XXRing = currRing;
4342
4343  //Print("\n// ring r_input = %s;", rString(currRing));
4344#ifdef TIME_TEST
4345  to = clock();
4346#endif
4347  /* compute the reduced Groebner basis of the given ideal w.r.t.
4348     a "fast" monomial order, e.g. degree reverse lex. order (dp) */
4349  G = MstdCC(Go);
4350#ifdef TIME_TEST
4351  tostd=clock()-to;
4352
4353  Print("\n// Computation of the first std took = %.2f sec",
4354        ((double) tostd)/1000000);
4355#endif
4356  if(currRing->order[0] == ringorder_a)
4357  {
4358    goto NEXT_VECTOR;
4359  }
4360  while(1)
4361  {
4362    nwalk ++;
4363    nstep ++;
4364#ifdef TIME_TEST
4365    to = clock();
4366#endif
4367    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
4368    Gomega = MwalkInitialForm(G, curr_weight);
4369#ifdef TIME_TEST
4370    xtif=xtif+clock()-to;
4371#endif
4372/*
4373    if(Overflow_Error == TRUE)
4374    {
4375      for(i=nV-1; i>=0; i--)
4376        (*curr_weight)[i] = (*extra_curr_weight)[i];
4377      delete extra_curr_weight;
4378      goto LAST_GB_ALT2;
4379    }
4380*/
4381    oldRing = currRing;
4382
4383    /* define a new ring that its ordering is "(a(curr_weight),lp) */
4384    if (rParameter(currRing) != NULL)
4385    {
4386      DefRingPar(curr_weight);
4387    }
4388    else
4389    {
4390      rChangeCurrRing(VMrDefault(curr_weight));
4391    }
4392    newRing = currRing;
4393    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
4394#ifdef TIME_TEST
4395    to = clock();
4396#endif
4397    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
4398    M = MstdhomCC(Gomega1);
4399#ifdef TIME_TEST
4400    xtstd=xtstd+clock()-to;
4401#endif
4402    /* change the ring to oldRing */
4403    rChangeCurrRing(oldRing);
4404    M1 =  idrMoveR(M, newRing,currRing);
4405    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
4406#ifdef TIME_TEST
4407    to = clock();
4408#endif
4409    /* compute the reduced Groebner basis of <G> w.r.t. "newRing"
4410       by the liftig process */
4411    F = MLifttwoIdeal(Gomega2, M1, G);
4412#ifdef TIME_TEST
4413    xtlift=xtlift+clock()-to;
4414#endif
4415    idDelete(&M1);
4416    idDelete(&Gomega2);
4417    idDelete(&G);
4418
4419    /* change the ring to newRing */
4420    rChangeCurrRing(newRing);
4421    F1 = idrMoveR(F, oldRing,currRing);
4422#ifdef TIME_TEST
4423    to = clock();
4424#endif
4425    /* reduce the Groebner basis <G> w.r.t. newRing */
4426    G = kInterRedCC(F1, NULL);
4427#ifdef TIME_TEST
4428    xtred=xtred+clock()-to;
4429#endif
4430    idDelete(&F1);
4431
4432    if(endwalks == 1)
4433      break;
4434
4435  NEXT_VECTOR:
4436#ifdef TIME_TEST
4437    to = clock();
4438#endif
4439    /* compute a next weight vector */
4440    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
4441#ifdef TIME_TEST
4442    xtnw=xtnw+clock()-to;
4443#endif
4444#ifdef PRINT_VECTORS
4445    MivString(curr_weight, target_weight, next_weight);
4446#endif
4447
4448    if(Overflow_Error == TRUE)
4449    {
4450      /*
4451        ivString(next_weight, "omega");
4452        PrintS("\n// ** The weight vector does NOT stay in Cone!!\n");
4453      */
4454#ifdef TEST_OVERFLOW
4455      goto  TEST_OVERFLOW_OI;
4456#endif
4457
4458      newRing = currRing;
4459      if (rParameter(currRing) != NULL)
4460      {
4461        DefRingPar(target_weight);
4462      }
4463      else
4464      {
4465        rChangeCurrRing(VMrDefault(target_weight)); // Aenderung
4466      }
4467      F1 = idrMoveR(G, newRing,currRing);
4468      G = MstdCC(F1);
4469      idDelete(&F1);
4470      newRing = currRing;
4471      break;
4472    }
4473
4474    if(MivComp(next_weight, ivNull) == 1)
4475    {
4476      newRing = currRing;
4477      delete next_weight;
4478      break;
4479    }
4480
4481    if(MivComp(next_weight, target_weight) == 1)
4482    {
4483      if(MivSame(target_weight, exivlp)==1)
4484      {
4485     // LAST_GB_ALT2:
4486        //nOverflow_Error = Overflow_Error;
4487#ifdef TIME_TEST
4488        tproc = clock()-xftinput;
4489#endif
4490        //Print("\n// takes %d steps and calls the recursion of level 2:",  nwalk);
4491        /* call the changed perturbation walk algorithm with degree 2 */
4492        G = Rec_LastGB(G, curr_weight, target_weight, 2,1);
4493        newRing = currRing;
4494        delete next_weight;
4495        break;
4496      }
4497      endwalks = 1;
4498    }
4499
4500    for(i=nV-1; i>=0; i--)
4501    {
4502      //(*extra_curr_weight)[i] = (*curr_weight)[i];
4503      (*curr_weight)[i] = (*next_weight)[i];
4504    }
4505    delete next_weight;
4506  }
4507#ifdef TEST_OVERFLOW
4508 TEST_OVERFLOW_OI:
4509#endif
4510  rChangeCurrRing(XXRing);
4511  G = idrMoveR(G, newRing,currRing);
4512  delete ivNull;
4513  delete exivlp;
4514
4515#ifdef TIME_TEST
4516  /*Print("\n// \"Main procedure\"  took %d steps dnd %.2f sec. Overflow_Error (%d)",
4517        nwalk, ((double) tproc)/1000000, nOverflow_Error);
4518*/
4519  TimeStringFractal(xftinput, tostd, xtif, xtstd, xtextra,xtlift, xtred,xtnw);
4520
4521  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
4522  //Print("\n// Overflow_Error? (%d)", nOverflow_Error);
4523  //Print("\n// Awalk2 took %d steps!!", nstep);
4524#endif
4525
4526  return(G);
4527}
4528
4529
4530/**************************************
4531 * perturb the matrix order of  "lex" *
4532 **************************************/
4533static intvec* NewVectorlp(ideal I)
4534{
4535  int nV = currRing->N;
4536  intvec* iv_wlp =  MivMatrixOrderlp(nV);
4537  intvec* result = Mfpertvector(I, iv_wlp);
4538  delete iv_wlp;
4539  return result;
4540}
4541
4542int ngleich;
4543intvec* Xsigma;
4544intvec* Xtau;
4545int xn;
4546intvec* Xivinput;
4547intvec* Xivlp;
4548
4549
4550/********************************
4551 * compute a next weight vector *
4552 ********************************/
4553static intvec* MWalkRandomNextWeight(ideal G, intvec* orig_M, intvec* target_weight,
4554       int weight_rad, int pert_deg)
4555{
4556  assume(currRing != NULL && orig_M != NULL &&
4557         target_weight != NULL && G->m[0] != NULL);
4558
4559  //BOOLEAN nError = Overflow_Error;
4560  Overflow_Error = FALSE;
4561
4562  BOOLEAN found_random_weight = FALSE;
4563  int i,nV = currRing->N;
4564  intvec* curr_weight = new intvec(nV);
4565
4566  for(i=0; i<nV; i++)
4567  {
4568    (*curr_weight)[i] = (*orig_M)[i];
4569  }
4570
4571  int k=0,weight_norm;
4572  intvec* next_weight;
4573  intvec* next_weight1 = MkInterRedNextWeight(curr_weight,target_weight,G);
4574  intvec* next_weight2 = new intvec(nV);
4575  intvec* result = new intvec(nV);
4576  intvec* curr_weight1;
4577  ideal G_test, G_test1, G_test2;
4578
4579  //try to find a random next weight vector "next_weight2"
4580  if(weight_rad > 0)
4581  {
4582    while(k<10)
4583    {
4584      weight_norm = 0;
4585      while(weight_norm == 0)
4586      {
4587        for(i=0; i<nV; i++)
4588        {
4589          (*next_weight2)[i] = rand() % 60000 - 30000;
4590          weight_norm = weight_norm + (*next_weight2)[i]*(*next_weight2)[i];
4591        }
4592        weight_norm = 1 + floor(sqrt(weight_norm));
4593      }
4594      for(i=0; i<nV; i++)
4595      {
4596        if((*next_weight2)[i] < 0)
4597        {
4598          (*next_weight2)[i] = 1 + (*curr_weight)[i] + floor(weight_rad*(*next_weight2)[i]/weight_norm);
4599        }
4600        else
4601        {
4602          (*next_weight2)[i] = (*curr_weight)[i] + floor(weight_rad*(*next_weight2)[i]/weight_norm);
4603        }
4604      }
4605      if(test_w_in_ConeCC(G,next_weight2) == 1)
4606      {
4607        if(maxlengthpoly(MwalkInitialForm(G,next_weight2))<2)
4608        {
4609          next_weight2 = MkInterRedNextWeight(next_weight2,target_weight,G);
4610        }
4611        G_test2 = MwalkInitialForm(G, next_weight2);
4612        found_random_weight = TRUE;
4613        break;
4614      }
4615      k++;
4616    }
4617  }
4618
4619  // compute "perturbed" next weight vector
4620  if(pert_deg > 1)
4621  {
4622    curr_weight1 = MPertVectors(G,orig_M,pert_deg);
4623    next_weight = MkInterRedNextWeight(curr_weight1,target_weight,G);
4624    delete curr_weight1;
4625  }
4626  else
4627  {
4628    next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
4629  }
4630  if(MivSame(curr_weight,next_weight)==1 || Overflow_Error == TRUE)
4631  {
4632    Overflow_Error = FALSE;
4633    delete next_weight;
4634    next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
4635  }
4636  G_test=MwalkInitialForm(G,next_weight);
4637  G_test1=MwalkInitialForm(G,next_weight1);
4638
4639  // compare next weights
4640  if(Overflow_Error == FALSE)
4641  {
4642    if(found_random_weight == TRUE)
4643    {
4644    // random next weight vector found
4645      if(G_test1->m[0] != NULL && maxlengthpoly(G_test1) < maxlengthpoly(G_test))
4646      {
4647        if(G_test2->m[0] != NULL && maxlengthpoly(G_test2) < maxlengthpoly(G_test1))
4648        {
4649          for(i=0; i<nV; i++)
4650          {
4651            (*result)[i] = (*next_weight2)[i];
4652          }
4653        }
4654        else
4655        {
4656          for(i=0; i<nV; i++)
4657          {
4658            (*result)[i] = (*next_weight1)[i];
4659          }
4660        }
4661      }
4662      else
4663      {
4664        if(G_test2->m[0] != NULL && maxlengthpoly(G_test2) < maxlengthpoly(G_test))
4665        {
4666          for(i=0; i<nV; i++)
4667          {
4668            (*result)[i] = (*next_weight2)[i];
4669          }
4670        }
4671        else
4672        {
4673          for(i=0; i<nV; i++)
4674          {
4675            (*result)[i] = (*next_weight)[i];
4676          }
4677        }
4678      }
4679    }
4680    else
4681    {
4682      // no random next weight vector found
4683      if(G_test1->m[0] != NULL && maxlengthpoly(G_test1) < maxlengthpoly(G_test))
4684      {
4685       for(i=0; i<nV; i++)
4686        {
4687          (*result)[i] = (*next_weight1)[i];
4688        }
4689      }
4690      else
4691      {
4692        for(i=0; i<nV; i++)
4693        {
4694          (*result)[i] = (*next_weight)[i];
4695        }
4696      }
4697    }
4698  }
4699  else
4700  {
4701    Overflow_Error = FALSE;
4702    if(found_random_weight == TRUE)
4703    {
4704      if(G_test2->m[0] != NULL && maxlengthpoly(G_test2) < maxlengthpoly(G_test))
4705      {
4706        for(i=1; i<nV; i++)
4707        {
4708          (*result)[i] = (*next_weight2)[i];
4709        }
4710      }
4711      else
4712      {
4713        for(i=0; i<nV; i++)
4714        {
4715          (*result)[i] = (*next_weight)[i];
4716        }
4717      }
4718    }
4719    else
4720    {
4721      for(i=0; i<nV; i++)
4722      {
4723        (*result)[i] = (*next_weight)[i];
4724      }
4725    }
4726  }
4727
4728  delete next_weight;
4729  delete next_weight2;
4730  idDelete(&G_test);
4731  idDelete(&G_test1);
4732  if(found_random_weight == TRUE)
4733  {
4734    idDelete(&G_test2);
4735  }
4736  if(test_w_in_ConeCC(G, result) == 1 && MivSame(curr_weight,result)==0)
4737  {
4738    delete curr_weight;
4739    delete next_weight1;
4740    return result;
4741  }
4742  else
4743  {
4744    delete curr_weight;
4745    delete result;
4746    return next_weight1;
4747  }
4748}
4749
4750
4751/***************************************************************************
4752 * The procedur REC_GB_Mwalk computes a GB for <G> w.r.t. the weight order *
4753 * otw, where G is a reduced GB w.r.t. the weight order cw.                *
4754 * The new procedure Mwalk calls REC_GB.                                   *
4755 ***************************************************************************/
4756static ideal REC_GB_Mwalk(ideal G, intvec* curr_weight, intvec* orig_target_weight,
4757                          int tp_deg, int npwinc)
4758{
4759  BOOLEAN nError = Overflow_Error;
4760  Overflow_Error = FALSE;
4761
4762  int i,  nV = currRing->N;
4763  int nwalk=0, endwalks=0, nnwinC=1, nlast = 0;
4764  ideal Gomega, M, F, Gomega1, Gomega2, M1,F1,result,ssG;
4765  ring newRing, oldRing, TargetRing;
4766  intvec* target_weight;
4767  intvec* ivNull = new intvec(nV);
4768#ifndef BUCHBERGER_ALG
4769  intvec* hilb_func;
4770  // to avoid (1,0,...,0) as the target vector
4771  intvec* last_omega = new intvec(nV);
4772  for(i=nV-1; i>0; i--)
4773  {
4774    (*last_omega)[i] = 1;
4775  }
4776  (*last_omega)[0] = 10000;
4777#endif
4778  BOOLEAN isGB = FALSE;
4779
4780  ring EXXRing = currRing;
4781
4782  // compute a pertubed weight vector of the target weight vector
4783  if(tp_deg > 1 && tp_deg <= nV)
4784  {
4785    ideal H0 = idHeadCC(G);
4786    if (rParameter(currRing) != NULL)
4787    {
4788      DefRingPar(orig_target_weight);
4789    }
4790    else
4791    {
4792      rChangeCurrRing(VMrDefault(orig_target_weight));
4793    }
4794    TargetRing = currRing;
4795    ssG = idrMoveR(G,EXXRing,currRing);
4796
4797    ideal H0_tmp = idrMoveR(H0,EXXRing,currRing);
4798    ideal H1 = idHeadCC(ssG);
4799    id_Delete(&H0,EXXRing);
4800
4801    if(test_G_GB_walk(H0_tmp,H1)==1)
4802    {
4803      //Print("\n//REC_GB_Mwalk: input in %d-th recursive is a GB!\n",tp_deg);
4804      idDelete(&H0_tmp);
4805      idDelete(&H1);
4806      G = ssG;
4807      ssG = NULL;
4808      newRing = currRing;
4809      delete ivNull;
4810      if(npwinc == 0)
4811      {
4812        isGB = TRUE;
4813        goto KSTD_Finish;
4814      }
4815      else
4816      {
4817        goto LastGB_Finish;
4818      }
4819    }
4820    idDelete(&H0_tmp);
4821    idDelete(&H1);
4822
4823    target_weight  = MPertVectors(ssG, MivMatrixOrder(orig_target_weight), tp_deg);
4824
4825    rChangeCurrRing(EXXRing);
4826    G = idrMoveR(ssG, TargetRing,currRing);
4827  }
4828
4829  while(1)
4830  {
4831    nwalk ++;
4832    nstep++;
4833    if(nwalk == 1)
4834    {
4835      goto NEXT_STEP;
4836    }
4837    //Print("\n//REC_GB_Mwalk: Entering the %d-th step in the %d-th recursive:\n",nwalk,tp_deg);
4838#ifdef TIME_TEST
4839    to = clock();
4840#endif
4841    // compute an initial form ideal of <G> w.r.t. "curr_vector"
4842    Gomega = MwalkInitialForm(G, curr_weight);
4843#ifdef TIME_TEST
4844    xtif = xtif + clock()-to;
4845#endif
4846
4847#ifndef  BUCHBERGER_ALG
4848    if(isNolVector(curr_weight) == 0)
4849    {
4850      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
4851    }
4852    else
4853    {
4854      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
4855    }
4856#endif
4857
4858    oldRing = currRing;
4859
4860    // define a new ring with ordering "(a(curr_weight),lp)
4861    if (rParameter(currRing) != NULL)
4862    {
4863      DefRingPar(curr_weight);
4864    }
4865    else
4866    {
4867      rChangeCurrRing(VMrDefault(curr_weight));
4868    }
4869    newRing = currRing;
4870    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
4871
4872#ifdef TIME_TEST
4873    to = clock();
4874#endif
4875    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
4876#ifdef  BUCHBERGER_ALG
4877    M = MstdhomCC(Gomega1);
4878#else
4879    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
4880    delete hilb_func;
4881#endif
4882#ifdef TIME_TEST
4883    xtstd = xtstd + clock() - to;
4884#endif
4885
4886    // change the ring to oldRing
4887    rChangeCurrRing(oldRing);
4888
4889    M1 =  idrMoveR(M, newRing,currRing);
4890    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
4891
4892#ifdef TIME_TEST
4893    to = clock();
4894#endif
4895    F = MLifttwoIdeal(Gomega2, M1, G);
4896#ifdef TIME_TEST
4897    xtlift = xtlift + clock() -to;
4898#endif
4899
4900    idDelete(&M1);
4901    idDelete(&Gomega2);
4902    idDelete(&G);
4903
4904
4905    // change the ring to newRing
4906    rChangeCurrRing(newRing);
4907    F1 = idrMoveR(F, oldRing,currRing);
4908
4909#ifdef TIME_TEST
4910    to = clock();
4911#endif
4912    // reduce the Groebner basis <G> w.r.t. new ring
4913    G = kInterRedCC(F1, NULL);
4914#ifdef TIME_TEST
4915    xtred = xtred + clock() -to;
4916#endif
4917
4918    idDelete(&F1);
4919
4920    if(endwalks == 1)
4921    {
4922      break;
4923    }
4924  NEXT_STEP:
4925#ifdef TIME_TEST
4926    to = clock();
4927#endif
4928    // compute a next weight vector
4929    intvec* next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
4930
4931
4932#ifdef TIME_TEST
4933    xtnw = xtnw + clock() - to;
4934#endif
4935
4936#ifdef PRINT_VECTORS
4937    MivString(curr_weight, target_weight, next_weight);
4938#endif
4939
4940    if(Overflow_Error == TRUE)
4941    {
4942      //PrintS("\n//REC_GB_Mwalk: The computed vector does NOT stay in the correct cone!!\n");
4943      nnwinC = 0;
4944      if(tp_deg == nV)
4945      {
4946        nlast = 1;
4947      }
4948      delete next_weight;
4949      break;
4950    }
4951    if(MivComp(next_weight, ivNull) == 1)
4952    {
4953      newRing = currRing;
4954      delete next_weight;
4955      break;
4956    }
4957
4958    if(MivComp(next_weight, target_weight) == 1)
4959    {
4960      if(tp_deg == nV)
4961      {
4962        endwalks = 1;
4963      }
4964      else
4965      {
4966        G = REC_GB_Mwalk(G,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
4967        newRing = currRing;
4968        delete next_weight;
4969        break;
4970      }
4971    }
4972
4973    for(i=nV-1; i>=0; i--)
4974    {
4975      (*curr_weight)[i] = (*next_weight)[i];
4976    }
4977    delete next_weight;
4978  }
4979
4980  delete ivNull;
4981
4982  if(tp_deg != nV)
4983  {
4984    newRing = currRing;
4985
4986    if (rParameter(currRing) != NULL)
4987    {
4988      DefRingPar(orig_target_weight);
4989    }
4990    else
4991    {
4992      rChangeCurrRing(VMrDefault(orig_target_weight));
4993    }
4994    F1 = idrMoveR(G, newRing,currRing);
4995
4996    if(nnwinC == 0)
4997    {
4998      F1 = REC_GB_Mwalk(F1,curr_weight, orig_target_weight, tp_deg+1,nnwinC);
4999    }
5000    else
5001    {
5002      if(test_w_in_ConeCC(F1, target_weight) != 1)
5003      {
5004        F1 = REC_GB_Mwalk(F1,curr_weight, orig_target_weight,tp_deg+1,nnwinC);
5005      }
5006    }
5007    delete target_weight;
5008
5009    TargetRing = currRing;
5010    rChangeCurrRing(EXXRing);
5011    result = idrMoveR(F1, TargetRing,currRing);
5012  }
5013  else
5014  {
5015    if(nlast == 1)
5016    {
5017      if (rParameter(currRing) != NULL)
5018      {
5019        DefRingPar(orig_target_weight);
5020      }
5021      else
5022      {
5023        rChangeCurrRing(VMrDefault(orig_target_weight));
5024      }
5025    KSTD_Finish:
5026      if(isGB == FALSE)
5027      {
5028        F1 = idrMoveR(G, newRing,currRing);
5029      }
5030      else
5031      {
5032        F1 = G;
5033      }
5034#ifdef TIME_TEST
5035      to=clock();
5036#endif
5037      // apply Buchberger alg to compute a red. GB of F1
5038      G = MstdCC(F1);
5039#ifdef TIME_TEST
5040      xtextra=clock()-to;
5041#endif
5042      idDelete(&F1);
5043      newRing = currRing;
5044    }
5045
5046  LastGB_Finish:
5047    rChangeCurrRing(EXXRing);
5048    result = idrMoveR(G, newRing,currRing);
5049  }
5050
5051  if(Overflow_Error == FALSE)
5052    {
5053    Overflow_Error = nError;
5054    }
5055#ifndef BUCHBERGER_ALG
5056  delete last_omega;
5057#endif
5058  return(result);
5059}
5060
5061
5062// THE NEW GROEBNER WALK ALGORITHM
5063// Groebnerwalk with a recursive "second" alternative GW, called REC_GB_Mwalk that only computes the last reduced GB
5064ideal MwalkAlt(ideal Go, intvec* curr_weight, intvec* target_weight)
5065{
5066  Set_Error(FALSE);
5067  Overflow_Error = FALSE;
5068  //Print("// pSetm_Error = (%d)", ErrorCheck());
5069
5070#ifdef TIME_TEST
5071  clock_t tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
5072  tinput = clock();
5073  clock_t tim;
5074  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
5075#endif
5076  nstep=0;
5077  int i;
5078  int nV = currRing->N;
5079  int nwalk=0;
5080  int endwalks=0;
5081
5082  ideal Gomega, M, F, Gomega1, Gomega2, M1, F1, G;
5083
5084  ring newRing, oldRing;
5085  intvec* ivNull = new intvec(nV);
5086  intvec* exivlp = Mivlp(nV);
5087#ifndef BUCHBERGER_ALG
5088  intvec* hilb_func;
5089#endif
5090  intvec* tmp_weight = new intvec(nV);
5091  for(i=nV-1; i>=0; i--)
5092    (*tmp_weight)[i] = (*curr_weight)[i];
5093
5094   // to avoid (1,0,...,0) as the target vector
5095  intvec* last_omega = new intvec(nV);
5096  for(i=nV-1; i>0; i--)
5097    (*last_omega)[i] = 1;
5098  (*last_omega)[0] = 10000;
5099
5100  ring XXRing = currRing;
5101
5102#ifdef TIME_TEST
5103  to = clock();
5104#endif
5105  // the monomial ordering of this current ring would be "dp"
5106  G = MstdCC(Go);
5107#ifdef TIME_TEST
5108  tostd = clock()-to;
5109#endif
5110
5111  if(currRing->order[0] == ringorder_a)
5112    goto NEXT_VECTOR;
5113
5114  while(1)
5115  {
5116    nwalk ++;
5117    nstep ++;
5118#ifdef TIME_TEST
5119    to = clock();
5120#endif
5121    // compute an initial form ideal of <G> w.r.t. "curr_vector"
5122    Gomega = MwalkInitialForm(G, curr_weight);
5123#ifdef TIME_TEST
5124    tif = tif + clock()-to;
5125#endif
5126    oldRing = currRing;
5127
5128    if(endwalks == 1)
5129    {
5130      /* compute a reduced Groebner basis of Gomega w.r.t. >>_cw by
5131         the recursive changed perturbation walk alg. */
5132#ifdef TIME_TEST
5133      tim = clock();
5134#endif
5135#ifdef CHECK_IDEAL_MWALK
5136        Print("\n// **** Groebnerwalk took %d steps and ", nwalk);
5137        PrintS("\n// **** call the rec. Pert. Walk to compute a red GB of:");
5138        idString(Gomega, "Gomega");
5139#endif
5140
5141      if(MivSame(exivlp, target_weight)==1)
5142        M = REC_GB_Mwalk(idCopy(Gomega), tmp_weight, curr_weight, 2,1);
5143      else
5144        goto NORMAL_GW;
5145#ifdef TIME_TEST
5146        Print("\n//  time for the last std(Gw)  = %.2f sec",
5147        ((double) (clock()-tim)/1000000));
5148#endif
5149/*
5150#ifdef CHECK_IDEAL_MWALK
5151      idElements(Gomega, "G_omega");
5152      headidString(Gomega, "Gw");
5153      idElements(M, "M");
5154      //headidString(M, "M");
5155#endif
5156*/
5157#ifdef TIME_TEST
5158      to = clock();
5159#endif
5160      F = MLifttwoIdeal(Gomega, M, G);
5161#ifdef TIME_TEST
5162      xtlift = xtlift + clock() - to;
5163#endif
5164
5165      idDelete(&Gomega);
5166      idDelete(&M);
5167      idDelete(&G);
5168
5169      oldRing = currRing;
5170
5171      // create a new ring newRing
5172       if (rParameter(currRing) != NULL)
5173       {
5174         DefRingPar(curr_weight);
5175       }
5176       else
5177       {
5178         rChangeCurrRing(VMrDefault(curr_weight));
5179       }
5180      newRing = currRing;
5181      F1 = idrMoveR(F, oldRing,currRing);
5182    }
5183    else
5184    {
5185    NORMAL_GW:
5186#ifndef  BUCHBERGER_ALG
5187      if(isNolVector(curr_weight) == 0)
5188      {
5189        hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
5190      }
5191      else
5192      {
5193        hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
5194      }
5195#endif // BUCHBERGER_ALG
5196
5197      // define a new ring that its ordering is "(a(curr_weight),lp)
5198      if (rParameter(currRing) != NULL)
5199      {
5200        DefRingPar(curr_weight);
5201      }
5202      else
5203      {
5204        rChangeCurrRing(VMrDefault(curr_weight));
5205      }
5206      newRing = currRing;
5207      Gomega1 = idrMoveR(Gomega, oldRing,currRing);
5208
5209#ifdef TIME_TEST
5210      to = clock();
5211#endif
5212      // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
5213#ifdef  BUCHBERGER_ALG
5214      M = MstdhomCC(Gomega1);
5215#else
5216      M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
5217      delete hilb_func;
5218#endif
5219#ifdef TIME_TEST
5220      tstd = tstd + clock() - to;
5221#endif
5222
5223      // change the ring to oldRing
5224      rChangeCurrRing(oldRing);
5225      M1 =  idrMoveR(M, newRing,currRing);
5226      Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
5227
5228#ifdef TIME_TEST
5229      to = clock();
5230#endif
5231      // compute a representation of the generators of submod (M) with respect
5232      // to those of mod (Gomega).
5233      // Gomega is a reduced Groebner basis w.r.t. the current ring.
5234      F = MLifttwoIdeal(Gomega2, M1, G);
5235#ifdef TIME_TEST
5236      tlift = tlift + clock() - to;
5237#endif
5238
5239      idDelete(&M1);
5240      idDelete(&Gomega2);
5241      idDelete(&G);
5242
5243      // change the ring to newRing
5244      rChangeCurrRing(newRing);
5245      F1 = idrMoveR(F, oldRing,currRing);
5246    }
5247
5248#ifdef TIME_TEST
5249    to = clock();
5250#endif
5251    // reduce the Groebner basis <G> w.r.t. new ring
5252    G = kInterRedCC(F1, NULL);
5253#ifdef TIME_TEST
5254    if(endwalks != 1)
5255    {
5256      tred = tred + clock() - to;
5257    }
5258    else
5259    {
5260      xtred = xtred + clock() - to;
5261    }
5262#endif
5263    idDelete(&F1);
5264    if(endwalks == 1)
5265    {
5266      break;
5267    }
5268  NEXT_VECTOR:
5269#ifdef TIME_TEST
5270    to = clock();
5271#endif
5272    // compute a next weight vector
5273    intvec* next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
5274#ifdef TIME_TEST
5275    tnw = tnw + clock() - to;
5276#endif
5277#ifdef PRINT_VECTORS
5278    MivString(curr_weight, target_weight, next_weight);
5279#endif
5280
5281    //if(test_w_in_ConeCC(G, next_weight) != 1)
5282    if(Overflow_Error == TRUE)
5283    {
5284      newRing = currRing;
5285      PrintS("\n// ** The computed vector does NOT stay in Cone!!\n");
5286
5287      if (rParameter(currRing) != NULL)
5288      {
5289        DefRingPar(target_weight);
5290      }
5291      else
5292      {
5293        rChangeCurrRing(VMrDefault(target_weight));
5294      }
5295      F1 = idrMoveR(G, newRing,currRing);
5296      G = MstdCC(F1);
5297      idDelete(&F1);
5298
5299      newRing = currRing;
5300      break;
5301    }
5302
5303    if(MivComp(next_weight, ivNull) == 1)
5304    {
5305      newRing = currRing;
5306      delete next_weight;
5307      break;
5308    }
5309    if(MivComp(next_weight, target_weight) == 1)
5310    {
5311      endwalks = 1;
5312    }
5313    for(i=nV-1; i>=0; i--)
5314    {
5315      (*tmp_weight)[i] = (*curr_weight)[i];
5316      (*curr_weight)[i] = (*next_weight)[i];
5317    }
5318    delete next_weight;
5319  }
5320  rChangeCurrRing(XXRing);
5321  G = idrMoveR(G, newRing,currRing);
5322
5323  delete tmp_weight;
5324  delete ivNull;
5325  delete exivlp;
5326
5327#ifdef TIME_TEST
5328  TimeString(tinput, tostd, tif, tstd, tlift, tred, tnw, nstep);
5329
5330  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
5331  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
5332#endif
5333  return(G);
5334}
5335
5336/*******************************
5337 * THE GROEBNER WALK ALGORITHM *
5338 *******************************/
5339ideal Mwalk(ideal Go, intvec* orig_M, intvec* target_M,
5340            ring baseRing, int reduction, int printout)
5341{
5342  // save current options
5343  BITSET save1 = si_opt_1;
5344  if(reduction == 0)
5345  {
5346    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
5347    si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
5348  }
5349  Set_Error(FALSE);
5350  Overflow_Error = FALSE;
5351  //BOOLEAN endwalks = FALSE;
5352#ifdef TIME_TEST
5353  clock_t tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
5354  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
5355  tinput = clock();
5356  clock_t tim;
5357#endif
5358  nstep=0;
5359  int i,nwalk;
5360  int nV = baseRing->N;
5361
5362  ideal Gomega, M, F, FF, Gomega1, Gomega2, M1;
5363  ring newRing;
5364  ring XXRing = baseRing;
5365  ring targetRing;
5366  intvec* ivNull = new intvec(nV);
5367  intvec* curr_weight = new intvec(nV);
5368  intvec* target_weight = new intvec(nV);
5369  intvec* exivlp = Mivlp(nV);
5370/*
5371  intvec* tmp_weight = new intvec(nV);
5372  for(i=0; i<nV; i++)
5373  {
5374    (*tmp_weight)[i] = (*orig_M)[i];
5375  }
5376*/
5377  for(i=0; i<nV; i++)
5378  {
5379    (*curr_weight)[i] = (*orig_M)[i];
5380    (*target_weight)[i] = (*target_M)[i];
5381  }
5382#ifndef BUCHBERGER_ALG
5383  intvec* hilb_func;
5384   // to avoid (1,0,...,0) as the target vector
5385  intvec* last_omega = new intvec(nV);
5386  for(i=nV-1; i>0; i--)
5387  {
5388    (*last_omega)[i] = 1;
5389  }
5390  (*last_omega)[0] = 10000;
5391#endif
5392  rComplete(currRing);
5393#ifdef CHECK_IDEAL_MWALK
5394  if(printout > 2)
5395  {
5396    idString(Go,"//** Mwalk: Go");
5397  }
5398#endif
5399
5400  if(target_M->length() == nV)
5401  {
5402   // define the target ring
5403    targetRing = VMrDefault(target_weight);
5404  }
5405  else
5406  {
5407    targetRing = VMatrDefault(target_M);
5408  }
5409  if(orig_M->length() == nV)
5410  {
5411    // define a new ring with ordering "(a(curr_weight),lp)
5412    //newRing = VMrDefault(curr_weight);
5413    newRing=VMrRefine(target_weight, curr_weight);
5414  }
5415  else
5416  {
5417    newRing = VMatrRefine(target_M,curr_weight); //newRing = VMatrDefault(orig_M);
5418  }
5419  rChangeCurrRing(newRing);
5420  if(printout > 2)
5421  {
5422    Print("\n//** Mrwalk: Current ring r = %s;\n", rString(currRing));
5423  }
5424#ifdef TIME_TEST
5425  to = clock();
5426#endif
5427  ideal G = MstdCC(idrMoveR(Go,baseRing,currRing));
5428#ifdef TIME_TEST
5429  tostd = clock()-to;
5430#endif
5431
5432  baseRing = currRing;
5433  nwalk = 0;
5434
5435  while(1)
5436  {
5437    nwalk ++;
5438    nstep ++;
5439    //compute an initial form ideal of <G> w.r.t. "curr_vector"
5440#ifdef TIME_TEST
5441    to = clock();
5442#endif
5443    Gomega = MwalkInitialForm(G, curr_weight);
5444#ifdef TIME_TEST
5445    tif = tif + clock()-to;
5446#endif
5447
5448#ifdef CHECK_IDEAL_MWALK
5449    if(printout > 1)
5450    {
5451      idString(Gomega,"//** Mwalk: Gomega");
5452    }
5453#endif
5454
5455    if(reduction == 0)
5456    {
5457      FF = middleOfCone(G,Gomega);
5458      if(FF != NULL)
5459      {
5460      PrintS("middle of Cone");
5461        idDelete(&G);
5462        G = idCopy(FF);
5463        idDelete(&FF);
5464        goto NEXT_VECTOR;
5465      }
5466    }
5467
5468#ifndef  BUCHBERGER_ALG
5469    if(isNolVector(curr_weight) == 0)
5470    {
5471      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
5472    }
5473    else
5474    {
5475      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
5476    }
5477#endif
5478
5479    if(nwalk == 1)
5480    {
5481      if(orig_M->length() == nV)
5482      {
5483        // define a new ring with ordering "(a(curr_weight),lp)
5484        //newRing = VMrDefault(curr_weight);
5485        newRing=VMrRefine(target_weight, curr_weight);
5486      }
5487      else
5488      {
5489        newRing = VMatrRefine(target_M,curr_weight);//newRing = VMatrDefault(orig_M);
5490      }
5491    }
5492    else
5493    {
5494     if(target_M->length() == nV)
5495     {
5496       //define a new ring with ordering "(a(curr_weight),lp)"
5497       //newRing = VMrDefault(curr_weight);
5498       newRing=VMrRefine(target_weight, curr_weight);
5499     }
5500     else
5501     {
5502       //define a new ring with matrix ordering
5503       newRing = VMatrRefine(target_M,curr_weight);
5504     }
5505    }
5506    rChangeCurrRing(newRing);
5507    if(printout > 2)
5508    {
5509      Print("\n// Current ring r = %s;\n", rString(currRing));
5510    }
5511    Gomega1 = idrMoveR(Gomega, baseRing,currRing);
5512    idDelete(&Gomega);
5513    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
5514#ifdef TIME_TEST
5515    to = clock();
5516#endif
5517#ifndef  BUCHBERGER_ALG
5518    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
5519    delete hilb_func;
5520#else
5521    M = kStd(Gomega1,NULL,testHomog,NULL,NULL,0,0,NULL);
5522#endif
5523#ifdef TIME_TEST
5524    tstd = tstd + clock() - to;
5525#endif
5526    idSkipZeroes(M);
5527#ifdef CHECK_IDEAL_MWALK
5528    if(printout > 2)
5529    {
5530      idString(M, "//** Mwalk: M");
5531    }
5532#endif
5533    //change the ring to baseRing
5534    rChangeCurrRing(baseRing);
5535    M1 =  idrMoveR(M, newRing,currRing);
5536    idDelete(&M);
5537    Gomega2 = idrMoveR(Gomega1, newRing,currRing);
5538    idDelete(&Gomega1);
5539#ifdef TIME_TEST
5540    to = clock();
5541#endif
5542    // compute a representation of the generators of submod (M) with respect to those of mod (Gomega),
5543    // where Gomega is a reduced Groebner basis w.r.t. the current ring
5544    F = MLifttwoIdeal(Gomega2, M1, G);
5545#ifdef TIME_TEST
5546    tlift = tlift + clock() - to;
5547#endif
5548#ifdef CHECK_IDEAL_MWALK
5549    if(printout > 2)
5550    {
5551      idString(F, "//** Mwalk: F");
5552    }
5553#endif
5554    idDelete(&Gomega2);
5555    idDelete(&M1);
5556
5557    rChangeCurrRing(newRing); // change the ring to newRing
5558    G = idrMoveR(F,baseRing,currRing);
5559    idDelete(&F);
5560    idSkipZeroes(G);
5561
5562#ifdef CHECK_IDEAL_MWALK
5563    if(printout > 2)
5564    {
5565      idString(G, "//** Mwalk: G");
5566    }
5567#endif
5568
5569    rChangeCurrRing(targetRing);
5570    G = idrMoveR(G,newRing,currRing);
5571    // test whether target cone is reached
5572    if(reduction !=0 && test_w_in_ConeCC(G,curr_weight) == 1)
5573    {
5574      baseRing = currRing;
5575      break;
5576      //endwalks = TRUE;
5577    }
5578
5579    rChangeCurrRing(newRing);
5580    G = idrMoveR(G,targetRing,currRing);
5581    baseRing = currRing;
5582
5583    NEXT_VECTOR:
5584#ifdef TIME_TEST
5585    to = clock();
5586#endif
5587    intvec* next_weight = MwalkNextWeightCC(curr_weight,target_weight,G);
5588#ifdef TIME_TEST
5589    tnw = tnw + clock() - to;
5590#endif
5591#ifdef PRINT_VECTORS
5592    if(printout > 0)
5593    {
5594      MivString(curr_weight, target_weight, next_weight);
5595    }
5596#endif
5597    if(reduction ==0)
5598    {
5599      if(MivComp(curr_weight,next_weight)==1)
5600      {
5601        break;
5602      }
5603    }
5604    if(MivComp(target_weight,curr_weight) == 1)
5605    {
5606      break;
5607    }
5608
5609    for(i=nV-1; i>=0; i--)
5610    {
5611      //(*tmp_weight)[i] = (*curr_weight)[i];
5612      (*curr_weight)[i] = (*next_weight)[i];
5613    }
5614    delete next_weight;
5615  }
5616  rChangeCurrRing(XXRing);
5617  ideal result = idrMoveR(G,baseRing,currRing);
5618  idDelete(&Go);
5619  idDelete(&G);
5620  //delete tmp_weight;
5621  delete ivNull;
5622  delete exivlp;
5623#ifndef BUCHBERGER_ALG
5624  delete last_omega;
5625#endif
5626#ifdef TIME_TEST
5627  TimeString(tinput, tostd, tif, tstd, tlift, tred, tnw, nstep);
5628  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
5629  //Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
5630#endif
5631  if(printout > 0)
5632  {
5633    Print("\n//** Mwalk: Groebner Walk took %d steps.\n", nstep);
5634  }
5635  si_opt_1 = save1; //set original options
5636  return(result);
5637}
5638
5639// THE RANDOM WALK ALGORITHM
5640ideal Mrwalk(ideal Go, intvec* orig_M, intvec* target_M, int weight_rad, int pert_deg,
5641             int reduction, int printout)
5642{
5643  BITSET save1 = si_opt_1; // save current options
5644  if(reduction == 0)
5645  {
5646    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
5647    si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
5648  }
5649
5650  Set_Error(FALSE);
5651  Overflow_Error = FALSE;
5652#ifdef TIME_TEST
5653  clock_t tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
5654  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
5655  tinput = clock();
5656  clock_t tim;
5657#endif
5658  nstep=0;
5659  int i,nwalk;//polylength;
5660  int nV = currRing->N;
5661
5662  //check that weight radius is valid
5663  if(weight_rad < 0)
5664  {
5665    WerrorS("Invalid radius.\n");
5666    return NULL;
5667  }
5668
5669  //check that perturbation degree is valid
5670  if(pert_deg > nV || pert_deg < 1)
5671  {
5672    WerrorS("Invalid perturbation degree.\n");
5673    return NULL;
5674  }
5675
5676  ideal Gomega, M, F,FF, Gomega1, Gomega2, M1;
5677  ring newRing;
5678  ring targetRing;
5679  ring baseRing = currRing;
5680  ring XXRing = currRing;
5681  intvec* iv_M;
5682  intvec* ivNull = new intvec(nV);
5683  intvec* curr_weight = new intvec(nV);
5684  intvec* target_weight = new intvec(nV);
5685  intvec* next_weight= new intvec(nV);
5686
5687  for(i=0; i<nV; i++)
5688  {
5689    (*curr_weight)[i] = (*orig_M)[i];
5690    (*target_weight)[i] = (*target_M)[i];
5691  }
5692
5693#ifndef BUCHBERGER_ALG
5694  intvec* hilb_func;
5695   // to avoid (1,0,...,0) as the target vector
5696  intvec* last_omega = new intvec(nV);
5697  for(i=nV-1; i>0; i--)
5698  {
5699    (*last_omega)[i] = 1;
5700  }
5701  (*last_omega)[0] = 10000;
5702#endif
5703  rComplete(currRing);
5704
5705  if(target_M->length() == nV)
5706  {
5707    targetRing = VMrDefault(target_weight); // define the target ring
5708  }
5709  else
5710  {
5711    targetRing = VMatrDefault(target_M);
5712  }
5713  if(orig_M->length() == nV)
5714  {
5715    //newRing = VMrDefault(curr_weight); // define a new ring with ordering "(a(curr_weight),lp)
5716    newRing=VMrRefine(target_weight, curr_weight);
5717  }
5718  else
5719  {
5720    newRing = VMatrRefine(target_M,curr_weight);//newRing = VMatrDefault(orig_M);
5721  }
5722  rChangeCurrRing(newRing);
5723#ifdef TIME_TEST
5724  to = clock();
5725#endif
5726  ideal G = MstdCC(idrMoveR(Go,baseRing,currRing));
5727#ifdef TIME_TEST
5728  tostd = clock()-to;
5729#endif
5730  baseRing = currRing;
5731  nwalk = 0;
5732
5733#ifdef TIME_TEST
5734  to = clock();
5735#endif
5736  Gomega = MwalkInitialForm(G, curr_weight); // compute an initial form ideal of <G> w.r.t. "curr_vector"
5737#ifdef TIME_TEST
5738  tif = tif + clock()-to; //time for computing initial form ideal
5739#endif
5740
5741  while(1)
5742  {
5743    nwalk ++;
5744    nstep ++;
5745#ifdef CHECK_IDEAL_MWALK
5746    if(printout > 1)
5747    {
5748      idString(Gomega,"//** Mrwalk: Gomega");
5749    }
5750#endif
5751    if(reduction == 0)
5752    {
5753      FF = middleOfCone(G,Gomega);
5754      if(FF != NULL)
5755      {
5756        idDelete(&G);
5757        G = idCopy(FF);
5758        idDelete(&FF);
5759        goto NEXT_VECTOR;
5760      }
5761    }
5762#ifndef  BUCHBERGER_ALG
5763    if(isNolVector(curr_weight) == 0)
5764    {
5765      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
5766    }
5767    else
5768    {
5769      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
5770    }
5771#endif
5772    if(nwalk == 1)
5773    {
5774      if(orig_M->length() == nV)
5775      {
5776        /*newRing = VMrDefault(curr_weight); // define a new ring with ordering "(a(curr_weight),lp)*/
5777        newRing=VMrRefine(target_weight, curr_weight);
5778      }
5779      else
5780      {
5781        newRing = VMatrRefine(target_M,curr_weight);//newRing = VMatrDefault(orig_M);
5782      }
5783    }
5784    else
5785    {
5786     if(target_M->length() == nV)
5787     {
5788       /*newRing = VMrDefault(curr_weight); // define a new ring with ordering "(a(curr_weight),lp)*/
5789       newRing=VMrRefine(target_weight, curr_weight);
5790     }
5791     else
5792     {
5793       newRing = VMatrRefine(target_M,curr_weight);
5794     }
5795    }
5796    rChangeCurrRing(newRing);
5797    Gomega1 = idrMoveR(Gomega, baseRing,currRing);
5798    idDelete(&Gomega);
5799    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
5800#ifdef TIME_TEST
5801    to = clock();
5802#endif
5803#ifndef BUCHBERGER_ALG
5804    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
5805    delete hilb_func;
5806#else
5807    M = kStd(Gomega1,NULL,testHomog,NULL,NULL,0,0,NULL);
5808#endif
5809#ifdef TIME_TEST
5810    tstd = tstd + clock() - to;
5811#endif
5812    idSkipZeroes(M);
5813#ifdef CHECK_IDEAL_MWALK
5814    if(printout > 2)
5815    {
5816      idString(M, "//** Mrwalk: M");
5817    }
5818#endif
5819    //change the ring to baseRing
5820    rChangeCurrRing(baseRing);
5821    M1 =  idrMoveR(M, newRing,currRing);
5822    idDelete(&M);
5823    Gomega2 = idrMoveR(Gomega1, newRing,currRing);
5824    idDelete(&Gomega1);
5825#ifdef TIME_TEST
5826    to = clock();
5827#endif
5828    // compute a representation of the generators of submod (M) with respect to those of mod (Gomega),
5829    // where Gomega is a reduced Groebner basis w.r.t. the current ring
5830    F = MLifttwoIdeal(Gomega2, M1, G);
5831#ifdef TIME_TEST
5832    tlift = tlift + clock() - to;
5833#endif
5834#ifdef CHECK_IDEAL_MWALK
5835    if(printout > 2)
5836    {
5837      idString(F,"//** Mrwalk: F");
5838    }
5839#endif
5840    idDelete(&Gomega2);
5841    idDelete(&M1);
5842    rChangeCurrRing(newRing); // change the ring to newRing
5843    G = idrMoveR(F,baseRing,currRing);
5844    idDelete(&F);
5845    baseRing = currRing;
5846#ifdef TIME_TEST
5847    to = clock();
5848    tstd = tstd + clock() - to;
5849#endif
5850    idSkipZeroes(G);
5851#ifdef CHECK_IDEAL_MWALK
5852    if(printout > 2)
5853    {
5854      idString(G,"//** Mrwalk: G");
5855    }
5856#endif
5857
5858    rChangeCurrRing(targetRing);
5859    G = idrMoveR(G,newRing,currRing);
5860
5861    // test whether target cone is reached
5862    if(reduction !=0 && test_w_in_ConeCC(G,curr_weight) == 1)
5863    {
5864      baseRing = currRing;
5865      break;
5866    }
5867
5868    rChangeCurrRing(newRing);
5869    G = idrMoveR(G,targetRing,currRing);
5870    baseRing = currRing;
5871
5872    NEXT_VECTOR:
5873#ifdef TIME_TEST
5874    to = clock();
5875#endif
5876    next_weight = MwalkNextWeightCC(curr_weight,target_weight,G);
5877#ifdef TIME_TEST
5878    tnw = tnw + clock() - to;
5879#endif
5880
5881#ifdef TIME_TEST
5882    to = clock();
5883#endif
5884    Gomega = MwalkInitialForm(G, next_weight); // compute an initial form ideal of <G> w.r.t. "curr_vector"
5885#ifdef TIME_TEST
5886    tif = tif + clock()-to; //time for computing initial form ideal
5887#endif
5888
5889    //lengthpoly(Gomega) = 1 if there is a polynomial in Gomega with at least 3 monomials and 0 otherwise
5890    //polylength = lengthpoly(Gomega);
5891    if(lengthpoly(Gomega) > 0)
5892    {
5893      //there is a polynomial in Gomega with at least 3 monomials,
5894      //low-dimensional facet of the cone
5895      delete next_weight;
5896      if(target_M->length() == nV)
5897      {
5898        //iv_M = MivMatrixOrder(curr_weight);
5899        iv_M = MivMatrixOrderRefine(curr_weight,target_M);
5900      }
5901      else
5902      {
5903        iv_M = MivMatrixOrderRefine(curr_weight,target_M);
5904      }
5905#ifdef TIME_TEST
5906      to = clock();
5907#endif
5908      next_weight = MWalkRandomNextWeight(G, iv_M, target_weight, weight_rad, pert_deg);
5909#ifdef TIME_TEST
5910      tnw = tnw + clock() - to;
5911#endif
5912      idDelete(&Gomega);
5913#ifdef TIME_TEST
5914      to = clock();
5915#endif
5916      Gomega = MwalkInitialForm(G, next_weight);
5917#ifdef TIME_TEST
5918      tif = tif + clock()-to; //time for computing initial form ideal
5919#endif
5920      delete iv_M;
5921    }
5922
5923    // test whether target weight vector is reached
5924    if(MivComp(next_weight, ivNull) == 1 || MivComp(target_weight,curr_weight) == 1)
5925    {
5926      baseRing = currRing;
5927      delete next_weight;
5928      break;
5929    }
5930    if(reduction ==0)
5931    {
5932      if(MivComp(curr_weight,next_weight)==1)
5933      {
5934        break;
5935      }
5936    }
5937#ifdef PRINT_VECTORS
5938    if(printout > 0)
5939    {
5940      MivString(curr_weight, target_weight, next_weight);
5941    }
5942#endif
5943
5944    for(i=nV-1; i>=0; i--)
5945    {
5946      (*curr_weight)[i] = (*next_weight)[i];
5947    }
5948    delete next_weight;
5949  }
5950  baseRing = currRing;
5951  rChangeCurrRing(XXRing);
5952  ideal result = idrMoveR(G,baseRing,currRing);
5953  idDelete(&G);
5954  delete ivNull;
5955#ifndef BUCHBERGER_ALG
5956  delete last_omega;
5957#endif
5958  if(printout > 0)
5959  {
5960    Print("\n//** Mrwalk: Groebner Walk took %d steps.\n", nstep);
5961  }
5962#ifdef TIME_TEST
5963  TimeString(tinput, tostd, tif, tstd, tlift, tred, tnw, nstep);
5964  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
5965  //Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
5966#endif
5967  si_opt_1 = save1; //set original options
5968  return(result);
5969}
5970
5971/**************************************************************/
5972/*     Implementation of the perturbation walk algorithm      */
5973/**************************************************************/
5974/* If the perturbed target weight vector or an intermediate weight vector
5975   doesn't stay in the correct Groebner cone, we have only
5976   a reduced Groebner basis for the given ideal with respect to
5977   a monomial order which differs to the given order.
5978   Then we have to compute the wanted  reduced Groebner basis for it.
5979   For this, we can use
5980   1) the improved Buchberger algorithm or
5981   2) the changed perturbation walk algorithm with a decreased degree.
5982*/
5983// if nP = 0 use kStd, else call LastGB
5984ideal Mpwalk(ideal Go, int op_deg, int tp_deg,intvec* curr_weight,
5985             intvec* target_weight, int nP, int reduction, int printout)
5986{
5987  BITSET save1 = si_opt_1; // save current options
5988  if(reduction == 0)
5989  {
5990    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
5991    si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
5992  }
5993  Set_Error(FALSE  );
5994  Overflow_Error = FALSE;
5995  //Print("// pSetm_Error = (%d)", ErrorCheck());
5996#ifdef TIME_TEST
5997  clock_t  tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
5998  xtextra=0;
5999  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
6000  tinput = clock();
6001
6002  clock_t tim;
6003#endif
6004  nstep = 0;
6005  int i, ntwC=1, ntestw=1,  nV = currRing->N;
6006
6007  //check that perturbation degree is valid
6008  if(op_deg < 1 || tp_deg < 1 || op_deg > nV || tp_deg > nV)
6009  {
6010    WerrorS("Invalid perturbation degree.\n");
6011    return NULL;
6012  }
6013
6014  BOOLEAN endwalks = FALSE;
6015  ideal Gomega, M, F, FF, G, Gomega1, Gomega2, M1,F1,Eresult,ssG;
6016  ring newRing, oldRing, TargetRing;
6017  intvec* iv_M_dp;
6018  intvec* iv_M_lp;
6019  intvec* exivlp = Mivlp(nV);
6020  intvec* orig_target = target_weight;
6021  intvec* pert_target_vector = target_weight;
6022  intvec* ivNull = new intvec(nV);
6023  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
6024#ifndef BUCHBERGER_ALG
6025  intvec* hilb_func;
6026#endif
6027  intvec* next_weight;
6028
6029  // to avoid (1,0,...,0) as the target vector
6030  intvec* last_omega = new intvec(nV);
6031  for(i=nV-1; i>0; i--)
6032    (*last_omega)[i] = 1;
6033  (*last_omega)[0] = 10000;
6034
6035  ring XXRing = currRing;
6036#ifdef TIME_TEST
6037  to = clock();
6038#endif
6039  // perturbs the original vector
6040  if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) := "dp"
6041  {
6042    G = MstdCC(Go);
6043#ifdef TIME_TEST
6044    tostd = clock()-to;
6045#endif
6046    if(op_deg != 1){
6047      iv_M_dp = MivMatrixOrderdp(nV);
6048      //ivString(iv_M_dp, "iv_M_dp");
6049      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
6050    }
6051  }
6052  else
6053  {
6054    //define ring order := (a(curr_weight),lp);
6055/*
6056    if (rParameter(currRing) != NULL)
6057      DefRingPar(curr_weight);
6058    else
6059      rChangeCurrRing(VMrDefault(curr_weight));
6060*/
6061    rChangeCurrRing(VMrRefine(target_weight,curr_weight));
6062
6063    G = idrMoveR(Go, XXRing,currRing);
6064    G = MstdCC(G);
6065#ifdef TIME_TEST
6066    tostd = clock()-to;
6067#endif
6068    if(op_deg != 1){
6069      iv_M_dp = MivMatrixOrder(curr_weight);
6070      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
6071    }
6072  }
6073  delete iv_dp;
6074  if(op_deg != 1) delete iv_M_dp;
6075
6076  ring HelpRing = currRing;
6077
6078  // perturbs the target weight vector
6079  if(tp_deg > 1 && tp_deg <= nV)
6080  {
6081/*
6082    if (rParameter(currRing) != NULL)
6083      DefRingPar(target_weight);
6084    else
6085      rChangeCurrRing(VMrDefault(target_weight));
6086*/
6087    rChangeCurrRing(VMrRefine(target_weight,curr_weight));
6088
6089    TargetRing = currRing;
6090    ssG = idrMoveR(G,HelpRing,currRing);
6091    if(MivSame(target_weight, exivlp) == 1)
6092    {
6093      iv_M_lp = MivMatrixOrderlp(nV);
6094      target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
6095    }
6096    else
6097    {
6098      iv_M_lp = MivMatrixOrder(target_weight);
6099      target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
6100    }
6101    delete iv_M_lp;
6102    pert_target_vector = target_weight;
6103    rChangeCurrRing(HelpRing);
6104    G = idrMoveR(ssG, TargetRing,currRing);
6105  }
6106  if(printout > 0)
6107  {
6108    Print("\n//** Mpwalk: Perturbation Walk of degree (%d,%d):",op_deg,tp_deg);
6109#ifdef PRINT_VECTORS
6110    ivString(curr_weight, "//** Mpwalk: new current weight");
6111    ivString(target_weight, "//** Mpwalk: new target weight");
6112#endif
6113  }
6114  while(1)
6115  {
6116    nstep ++;
6117#ifdef TIME_TEST
6118    to = clock();
6119#endif
6120    // compute an initial form ideal of <G> w.r.t. the weight vector
6121    // "curr_weight"
6122    Gomega = MwalkInitialForm(G, curr_weight);
6123#ifdef TIME_TEST
6124    tif = tif + clock()-to;
6125#endif
6126#ifdef CHECK_IDEAL_MWALK
6127    if(printout > 1)
6128    {
6129      idString(Gomega,"//** Mpwalk: Gomega");
6130    }
6131#endif
6132    if(reduction == 0 && nstep > 1)
6133    {
6134      FF = middleOfCone(G,Gomega);
6135      if(FF != NULL)
6136      {
6137        idDelete(&G);
6138        G = idCopy(FF);
6139        idDelete(&FF);
6140        goto NEXT_VECTOR;
6141      }
6142    }
6143
6144#ifdef ENDWALKS
6145    if(endwalks == TRUE)
6146    {
6147      if(printout > 0)
6148      {
6149        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6150      }
6151      //idElements(G, "G");
6152      //headidString(G, "G");
6153    }
6154#endif
6155
6156#ifndef  BUCHBERGER_ALG
6157    if(isNolVector(curr_weight) == 0)
6158      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
6159    else
6160      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
6161#endif // BUCHBERGER_ALG
6162
6163    oldRing = currRing;
6164
6165    // define a new ring with ordering "(a(curr_weight),lp)
6166/*
6167    if (rParameter(currRing) != NULL)
6168      DefRingPar(curr_weight);
6169    else
6170      rChangeCurrRing(VMrDefault(curr_weight));
6171*/
6172    rChangeCurrRing(VMrRefine(target_weight,curr_weight));
6173
6174    newRing = currRing;
6175    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
6176
6177#ifdef ENDWALKS
6178    if(endwalks==TRUE)
6179    {
6180      if(printout > 0)
6181      {
6182        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6183        //idElements(Gomega1, "Gw");
6184        //headidString(Gomega1, "headGw");
6185        PrintS("\n// compute a rGB of Gw:\n");
6186      }
6187#ifndef  BUCHBERGER_ALG
6188      ivString(hilb_func, "w");
6189#endif
6190    }
6191#endif
6192#ifdef TIME_TEST
6193    tim = clock();
6194    to = clock();
6195#endif
6196    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
6197#ifdef  BUCHBERGER_ALG
6198    M = MstdhomCC(Gomega1);
6199#else
6200    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
6201    delete hilb_func;
6202#endif
6203
6204    if(endwalks == TRUE)
6205    {
6206#ifdef TIME_TEST
6207      xtstd = xtstd+clock()-to;
6208#endif
6209#ifdef ENDWALKS
6210#ifdef TIME_TEST
6211      if(printout > 1)
6212      {
6213        Print("\n// time for the last std(Gw)  = %.2f sec\n",
6214            ((double) clock())/1000000 -((double)tim) /1000000);
6215      }
6216#endif
6217#endif
6218    }
6219    else
6220    {
6221#ifdef TIME_TEST
6222      tstd=tstd+clock()-to;
6223#endif
6224    }
6225#ifdef CHECK_IDEAL_MWALK
6226    if(printout > 2)
6227    {
6228      idString(M,"//** Mpwalk: M");
6229    }
6230#endif
6231    // change the ring to oldRing
6232    rChangeCurrRing(oldRing);
6233    M1 =  idrMoveR(M, newRing,currRing);
6234    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
6235#ifdef TIME_TEST
6236    to=clock();
6237#endif
6238    /* compute a representation of the generators of submod (M)
6239       with respect to those of mod (Gomega).
6240       Gomega is a reduced Groebner basis w.r.t. the current ring */
6241    F = MLifttwoIdeal(Gomega2, M1, G);
6242#ifdef TIME_TEST
6243    if(endwalks == FALSE)
6244      tlift = tlift+clock()-to;
6245    else
6246      xtlift=clock()-to;
6247#endif
6248#ifdef CHECK_IDEAL_MWALK
6249    if(printout > 2)
6250    {
6251      idString(F,"//** Mpwalk: F");
6252    }
6253#endif
6254
6255    idDelete(&M1);
6256    idDelete(&Gomega2);
6257    idDelete(&G);
6258
6259    // change the ring to newRing
6260    rChangeCurrRing(newRing);
6261    if(reduction == 0)
6262    {
6263      G = idrMoveR(F,oldRing,currRing);
6264    }
6265    else
6266    {
6267      F1 = idrMoveR(F, oldRing,currRing);
6268      if(printout > 2)
6269      {
6270        PrintS("\n //** Mpwalk: reduce the Groebner basis.\n");
6271      }
6272#ifdef TIME_TEST
6273      to=clock();
6274#endif
6275      G = kInterRedCC(F1, NULL);
6276#ifdef TIME_TEST
6277      if(endwalks == FALSE)
6278        tred = tred+clock()-to;
6279      else
6280        xtred=clock()-to;
6281#endif
6282      idDelete(&F1);
6283    }
6284    if(endwalks == TRUE)
6285      break;
6286
6287    NEXT_VECTOR:
6288#ifdef TIME_TEST
6289    to=clock();
6290#endif
6291    // compute a next weight vector
6292    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
6293#ifdef TIME_TEST
6294    tnw=tnw+clock()-to;
6295#endif
6296#ifdef PRINT_VECTORS
6297    if(printout > 0)
6298    {
6299      MivString(curr_weight, target_weight, next_weight);
6300    }
6301#endif
6302
6303    if(Overflow_Error == TRUE)
6304    {
6305      ntwC = 0;
6306      //ntestomega = 1;
6307      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6308      //idElements(G, "G");
6309      delete next_weight;
6310      goto FINISH_160302;
6311    }
6312    if(MivComp(next_weight, ivNull) == 1){
6313      newRing = currRing;
6314      delete next_weight;
6315      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6316      break;
6317    }
6318    if(MivComp(next_weight, target_weight) == 1)
6319      endwalks = TRUE;
6320
6321    for(i=nV-1; i>=0; i--)
6322      (*curr_weight)[i] = (*next_weight)[i];
6323
6324    delete next_weight;
6325  }//end of while-loop
6326
6327  if(tp_deg != 1)
6328  {
6329  FINISH_160302:
6330    if(MivSame(orig_target, exivlp) == 1) {
6331    /*  if (rParameter(currRing) != NULL)
6332        DefRingParlp();
6333      else
6334        VMrDefaultlp();
6335    else
6336      if (rParameter(currRing) != NULL)
6337        DefRingPar(orig_target);
6338      else*/
6339        rChangeCurrRing(VMrDefault(orig_target));
6340    }
6341    TargetRing=currRing;
6342    F1 = idrMoveR(G, newRing,currRing);
6343/*
6344#ifdef CHECK_IDEAL_MWALK
6345      headidString(G, "G");
6346#endif
6347*/
6348
6349    // check whether the pertubed target vector stays in the correct cone
6350    if(ntwC != 0){
6351      ntestw = test_w_in_ConeCC(F1, pert_target_vector);
6352    }
6353
6354    if( ntestw != 1 || ntwC == 0)
6355    {
6356      if(ntestw != 1 && printout >2)
6357      {
6358        ivString(pert_target_vector, "tau");
6359        PrintS("\n// ** perturbed target vector doesn't stay in cone!!");
6360        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6361        //idElements(F1, "G");
6362      }
6363      // LastGB is "better" than the kStd subroutine
6364#ifdef TIME_TEST
6365      to=clock();
6366#endif
6367      ideal eF1;
6368      if(nP == 0 || tp_deg == 1 || MivSame(orig_target, exivlp) != 1){
6369        // PrintS("\n// ** calls \"std\" to compute a GB");
6370        eF1 = MstdCC(F1);
6371        idDelete(&F1);
6372      }
6373      else {
6374        // PrintS("\n// ** calls \"LastGB\" to compute a GB");
6375        rChangeCurrRing(newRing);
6376        ideal F2 = idrMoveR(F1, TargetRing,currRing);
6377        eF1 = LastGB(F2, curr_weight, tp_deg-1);
6378        F2=NULL;
6379      }
6380#ifdef TIME_TEST
6381      xtextra=clock()-to;
6382#endif
6383      ring exTargetRing = currRing;
6384
6385      rChangeCurrRing(XXRing);
6386      Eresult = idrMoveR(eF1, exTargetRing,currRing);
6387    }
6388    else{
6389      rChangeCurrRing(XXRing);
6390      Eresult = idrMoveR(F1, TargetRing,currRing);
6391    }
6392  }
6393  else {
6394    rChangeCurrRing(XXRing);
6395    Eresult = idrMoveR(G, newRing,currRing);
6396  }
6397  si_opt_1 = save1; //set original options, e. g. option(RedSB)
6398  delete ivNull;
6399  if(tp_deg != 1)
6400    delete target_weight;
6401
6402  if(op_deg != 1 )
6403    delete curr_weight;
6404
6405  delete exivlp;
6406  delete last_omega;
6407
6408#ifdef TIME_TEST
6409  TimeStringFractal(tinput, tostd, tif+xtif, tstd+xtstd,0, tlift+xtlift, tred+xtred,
6410             tnw+xtnw);
6411
6412  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
6413  //Print("\n// It took %d steps and Overflow_Error? (%d)\n", nstep,  Overflow_Error);
6414#endif
6415  if(printout > 0)
6416  {
6417    Print("\n//** Mpwalk: Perturbation Walk took %d steps.\n", nstep);
6418  }
6419  return(Eresult);
6420}
6421
6422/*******************************************************
6423 * THE PERTURBATION WALK ALGORITHM WITH RANDOM ELEMENT *
6424 *******************************************************/
6425ideal Mprwalk(ideal Go, intvec* orig_M, intvec* target_M, int weight_rad,
6426              int op_deg, int tp_deg, int nP, int reduction, int printout)
6427{
6428  BITSET save1 = si_opt_1; // save current options
6429  if(reduction == 0)
6430  {
6431    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
6432    si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
6433  }
6434  Set_Error(FALSE);
6435  Overflow_Error = FALSE;
6436  //Print("// pSetm_Error = (%d)", ErrorCheck());
6437#ifdef TIME_TEST
6438  clock_t  tinput, tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0;
6439  xtextra=0;
6440  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0;
6441  tinput = clock();
6442
6443  clock_t tim;
6444#endif
6445  nstep = 0;
6446  int i, ntwC=1, ntestw=1, nV = currRing->N; //polylength
6447
6448  //check that weight radius is valid
6449  if(weight_rad < 0)
6450  {
6451    WerrorS("Invalid radius.\n");
6452    return NULL;
6453  }
6454
6455  //check that perturbation degree is valid
6456  if(op_deg < 1 || tp_deg < 1 || op_deg > nV || tp_deg > nV)
6457  {
6458    WerrorS("Invalid perturbation degree.\n");
6459    return NULL;
6460  }
6461
6462  BOOLEAN endwalks = FALSE;
6463
6464  ideal Gomega, M, F, FF, G, Gomega1, Gomega2, M1,F1,Eresult,ssG;
6465  ring newRing, oldRing, TargetRing;
6466  intvec* iv_M;
6467  intvec* iv_M_dp;
6468  intvec* iv_M_lp;
6469  intvec* exivlp = Mivlp(nV);
6470  intvec* curr_weight = new intvec(nV);
6471  intvec* target_weight = new intvec(nV);
6472  for(i=0; i<nV; i++)
6473  {
6474    (*curr_weight)[i] = (*orig_M)[i];
6475    (*target_weight)[i] = (*target_M)[i];
6476  }
6477  intvec* orig_target = target_weight;
6478  intvec* pert_target_vector = target_weight;
6479  intvec* ivNull = new intvec(nV);
6480  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
6481#ifndef BUCHBERGER_ALG
6482  intvec* hilb_func;
6483#endif
6484  intvec* next_weight;
6485
6486  // to avoid (1,0,...,0) as the target vector
6487  intvec* last_omega = new intvec(nV);
6488  for(i=nV-1; i>0; i--)
6489    (*last_omega)[i] = 1;
6490  (*last_omega)[0] = 10000;
6491
6492  ring XXRing = currRing;
6493
6494  // perturbs the original vector
6495  if(orig_M->length() == nV)
6496  {
6497    if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) := "dp"
6498    {
6499#ifdef TIME_TEST
6500  to = clock();
6501#endif
6502      G = MstdCC(Go);
6503#ifdef TIME_TEST
6504      tostd = clock()-to;
6505#endif
6506      if(op_deg != 1)
6507      {
6508        iv_M_dp = MivMatrixOrderdp(nV);
6509        curr_weight = MPertVectors(G, iv_M_dp, op_deg);
6510      }
6511    }
6512    else
6513    {
6514      //define ring order := (a(curr_weight),lp);
6515      if (rParameter(currRing) != NULL)
6516        DefRingPar(curr_weight);
6517      else
6518        rChangeCurrRing(VMrDefault(curr_weight));
6519
6520      G = idrMoveR(Go, XXRing,currRing);
6521#ifdef TIME_TEST
6522  to = clock();
6523#endif
6524      G = MstdCC(G);
6525#ifdef TIME_TEST
6526      tostd = clock()-to;
6527#endif
6528      if(op_deg != 1)
6529      {
6530        iv_M_dp = MivMatrixOrder(curr_weight);
6531        curr_weight = MPertVectors(G, iv_M_dp, op_deg);
6532      }
6533    }
6534  }
6535  else
6536  {
6537    rChangeCurrRing(VMatrDefault(orig_M));
6538    G = idrMoveR(Go, XXRing,currRing);
6539#ifdef TIME_TEST
6540    to = clock();
6541#endif
6542    G = MstdCC(G);
6543#ifdef TIME_TEST
6544    tostd = clock()-to;
6545#endif
6546    if(op_deg != 1)
6547    {
6548      curr_weight = MPertVectors(G, orig_M, op_deg);
6549    }
6550  }
6551
6552  delete iv_dp;
6553  if(op_deg != 1) delete iv_M_dp;
6554
6555  ring HelpRing = currRing;
6556
6557  // perturbs the target weight vector
6558  if(target_M->length() == nV)
6559  {
6560    if(tp_deg > 1 && tp_deg <= nV)
6561    {
6562      if (rParameter(currRing) != NULL)
6563        DefRingPar(target_weight);
6564      else
6565        rChangeCurrRing(VMrDefault(target_weight));
6566
6567      TargetRing = currRing;
6568      ssG = idrMoveR(G,HelpRing,currRing);
6569      if(MivSame(target_weight, exivlp) == 1)
6570      {
6571        iv_M_lp = MivMatrixOrderlp(nV);
6572        target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
6573      }
6574      else
6575      {
6576        iv_M_lp = MivMatrixOrder(target_weight);
6577        target_weight = MPertVectors(ssG, iv_M_lp, tp_deg);
6578      }
6579      delete iv_M_lp;
6580      pert_target_vector = target_weight;
6581      rChangeCurrRing(HelpRing);
6582      G = idrMoveR(ssG, TargetRing,currRing);
6583    }
6584  }
6585  else
6586  {
6587    if(tp_deg > 1 && tp_deg <= nV)
6588    {
6589      rChangeCurrRing(VMatrDefault(target_M));
6590      TargetRing = currRing;
6591      ssG = idrMoveR(G,HelpRing,currRing);
6592      target_weight = MPertVectors(ssG, target_M, tp_deg);
6593    }
6594  }
6595  if(printout > 0)
6596  {
6597    Print("\n//** Mprwalk: Random Perturbation Walk of degree (%d,%d):",op_deg,tp_deg);
6598    ivString(curr_weight, "//** Mprwalk: new current weight");
6599    ivString(target_weight, "//** Mprwalk: new target weight");
6600  }
6601
6602#ifdef TIME_TEST
6603  to = clock();
6604#endif
6605  Gomega = MwalkInitialForm(G, curr_weight); // compute an initial form ideal of <G> w.r.t. "curr_vector"
6606#ifdef TIME_TEST
6607  tif = tif + clock()-to; //time for computing initial form ideal
6608#endif
6609
6610  while(1)
6611  {
6612    nstep ++;
6613#ifdef CHECK_IDEAL_MWALK
6614    if(printout > 1)
6615    {
6616      idString(Gomega,"//** Mprwalk: Gomega");
6617    }
6618#endif
6619
6620    if(reduction == 0 && nstep > 1)
6621    {
6622      FF = middleOfCone(G,Gomega);
6623      if(FF != NULL)
6624      {
6625        idDelete(&G);
6626        G = idCopy(FF);
6627        idDelete(&FF);
6628        goto NEXT_VECTOR;
6629      }
6630    }
6631
6632#ifdef ENDWALKS
6633    if(endwalks == TRUE)
6634    {
6635      if(printout > 0)
6636      {
6637        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6638        //idElements(G, "G");
6639        //headidString(G, "G");
6640      }
6641    }
6642#endif
6643
6644#ifndef  BUCHBERGER_ALG
6645    if(isNolVector(curr_weight) == 0)
6646      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
6647    else
6648      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
6649#endif // BUCHBERGER_ALG
6650
6651    oldRing = currRing;
6652
6653    if(target_M->length() == nV)
6654    {/*
6655      // define a new ring with ordering "(a(curr_weight),lp)
6656      if (rParameter(currRing) != NULL)
6657        DefRingPar(curr_weight);
6658      else
6659        rChangeCurrRing(VMrDefault(curr_weight));
6660*/
6661      rChangeCurrRing(VMrRefine(target_M,curr_weight));
6662    }
6663    else
6664    {
6665      rChangeCurrRing(VMatrRefine(target_M,curr_weight));
6666    }
6667    newRing = currRing;
6668    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
6669#ifdef ENDWALKS
6670    if(endwalks == TRUE)
6671    {
6672      if(printout > 0)
6673      {
6674        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6675
6676        //idElements(Gomega1, "Gw");
6677        //headidString(Gomega1, "headGw");
6678
6679        PrintS("\n// compute a rGB of Gw:\n");
6680      }
6681#ifndef  BUCHBERGER_ALG
6682      ivString(hilb_func, "w");
6683#endif
6684    }
6685#endif
6686#ifdef TIME_TEST
6687    tim = clock();
6688    to = clock();
6689#endif
6690    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
6691#ifdef  BUCHBERGER_ALG
6692    M = MstdhomCC(Gomega1);
6693#else
6694    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
6695    delete hilb_func;
6696#endif
6697#ifdef CHECK_IDEAL_MWALK
6698    if(printout > 2)
6699    {
6700      idString(M,"//** Mprwalk: M");
6701    }
6702#endif
6703#ifdef TIME_TEST
6704    if(endwalks == TRUE)
6705    {
6706      xtstd = xtstd+clock()-to;
6707#ifdef ENDWALKS
6708      Print("\n// time for the last std(Gw)  = %.2f sec\n",
6709            ((double) clock())/1000000 -((double)tim) /1000000);
6710#endif
6711    }
6712    else
6713      tstd=tstd+clock()-to;
6714#endif
6715    /* change the ring to oldRing */
6716    rChangeCurrRing(oldRing);
6717    M1 =  idrMoveR(M, newRing,currRing);
6718    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
6719#ifdef TIME_TEST
6720    to=clock();
6721#endif
6722    /* compute a representation of the generators of submod (M)
6723       with respect to those of mod (Gomega).
6724       Gomega is a reduced Groebner basis w.r.t. the current ring */
6725    F = MLifttwoIdeal(Gomega2, M1, G);
6726#ifdef TIME_TEST
6727    if(endwalks == FALSE)
6728      tlift = tlift+clock()-to;
6729    else
6730      xtlift=clock()-to;
6731#endif
6732#ifdef CHECK_IDEAL_MWALK
6733    if(printout > 2)
6734    {
6735      idString(F,"//** Mprwalk: F");
6736    }
6737#endif
6738
6739    idDelete(&M1);
6740    idDelete(&Gomega2);
6741    idDelete(&G);
6742
6743    // change the ring to newRing
6744    rChangeCurrRing(newRing);
6745    if(reduction == 0)
6746    {
6747      G = idrMoveR(F,oldRing,currRing);
6748    }
6749    else
6750    {
6751      F1 = idrMoveR(F, oldRing,currRing);
6752      if(printout > 2)
6753      {
6754        PrintS("\n //** Mprwalk: reduce the Groebner basis.\n");
6755      }
6756#ifdef TIME_TEST
6757      to=clock();
6758#endif
6759      G = kInterRedCC(F1, NULL);
6760#ifdef TIME_TEST
6761      if(endwalks == FALSE)
6762        tred = tred+clock()-to;
6763      else
6764        xtred=clock()-to;
6765#endif
6766      idDelete(&F1);
6767    }
6768
6769    if(endwalks == TRUE)
6770      break;
6771
6772    NEXT_VECTOR:
6773#ifdef TIME_TEST
6774    to = clock();
6775#endif
6776    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
6777#ifdef TIME_TEST
6778    tnw = tnw + clock() - to;
6779#endif
6780
6781#ifdef TIME_TEST
6782    to = clock();
6783#endif
6784    // compute an initial form ideal of <G> w.r.t. "next_vector"
6785    Gomega = MwalkInitialForm(G, next_weight);
6786#ifdef TIME_TEST
6787    tif = tif + clock()-to; //time for computing initial form ideal
6788#endif
6789
6790    //lengthpoly(Gomega) = 1 if there is a polynomial in Gomega with at least 3 monomials and 0 otherwise
6791    if(lengthpoly(Gomega) > 0)
6792    {
6793      if(printout > 1)
6794      {
6795        PrintS("\n Mpwalk: there is a polynomial in Gomega with at least 3 monomials.\n");
6796      }
6797      // low-dimensional facet of the cone
6798      delete next_weight;
6799      if(target_M->length() == nV)
6800      {
6801        iv_M = MivMatrixOrder(curr_weight);
6802      }
6803      else
6804      {
6805        iv_M = MivMatrixOrderRefine(curr_weight,target_M);
6806      }
6807#ifdef TIME_TEST
6808      to = clock();
6809#endif
6810      next_weight = MWalkRandomNextWeight(G, iv_M, target_weight, weight_rad, op_deg);
6811#ifdef TIME_TEST
6812      tnw = tnw + clock() - to;
6813#endif
6814      idDelete(&Gomega);
6815#ifdef TIME_TEST
6816      to = clock();
6817#endif
6818      Gomega = MwalkInitialForm(G, next_weight);
6819#ifdef TIME_TEST
6820      tif = tif + clock()-to; //time for computing initial form ideal
6821#endif
6822      delete iv_M;
6823    }
6824
6825#ifdef PRINT_VECTORS
6826    if(printout > 0)
6827    {
6828      MivString(curr_weight, target_weight, next_weight);
6829    }
6830#endif
6831
6832    if(Overflow_Error == TRUE)
6833    {
6834      ntwC = 0;
6835      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6836      //idElements(G, "G");
6837      delete next_weight;
6838      goto FINISH_160302;
6839    }
6840    if(MivComp(next_weight, ivNull) == 1){
6841      newRing = currRing;
6842      delete next_weight;
6843      //Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6844      break;
6845    }
6846    if(MivComp(next_weight, target_weight) == 1)
6847      endwalks = TRUE;
6848
6849    for(i=nV-1; i>=0; i--)
6850      (*curr_weight)[i] = (*next_weight)[i];
6851
6852    delete next_weight;
6853  }// end of while-loop
6854
6855  if(tp_deg != 1)
6856  {
6857    FINISH_160302:
6858    if(target_M->length() == nV)
6859    {
6860      if(MivSame(orig_target, exivlp) == 1)
6861        if (rParameter(currRing) != NULL)
6862          DefRingParlp();
6863        else
6864          VMrDefaultlp();
6865      else
6866        if (rParameter(currRing) != NULL)
6867          DefRingPar(orig_target);
6868        else
6869          rChangeCurrRing(VMrDefault(orig_target));
6870    }
6871    else
6872    {
6873      rChangeCurrRing(VMatrDefault(target_M));
6874    }
6875    TargetRing=currRing;
6876    F1 = idrMoveR(G, newRing,currRing);
6877
6878    // check whether the pertubed target vector stays in the correct cone
6879    if(ntwC != 0)
6880    {
6881      ntestw = test_w_in_ConeCC(F1, pert_target_vector);
6882    }
6883    if(ntestw != 1 || ntwC == 0)
6884    {
6885      if(ntestw != 1 && printout > 2)
6886      {
6887#ifdef PRINT_VECTORS
6888        ivString(pert_target_vector, "tau");
6889#endif
6890        PrintS("\n// **Mprwalk: perturbed target vector doesn't stay in cone.");
6891        Print("\n// ring r%d = %s;\n", nstep, rString(currRing));
6892        //idElements(F1, "G");
6893      }
6894      // LastGB is "better" than the kStd subroutine
6895#ifdef TIME_TEST
6896      to=clock();
6897#endif
6898      ideal eF1;
6899      if(nP == 0 || tp_deg == 1 || MivSame(orig_target, exivlp) != 1 || target_M->length() != nV)
6900      {
6901        if(printout > 2)
6902        {
6903          PrintS("\n// ** Mprwalk: Call \"std\" to compute a Groebner basis.\n");
6904        }
6905        eF1 = MstdCC(F1);
6906        idDelete(&F1);
6907      }
6908      else
6909      {
6910        if(printout > 2)
6911        {
6912          PrintS("\n// **Mprwalk: Call \"LastGB\" to compute a Groebner basis.\n");
6913        }
6914        rChangeCurrRing(newRing);
6915        ideal F2 = idrMoveR(F1, TargetRing,currRing);
6916        eF1 = LastGB(F2, curr_weight, tp_deg-1);
6917        F2=NULL;
6918      }
6919#ifdef TIME_TEST
6920      xtextra=clock()-to;
6921#endif
6922      ring exTargetRing = currRing;
6923
6924      rChangeCurrRing(XXRing);
6925      Eresult = idrMoveR(eF1, exTargetRing,currRing);
6926    }
6927    else
6928    {
6929      rChangeCurrRing(XXRing);
6930      Eresult = idrMoveR(F1, TargetRing,currRing);
6931    }
6932  }
6933  else
6934  {
6935    rChangeCurrRing(XXRing);
6936    Eresult = idrMoveR(G, newRing,currRing);
6937  }
6938  si_opt_1 = save1; //set original options, e. g. option(RedSB)
6939  delete ivNull;
6940  if(tp_deg != 1)
6941    delete target_weight;
6942
6943  if(op_deg != 1 )
6944    delete curr_weight;
6945
6946  delete exivlp;
6947  delete last_omega;
6948
6949#ifdef TIME_TEST
6950  TimeStringFractal(tinput, tostd, tif+xtif, tstd+xtstd,0, tlift+xtlift, tred+xtred,
6951             tnw+xtnw);
6952
6953  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
6954  //Print("\n// It took %d steps and Overflow_Error? (%d)\n", nstep,  Overflow_Error);
6955#endif
6956
6957  if(printout > 0)
6958  {
6959    Print("\n//** Mprwalk: Perturbation Walk took %d steps.\n", nstep);
6960  }
6961  return(Eresult);
6962}
6963
6964intvec* XivNull;
6965
6966/*****************************
6967 * define a matrix (1 ... 1) *
6968 *****************************/
6969intvec* MMatrixone(int nV)
6970{
6971  int i,j;
6972  intvec* ivM = new intvec(nV*nV);
6973
6974  for(i=0; i<nV; i++)
6975    for(j=0; j<nV; j++)
6976    (*ivM)[i*nV + j] = 1;
6977
6978  return(ivM);
6979}
6980
6981int nnflow;
6982int Xcall;
6983int Xngleich;
6984
6985/***********************************************************************
6986 * Perturb the start weight vector at the top level, i.e. nlev = 1     *
6987 ***********************************************************************/
6988static ideal rec_fractal_call(ideal G, int nlev, intvec* ivtarget,
6989             int reduction, int printout)
6990{
6991  Overflow_Error =  FALSE;
6992  if(printout >0)
6993  {
6994    Print("\n\n// Entering the %d-th recursion:", nlev);
6995  }
6996  int i, nV = currRing->N;
6997  ring new_ring, testring;
6998  //ring extoRing;
6999  ideal Gomega, Gomega1, Gomega2, FF, F, Gresult, Gresult1, G1, Gt;
7000  int nwalks = 0;
7001  intvec* Mwlp;
7002#ifndef BUCHBERGER_ALG
7003  intvec* hilb_func;
7004#endif
7005  //intvec* extXtau;
7006  intvec* next_vect;
7007  intvec* omega2 = new intvec(nV);
7008  intvec* omtmp = new intvec(nV);
7009  //intvec* altomega = new intvec(nV);
7010
7011  for(i = nV -1; i>=0; i--)//Aenderung!!
7012  {
7013    (*omtmp)[i] = (*ivtarget)[i];
7014  }
7015  //BOOLEAN isnewtarget = FALSE;
7016
7017  // to avoid (1,0,...,0) as the target vector (Hans)
7018  intvec* last_omega = new intvec(nV);
7019  for(i=nV-1; i>0; i--)
7020    (*last_omega)[i] = 1;
7021  (*last_omega)[0] = 10000;
7022
7023  intvec* omega = new intvec(nV);
7024  for(i=0; i<nV; i++) {
7025    if(Xsigma->length() == nV)
7026      (*omega)[i] =  (*Xsigma)[i];
7027    else
7028      (*omega)[i] = (*Xsigma)[(nV*(nlev-1))+i];
7029
7030    (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
7031  }
7032
7033   if(nlev == 1)  Xcall = 1;
7034   else Xcall = 0;
7035
7036  ring oRing = currRing;
7037
7038  while(1)
7039  {
7040#ifdef FIRST_STEP_FRACTAL
7041    // perturb the current weight vector only on the top level or
7042    // after perturbation of the both vectors, nlev = 2 as the top level
7043    if((nlev == 1 && Xcall == 0) || (nlev == 2 && Xngleich == 1))
7044      if(islengthpoly2(G) == 1)
7045      {
7046        Mwlp = MivWeightOrderlp(omega);
7047        Xsigma = Mfpertvector(G, Mwlp);
7048        delete Mwlp;
7049        Overflow_Error = FALSE;
7050      }
7051#endif
7052    nwalks ++;
7053    NEXT_VECTOR_FRACTAL:
7054#ifdef TIME_TEST
7055    to=clock();
7056#endif
7057    // determine the next border
7058    next_vect = MkInterRedNextWeight(omega,omega2,G);
7059#ifdef TIME_TEST
7060    xtnw=xtnw+clock()-to;
7061#endif
7062    oRing = currRing;
7063
7064    // We only perturb the current target vector at the recursion level 1
7065    if(Xngleich == 0 && nlev == 1) //(ngleich == 0) important, e.g. ex2, ex3
7066      if (MivComp(next_vect, omega2) == 1)
7067      {
7068        // to dispense with taking initial (and lifting/interreducing
7069        // after the call of recursion
7070        if(printout > 0)
7071        {
7072          Print("\n//** rec_fractal_call: Perturb the both vectors with degree %d.",nlev);
7073          //idElements(G, "G");
7074        }
7075
7076        Xngleich = 1;
7077        nlev +=1;
7078
7079        if(ivtarget->length() == nV)
7080        {
7081/*
7082          if (rParameter(currRing) != NULL)
7083            DefRingPar(omtmp);
7084          else
7085            rChangeCurrRing(VMrDefault(omtmp));
7086*/
7087          rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7088        }
7089        else
7090        {
7091          //rChangeCurrRing(VMatrDefault(ivtarget));
7092          rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7093        }
7094        testring = currRing;
7095        Gt = idrMoveR(G, oRing,currRing);
7096
7097        // perturb the original target vector w.r.t. the current GB
7098        if(ivtarget->length() == nV)
7099        {
7100          delete Xtau;
7101          Xtau = NewVectorlp(Gt);
7102        }
7103        else
7104        {
7105          delete Xtau;
7106          Xtau = Mfpertvector(Gt,ivtarget);
7107        }
7108
7109        rChangeCurrRing(oRing);
7110        G = idrMoveR(Gt, testring,currRing);
7111
7112        // perturb the current vector w.r.t. the current GB
7113        Mwlp = MivWeightOrderlp(omega);
7114        Xsigma = Mfpertvector(G, Mwlp);
7115        delete Mwlp;
7116
7117        for(i=nV-1; i>=0; i--) {
7118          (*omega2)[i] = (*Xtau)[nV+i];
7119          (*omega)[i] = (*Xsigma)[nV+i];
7120        }
7121
7122        delete next_vect;
7123#ifdef TIME_TEST
7124        to=clock();
7125#endif
7126        // to avoid the value of Overflow_Error that occur in Mfpertvector
7127        Overflow_Error = FALSE;
7128        next_vect = MkInterRedNextWeight(omega,omega2,G);
7129#ifdef TIME_TEST
7130        xtnw=xtnw+clock()-to;
7131#endif
7132      }// end of (if MivComp(next_vect, omega2) == 1)
7133
7134#ifdef PRINT_VECTORS
7135      if(printout > 0)
7136      {
7137        MivString(omega, omega2, next_vect);
7138      }
7139#endif
7140
7141    // check whether the the computed vector is in the correct cone.
7142    // If no, compute the reduced Groebner basis of an omega-homogeneous
7143    // ideal with Buchberger's algorithm and stop this recursion step
7144    if(Overflow_Error == TRUE || test_w_in_ConeCC(G, next_vect) != 1)  //e.g. Example s7, cyc6
7145    {
7146      delete next_vect;
7147      if(ivtarget->length() == nV)
7148      {
7149/*
7150        if (rParameter(currRing) != NULL)
7151          DefRingPar(omtmp);
7152        else
7153          rChangeCurrRing(VMrDefault(omtmp));
7154*/
7155        rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7156      }
7157      else
7158      {
7159        //rChangeCurrRing(VMatrDefault(ivtarget));
7160        rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7161      }
7162#ifdef TEST_OVERFLOW
7163      Gt = idrMoveR(G, oRing,currRing);
7164      Gt = NULL; return(Gt);
7165#endif
7166      if(printout > 0)
7167      {
7168        Print("\n//** rec_fractal_call: Applying Buchberger's algorithm in ring r = %s;",
7169              rString(currRing));
7170      }
7171#ifdef TIME_TEST
7172      to=clock();
7173#endif
7174      Gt = idrMoveR(G, oRing,currRing);
7175      G1 = MstdCC(Gt);
7176#ifdef TIME_TEST
7177      xtextra=xtextra+clock()-to;
7178#endif
7179      Gt = NULL;
7180
7181      delete omega2;
7182      //delete altomega;
7183      if(printout > 0)
7184      {
7185        Print("\n//** rec_fractal_call: Overflow. (4) Leaving the %d-th recursion with %d steps.\n",
7186              nlev, nwalks);
7187        //Print(" ** Overflow_Error? (%d)", Overflow_Error);
7188      }
7189
7190      nnflow ++;
7191      Overflow_Error = FALSE;
7192      return (G1);
7193    }
7194
7195    /* If the perturbed target vector stays in the correct cone,
7196       return the current GB,
7197       otherwise, return the computed  GB by the Buchberger-algorithm.
7198       Then we update the perturbed target vectors w.r.t. this GB. */
7199
7200    /* the computed vector is equal to the origin vector, since
7201       t is not defined */
7202
7203    if (MivComp(next_vect, XivNull) == 1)
7204    {
7205      if(ivtarget->length() == nV)
7206      {
7207/*
7208        if (rParameter(currRing) != NULL)
7209          DefRingPar(omtmp);
7210        else
7211          rChangeCurrRing(VMrDefault(omtmp));
7212*/
7213        rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7214      }
7215      else
7216      {
7217        //rChangeCurrRing(VMatrDefault(ivtarget));
7218        rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7219      }
7220
7221      testring = currRing;
7222      Gt = idrMoveR(G, oRing,currRing);
7223      if(test_w_in_ConeCC(Gt, omega2) == 1)
7224      {
7225        delete omega2;
7226        delete next_vect;
7227        //delete altomega;
7228        if(printout > 0)
7229        {
7230          Print("\n//** rec_fractal_call: Correct cone. (5) Leaving the %d-th recursion with %d steps.\n",
7231              nlev, nwalks);
7232        }
7233        if(printout>2)
7234        {
7235          idString(Gt,"//** rec_fractal_call: Gt");
7236        }
7237        return (Gt);
7238      }
7239      else
7240      {
7241        if(printout > 0)
7242        {
7243          PrintS("\n//** rec_fractal_call: Wrong cone. Tau doesn't stay in the correct cone.\n");
7244        }
7245
7246#ifndef  MSTDCC_FRACTAL
7247        intvec* Xtautmp;
7248        if(ivtarget->length() == nV)
7249        {
7250          Xtautmp = Mfpertvector(Gt, MivMatrixOrder(omtmp));
7251        }
7252        else
7253        {
7254          Xtautmp = Mfpertvector(Gt, ivtarget);
7255        }
7256#ifdef TEST_OVERFLOW
7257      if(Overflow_Error == TRUE)
7258      Gt = NULL; return(Gt);
7259#endif
7260
7261        if(MivSame(Xtau, Xtautmp) == 1)
7262        {
7263          if(printout > 0)
7264          {
7265            PrintS("\n//** rec_fractal_call: Updated vectors are equal to the old vectors.\n");
7266          }
7267          delete Xtautmp;
7268          goto FRACTAL_MSTDCC;
7269        }
7270
7271        Xtau = Xtautmp;
7272        Xtautmp = NULL;
7273
7274        for(i=nV-1; i>=0; i--)
7275          (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
7276
7277        rChangeCurrRing(oRing);
7278        G = idrMoveR(Gt, testring,currRing);
7279
7280        goto NEXT_VECTOR_FRACTAL;
7281#endif
7282
7283      FRACTAL_MSTDCC:
7284        if(printout > 0)
7285        {
7286          Print("\n//** rec_fractal_call: Wrong cone. Applying Buchberger's algorithm in ring = %s.\n",
7287                rString(currRing));
7288        }
7289#ifdef TIME_TEST
7290        to=clock();
7291#endif
7292        G = MstdCC(Gt);
7293#ifdef TIME_TEST
7294        xtextra=xtextra+clock()-to;
7295#endif
7296        oRing = currRing;
7297
7298        // update the original target vector w.r.t. the current GB
7299        if(ivtarget->length() == nV)
7300        {
7301/*
7302          if(MivSame(Xivinput, Xivlp) == 1)
7303            if (rParameter(currRing) != NULL)
7304              DefRingParlp();
7305            else
7306              VMrDefaultlp();
7307          else
7308            if (rParameter(currRing) != NULL)
7309              DefRingPar(Xivinput);
7310            else
7311              rChangeCurrRing(VMrDefault(Xivinput));
7312*/
7313          rChangeCurrRing(VMrRefine(ivtarget,Xivinput));
7314        }
7315        else
7316        {
7317          rChangeCurrRing(VMatrRefine(ivtarget,Xivinput));
7318        }
7319        testring = currRing;
7320        Gt = idrMoveR(G, oRing,currRing);
7321
7322        // perturb the original target vector w.r.t. the current GB
7323        if(ivtarget->length() == nV)
7324        {
7325          delete Xtau;
7326          Xtau = NewVectorlp(Gt);
7327        }
7328        else
7329        {
7330          delete Xtau;
7331          Xtau = Mfpertvector(Gt,ivtarget);
7332        }
7333
7334        rChangeCurrRing(oRing);
7335        G = idrMoveR(Gt, testring,currRing);
7336
7337        delete omega2;
7338        delete next_vect;
7339        //delete altomega;
7340        if(printout > 0)
7341        {
7342          Print("\n//** rec_fractal_call: Vectors updated. (6) Leaving the %d-th recursion with %d steps.\n",
7343              nlev, nwalks);
7344          //Print(" ** Overflow_Error? (%d)", Overflow_Error);
7345        }
7346        if(Overflow_Error == TRUE)
7347          nnflow ++;
7348
7349        Overflow_Error = FALSE;
7350        return(G);
7351      }
7352    }// end of (if next_vect==nullvector)
7353
7354    for(i=nV-1; i>=0; i--) {
7355      //(*altomega)[i] = (*omega)[i];
7356      (*omega)[i] = (*next_vect)[i];
7357    }
7358    delete next_vect;
7359#ifdef TIME_TEST
7360    to=clock();
7361#endif
7362    // Take the initial form of <G> w.r.t. omega
7363    Gomega = MwalkInitialForm(G, omega);
7364#ifdef TIME_TEST
7365    xtif=xtif+clock()-to;
7366#endif
7367#ifdef CHECK_IDEAL_MWALK
7368    if(printout > 1)
7369    {
7370      idString(Gomega,"//** rec_fractal_call: Gomega");
7371    }
7372#endif
7373    if(reduction == 0)
7374    {
7375      // Check whether the intermediate weight vector lies in the interior of the cone.
7376      // If so, only perform reductions. Otherwise apply Buchberger's algorithm.
7377      FF = middleOfCone(G,Gomega);
7378      if( FF != NULL)
7379      {
7380        idDelete(&G);
7381        G = idCopy(FF);
7382        idDelete(&FF);
7383        // Compue next vector.
7384        goto NEXT_VECTOR_FRACTAL;
7385      }
7386    }
7387
7388#ifndef  BUCHBERGER_ALG
7389    if(isNolVector(omega) == 0)
7390      hilb_func = hFirstSeries(Gomega,NULL,NULL,omega,currRing);
7391    else
7392      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
7393#endif
7394
7395    if(ivtarget->length() == nV)
7396    {
7397/*
7398      if (rParameter(currRing) != NULL)
7399        DefRingPar(omega);
7400      else
7401        rChangeCurrRing(VMrDefault(omega));
7402*/
7403      rChangeCurrRing(VMrRefine(ivtarget,omega));
7404    }
7405    else
7406    {
7407      rChangeCurrRing(VMatrRefine(ivtarget,omega));
7408    }
7409    Gomega1 = idrMoveR(Gomega, oRing,currRing);
7410
7411    // Maximal recursion depth, to compute a red. GB
7412    // Fractal walk with the alternative recursion
7413    // alternative recursion
7414    if(nlev == Xnlev || lengthpoly(Gomega1) == 0)
7415    {
7416      if(printout > 1)
7417      {
7418        PrintS("\n//** rec_fractal_call: Maximal recursion depth.\n");
7419      }
7420#ifdef TIME_TEST
7421      to=clock();
7422#endif
7423#ifdef  BUCHBERGER_ALG
7424      Gresult = MstdhomCC(Gomega1);
7425#else
7426      Gresult =kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,omega);
7427      delete hilb_func;
7428#endif
7429#ifdef TIME_TEST
7430      xtstd=xtstd+clock()-to;
7431#endif
7432    }
7433    else
7434    {
7435      rChangeCurrRing(oRing);
7436      Gomega1 = idrMoveR(Gomega1, oRing,currRing);
7437      Gresult = rec_fractal_call(idCopy(Gomega1),nlev+1,omega,reduction,printout);
7438    }
7439#ifdef CHECK_IDEAL_MWALK
7440    if(printout > 2)
7441    {
7442      idString(Gresult,"//** rec_fractal_call: M");
7443    }
7444#endif
7445    //convert a Groebner basis from a ring to another ring
7446    new_ring = currRing;
7447
7448    rChangeCurrRing(oRing);
7449    Gresult1 = idrMoveR(Gresult, new_ring,currRing);
7450    Gomega2 = idrMoveR(Gomega1, new_ring,currRing);
7451#ifdef TIME_TEST
7452    to=clock();
7453#endif
7454    // Lifting process
7455    F = MLifttwoIdeal(Gomega2, Gresult1, G);
7456#ifdef TIME_TEST
7457    xtlift=xtlift+clock()-to;
7458#endif
7459#ifdef CHECK_IDEAL_MWALK
7460    if(printout > 2)
7461    {
7462      idString(F,"//** rec_fractal_call: F");
7463    }
7464#endif
7465    id_Normalize(F,currRing);
7466    idDelete(&Gresult1);
7467    idDelete(&Gomega2);
7468    idDelete(&G);
7469
7470    rChangeCurrRing(new_ring);
7471    G = idrMoveR(F,oRing,currRing);
7472/*
7473    ideal F1 = idrMoveR(F, oRing,currRing);
7474#ifdef TIME_TEST
7475    to=clock();
7476#endif
7477    // Interreduce G
7478    G = kInterRedCC(F1, NULL);
7479#ifdef TIME_TEST
7480    xtred=xtred+clock()-to;
7481#endif
7482    idDelete(&F1);
7483*/
7484  }
7485}
7486
7487/************************************************************************
7488 * Perturb the start weight vector at the top level with random element *
7489 ************************************************************************/
7490static ideal rec_r_fractal_call(ideal G, int nlev, intvec* ivtarget,
7491                int weight_rad, int reduction, int printout)
7492{
7493  Overflow_Error =  FALSE;
7494  //Print("\n\n// Entering the %d-th recursion:", nlev);
7495
7496  int nwalks = 0,i,nV=currRing->N;//polylength
7497  ring new_ring, testring;
7498  //ring extoRing;
7499  ideal Gomega, Gomega1, Gomega2, F, FF, Gresult, Gresult1, G1, Gt;
7500#ifdef TIME_TEST
7501  ideal F1;
7502#endif
7503  intvec* Mwlp;
7504#ifndef BUCHBERGER_ALG
7505  intvec* hilb_func;
7506#endif
7507//  intvec* extXtau;
7508  intvec* next_vect;
7509  intvec* iv_M;
7510  intvec* omega2 = new intvec(nV);
7511  intvec* omtmp = new intvec(nV);
7512  intvec* altomega = new intvec(nV);
7513
7514  //BOOLEAN isnewtarget = FALSE;
7515
7516  for(i = nV -1; i>=0; i--)
7517  {
7518    (*omtmp)[i] = (*ivtarget)[i];
7519  }
7520  // to avoid (1,0,...,0) as the target vector (Hans)
7521  intvec* last_omega = new intvec(nV);
7522  for(i=nV-1; i>0; i--)
7523    (*last_omega)[i] = 1;
7524  (*last_omega)[0] = 10000;
7525
7526  intvec* omega = new intvec(nV);
7527  for(i=0; i<nV; i++) {
7528    if(Xsigma->length() == nV)
7529      (*omega)[i] =  (*Xsigma)[i];
7530    else
7531      (*omega)[i] = (*Xsigma)[(nV*(nlev-1))+i];
7532
7533    (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
7534  }
7535
7536   if(nlev == 1)  Xcall = 1;
7537   else Xcall = 0;
7538
7539  ring oRing = currRing;
7540
7541  while(1)
7542  {
7543#ifdef FIRST_STEP_FRACTAL
7544    /*
7545    perturb the current weight vector only on the top level or
7546    after perturbation of the both vectors, nlev = 2 as the top level
7547    */
7548    if((nlev == 1 && Xcall == 0) || (nlev == 2 && Xngleich == 1))
7549      if(islengthpoly2(G) == 1)
7550      {
7551        Mwlp = MivWeightOrderlp(omega);
7552        Xsigma = Mfpertvector(G, Mwlp);
7553        delete Mwlp;
7554        Overflow_Error = FALSE;
7555      }
7556#endif
7557    nwalks ++;
7558    NEXT_VECTOR_FRACTAL:
7559#ifdef TIME_TEST
7560    to=clock();
7561#endif
7562    /* determine the next border */
7563    next_vect = MkInterRedNextWeight(omega,omega2,G);
7564#ifdef TIME_TEST
7565    xtnw=xtnw+clock()-to;
7566#endif
7567    if(lengthpoly(MwalkInitialForm(G, next_vect)) > 0 && G->m[0] != NULL)
7568    {
7569      if(printout > 0)
7570      {
7571        PrintS("\n**// rec_r_fractal_call: there is a polynomial in Gomega with at least 3 monomials.\n");
7572      }
7573      delete next_vect;
7574      iv_M = MivMatrixOrder(omega);
7575#ifdef TIME_TEST
7576      to=clock();
7577#endif
7578      next_vect = MWalkRandomNextWeight(G,iv_M,omega2,weight_rad,nlev);
7579#ifdef TIME_TEST
7580      xtnw=xtnw+clock()-to;
7581#endif
7582      if(isNegNolVector(next_vect) == 1)
7583      {
7584        delete next_vect;
7585#ifdef TIME_TEST
7586        to=clock();
7587#endif
7588        next_vect = MkInterRedNextWeight(omega,omega2,G);
7589#ifdef TIME_TEST
7590        xtnw=xtnw+clock()-to;
7591#endif
7592      }
7593    }
7594    oRing = currRing;
7595
7596    // We only perturb the current target vector at the recursion  level 1
7597    if(Xngleich == 0 && nlev == 1) //(ngleich == 0) important, e.g. ex2, ex3
7598      if (MivComp(next_vect, omega2) == 1)
7599      {
7600        // to dispense with taking initials and lifting/interreducing
7601        // after the call of recursion.
7602        if(printout > 0)
7603        {
7604          Print("\n//** rec_r_fractal_call: Perturb both vectors with degree %d.",nlev);
7605          //idElements(G, "G");
7606        }
7607        Xngleich = 1;
7608        nlev +=1;
7609        if(ivtarget->length() == nV)
7610        {
7611/*
7612          if (rParameter(currRing) != NULL)
7613            DefRingPar(omtmp);
7614          else
7615            rChangeCurrRing(VMrDefault(omtmp));
7616*/
7617          rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7618        }
7619        else
7620        {
7621          //rChangeCurrRing(VMatrDefault(ivtarget));
7622          rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7623        }
7624        testring = currRing;
7625        Gt = idrMoveR(G, oRing,currRing);
7626
7627        // perturb the original target vector w.r.t. the current GB
7628        if(ivtarget->length() == nV)
7629        {
7630          delete Xtau;
7631          Xtau = NewVectorlp(Gt);
7632        }
7633        else
7634        {
7635          delete Xtau;
7636          Xtau = Mfpertvector(Gt,ivtarget);
7637        }
7638
7639        rChangeCurrRing(oRing);
7640        G = idrMoveR(Gt,testring,currRing);
7641
7642        // perturb the current vector w.r.t. the current GB
7643        Mwlp = MivWeightOrderlp(omega);
7644        if(ivtarget->length() > nV)
7645        {
7646          delete Mwlp;
7647          Mwlp = MivMatrixOrderRefine(omega,ivtarget);
7648        }
7649        Xsigma = Mfpertvector(G, Mwlp);
7650        delete Mwlp;
7651
7652        for(i=nV-1; i>=0; i--)
7653        {
7654          (*omega2)[i] = (*Xtau)[nV+i];
7655          (*omega)[i] = (*Xsigma)[nV+i];
7656        }
7657
7658        delete next_vect;
7659
7660   //to avoid the value of Overflow_Error that occur in Mfpertvector
7661        Overflow_Error = FALSE;
7662#ifdef TIME_TEST
7663        to=clock();
7664#endif
7665        next_vect = MkInterRedNextWeight(omega,omega2,G);
7666#ifdef TIME_TEST
7667        xtnw=xtnw+clock()-to;
7668#endif
7669        if(lengthpoly(MwalkInitialForm(G, next_vect)) > 0 && G->m[0] != NULL)
7670        {
7671          // there is a polynomial in Gomega with at least 3 monomials
7672          iv_M = MivMatrixOrder(omega);
7673          delete next_vect;
7674#ifdef TIME_TEST
7675          to=clock();
7676#endif
7677          next_vect = MWalkRandomNextWeight(G,iv_M,omega2,weight_rad,nlev);
7678#ifdef TIME_TEST
7679          xtnw=xtnw+clock()-to;
7680#endif
7681          delete iv_M;
7682          if(isNegNolVector(next_vect) == 1)
7683          {
7684            delete next_vect;
7685#ifdef TIME_TEST
7686            to=clock();
7687#endif
7688            next_vect = MkInterRedNextWeight(omega,omega2,G);
7689#ifdef TIME_TEST
7690        xtnw=xtnw+clock()-to;
7691#endif
7692          }
7693        }
7694      }
7695#ifdef PRINT_VECTORS
7696      if(printout > 0)
7697      {
7698        MivString(omega, omega2, next_vect);
7699      }
7700#endif
7701
7702/*     check whether the the computed vector is in the correct cone
7703       If no, the reduced GB of an omega-homogeneous ideal will be
7704       computed by Buchberger algorithm and stop this recursion step
7705*/
7706    if(Overflow_Error == TRUE || test_w_in_ConeCC(G,next_vect) != 1)//e.g. Example s7, cyc6
7707    {
7708      delete next_vect;
7709      if(ivtarget->length() == nV)
7710      {
7711/*
7712        if (rParameter(currRing) != NULL)
7713        {
7714          DefRingPar(omtmp);
7715        }
7716        else
7717        {
7718          rChangeCurrRing(VMrDefault(omtmp));
7719        }
7720*/
7721        rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7722      }
7723      else
7724      {
7725        //rChangeCurrRing(VMatrDefault(ivtarget));
7726        rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7727      }
7728#ifdef TEST_OVERFLOW
7729      Gt = idrMoveR(G, oRing,currRing);
7730      Gt = NULL;
7731      return(Gt);
7732#endif
7733      if(printout > 0)
7734      {
7735        Print("\n//** rec_r_fractal_call: applying Buchberger's algorithm in ring r = %s;",
7736              rString(currRing));
7737      }
7738      Gt = idrMoveR(G, oRing,currRing);
7739#ifdef TIME_TEST
7740      to=clock();
7741#endif
7742      G1 = MstdCC(Gt);
7743#ifdef TIME_TEST
7744      xtextra=xtextra+clock()-to;
7745#endif
7746      Gt = NULL;
7747
7748      delete omega2;
7749      delete altomega;
7750      if(printout > 0)
7751      {
7752        Print("\n//** rec_r_fractal_call: (1) Leaving the %d-th recursion with %d steps.\n",
7753              nlev, nwalks);
7754        //Print(" ** Overflow_Error? (%d)", Overflow_Error);
7755      }
7756      nnflow ++;
7757      Overflow_Error = FALSE;
7758      return (G1);
7759    }
7760    /*
7761       If the perturbed target vector stays in the correct cone,
7762       return the current Groebner basis.
7763       Otherwise, return the Groebner basis computed with Buchberger's
7764       algorithm.
7765       Then we update the perturbed target vectors w.r.t. this GB.
7766    */
7767    if (MivComp(next_vect, XivNull) == 1)
7768    {
7769      // The computed vector is equal to the origin vector,
7770      // because t is not defined
7771      if(ivtarget->length() == nV)
7772      {
7773/*
7774        if (rParameter(currRing) != NULL)
7775          DefRingPar(omtmp);
7776        else
7777          rChangeCurrRing(VMrDefault(omtmp));
7778*/
7779        rChangeCurrRing(VMrRefine(ivtarget,omtmp));
7780      }
7781      else
7782      {
7783        //rChangeCurrRing(VMatrDefault(ivtarget));
7784        rChangeCurrRing(VMatrRefine(ivtarget,omtmp));
7785      }
7786      testring = currRing;
7787      Gt = idrMoveR(G, oRing,currRing);
7788
7789      if(test_w_in_ConeCC(Gt, omega2) == 1)
7790      {
7791        delete omega2;
7792        delete next_vect;
7793        delete altomega;
7794        if(printout > 0)
7795        {
7796          Print("\n//** rec_r_fractal_call: (2) Leaving the %d-th recursion with %d steps.\n",
7797                nlev, nwalks);
7798          //Print(" ** Overflow_Error? (%d)", Overflow_Error);
7799        }
7800        return (Gt);
7801      }
7802      else
7803      {
7804        if(printout > 0)
7805        {
7806          Print("\n//** rec_r_fractal_call: target weight doesn't stay in the correct cone.\n");
7807        }
7808
7809#ifndef  MSTDCC_FRACTAL
7810#ifdef PRINT_VECTORS
7811        if(printout > 0)
7812        {
7813          ivString(Xtau, "old Xtau");
7814        }
7815#endif
7816        intvec* Xtautmp;
7817        if(ivtarget->length() == nV)
7818        {
7819          Xtautmp = Mfpertvector(Gt, MivMatrixOrder(omtmp));
7820        }
7821        else
7822        {
7823          Xtautmp = Mfpertvector(Gt, ivtarget);
7824        }
7825#ifdef TEST_OVERFLOW
7826      if(Overflow_Error == TRUE)
7827      Gt = NULL; return(Gt);
7828#endif
7829
7830        if(MivSame(Xtau, Xtautmp) == 1)
7831        {
7832          //PrintS("\n// Update vectors are equal to the old vectors!!");
7833          delete Xtautmp;
7834          goto FRACTAL_MSTDCC;
7835        }
7836
7837        Xtau = Xtautmp;
7838        Xtautmp = NULL;
7839#ifdef PRINT_VECTORS
7840        if(printout > 0)
7841        {
7842          ivString(Xtau, "new  Xtau");
7843        }
7844#endif
7845
7846        for(i=nV-1; i>=0; i--)
7847          (*omega2)[i] = (*Xtau)[(nlev-1)*nV+i];
7848
7849        //Print("\n//  ring tau = %s;", rString(currRing));
7850        rChangeCurrRing(oRing);
7851        G = idrMoveR(Gt, testring,currRing);
7852
7853        goto NEXT_VECTOR_FRACTAL;
7854#endif
7855
7856      FRACTAL_MSTDCC:
7857        if(printout > 0)
7858        {
7859          Print("\n//** rec_r_fractal_call: apply Buchberger's algorithm in ring = %s.\n",
7860                rString(currRing));
7861        }
7862#ifdef TIME_TEST
7863        to=clock();
7864#endif
7865        G = MstdCC(Gt);
7866#ifdef TIME_TEST
7867        xtextra=xtextra+clock()-to;
7868#endif
7869        oRing = currRing;
7870
7871        // update the original target vector w.r.t. the current GB
7872        if(ivtarget->length() == nV)
7873        {
7874/*
7875          if(MivSame(Xivinput, Xivlp) == 1)
7876            if (rParameter(currRing) != NULL)
7877              DefRingParlp();
7878            else
7879              VMrDefaultlp();
7880          else
7881            if (rParameter(currRing) != NULL)
7882              DefRingPar(Xivinput);
7883            else
7884              rChangeCurrRing(VMrDefault(Xivinput));
7885*/
7886          rChangeCurrRing(VMrRefine(ivtarget,Xivinput));
7887        }
7888        else
7889        {
7890          rChangeCurrRing(VMatrRefine(ivtarget,Xivinput));
7891        }
7892        testring = currRing;
7893        Gt = idrMoveR(G, oRing,currRing);
7894
7895        // perturb the original target vector w.r.t. the current GB
7896        if(ivtarget->length() == nV)
7897        {
7898          delete Xtau;
7899          Xtau = NewVectorlp(Gt);
7900        }
7901        else
7902        {
7903          delete Xtau;
7904          Xtau = Mfpertvector(Gt,ivtarget);
7905        }
7906
7907        rChangeCurrRing(oRing);
7908        G = idrMoveR(Gt, testring,currRing);
7909
7910        delete omega2;
7911        delete next_vect;
7912        delete altomega;
7913        if(printout > 0)
7914        {
7915          Print("\n//** rec_r_fractal_call: (3) Leaving the %d-th recursion with %d steps.\n",
7916                nlev,nwalks);
7917          //Print(" ** Overflow_Error? (%d)", Overflow_Error);
7918        }
7919        if(Overflow_Error == TRUE)
7920          nnflow ++;
7921
7922        Overflow_Error = FALSE;
7923        return(G);
7924      }
7925    } //end of if(MivComp(next_vect, XivNull) == 1)
7926
7927    for(i=nV-1; i>=0; i--)
7928    {
7929      (*altomega)[i] = (*omega)[i];
7930      (*omega)[i] = (*next_vect)[i];
7931    }
7932    delete next_vect;
7933#ifdef TIME_TEST
7934    to=clock();
7935#endif
7936    // Take the initial form of <G> w.r.t. omega
7937    Gomega = MwalkInitialForm(G, omega);
7938#ifdef TIME_TEST
7939    xtif=xtif+clock()-to;
7940#endif
7941    //polylength = 1 if there is a polynomial in Gomega with at least 3 monomials and 0 otherwise
7942    //polylength = lengthpoly(Gomega);
7943#ifdef CHECK_IDEAL_MWALK
7944    if(printout > 1)
7945    {
7946      idString(Gomega,"//** rec_r_fractal_call: Gomega");
7947    }
7948#endif
7949    if(reduction == 0)
7950    {
7951      /* Check whether the intermediate weight vector lies in the interior of the cone.
7952       * If so, only perform reductions. Otherwise apply Buchberger's algorithm. */
7953      FF = middleOfCone(G,Gomega);
7954      if( FF != NULL)
7955      {
7956        idDelete(&G);
7957        G = idCopy(FF);
7958        idDelete(&FF);
7959        /* Compue next vector. */
7960        goto NEXT_VECTOR_FRACTAL;
7961      }
7962    }
7963
7964#ifndef  BUCHBERGER_ALG
7965    if(isNolVector(omega) == 0)
7966      hilb_func = hFirstSeries(Gomega,NULL,NULL,omega,currRing);
7967    else
7968      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
7969#endif
7970    if(ivtarget->length() == nV)
7971    {
7972/*
7973      if (rParameter(currRing) != NULL)
7974        DefRingPar(omega);
7975      else
7976        rChangeCurrRing(VMrDefault(omega));
7977*/
7978      rChangeCurrRing(VMrRefine(ivtarget,omega));
7979    }
7980    else
7981    {
7982      rChangeCurrRing(VMatrRefine(ivtarget,omega));
7983    }
7984    Gomega1 = idrMoveR(Gomega, oRing,currRing);
7985
7986    // Maximal recursion depth, to compute a red. GB
7987    // Fractal walk with the alternative recursion
7988    // alternative recursion
7989    if(nlev == Xnlev || lengthpoly(Gomega1) == 0)
7990    {
7991#ifdef TIME_TEST
7992      to=clock();
7993#endif
7994#ifdef  BUCHBERGER_ALG
7995      Gresult = MstdhomCC(Gomega1);
7996#else
7997      Gresult =kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,omega);
7998      delete hilb_func;
7999#endif
8000#ifdef TIME_TEST
8001      xtstd=xtstd+clock()-to;
8002#endif
8003    }
8004    else
8005    {
8006      rChangeCurrRing(oRing);
8007      Gomega1 = idrMoveR(Gomega1, oRing,currRing);
8008      Gresult = rec_r_fractal_call(idCopy(Gomega1),nlev+1,omega,weight_rad,reduction,printout);
8009    }
8010#ifdef CHECK_IDEAL_MWALK
8011    if(printout > 2)
8012    {
8013      idString(Gresult,"//** rec_r_fractal_call: M");
8014    }
8015#endif
8016    //convert a Groebner basis from a ring to another ring
8017    new_ring = currRing;
8018
8019    rChangeCurrRing(oRing);
8020    Gresult1 = idrMoveR(Gresult, new_ring,currRing);
8021    Gomega2 = idrMoveR(Gomega1, new_ring,currRing);
8022#ifdef TIME_TEST
8023    to=clock();
8024#endif
8025    // Lifting process
8026    F = MLifttwoIdeal(Gomega2, Gresult1, G);
8027#ifdef TIME_TEST
8028    xtlift=xtlift+clock()-to;
8029#endif
8030#ifdef CHECK_IDEAL_MWALK
8031    if(printout > 2)
8032    {
8033      idString(F,"//** rec_r_fractal_call: F");
8034    }
8035#endif
8036    id_Normalize(F,currRing);
8037    idDelete(&Gresult1);
8038    idDelete(&Gomega2);
8039    idDelete(&G);
8040
8041    rChangeCurrRing(new_ring);
8042    //F1 = idrMoveR(F, oRing,currRing);
8043    G = idrMoveR(F,oRing,currRing);
8044/*
8045#ifdef TIME_TEST
8046    to=clock();
8047#endif
8048    // Interreduce G
8049    G = kInterRedCC(F1, NULL);
8050#ifdef TIME_TEST
8051    xtred=xtred+clock()-to;
8052#endif
8053    idDelete(&F1);
8054*/
8055  }
8056}
8057
8058
8059/*******************************************************************************
8060 * The implementation of the fractal walk algorithm                            *
8061 *                                                                             *
8062 * The main procedure Mfwalk calls the recursive Subroutine                    *
8063 * rec_fractal_call to compute the wanted Groebner basis.                      *
8064 * At the main procedur we compute the reduced Groebner basis w.r.t. a "fast"  *
8065 * order, e.g. "dp" and a sequence of weight vectors which are row vectors     *
8066 * of a matrix. This matrix defines the given monomial order, e.g. "lp"        *
8067 *******************************************************************************/
8068ideal Mfwalk(ideal G, intvec* ivstart, intvec* ivtarget,
8069             int reduction, int printout)
8070{
8071  BITSET save1 = si_opt_1; // save current options
8072  if(reduction == 0)
8073  {
8074    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
8075    //si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
8076  }
8077  Set_Error(FALSE);
8078  Overflow_Error = FALSE;
8079  //Print("// pSetm_Error = (%d)", ErrorCheck());
8080  //Print("\n// ring ro = %s;", rString(currRing));
8081
8082  nnflow = 0;
8083  Xngleich = 0;
8084  Xcall = 0;
8085#ifdef TIME_TEST
8086  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
8087  xftinput = clock();
8088#endif
8089  ring  oldRing = currRing;
8090  int i, nV = currRing->N;
8091  XivNull = new intvec(nV);
8092  Xivinput = ivtarget;
8093  ngleich = 0;
8094#ifdef TIME_TEST
8095  to=clock();
8096#endif
8097  ideal I = MstdCC(G);
8098  G = NULL;
8099#ifdef TIME_TEST
8100  xftostd=clock()-to;
8101#endif
8102  Xsigma = ivstart;
8103
8104  Xnlev=nV;
8105
8106#ifdef FIRST_STEP_FRACTAL
8107  ideal Gw = MwalkInitialForm(I, ivstart);
8108  for(i=IDELEMS(Gw)-1; i>=0; i--)
8109  {
8110    if((Gw->m[i]!=NULL) // len >=0
8111    && (Gw->m[i]->next!=NULL) // len >=1
8112    && (Gw->m[i]->next->next!=NULL)) // len >=2
8113    {
8114      intvec* iv_dp = MivUnit(nV); // define (1,1,...,1)
8115      intvec* Mdp;
8116      if(ivstart->length() == nV)
8117      {
8118        if(MivSame(ivstart, iv_dp) != 1)
8119          Mdp = MivWeightOrderdp(ivstart);
8120        else
8121          Mdp = MivMatrixOrderdp(nV);
8122      }
8123      else
8124      {
8125        Mdp = ivstart;
8126      }
8127
8128      Xsigma = Mfpertvector(I, Mdp);
8129      Overflow_Error = FALSE;
8130
8131      delete Mdp;
8132      delete iv_dp;
8133      break;
8134    }
8135  }
8136  idDelete(&Gw);
8137#endif
8138
8139  ideal I1;
8140  intvec* Mlp;
8141  Xivlp = Mivlp(nV);
8142
8143  if(ivtarget->length() == nV)
8144  {
8145    if(MivComp(ivtarget, Xivlp)  != 1)
8146    {
8147      if (rParameter(currRing) != NULL)
8148        DefRingPar(ivtarget);
8149      else
8150        rChangeCurrRing(VMrDefault(ivtarget));
8151
8152      I1 = idrMoveR(I, oldRing,currRing);
8153      Mlp = MivWeightOrderlp(ivtarget);
8154      Xtau = Mfpertvector(I1, Mlp);
8155    }
8156    else
8157    {
8158      if (rParameter(currRing) != NULL)
8159        DefRingParlp();
8160      else
8161        VMrDefaultlp();
8162
8163      I1 = idrMoveR(I, oldRing,currRing);
8164      Mlp =  MivMatrixOrderlp(nV);
8165      Xtau = Mfpertvector(I1, Mlp);
8166    }
8167  }
8168  else
8169  {
8170    rChangeCurrRing(VMatrDefault(ivtarget));
8171    I1 = idrMoveR(I,oldRing,currRing);
8172    Mlp =  ivtarget;
8173    Xtau = Mfpertvector(I1, Mlp);
8174  }
8175  delete Mlp;
8176  Overflow_Error = FALSE;
8177
8178  //ivString(Xsigma, "Xsigma");
8179  //ivString(Xtau, "Xtau");
8180
8181  id_Delete(&I, oldRing);
8182  ring tRing = currRing;
8183  if(ivtarget->length() == nV)
8184  {
8185/*
8186    if (rParameter(currRing) != NULL)
8187      DefRingPar(ivstart);
8188    else
8189      rChangeCurrRing(VMrDefault(ivstart));
8190*/
8191    rChangeCurrRing(VMrRefine(ivtarget,ivstart));
8192  }
8193  else
8194  {
8195    //rChangeCurrRing(VMatrDefault(ivstart));
8196    rChangeCurrRing(VMatrRefine(ivtarget,ivstart));
8197  }
8198
8199  I = idrMoveR(I1,tRing,currRing);
8200#ifdef TIME_TEST
8201  to=clock();
8202#endif
8203  ideal J = MstdCC(I);
8204  idDelete(&I);
8205#ifdef TIME_TEST
8206  xftostd=xftostd+clock()-to;
8207#endif
8208  ideal resF;
8209  ring helpRing = currRing;
8210
8211  J = rec_fractal_call(J,1,ivtarget,reduction,printout);
8212  //idString(J,"//** Mfwalk: J");
8213  rChangeCurrRing(oldRing);
8214  //Print("\n//Mfwalk: (2)\n");
8215  resF = idrMoveR(J, helpRing,currRing);
8216  //Print("\n//Mfwalk: (3)\n");
8217  idSkipZeroes(resF);
8218  //Print("\n//Mfwalk: (4)\n");
8219
8220  si_opt_1 = save1; //set original options, e. g. option(RedSB)
8221  delete Xivlp;
8222  //delete Xsigma;
8223  delete Xtau;
8224  delete XivNull;
8225  //Print("\n//Mfwalk: (5)\n");
8226#ifdef TIME_TEST
8227  TimeStringFractal(xftinput, xftostd, xtif, xtstd, xtextra,
8228                    xtlift, xtred, xtnw);
8229
8230
8231  //Print("\n// pSetm_Error = (%d)", ErrorCheck());
8232  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
8233  Print("\n// the numbers of Overflow_Error (%d)", nnflow);
8234#endif
8235  //Print("\n//Mfwalk: (6)\n");
8236  //idString(resF,"//** Mfwalk: resF");
8237  return(idCopy(resF));
8238}
8239
8240/*******************************************************************************
8241 * The implementation of the fractal walk algorithm with random element        *
8242 *                                                                             *
8243 * The main procedur Mfwalk calls the recursive Subroutine                     *
8244 * rec_r_fractal_call to compute the wanted Groebner basis.                    *
8245 * At the main procedure we compute the reduced Groebner basis w.r.t. a "fast" *
8246 * order, e.g. "dp" and a sequence of weight vectors which are row vectors     *
8247 * of a matrix. This matrix defines the given monomial order, e.g. "lp"        *
8248 *******************************************************************************/
8249ideal Mfrwalk(ideal G, intvec* ivstart, intvec* ivtarget,
8250              int weight_rad, int reduction, int printout)
8251{
8252  BITSET save1 = si_opt_1; // save current options
8253  //check that weight radius is valid
8254  if(weight_rad < 0)
8255  {
8256    WerrorS("Invalid radius.\n");
8257    return NULL;
8258  }
8259  if(reduction == 0)
8260  {
8261    si_opt_1 &= (~Sy_bit(OPT_REDSB)); // no reduced Groebner basis
8262    si_opt_1 &= (~Sy_bit(OPT_REDTAIL)); // not tail reductions
8263  }
8264  Set_Error(FALSE);
8265  Overflow_Error = FALSE;
8266  //Print("// pSetm_Error = (%d)", ErrorCheck());
8267  //Print("\n// ring ro = %s;", rString(currRing));
8268
8269  nnflow = 0;
8270  Xngleich = 0;
8271  Xcall = 0;
8272#ifdef TIME_TEST
8273  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
8274  xftinput = clock();
8275#endif
8276  ring  oldRing = currRing;
8277  int i, nV = currRing->N;
8278  XivNull = new intvec(nV);
8279  Xivinput = ivtarget;
8280  ngleich = 0;
8281#ifdef TIME_TEST
8282  to=clock();
8283#endif
8284  ideal I = MstdCC(G);
8285  G = NULL;
8286#ifdef TIME_TEST
8287  xftostd=clock()-to;
8288#endif
8289  Xsigma = ivstart;
8290
8291  Xnlev=nV;
8292
8293#ifdef FIRST_STEP_FRACTAL
8294  ideal Gw = MwalkInitialForm(I, ivstart);
8295  for(i=IDELEMS(Gw)-1; i>=0; i--)
8296  {
8297    if((Gw->m[i]!=NULL) // len >=0
8298    && (Gw->m[i]->next!=NULL) // len >=1
8299    && (Gw->m[i]->next->next!=NULL)) // len >=2
8300    {
8301      intvec* iv_dp = MivUnit(nV); // define (1,1,...,1)
8302      intvec* Mdp;
8303      if(ivstart->length() == nV)
8304      {
8305        if(MivSame(ivstart, iv_dp) != 1)
8306          Mdp = MivWeightOrderdp(ivstart);
8307        else
8308          Mdp = MivMatrixOrderdp(nV);
8309      }
8310      else
8311      {
8312        Mdp = ivstart;
8313      }
8314
8315      Xsigma = Mfpertvector(I, Mdp);
8316      Overflow_Error = FALSE;
8317
8318      delete Mdp;
8319      delete iv_dp;
8320      break;
8321    }
8322  }
8323  idDelete(&Gw);
8324#endif
8325
8326  ideal I1;
8327  intvec* Mlp;
8328  Xivlp = Mivlp(nV);
8329
8330  if(ivtarget->length() == nV)
8331  {
8332    if(MivComp(ivtarget, Xivlp)  != 1)
8333    {
8334      if (rParameter(currRing) != NULL)
8335        DefRingPar(ivtarget);
8336      else
8337        rChangeCurrRing(VMrDefault(ivtarget));
8338
8339      I1 = idrMoveR(I, oldRing,currRing);
8340      Mlp = MivWeightOrderlp(ivtarget);
8341      Xtau = Mfpertvector(I1, Mlp);
8342    }
8343    else
8344    {
8345      if (rParameter(currRing) != NULL)
8346        DefRingParlp();
8347      else
8348        VMrDefaultlp();
8349
8350      I1 = idrMoveR(I, oldRing,currRing);
8351      Mlp =  MivMatrixOrderlp(nV);
8352      Xtau = Mfpertvector(I1, Mlp);
8353    }
8354  }
8355  else
8356  {
8357    rChangeCurrRing(VMatrDefault(ivtarget));
8358    I1 = idrMoveR(I,oldRing,currRing);
8359    Mlp =  ivtarget;
8360    Xtau = Mfpertvector(I1, Mlp);
8361  }
8362  delete Mlp;
8363  Overflow_Error = FALSE;
8364
8365  //ivString(Xsigma, "Xsigma");
8366  //ivString(Xtau, "Xtau");
8367
8368  id_Delete(&I, oldRing);
8369  ring tRing = currRing;
8370  if(ivtarget->length() == nV)
8371  {
8372/*
8373    if (rParameter(currRing) != NULL)
8374      DefRingPar(ivstart);
8375    else
8376      rChangeCurrRing(VMrDefault(ivstart));
8377*/
8378    rChangeCurrRing(VMrRefine(ivtarget,ivstart));
8379  }
8380  else
8381  {
8382    //rChangeCurrRing(VMatrDefault(ivstart));
8383    rChangeCurrRing(VMatrRefine(ivtarget,ivstart));
8384  }
8385
8386  I = idrMoveR(I1,tRing,currRing);
8387#ifdef TIME_TEST
8388  to=clock();
8389#endif
8390  ideal J = MstdCC(I);
8391  idDelete(&I);
8392#ifdef TIME_TEST
8393  xftostd=xftostd+clock()-to;
8394#endif
8395  ideal resF;
8396  ring helpRing = currRing;
8397
8398  J = rec_r_fractal_call(J,1,ivtarget,weight_rad,reduction,printout);
8399  //idString(J,"//*** Mfrwalk: J");
8400  //Print("\n//** Mfrwalk hier (1)\n");
8401  rChangeCurrRing(oldRing);
8402  //Print("\n//** Mfrwalk hier (2)\n");
8403  resF = idrMoveR(J, helpRing,currRing);
8404  //Print("\n//** Mfrwalk hier (3)\n");
8405  //idSkipZeroes(resF);
8406  //Print("\n//** Mfrwalk hier (4)\n");
8407  si_opt_1 = save1; //set original options, e. g. option(RedSB)
8408  delete Xivlp;
8409  //delete Xsigma;
8410  delete Xtau;
8411  delete XivNull;
8412  //Print("\n//** Mfrwalk hier (5)\n");
8413#ifdef TIME_TEST
8414  TimeStringFractal(xftinput, xftostd, xtif, xtstd, xtextra,
8415                    xtlift, xtred, xtnw);
8416
8417
8418 // Print("\n// pSetm_Error = (%d)", ErrorCheck());
8419  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
8420  Print("\n// the numbers of Overflow_Error (%d)", nnflow);
8421#endif
8422  //Print("\n//** Mfrwalk hier (6)\n");
8423  //idString(resF,"resF");
8424  //Print("\n//** Mfrwalk hier (7)\n");
8425  return(resF);
8426}
8427
8428/*******************************************************
8429 * Tran's algorithm                                    *
8430 *                                                     *
8431 * use kStd, if nP = 0, else call Ab_Rec_Pert (LastGB) *
8432 *******************************************************/
8433ideal TranMImprovwalk(ideal G,intvec* curr_weight,intvec* target_tmp, int nP)
8434{
8435#ifdef TIME_TEST
8436  clock_t mtim = clock();
8437#endif
8438  Set_Error(FALSE  );
8439  Overflow_Error =  FALSE;
8440  //Print("// pSetm_Error = (%d)", ErrorCheck());
8441  //Print("\n// ring ro = %s;", rString(currRing));
8442
8443#ifdef TIME_TEST
8444  clock_t tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0, textra=0;
8445  clock_t tinput = clock();
8446#endif
8447  int nsteppert=0, i, nV = currRing->N, nwalk=0, npert_tmp=0;
8448  int *npert=(int*)omAlloc(2*nV*sizeof(int));
8449  ideal Gomega, M,F,  G1, Gomega1, Gomega2, M1, F1;
8450  //ring endRing;
8451  ring newRing, oldRing, lpRing;
8452  intvec* next_weight;
8453  intvec* ivNull = new intvec(nV); //define (0,...,0)
8454  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
8455  intvec* iv_lp = Mivlp(nV); //define (1,0,...,0)
8456  ideal H0;
8457  //ideal  H1;
8458  ideal H2, Glp;
8459  int nGB, endwalks = 0,  nwalkpert=0;
8460  intvec* Mlp =  MivMatrixOrderlp(nV);
8461  intvec* vector_tmp = new intvec(nV);
8462#ifndef BUCHBERGER_ALG
8463  intvec* hilb_func;
8464#endif
8465  // to avoid (1,0,...,0) as the target vector
8466  intvec* last_omega = new intvec(nV);
8467  for(i=nV-1; i>0; i--)
8468    (*last_omega)[i] = 1;
8469  (*last_omega)[0] = 10000;
8470
8471  //  intvec* extra_curr_weight = new intvec(nV);
8472  intvec* target_weight = new intvec(nV);
8473  for(i=nV-1; i>=0; i--)
8474    (*target_weight)[i] = (*target_tmp)[i];
8475
8476  ring XXRing = currRing;
8477  newRing = currRing;
8478
8479#ifdef TIME_TEST
8480  to=clock();
8481#endif
8482  // compute a red. GB w.r.t. the help ring
8483  if(MivComp(curr_weight, iv_dp) == 1) //rOrdStr(currRing) = "dp"
8484    G = MstdCC(G);
8485  else
8486  {
8487    //rOrdStr(currRing) = (a(.c_w..),lp,C)
8488    if (rParameter(currRing) != NULL)
8489      DefRingPar(curr_weight);
8490    else
8491      rChangeCurrRing(VMrDefault(curr_weight));
8492    G = idrMoveR(G, XXRing,currRing);
8493    G = MstdCC(G);
8494  }
8495#ifdef TIME_TEST
8496  tostd=clock()-to;
8497#endif
8498
8499#ifdef REPRESENTATION_OF_SIGMA
8500  ideal Gw = MwalkInitialForm(G, curr_weight);
8501
8502  if(islengthpoly2(Gw)==1)
8503  {
8504    intvec* MDp;
8505    if(MivComp(curr_weight, iv_dp) == 1)
8506      MDp = MatrixOrderdp(nV); //MivWeightOrderlp(iv_dp);
8507    else
8508      MDp = MivWeightOrderlp(curr_weight);
8509
8510    curr_weight = RepresentationMatrix_Dp(G, MDp);
8511
8512    delete MDp;
8513
8514    ring exring = currRing;
8515
8516    if (rParameter(currRing) != NULL)
8517      DefRingPar(curr_weight);
8518    else
8519      rChangeCurrRing(VMrDefault(curr_weight));
8520#ifdef TIME_TEST
8521    to=clock();
8522#endif
8523    Gw = idrMoveR(G, exring,currRing);
8524    G = MstdCC(Gw);
8525    Gw = NULL;
8526#ifdef TIME_TEST
8527    tostd=tostd+clock()-to;
8528#endif
8529    //ivString(curr_weight,"rep. sigma");
8530    goto COMPUTE_NEW_VECTOR;
8531  }
8532
8533  idDelete(&Gw);
8534  delete iv_dp;
8535#endif
8536
8537
8538  while(1)
8539  {
8540#ifdef TIME_TEST
8541    to=clock();
8542#endif
8543    /* compute an initial form ideal of <G> w.r.t. "curr_vector" */
8544    Gomega = MwalkInitialForm(G, curr_weight);
8545#ifdef TIME_TEST
8546    tif=tif+clock()-to;
8547#endif
8548
8549#ifndef  BUCHBERGER_ALG
8550    if(isNolVector(curr_weight) == 0)
8551      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
8552    else
8553      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
8554#endif // BUCHBERGER_ALG
8555
8556    oldRing = currRing;
8557
8558    /* define a new ring that its ordering is "(a(curr_weight),lp) */
8559    if (rParameter(currRing) != NULL)
8560      DefRingPar(curr_weight);
8561    else
8562      rChangeCurrRing(VMrDefault(curr_weight));
8563
8564    newRing = currRing;
8565    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
8566
8567#ifdef TIME_TEST
8568    to=clock();
8569#endif
8570    /* compute a reduced Groebner basis of <Gomega> w.r.t. "newRing" */
8571#ifdef  BUCHBERGER_ALG
8572    M = MstdhomCC(Gomega1);
8573#else
8574    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
8575    delete hilb_func;
8576#endif // BUCHBERGER_ALG
8577#ifdef TIME_TEST
8578    tstd=tstd+clock()-to;
8579#endif
8580
8581    /* change the ring to oldRing */
8582    rChangeCurrRing(oldRing);
8583    M1 =  idrMoveR(M, newRing,currRing);
8584    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
8585
8586#ifdef TIME_TEST
8587    to=clock();
8588#endif
8589    /* compute a representation of the generators of submod (M)
8590       with respect to those of mod (Gomega).
8591       Gomega is a reduced Groebner basis w.r.t. the current ring */
8592    F = MLifttwoIdeal(Gomega2, M1, G);
8593#ifdef TIME_TEST
8594    tlift=tlift+clock()-to;
8595#endif
8596
8597    idDelete(&M1);
8598    idDelete(&Gomega2);
8599    idDelete(&G);
8600
8601    /* change the ring to newRing */
8602    rChangeCurrRing(newRing);
8603    F1 = idrMoveR(F, oldRing,currRing);
8604
8605#ifdef TIME_TEST
8606    to=clock();
8607#endif
8608    /* reduce the Groebner basis <G> w.r.t. new ring */
8609    G = kInterRedCC(F1, NULL);
8610#ifdef TIME_TEST
8611    tred=tred+clock()-to;
8612#endif
8613    idDelete(&F1);
8614
8615
8616  COMPUTE_NEW_VECTOR:
8617    newRing = currRing;
8618    nwalk++;
8619    nwalkpert++;
8620#ifdef TIME_TEST
8621    to=clock();
8622#endif
8623    // compute a next weight vector
8624    next_weight = MwalkNextWeightCC(curr_weight,target_weight, G);
8625#ifdef TIME_TEST
8626    tnw=tnw+clock()-to;
8627#endif
8628#ifdef PRINT_VECTORS
8629    MivString(curr_weight, target_weight, next_weight);
8630#endif
8631
8632    /* check whether the computed intermediate weight vector is in
8633       the correct cone; sometimes it is very big e.g. s7, cyc7.
8634       If it is NOT in the correct cone, then compute directly
8635       a reduced Groebner basis with respect to the lexicographic ordering
8636       for the known Groebner basis that it is computed in the last step.
8637    */
8638    //if(test_w_in_ConeCC(G, next_weight) != 1)
8639    if(Overflow_Error == TRUE)
8640    {
8641    OMEGA_OVERFLOW_TRAN_NEW:
8642      //Print("\n//  takes %d steps!", nwalk-1);
8643      //Print("\n//ring lastRing = %s;", rString(currRing));
8644#ifdef TEST_OVERFLOW
8645      goto  BE_FINISH;
8646#endif
8647/*
8648#ifdef CHECK_IDEAL_MWALK
8649      idElements(G, "G");
8650      //headidString(G, "G");
8651#endif
8652*/
8653      if(MivSame(target_tmp, iv_lp) == 1)
8654        if (rParameter(currRing) != NULL)
8655          DefRingParlp();
8656        else
8657          VMrDefaultlp();
8658      else
8659        if (rParameter(currRing) != NULL)
8660          DefRingPar(target_tmp);
8661        else
8662          rChangeCurrRing(VMrDefault(target_tmp));
8663
8664      lpRing = currRing;
8665      G1 = idrMoveR(G, newRing,currRing);
8666
8667#ifdef TIME_TEST
8668      to=clock();
8669#endif
8670      /*apply kStd or LastGB to compute  a lex. red. Groebner basis of <G>*/
8671      if(nP == 0 || MivSame(target_tmp, iv_lp) == 0){
8672        //Print("\n\n// calls \"std in ring r_%d = %s;", nwalk, rString(currRing));
8673        G = MstdCC(G1);//no result for qnt1
8674      }
8675      else {
8676        rChangeCurrRing(newRing);
8677        G1 = idrMoveR(G1, lpRing,currRing);
8678
8679        //Print("\n\n// calls \"LastGB\" (%d) to compute a GB", nV-1);
8680        G = LastGB(G1, curr_weight, nV-1); //no result for kats7
8681
8682        rChangeCurrRing(lpRing);
8683        G = idrMoveR(G, newRing,currRing);
8684      }
8685#ifdef TIME_TEST
8686      textra=clock()-to;
8687#endif
8688      npert[endwalks]=nwalk-npert_tmp;
8689      npert_tmp = nwalk;
8690      endwalks ++;
8691      break;
8692    }
8693
8694    /* check whether the computed Groebner basis is really a Groebner basis.
8695       If not, we perturb the target vector with the maximal "perturbation"
8696       degree.*/
8697    if(MivComp(next_weight, target_weight) == 1 ||
8698       MivComp(next_weight, curr_weight) == 1 )
8699    {
8700      //Print("\n//ring r_%d = %s;", nwalk, rString(currRing));
8701
8702
8703      //compute the number of perturbations and its step
8704      npert[endwalks]=nwalk-npert_tmp;
8705      npert_tmp = nwalk;
8706
8707      endwalks ++;
8708
8709      /*it is very important if the walk only uses one step, e.g. Fate, liu*/
8710      if(endwalks == 1 && MivComp(next_weight, curr_weight) == 1){
8711        rChangeCurrRing(XXRing);
8712        G = idrMoveR(G, newRing,currRing);
8713        goto FINISH;
8714      }
8715      H0 = id_Head(G,currRing);
8716
8717      if(MivSame(target_tmp, iv_lp) == 1)
8718        if (rParameter(currRing) != NULL)
8719          DefRingParlp();
8720        else
8721          VMrDefaultlp();
8722      else
8723        if (rParameter(currRing) != NULL)
8724          DefRingPar(target_tmp);
8725        else
8726          rChangeCurrRing(VMrDefault(target_tmp));
8727
8728      lpRing = currRing;
8729      Glp = idrMoveR(G, newRing,currRing);
8730      H2 = idrMoveR(H0, newRing,currRing);
8731
8732      /* Apply Lemma 2.2 in Collart et. al (1997) to check whether
8733         cone(k-1) is equal to cone(k) */
8734      nGB = 1;
8735      for(i=IDELEMS(Glp)-1; i>=0; i--)
8736      {
8737        poly t;
8738        if((t=pSub(pHead(Glp->m[i]), pCopy(H2->m[i]))) != NULL)
8739        {
8740          pDelete(&t);
8741          idDelete(&H2);//5.5.02
8742          nGB = 0; //i.e. Glp is no reduced Groebner basis
8743          break;
8744        }
8745        pDelete(&t);
8746      }
8747
8748      idDelete(&H2);//5.5.02
8749
8750      if(nGB == 1)
8751      {
8752        G = Glp;
8753        Glp = NULL;
8754        break;
8755      }
8756
8757       /* perturb the target weight vector, if the vector target_tmp
8758          stays in many cones */
8759      poly p;
8760      BOOLEAN plength3 = FALSE;
8761      for(i=IDELEMS(Glp)-1; i>=0; i--)
8762      {
8763        p = MpolyInitialForm(Glp->m[i], target_tmp);
8764        if(p->next != NULL &&
8765           p->next->next != NULL &&
8766           p->next->next->next != NULL)
8767        {
8768          Overflow_Error = FALSE;
8769
8770          for(i=0; i<nV; i++)
8771            (*vector_tmp)[i] = (*target_weight)[i];
8772
8773          delete target_weight;
8774          target_weight = MPertVectors(Glp, Mlp, nV);
8775
8776          if(MivComp(vector_tmp, target_weight)==1)
8777          {
8778            //PrintS("\n// The old and new representaion vector are the same!!");
8779            G = Glp;
8780            newRing = currRing;
8781            goto OMEGA_OVERFLOW_TRAN_NEW;
8782           }
8783
8784          if(Overflow_Error == TRUE)
8785          {
8786            rChangeCurrRing(newRing);
8787            G = idrMoveR(Glp, lpRing,currRing);
8788            goto OMEGA_OVERFLOW_TRAN_NEW;
8789          }
8790
8791          plength3 = TRUE;
8792          pDelete(&p);
8793          break;
8794        }
8795        pDelete(&p);
8796      }
8797
8798      if(plength3 == FALSE)
8799      {
8800        rChangeCurrRing(newRing);
8801        G = idrMoveR(Glp, lpRing,currRing);
8802        goto TRAN_LIFTING;
8803      }
8804
8805
8806      nwalkpert = 1;
8807      nsteppert ++;
8808
8809      /*
8810      Print("\n// Subroutine needs (%d) steps.", nwalk);
8811      idElements(Glp, "last G in walk:");
8812      PrintS("\n// ****************************************");
8813      Print("\n// Perturb the original target vector (%d): ", nsteppert);
8814      ivString(target_weight, "new target");
8815      PrintS("\n// ****************************************\n");
8816      */
8817      rChangeCurrRing(newRing);
8818      G = idrMoveR(Glp, lpRing,currRing);
8819
8820      delete next_weight;
8821
8822      //Print("\n// ring rNEW = %s;", rString(currRing));
8823      goto COMPUTE_NEW_VECTOR;
8824    }
8825
8826  TRAN_LIFTING:
8827    for(i=nV-1; i>=0; i--)
8828      (*curr_weight)[i] = (*next_weight)[i];
8829
8830    delete next_weight;
8831  }//while
8832#ifdef TEST_OVERFLOW
8833 BE_FINISH:
8834#endif
8835  rChangeCurrRing(XXRing);
8836  G = idrMoveR(G, lpRing,currRing);
8837
8838 FINISH:
8839  delete ivNull;
8840  delete next_weight;
8841  delete iv_lp;
8842  omFree(npert);
8843/*
8844#ifdef TIME_TEST
8845  Print("\n// Computation took %d steps and %.2f sec",
8846        nwalk, ((double) (clock()-mtim)/1000000));
8847
8848  TimeStringFractal(tinput, tostd, tif, tstd, textra, tlift, tred, tnw);
8849
8850 // Print("\n// pSetm_Error = (%d)", ErrorCheck());
8851  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
8852#endif
8853*/
8854  return(G);
8855}
8856
8857#if 0
8858/*******************************************************
8859 * Tran's algorithm with random element                *
8860 *                                                     *
8861 * use kStd, if nP = 0, else call Ab_Rec_Pert (LastGB) *
8862 *******************************************************/
8863ideal TranMrImprovwalk(ideal G,intvec* curr_weight,intvec* target_tmp, int nP, int weight_rad, int pert_deg)
8864{
8865#ifdef TIME_TEST
8866  clock_t mtim = clock();
8867#endif
8868  Set_Error(FALSE  );
8869  Overflow_Error =  FALSE;
8870  //Print("// pSetm_Error = (%d)", ErrorCheck());
8871  //Print("\n// ring ro = %s;", rString(currRing));
8872
8873#ifdef TIME_TEST
8874  clock_t tostd, tif=0, tstd=0, tlift=0, tred=0, tnw=0, textra=0;
8875  clock_t tinput = clock();
8876#endif
8877  int nsteppert=0, i, nV = currRing->N, nwalk=0, npert_tmp=0;
8878  int *npert=(int*)omAlloc(2*nV*sizeof(int));
8879  ideal Gomega, M,F,  G1, Gomega1, Gomega2, M1, F1;
8880  //ring endRing;
8881  ring newRing, oldRing, lpRing;
8882  intvec* next_weight;
8883  intvec* ivNull = new intvec(nV); //define (0,...,0)
8884  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
8885  intvec* iv_lp = Mivlp(nV); //define (1,0,...,0)
8886  ideal H0;
8887  //ideal H1;
8888  ideal H2, Glp;
8889  int weight_norm, nGB, endwalks = 0,  nwalkpert=0,  npertstep=0;
8890  intvec* Mlp =  MivMatrixOrderlp(nV);
8891  intvec* vector_tmp = new intvec(nV);
8892#ifndef BUCHBERGER_ALG
8893  intvec* hilb_func;
8894#endif
8895  // to avoid (1,0,...,0) as the target vector
8896  intvec* last_omega = new intvec(nV);
8897  for(i=nV-1; i>0; i--)
8898  {
8899    (*last_omega)[i] = 1;
8900  }
8901  (*last_omega)[0] = 10000;
8902
8903//intvec* extra_curr_weight = new intvec(nV);
8904  intvec* target_weight = new intvec(nV);
8905  for(i=nV-1; i>=0; i--)
8906  {
8907    (*target_weight)[i] = (*target_tmp)[i];
8908  }
8909  ring XXRing = currRing;
8910  newRing = currRing;
8911
8912#ifdef TIME_TEST
8913  to=clock();
8914#endif
8915  // compute a red. GB w.r.t. the help ring
8916  if(MivComp(curr_weight, iv_dp) == 1)
8917  {
8918    //rOrdStr(currRing) = "dp"
8919    G = MstdCC(G);
8920  }
8921  else
8922  {
8923    //rOrdStr(currRing) = (a(.c_w..),lp,C)
8924    if (rParameter(currRing) != NULL)
8925    {
8926      DefRingPar(curr_weight);
8927    }
8928    else
8929    {
8930      rChangeCurrRing(VMrDefault(curr_weight));
8931    }
8932    G = idrMoveR(G, XXRing,currRing);
8933    G = MstdCC(G);
8934  }
8935#ifdef TIME_TEST
8936  tostd=clock()-to;
8937#endif
8938
8939#ifdef REPRESENTATION_OF_SIGMA
8940  ideal Gw = MwalkInitialForm(G, curr_weight);
8941
8942  if(islengthpoly2(Gw)==1)
8943  {
8944    intvec* MDp;
8945    if(MivComp(curr_weight, iv_dp) == 1)
8946    {
8947      MDp = MatrixOrderdp(nV); //MivWeightOrderlp(iv_dp);
8948    }
8949    else
8950    {
8951      MDp = MivWeightOrderlp(curr_weight);
8952    }
8953    curr_weight = RepresentationMatrix_Dp(G, MDp);
8954
8955    delete MDp;
8956
8957    ring exring = currRing;
8958
8959    if (rParameter(currRing) != NULL)
8960    {
8961      DefRingPar(curr_weight);
8962    }
8963    else
8964    {
8965      rChangeCurrRing(VMrDefault(curr_weight));
8966    }
8967#ifdef TIME_TEST
8968    to=clock();
8969#endif
8970    Gw = idrMoveR(G, exring,currRing);
8971    G = MstdCC(Gw);
8972    Gw = NULL;
8973#ifdef TIME_TEST
8974    tostd=tostd+clock()-to;
8975#endif
8976    //ivString(curr_weight,"rep. sigma");
8977    goto COMPUTE_NEW_VECTOR;
8978  }
8979
8980  idDelete(&Gw);
8981  delete iv_dp;
8982#endif
8983
8984
8985  while(1)
8986  {
8987#ifdef TIME_TEST
8988    to=clock();
8989#endif
8990    // compute an initial form ideal of <G> w.r.t. "curr_vector"
8991    Gomega = MwalkInitialForm(G, curr_weight);
8992#ifdef TIME_TEST
8993    tif=tif+clock()-to;
8994#endif
8995
8996#ifndef  BUCHBERGER_ALG
8997    if(isNolVector(curr_weight) == 0)
8998    {
8999      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
9000    }
9001    else
9002    {
9003      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
9004    }
9005#endif // BUCHBERGER_ALG
9006
9007    oldRing = currRing;
9008
9009    // define a new ring with ordering "(a(curr_weight),lp)
9010    if (rParameter(currRing) != NULL)
9011    {
9012      DefRingPar(curr_weight);
9013    }
9014    else
9015    {
9016      rChangeCurrRing(VMrDefault(curr_weight));
9017    }
9018    newRing = currRing;
9019    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
9020
9021#ifdef TIME_TEST
9022    to=clock();
9023#endif
9024    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
9025#ifdef  BUCHBERGER_ALG
9026    M = MstdhomCC(Gomega1);
9027#else
9028    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
9029    delete hilb_func;
9030#endif
9031#ifdef TIME_TEST
9032    tstd=tstd+clock()-to;
9033#endif
9034
9035    // change the ring to oldRing
9036    rChangeCurrRing(oldRing);
9037    M1 =  idrMoveR(M, newRing,currRing);
9038    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
9039
9040#ifdef TIME_TEST
9041    to=clock();
9042#endif
9043    // compute a representation of the generators of submod (M) with respect to those of mod (Gomega).
9044    // Gomega is a reduced Groebner basis w.r.t. the current ring
9045    F = MLifttwoIdeal(Gomega2, M1, G);
9046#ifdef TIME_TEST
9047    tlift=tlift+clock()-to;
9048#endif
9049
9050    idDelete(&M1);
9051    idDelete(&Gomega2);
9052    idDelete(&G);
9053
9054    // change the ring to newRing
9055    rChangeCurrRing(newRing);
9056    F1 = idrMoveR(F, oldRing,currRing);
9057
9058#ifdef TIME_TEST
9059    to=clock();
9060#endif
9061    // reduce the Groebner basis <G> w.r.t. new ring
9062    G = kInterRedCC(F1, NULL);
9063#ifdef TIME_TEST
9064    tred=tred+clock()-to;
9065#endif
9066    idDelete(&F1);
9067
9068  COMPUTE_NEW_VECTOR:
9069    newRing = currRing;
9070    nwalk++;
9071    nwalkpert++;
9072#ifdef TIME_TEST
9073    to=clock();
9074#endif
9075    // compute a next weight vector
9076    //next_weight = MwalkNextWeightCC(curr_weight,target_weight, G);
9077    next_weight = MWalkRandomNextWeight(G, curr_weight, target_weight, weight_rad, pert_deg);
9078/*
9079    next_weight = MkInterRedNextWeight(curr_weight,target_weight,G);
9080
9081    if(MivComp(next_weight, target_weight) != 1)
9082    {
9083      // compute a perturbed next weight vector "next_weight1"
9084      intvec* next_weight1 = MkInterRedNextWeight(MPertVectors(G, MivMatrixOrder(curr_weight), pert_deg), target_weight, G);
9085
9086      // compare next_weight and next_weight1
9087      ideal G_test = MwalkInitialForm(G, next_weight);
9088      ideal G_test1 = MwalkInitialForm(G, next_weight1);
9089      if(IDELEMS(G_test1) <= IDELEMS(G_test))
9090      {
9091        next_weight = ivCopy(next_weight1);
9092      }
9093      delete next_weight1;
9094      // compute a random next weight vector "next_weight2"
9095      intvec* next_weight22 = ivCopy(target_weight);
9096      // Print("\n//  size of target_weight  = %d", sizeof((*target_weight)));
9097      k = 0;
9098
9099      while(test_w_in_ConeCC(G, next_weight22) == 0 && k < 11)
9100      {
9101        k++;
9102        if(k>10)
9103        {
9104          break;
9105        }
9106        weight_norm = 0;
9107        while(weight_norm == 0)
9108        {
9109          for(i=nV-1; i>=0; i--)
9110          {
9111            // Print("\n//  next_weight[%d]  = %d", i, (*next_weight)[i]);
9112            (*next_weight22)[i] = rand() % 60000 - 30000;
9113            weight_norm = weight_norm + (*next_weight22)[i]*(*next_weight22)[i];
9114          }
9115          weight_norm = 1 + floor(sqrt(weight_norm));
9116        }
9117        for(i=nV-1; i>=0; i--)
9118        {
9119          if((*next_weight22)[i] < 0)
9120          {
9121            (*next_weight22)[i] = 1 + (*curr_weight)[i] + floor(weight_rad*(*next_weight22)[i]/weight_norm);
9122          }
9123          else
9124          {
9125            (*next_weight22)[i] = (*curr_weight)[i] + floor(weight_rad*(*next_weight22)[i]/weight_norm);
9126          }
9127          // Print("\n//  next_weight22[%d]  = %d", i, (*next_weight22)[i]);
9128        }
9129      }
9130
9131      if(test_w_in_ConeCC(G, next_weight22) == 1)
9132      {
9133        // compare next_weight and next_weight2
9134        // Print("\n// ZUFALL IM KEGEL");
9135        intvec* next_weight2 = MkInterRedNextWeight(next_weight22, target_weight, G);
9136
9137        ideal G_test2 = MwalkInitialForm(G, next_weight2);
9138        if(IDELEMS(G_test2) <= IDELEMS(G_test))
9139        {
9140          if(IDELEMS(G_test2) <= IDELEMS(G_test1))
9141          {
9142             // Print("\n// ZUFALL BENUTZT!\n");
9143            next_weight = ivCopy(next_weight2);
9144          }
9145        }
9146        idDelete(&G_test2);
9147        delete next_weight2;
9148      }
9149      delete next_weight22;
9150      idDelete(&G_test);
9151      idDelete(&G_test1);
9152    }*/
9153
9154#ifdef TIME_TEST
9155    tnw=tnw+clock()-to;
9156#endif
9157#ifdef PRINT_VECTORS
9158    MivString(curr_weight, target_weight, next_weight);
9159#endif
9160
9161/*   check whether the computed intermediate weight vector is in
9162     the correct cone; sometimes it is very big e.g. s7, cyc7.
9163     If it is NOT in the correct cone, then compute directly
9164     a reduced Groebner basis with respect to the lexicographic ordering
9165     for the known Groebner basis that it is computed in the last step.
9166*/
9167    //if(test_w_in_ConeCC(G, next_weight) != 1)
9168    if(Overflow_Error == TRUE)
9169    {
9170    OMEGA_OVERFLOW_TRAN_NEW:
9171      //Print("\n//  takes %d steps!", nwalk-1);
9172      //Print("\n//ring lastRing = %s;", rString(currRing));
9173#ifdef TEST_OVERFLOW
9174      goto  BE_FINISH;
9175#endif
9176
9177#ifdef CHECK_IDEAL_MWALK
9178      idElements(G, "G");
9179      //headidString(G, "G");
9180#endif
9181
9182      if(MivSame(target_tmp, iv_lp) == 1)
9183      {
9184        if (rParameter(currRing) != NULL)
9185        {
9186          DefRingParlp();
9187        }
9188        else
9189        {
9190          VMrDefaultlp();
9191        }
9192      }
9193      else
9194      {
9195        if (rParameter(currRing) != NULL)
9196        {
9197          DefRingPar(target_tmp);
9198        }
9199        else
9200        {
9201          rChangeCurrRing(VMrDefault(target_tmp));
9202        }
9203      }
9204      lpRing = currRing;
9205      G1 = idrMoveR(G, newRing,currRing);
9206
9207#ifdef TIME_TEST
9208      to=clock();
9209#endif
9210      // apply kStd or LastGB to compute  a lex. red. Groebner basis of <G>
9211      if(nP == 0 || MivSame(target_tmp, iv_lp) == 0)
9212      {
9213        //Print("\n\n// calls \"std in ring r_%d = %s;", nwalk, rString(currRing));
9214        G = MstdCC(G1);//no result for qnt1
9215      }
9216      else
9217      {
9218        rChangeCurrRing(newRing);
9219        G1 = idrMoveR(G1, lpRing,currRing);
9220
9221        //Print("\n\n// calls \"LastGB\" (%d) to compute a GB", nV-1);
9222        G = LastGB(G1, curr_weight, nV-1); //no result for kats7
9223
9224        rChangeCurrRing(lpRing);
9225        G = idrMoveR(G, newRing,currRing);
9226      }
9227#ifdef TIME_TEST
9228      textra=clock()-to;
9229#endif
9230      npert[endwalks]=nwalk-npert_tmp;
9231      npert_tmp = nwalk;
9232      endwalks ++;
9233      break;
9234    }
9235
9236    // check whether the computed Groebner basis is really a Groebner basis.
9237    // If not, we perturb the target vector with the maximal "perturbation" degree.
9238
9239    if(MivComp(next_weight, target_weight) == 1 || MivComp(next_weight, curr_weight) == 1 )
9240    {
9241      //Print("\n//ring r_%d = %s;", nwalk, rString(currRing));
9242
9243
9244      //compute the number of perturbations and its step
9245      npert[endwalks]=nwalk-npert_tmp;
9246      npert_tmp = nwalk;
9247
9248      endwalks ++;
9249
9250      // it is very important if the walk only uses one step, e.g. Fate, liu
9251      if(endwalks == 1 && MivComp(next_weight, curr_weight) == 1)
9252      {
9253        rChangeCurrRing(XXRing);
9254        G = idrMoveR(G, newRing,currRing);
9255        goto FINISH;
9256      }
9257      H0 = id_Head(G,currRing);
9258
9259      if(MivSame(target_tmp, iv_lp) == 1)
9260      {
9261        if (rParameter(currRing) != NULL)
9262        {
9263          DefRingParlp();
9264        }
9265        else
9266        {
9267          VMrDefaultlp();
9268        }
9269      }
9270      else
9271      {
9272        if (rParameter(currRing) != NULL)
9273        {
9274          DefRingPar(target_tmp);
9275        }
9276        else
9277        {
9278          rChangeCurrRing(VMrDefault(target_tmp));
9279        }
9280      }
9281      lpRing = currRing;
9282      Glp = idrMoveR(G, newRing,currRing);
9283      H2 = idrMoveR(H0, newRing,currRing);
9284
9285      // Apply Lemma 2.2 in Collart et. al (1997) to check whether cone(k-1) is equal to cone(k)
9286      nGB = 1;
9287      for(i=IDELEMS(Glp)-1; i>=0; i--)
9288      {
9289        poly t;
9290        if((t=pSub(pHead(Glp->m[i]), pCopy(H2->m[i]))) != NULL)
9291        {
9292          pDelete(&t);
9293          idDelete(&H2);//5.5.02
9294          nGB = 0; //i.e. Glp is no reduced Groebner basis
9295          break;
9296        }
9297        pDelete(&t);
9298      }
9299
9300      idDelete(&H2);//5.5.02
9301
9302      if(nGB == 1)
9303      {
9304        G = Glp;
9305        Glp = NULL;
9306        break;
9307      }
9308
9309       // perturb the target weight vector, if the vector target_tmp stays in many cones
9310      poly p;
9311      BOOLEAN plength3 = FALSE;
9312      for(i=IDELEMS(Glp)-1; i>=0; i--)
9313      {
9314        p = MpolyInitialForm(Glp->m[i], target_tmp);
9315        if(p->next != NULL &&
9316           p->next->next != NULL &&
9317           p->next->next->next != NULL)
9318        {
9319          Overflow_Error = FALSE;
9320
9321          for(i=0; i<nV; i++)
9322          {
9323            (*vector_tmp)[i] = (*target_weight)[i];
9324          }
9325          delete target_weight;
9326          target_weight = MPertVectors(Glp, Mlp, nV);
9327
9328          if(MivComp(vector_tmp, target_weight)==1)
9329          {
9330            //PrintS("\n// The old and new representaion vector are the same!!");
9331            G = Glp;
9332            newRing = currRing;
9333            goto OMEGA_OVERFLOW_TRAN_NEW;
9334           }
9335
9336          if(Overflow_Error == TRUE)
9337          {
9338            rChangeCurrRing(newRing);
9339            G = idrMoveR(Glp, lpRing,currRing);
9340            goto OMEGA_OVERFLOW_TRAN_NEW;
9341          }
9342
9343          plength3 = TRUE;
9344          pDelete(&p);
9345          break;
9346        }
9347        pDelete(&p);
9348      }
9349
9350      if(plength3 == FALSE)
9351      {
9352        rChangeCurrRing(newRing);
9353        G = idrMoveR(Glp, lpRing,currRing);
9354        goto TRAN_LIFTING;
9355      }
9356
9357
9358      npertstep = nwalk;
9359      nwalkpert = 1;
9360      nsteppert ++;
9361
9362      /*
9363      Print("\n// Subroutine needs (%d) steps.", nwalk);
9364      idElements(Glp, "last G in walk:");
9365      PrintS("\n// ****************************************");
9366      Print("\n// Perturb the original target vector (%d): ", nsteppert);
9367      ivString(target_weight, "new target");
9368      PrintS("\n// ****************************************\n");
9369      */
9370      rChangeCurrRing(newRing);
9371      G = idrMoveR(Glp, lpRing,currRing);
9372
9373      delete next_weight;
9374
9375      //Print("\n// ring rNEW = %s;", rString(currRing));
9376      goto COMPUTE_NEW_VECTOR;
9377    }
9378
9379  TRAN_LIFTING:
9380    for(i=nV-1; i>=0; i--)
9381    {
9382      (*curr_weight)[i] = (*next_weight)[i];
9383    }
9384    delete next_weight;
9385  } // end of while
9386#ifdef TEST_OVERFLOW
9387 BE_FINISH:
9388#endif
9389  rChangeCurrRing(XXRing);
9390  G = idrMoveR(G, lpRing,currRing);
9391
9392 FINISH:
9393  delete ivNull;
9394  delete next_weight;
9395  delete iv_lp;
9396  omFree(npert);
9397
9398#ifdef TIME_TEST
9399  Print("\n// Computation took %d steps and %.2f sec", nwalk, ((double) (clock()-mtim)/1000000));
9400
9401  TimeStringFractal(tinput, tostd, tif, tstd, textra, tlift, tred, tnw);
9402
9403  Print("\n// pSetm_Error = (%d)", ErrorCheck());
9404  Print("\n// Overflow_Error? (%d)\n", Overflow_Error);
9405#endif
9406
9407  return(G);
9408}
9409#endif
9410
9411/*****************************************************************
9412 * compute the reduced Groebner basis of an ideal <Go> w.r.t. lp *
9413 *****************************************************************/
9414static ideal Mpwalk_MAltwalk1(ideal Go, intvec* curr_weight, int tp_deg)
9415{
9416  Overflow_Error = FALSE;
9417 // BOOLEAN nOverflow_Error = FALSE;
9418#ifdef TIME_TEST
9419  clock_t tproc=0;
9420  clock_t tinput=clock();
9421#endif
9422  int i, nV = currRing->N;
9423
9424  //check that perturbation degree is valid
9425  if(tp_deg < 1 || tp_deg > nV)
9426  {
9427    WerrorS("Invalid perturbation degree.\n");
9428    return NULL;
9429  }
9430
9431  int nwalk=0, endwalks=0, ntestwinC=1;
9432  int tp_deg_tmp = tp_deg;
9433  ideal Gomega, M, F, G, M1, F1, Gomega1, Gomega2, G1;
9434  ring newRing, oldRing, TargetRing;
9435  intvec* next_weight;
9436  intvec* ivNull = new intvec(nV);
9437
9438  ring YXXRing = currRing;
9439
9440  intvec* iv_M_dpp = MivMatrixOrderlp(nV);
9441  intvec* target_weight;// = Mivlp(nV);
9442  ideal ssG;
9443
9444  // perturb the target vector
9445  while(1)
9446  {
9447    if(Overflow_Error == FALSE)
9448    {
9449      if (rParameter(currRing) != NULL)
9450      {
9451        DefRingParlp();
9452      }
9453      else
9454      {
9455        VMrDefaultlp();
9456      }
9457      TargetRing = currRing;
9458      ssG = idrMoveR(Go,YXXRing,currRing);
9459    }
9460    Overflow_Error = FALSE;
9461    if(tp_deg != 1)
9462    {
9463      target_weight = MPertVectors(ssG, iv_M_dpp, tp_deg);
9464    }
9465    else
9466    {
9467      target_weight = Mivlp(nV);
9468      break;
9469    }
9470    if(Overflow_Error == FALSE)
9471    {
9472      break;
9473    }
9474    Overflow_Error = TRUE;
9475    tp_deg --;
9476  }
9477  if(tp_deg != tp_deg_tmp)
9478  {
9479    Overflow_Error = TRUE;
9480    //nOverflow_Error = TRUE;
9481  }
9482
9483  //  Print("\n// tp_deg = %d", tp_deg);
9484  // ivString(target_weight, "pert target");
9485
9486  delete iv_M_dpp;
9487#ifndef  BUCHBERGER_ALG
9488  intvec* hilb_func;
9489#endif
9490  // to avoid (1,0,...,0) as the target vector
9491  intvec* last_omega = new intvec(nV);
9492  for(i=nV-1; i>0; i--)
9493  {
9494    (*last_omega)[i] = 1;
9495  }
9496  (*last_omega)[0] = 10000;
9497
9498  rChangeCurrRing(YXXRing);
9499  G = idrMoveR(ssG, TargetRing,currRing);
9500
9501  while(1)
9502  {
9503    nwalk ++;
9504    nstep ++;
9505
9506    if(nwalk==1)
9507    {
9508      goto FIRST_STEP;
9509    }
9510#ifdef TIME_TEST
9511    to=clock();
9512#endif
9513    // compute an initial form ideal of <G> w.r.t. "curr_vector"
9514    Gomega = MwalkInitialForm(G, curr_weight);
9515#ifdef TIME_TEST
9516    xtif=xtif+clock()-to;
9517#endif
9518
9519#ifndef  BUCHBERGER_ALG
9520    if(isNolVector(curr_weight) == 0)
9521      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
9522    else
9523      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
9524#endif
9525
9526    oldRing = currRing;
9527
9528    // define a new ring that its ordering is "(a(curr_weight),lp)
9529    if (rParameter(currRing) != NULL)
9530    {
9531      DefRingPar(curr_weight);
9532    }
9533    else
9534    {
9535      rChangeCurrRing(VMrDefault(curr_weight));
9536    }
9537    newRing = currRing;
9538    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
9539/*
9540#ifdef ENDWALKS
9541    if(endwalks == 1)
9542    {
9543      Print("\n//  it is  %d-th step!!", nwalk);
9544      idString(Gomega1, "Gw");
9545      PrintS("\n//  compute a rGB of Gw:");
9546    }
9547#endif
9548*/
9549#ifdef TIME_TEST
9550    to=clock();
9551#endif
9552    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
9553#ifdef  BUCHBERGER_ALG
9554    M = MstdhomCC(Gomega1);
9555#else
9556    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
9557    delete hilb_func;
9558#endif // BUCHBERGER_ALG
9559#ifdef TIME_TEST
9560    xtstd=xtstd+clock()-to;
9561#endif
9562
9563    // change the ring to oldRing
9564    rChangeCurrRing(oldRing);
9565    M1 =  idrMoveR(M, newRing,currRing);
9566    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
9567#ifdef TIME_TEST
9568    to=clock();
9569#endif
9570
9571    // if(endwalks == 1){PrintS("\n//  Lifting is still working:");}
9572
9573    // compute a reduced Groebner basis of <G> w.r.t. "newRing" by the lifting process
9574    F = MLifttwoIdeal(Gomega2, M1, G);
9575#ifdef TIME_TEST
9576    xtlift=xtlift+clock()-to;
9577#endif
9578
9579    idDelete(&M1);
9580    idDelete(&Gomega2);
9581    idDelete(&G);
9582
9583    // change the ring to newRing
9584    rChangeCurrRing(newRing);
9585    F1 = idrMoveR(F, oldRing,currRing);
9586#ifdef TIME_TEST
9587    to=clock();
9588#endif
9589    //if(endwalks == 1){ PrintS("\n//  InterRed is still working:");}
9590    // reduce the Groebner basis <G> w.r.t. the new ring
9591    G = kInterRedCC(F1, NULL);
9592#ifdef TIME_TEST
9593    xtred=xtred+clock()-to;
9594#endif
9595    idDelete(&F1);
9596
9597    if(endwalks == 1)
9598      break;
9599
9600  FIRST_STEP:
9601    Overflow_Error=FALSE;
9602#ifdef TIME_TEST
9603    to=clock();
9604#endif
9605    // compute a next weight vector
9606    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
9607#ifdef TIME_TEST
9608    xtnw=xtnw+clock()-to;
9609#endif
9610#ifdef PRINT_VECTORS
9611    MivString(curr_weight, target_weight, next_weight);
9612#endif
9613
9614    if(Overflow_Error == TRUE)
9615    {
9616      delete next_weight;
9617      if(tp_deg > 1){
9618        //nOverflow_Error = Overflow_Error;
9619#ifdef TIME_TEST
9620        tproc = tproc+clock()-tinput;
9621#endif
9622        //Print("\n// A subroutine takes %d steps and calls \"Mpwalk\" (1,%d):", nwalk, tp_deg-1);
9623        G1 = Mpwalk_MAltwalk1(G, curr_weight, tp_deg-1);
9624        goto MPW_Finish;
9625      }
9626      else {
9627        newRing = currRing;
9628        ntestwinC = 0;
9629        break;
9630      }
9631    }
9632
9633    if(MivComp(next_weight, ivNull) == 1)
9634    {
9635      newRing = currRing;
9636      delete next_weight;
9637      break;
9638    }
9639    if(MivComp(next_weight, target_weight) == 1)
9640    {
9641      endwalks = 1;
9642    }
9643    for(i=nV-1; i>=0; i--)
9644    {
9645      //(*extra_curr_weight)[i] = (*curr_weight)[i];
9646      (*curr_weight)[i] = (*next_weight)[i];
9647    }
9648    delete next_weight;
9649  }//while
9650
9651  // check whether the pertubed target vector is correct
9652
9653  //define and execute ring with lex. order
9654  if (rParameter(currRing) != NULL)
9655  {
9656    DefRingParlp();
9657  }
9658  else
9659  {
9660    VMrDefaultlp();
9661  }
9662  G1 = idrMoveR(G, newRing,currRing);
9663
9664  if( test_w_in_ConeCC(G1, target_weight) != 1 || ntestwinC == 0)
9665  {
9666    //PrintS("\n// The perturbed target vector doesn't STAY in the correct cone!!");
9667    if(tp_deg == 1)
9668    {
9669      //Print("\n// subroutine takes %d steps and applys \"std\"", nwalk);
9670#ifdef TIME_TEST
9671      to=clock();
9672#endif
9673      ideal G2 = MstdCC(G1);
9674#ifdef TIME_TEST
9675      xtextra=xtextra+clock()-to;
9676#endif
9677      idDelete(&G1);
9678      G1 = G2;
9679      G2 = NULL;
9680    }
9681    else
9682    {
9683      //nOverflow_Error = Overflow_Error;
9684#ifdef TIME_TEST
9685      tproc = tproc+clock()-tinput;
9686#endif
9687      // Print("\n// B subroutine takes %d steps and calls \"Mpwalk\" (1,%d) :", nwalk,  tp_deg-1);
9688      G1 = Mpwalk_MAltwalk1(G1, curr_weight, tp_deg-1);
9689    }
9690  }
9691
9692 MPW_Finish:
9693  newRing = currRing;
9694  rChangeCurrRing(YXXRing);
9695  ideal result = idrMoveR(G1, newRing,currRing);
9696
9697  delete ivNull;
9698  delete target_weight;
9699
9700  //Print("\n// \"Mpwalk\" (1,%d) took %d steps and %.2f sec. Overflow_Error (%d)", tp_deg, nwalk, ((double) clock()-tinput)/1000000, nOverflow_Error);
9701  //Print("\n// Mprwalk took %d steps. Ring= %s;\n", nwalk, rString(currRing));
9702  return(result);
9703}
9704
9705/*******************************************************************
9706 * Implementation of the first alternative Groebner Walk Algorithm *
9707 *******************************************************************/
9708ideal MAltwalk1(ideal Go, int op_deg, int tp_deg, intvec* curr_weight,
9709                intvec* target_weight)
9710{
9711  Set_Error(FALSE  );
9712  Overflow_Error = FALSE;
9713#ifdef TIME_TEST
9714  BOOLEAN nOverflow_Error = FALSE;
9715#endif
9716  // Print("// pSetm_Error = (%d)", ErrorCheck());
9717
9718#ifdef TIME_TEST
9719  xtif=0; xtstd=0; xtlift=0; xtred=0; xtnw=0; xtextra=0;
9720  xftinput = clock();
9721  clock_t tostd, tproc;
9722#endif
9723
9724  nstep = 0;
9725  int i, nV = currRing->N;
9726  int nwalk=0, endwalks=0;
9727  int op_tmp = op_deg;
9728  ideal Gomega, M, F, G, Gomega1, Gomega2, M1, F1;
9729  ring newRing, oldRing;
9730  intvec* next_weight;
9731  intvec* iv_M_dp;
9732  intvec* ivNull = new intvec(nV);
9733  intvec* iv_dp = MivUnit(nV);// define (1,1,...,1)
9734  intvec* exivlp = Mivlp(nV);
9735  //intvec* extra_curr_weight = new intvec(nV);
9736#ifndef  BUCHBERGER_ALG
9737  intvec* hilb_func;
9738#endif
9739  intvec* cw_tmp = curr_weight;
9740
9741  // to avoid (1,0,...,0) as the target vector
9742  intvec* last_omega = new intvec(nV);
9743  for(i=nV-1; i>0; i--)
9744  {
9745    (*last_omega)[i] = 1;
9746  }
9747  (*last_omega)[0] = 10000;
9748
9749  ring XXRing = currRing;
9750
9751#ifdef TIME_TEST
9752  to=clock();
9753#endif
9754  /* compute a pertubed weight vector of the original weight vector.
9755     The perturbation degree is recursive decrease until that vector
9756     stays inn the correct cone. */
9757  while(1)
9758  {
9759    if(Overflow_Error == FALSE)
9760    {
9761      if(MivComp(curr_weight, iv_dp) == 1)
9762      {
9763      //rOrdStr(currRing) = "dp"
9764        if(op_tmp == op_deg)
9765        {
9766          G = MstdCC(Go);
9767          if(op_deg != 1)
9768          {
9769            iv_M_dp = MivMatrixOrderdp(nV);
9770          }
9771        }
9772      }
9773    }
9774    else
9775    {
9776      if(op_tmp == op_deg)
9777      {
9778        //rOrdStr(currRing) = (a(...),lp,C)
9779        if (rParameter(currRing) != NULL)
9780        {
9781          DefRingPar(cw_tmp);
9782        }
9783        else
9784        {
9785          rChangeCurrRing(VMrDefault(cw_tmp));
9786        }
9787        G = idrMoveR(Go, XXRing,currRing);
9788        G = MstdCC(G);
9789        if(op_deg != 1)
9790          iv_M_dp = MivMatrixOrder(cw_tmp);
9791      }
9792    }
9793    Overflow_Error = FALSE;
9794    if(op_deg != 1)
9795    {
9796      curr_weight = MPertVectors(G, iv_M_dp, op_deg);
9797    }
9798    else
9799    {
9800      curr_weight =  cw_tmp;
9801      break;
9802    }
9803    if(Overflow_Error == FALSE)
9804    {
9805      break;
9806    }
9807    Overflow_Error = TRUE;
9808    op_deg --;
9809  }
9810#ifdef TIME_TEST
9811  tostd=clock()-to;
9812#endif
9813
9814  if(op_tmp != 1 )
9815    delete iv_M_dp;
9816  delete iv_dp;
9817
9818  if(currRing->order[0] == ringorder_a)
9819    goto NEXT_VECTOR;
9820
9821  while(1)
9822  {
9823    nwalk ++;
9824    nstep ++;
9825
9826#ifdef TIME_TEST
9827    to = clock();
9828#endif
9829    // compute an initial form ideal of <G> w.r.t. "curr_vector"
9830    Gomega = MwalkInitialForm(G, curr_weight);
9831#ifdef TIME_TEST
9832    xtif=xtif+clock()-to;
9833#endif
9834#if 0
9835    if(Overflow_Error == TRUE)
9836    {
9837      for(i=nV-1; i>=0; i--)
9838        (*curr_weight)[i] = (*extra_curr_weight)[i];
9839      delete extra_curr_weight;
9840
9841      newRing = currRing;
9842      goto MSTD_ALT1;
9843    }
9844#endif
9845#ifndef  BUCHBERGER_ALG
9846    if(isNolVector(curr_weight) == 0)
9847    {
9848      hilb_func = hFirstSeries(Gomega,NULL,NULL,curr_weight,currRing);
9849    }
9850    else
9851    {
9852      hilb_func = hFirstSeries(Gomega,NULL,NULL,last_omega,currRing);
9853    }
9854#endif // BUCHBERGER_ALG
9855
9856    oldRing = currRing;
9857
9858    // define a new ring which ordering is "(a(curr_weight),lp)
9859    if (rParameter(currRing) != NULL)
9860    {
9861      DefRingPar(curr_weight);
9862    }
9863    else
9864    {
9865      rChangeCurrRing(VMrDefault(curr_weight));
9866    }
9867    newRing = currRing;
9868    Gomega1 = idrMoveR(Gomega, oldRing,currRing);
9869
9870#ifdef TIME_TEST
9871    to=clock();
9872#endif
9873    // compute a reduced Groebner basis of <Gomega> w.r.t. "newRing"
9874#ifdef  BUCHBERGER_ALG
9875    M = MstdhomCC(Gomega1);
9876#else
9877    M=kStd(Gomega1,NULL,isHomog,NULL,hilb_func,0,NULL,curr_weight);
9878    delete hilb_func;
9879#endif // BUCHBERGER_ALG
9880#ifdef TIME_TEST
9881    xtstd=xtstd+clock()-to;
9882#endif
9883
9884    // change the ring to oldRing
9885    rChangeCurrRing(oldRing);
9886    M1 =  idrMoveR(M, newRing,currRing);
9887    Gomega2 =  idrMoveR(Gomega1, newRing,currRing);
9888
9889#ifdef TIME_TEST
9890    to=clock();
9891#endif
9892    // compute a reduced Groebner basis of <G> w.r.t. "newRing" by the lifting process
9893    F = MLifttwoIdeal(Gomega2, M1, G);
9894#ifdef TIME_TEST
9895    xtlift=xtlift+clock()-to;
9896#endif
9897
9898    idDelete(&M1);
9899    idDelete(&Gomega2);
9900    idDelete(&G);
9901
9902    // change the ring to newRing
9903    rChangeCurrRing(newRing);
9904    F1 = idrMoveR(F, oldRing,currRing);
9905    if (oldRing!=IDRING(currRingHdl)) rDelete(oldRing); // do not delete the global currRing
9906    oldRing=NULL;
9907
9908#ifdef TIME_TEST
9909    to=clock();
9910#endif
9911    // reduce the Groebner basis <G> w.r.t. new ring
9912    G = kInterRedCC(F1, NULL);
9913#ifdef TIME_TEST
9914    xtred=xtred+clock()-to;
9915#endif
9916    idDelete(&F1);
9917
9918    if(endwalks == 1)
9919    {
9920      break;
9921    }
9922  NEXT_VECTOR:
9923#ifdef TIME_TEST
9924    to=clock();
9925#endif
9926    // compute a next weight vector
9927    next_weight = MkInterRedNextWeight(curr_weight,target_weight, G);
9928#ifdef TIME_TEST
9929    xtnw=xtnw+clock()-to;
9930#endif
9931#ifdef PRINT_VECTORS
9932    MivString(curr_weight, target_weight, next_weight);
9933#endif
9934    if(Overflow_Error == TRUE)
9935    {
9936      newRing = currRing;
9937
9938      if (rParameter(currRing) != NULL)
9939      {
9940        DefRingPar(target_weight);
9941      }
9942      else
9943      {
9944        rChangeCurrRing(VMrDefault(target_weight));
9945      }
9946      F1 = idrMoveR(G, newRing,currRing);
9947      G = MstdCC(F1);
9948      idDelete(&F1);
9949      newRing = currRing;
9950      break; //for while
9951    }
9952
9953
9954    /* G is the wanted Groebner basis if next_weight == curr_weight */
9955    if(MivComp(next_weight, ivNull) == 1)
9956    {
9957      newRing = currRing;
9958      delete next_weight;
9959      break; //for while
9960    }
9961
9962    if(MivComp(next_weight, target_weight) == 1)
9963    {
9964      if(tp_deg == 1 || MivSame(target_weight, exivlp) == 0)
9965        endwalks = 1;
9966      else
9967      {
9968       // MSTD_ALT1:
9969#ifdef TIME_TEST
9970        nOverflow_Error = Overflow_Error;
9971        tproc = clock()-xftinput;
9972#endif
9973
9974        //Print("\n//  main routine takes %d steps and calls \"Mpwalk\" (1,%d):", nwalk,  tp_deg);
9975
9976        // compute the red. GB of <G> w.r.t. the lex order by the "recursive-modified" perturbation walk alg (1,tp_deg)
9977        G = Mpwalk_MAltwalk1(G, curr_weight, tp_deg);
9978        delete next_weight;
9979        break; // for while
9980      }
9981    }
9982
9983    //NOT Changed, to free memory
9984    for(i=nV-1; i>=0; i--)
9985    {
9986      //(*extra_curr_weight)[i] = (*curr_weight)[i];
9987      (*curr_weight)[i] = (*next_weight)[i];
9988    }
9989    delete next_weight;
9990  }//while
9991
9992  rChangeCurrRing(XXRing);
9993  ideal result = idrMoveR(G, newRing,currRing);
9994  id_Delete(&G, newRing);
9995
9996  delete ivNull;
9997  if(op_deg != 1 )
9998  {
9999    delete curr_weight;
10000  }
10001  delete exivlp;
10002#ifdef TIME_TEST
10003/*
10004  Print("\n// \"Main procedure\"  took %d steps, %.2f sec. and Overflow_Error(%d)",
10005        nwalk, ((double) tproc)/1000000, nOverflow_Error);
10006
10007  TimeStringFractal(xftinput, tostd, xtif, xtstd,xtextra, xtlift, xtred, xtnw);
10008*/
10009 // Print("\n// pSetm_Error = (%d)", ErrorCheck());
10010 // Print("\n// Overflow_Error? (%d)", Overflow_Error);
10011 // Print("\n// Awalk1 took %d steps.\n", nstep);
10012#endif
10013  return(result);
10014}
Note: See TracBrowser for help on using the repository browser.