source: git/Singular/walk_ip.cc @ 0fb34ba

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