source: git/Singular/walk.cc @ 633c14

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