source: git/Singular/walk_ip.cc @ def568

spielwiese
Last change on this file since def568 was def568, checked in by Hans Schönemann <hannes@…>, 14 years ago
*hannes: code simpl. git-svn-id: file:///usr/local/Singular/svn/trunk@11771 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 9.2 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/* $Id: walk_ip.cc,v 1.3 2009-05-05 10:09:24 Singular Exp $ */
5/*
6* ABSTRACT: frwalk: interpreter link
7*/
8
9//#include <stdlib.h>
10#include <stdio.h>
11#include <string.h>
12#include <ctype.h>
13#include <math.h>
14
15#include "mod2.h"
16#include "tok.h"
17#include "ipid.h"
18#include "intvec.h"
19#include "omalloc.h"
20#include "febase.h"
21#include "polys.h"
22#include "ideals.h"
23#include "matpol.h"
24#include "kstd1.h"
25#include "ring.h"
26#include "subexpr.h"
27#include "maps.h"
28#include "syz.h"
29#include "numbers.h"
30#include "lists.h"
31#include "attrib.h"
32#include "ipconv.h"
33#include "silink.h"
34#include "stairc.h"
35#include "weight.h"
36#include "semic.h"
37#include "splist.h"
38#include "spectrum.h"
39#include "gnumpfl.h"
40#include "mpr_base.h"
41#include "ffields.h"
42#include "clapsing.h"
43#include "hutil.h"
44#include "ipshell.h"
45#include "walkMain.h"
46#include "walkProc.h"
47#include "walkSupport.h"
48#include "prCopy.h"
49
50///////////////////////////////////////////////////////////////////
51//walkProc
52///////////////////////////////////////////////////////////////////
53//Description: The main function for the Walk-Algorithm. Checks the
54//input-data, and calls walk64 (see walkMain.cc). Returns the new
55//groebner basis or something else if an error occoured.
56///////////////////////////////////////////////////////////////////
57//Uses: omAlloc0,walkConsistency,rGetGlobalOrderWeightVec,
58//omFreeSize,sizeof,IDIDEAL,walk64,rSetHdl,idrMoveR,Werror,idInit
59///////////////////////////////////////////////////////////////////
60
61ideal
62walkProc(leftv first, leftv second)
63{
64    WalkState state = WalkOk;
65    BITSET saveTest=test;
66    test &= (~Sy_bit(OPT_REDSB)); //make sure option noredSB is set
67
68    idhdl destRingHdl = currRingHdl;
69    ring destRing = currRing;
70    ideal destIdeal = NULL;
71    idhdl sourceRingHdl = (idhdl)first->data;
72    rSetHdl( sourceRingHdl );
73    ring sourceRing = currRing;
74
75    if(state==WalkOk)
76    {
77      int * vperm = (int *)omAlloc0( (pVariables+1)*sizeof( int ) );
78      state= walkConsistency( sourceRingHdl, destRingHdl, vperm );
79      omFreeSize( (ADDRESS)vperm, (pVariables+1)*sizeof(int) );
80    }
81
82    int64vec* currw64=rGetGlobalOrderWeightVec(sourceRing);
83    int64vec* destVec64=rGetGlobalOrderWeightVec(destRing);
84
85    ideal sourceIdeal;
86    BOOLEAN sourcIdealIsSB=FALSE;
87    if ( state == WalkOk )
88    {
89      idhdl ih = currRing->idroot->get( second->Name(), myynest );
90      if ( (ih != NULL) && (IDTYP(ih)==IDEAL_CMD) )
91      {
92           sourceIdeal = idCopy(IDIDEAL( ih ));
93           if(hasFlag((leftv)ih,FLAG_STD)){
94              sourcIdealIsSB=TRUE;
95           }
96      }
97      else
98      {
99        state=WalkNoIdeal;
100      }
101    }
102
103    if ( state == WalkOk )
104    {
105      // Now the settings are compatible with Walk
106      state=walk64(sourceIdeal,currw64,destRing,destVec64,
107                   destIdeal,sourcIdealIsSB);
108    }
109
110    test=saveTest;//making sure options are as before function call
111
112    ring almostDestRing=currRing;
113    rSetHdl(destRingHdl);
114
115    switch (state) {
116        case WalkOk:
117          destIdeal=idrMoveR(destIdeal,almostDestRing);
118          break;
119
120        case WalkIncompatibleRings:
121          Werror("ring %s and current ring are incompatible\n",
122                 first->Name() );
123          destIdeal= idInit(0,0);
124          break;
125
126        case WalkIncompatibleDestRing:
127          Werror( "Order of basering not allowed,\n must be a combination of a,A,lp,dp,Dp,wp,Wp,M and C.\n");
128          destIdeal= idInit(0,0);
129          break;
130
131        case WalkIncompatibleSourceRing:
132          Werror( "Order of %s not allowed,\n must be a combination of a,A,lp,dp,Dp,wp,Wp,M and C.\n",first->Name());
133          rSetHdl(destRingHdl);
134          destIdeal= idInit(0,0);
135          break;
136
137        case WalkNoIdeal:
138          Werror( "Can't find ideal %s in ring %s.\n",
139                   second->Name(), first->Name() );
140          destIdeal= idInit(0,0);
141          break;
142
143        case WalkOverFlowError:
144          Werror( "Overflow occured.\n");
145          destIdeal= idInit(0,0);
146          break;
147
148        default:
149           destIdeal= idInit(1,1);
150    }
151
152    return destIdeal;
153}
154
155///////////////////////////////////////////////////////////////////
156//fractalWalkProc
157///////////////////////////////////////////////////////////////////
158//Description: The main function for the Fractalwalk-Algorithm.
159//Responsible for contact between user and walk64. Checks the
160//input-data, and calls fractalWalk64. Returns the new groebner
161//basis or something else if an error occured.
162///////////////////////////////////////////////////////////////////
163//Uses: omAlloc0,fractalWalkConsistency,omFreeSize,sizeof,IDIDEAL,
164//fractalWalk64,rSetHdl,idrMoveR,Werror,idInit
165///////////////////////////////////////////////////////////////////
166
167ideal
168fractalWalkProc(leftv first, leftv second)
169{
170
171  //unperturbedStartVectorStrategy SHOULD BE SET BY THE USER THROUGH
172  //A THIRD ARGUMENT. TRUE MEANS THAT THE UNPERTURBED START
173  //VECTOR STRATEGY IS USED AND FALSE THAT THE START VECTOR IS
174  //MAXIMALLY PERTURBED
175
176    BOOLEAN unperturbedStartVectorStrategy=TRUE;
177
178    WalkState state = WalkOk;
179    BITSET saveTest=test;
180    test &= (~Sy_bit(OPT_REDSB)); //make sure option noredSB is set
181
182    idhdl destRingHdl = currRingHdl;
183    ring destRing = currRing;
184    ideal destIdeal = NULL;
185    idhdl sourceRingHdl = (idhdl)first->data;
186    rSetHdl( sourceRingHdl );
187    ring sourceRing = currRing;
188
189    int * vperm = (int *)omAlloc0( (pVariables+1)*sizeof( int ) );
190    state= fractalWalkConsistency( sourceRingHdl, destRingHdl, vperm );
191    omFreeSize( (ADDRESS)vperm, (pVariables+1)*sizeof(int) );
192
193    ideal sourceIdeal;
194    BOOLEAN sourcIdealIsSB=FALSE;
195    if ( state == WalkOk ) {
196      idhdl ih = currRing->idroot->get( second->Name(), myynest );
197      if ( (ih != NULL) && (IDTYP(ih)==IDEAL_CMD) ) {
198           sourceIdeal = IDIDEAL( ih );
199           if(hasFlag((leftv)ih,FLAG_STD)){
200              sourcIdealIsSB=TRUE;
201           }
202      }
203      else {
204        state=WalkNoIdeal;
205      }
206    }
207
208    if ( state == WalkOk ) {
209      // Now the settings are compatible with Walk
210      state=fractalWalk64(sourceIdeal,destRing,destIdeal,
211                          sourcIdealIsSB,
212                          unperturbedStartVectorStrategy);
213    }
214
215    test=saveTest;//making sure options are as before functiocall
216
217     if ( state == WalkOk )
218     {
219       ring almostDestRing=currRing;
220       rSetHdl(destRingHdl);
221       destIdeal=idrMoveR(destIdeal,almostDestRing);
222     }
223
224
225     switch (state) {
226
227        case WalkOk:
228            destIdeal=sortRedSB(destIdeal);
229            return(destIdeal);
230            break;
231
232        case WalkIncompatibleRings:
233            Werror( "ring %s and current ring are incompatible\n",
234                     first->Name() );
235            rSetHdl(destRingHdl);
236            destIdeal= idInit(0,0);
237            return destIdeal;
238            break;
239
240        case WalkIncompatibleDestRing:
241            Werror( "Order of basering not allowed,\n must be a combination of lp,dp,Dp,wp,Wp and C or just M.\n");
242            rSetHdl(destRingHdl);
243            destIdeal= idInit(0,0);
244            return destIdeal;
245            break;
246
247        case WalkIncompatibleSourceRing:
248            Werror( "Order of %s not allowed,\n must be a combination of lp,dp,Dp,wp,Wp and C or just M.\n",
249                     first->Name());
250            rSetHdl(destRingHdl);
251            destIdeal= idInit(0,0);
252            return destIdeal;
253            break;
254
255        case WalkNoIdeal:
256            Werror( "Can't find ideal %s in ring %s.\n",
257                     second->Name(), first->Name() );
258            rSetHdl(destRingHdl);
259            destIdeal= idInit(0,0);
260            return destIdeal;
261            break;
262
263        case WalkOverFlowError:
264            Werror( "Overflow occured in ring %s.\n", first->Name() );
265            rSetHdl(destRingHdl);
266            destIdeal= idInit(0,0);
267            return destIdeal;
268            break;
269
270        default:
271            rSetHdl(destRingHdl);
272            destIdeal= idInit(1,1);
273            return destIdeal;
274    }
275
276
277  return NULL;
278}
279
280
281///////////////////////////////////////////////////////////////////
282//getiv64
283///////////////////////////////////////////////////////////////////
284//Description: retrieves the int64vec from input list l
285///////////////////////////////////////////////////////////////////
286//Assumes: that the first entry of l is an int64vec
287///////////////////////////////////////////////////////////////////
288//Uses: none
289///////////////////////////////////////////////////////////////////
290
291int64vec* getiv64(lists l)
292{
293  return (int64vec*)(l->m[0].data);
294}
295
296///////////////////////////////////////////////////////////////////
297
298
299///////////////////////////////////////////////////////////////////
300//getint64
301///////////////////////////////////////////////////////////////////
302//Description: retrieves the int64 from input list l
303///////////////////////////////////////////////////////////////////
304//Assumes: that the second entry of l is an int64
305///////////////////////////////////////////////////////////////////
306//Uses: none
307///////////////////////////////////////////////////////////////////
308
309// not used, bad impl.
310//int64 getint64(lists l)
311//{
312//  return (int64)(long)(l->m[1].data);
313//}
314
315///////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.