source: git/Singular/walk.cc @ e57a75

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