source: git/Singular/walk_ip.cc @ b0732eb

spielwiese
Last change on this file since b0732eb was ebbb9c, checked in by Hans Schoenemann <hannes@…>, 12 years ago
fix: assign bigint = something should fail for 1x0 matrices fix: #427, bug in minor
  • Property mode set to 100644
File size: 9.4 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4/*
5* ABSTRACT: frwalk: interpreter link
6*/
7
8//#include <stdlib.h>
9#include <stdio.h>
10#include <string.h>
11#include <ctype.h>
12#include <math.h>
13
14#include "config.h"
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 <kernel/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 <polys/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    ring destRing = currRing;
70    ideal destIdeal = NULL;
71    idhdl sourceRingHdl = (idhdl)first->data;
72    ring sourceRing = IDRING(sourceRingHdl);
73    rChangeCurrRing( sourceRing );
74
75    if(state==WalkOk)
76    {
77      int * vperm = (int *)omAlloc0( (currRing->N+1)*sizeof( int ) );
78      state= walkConsistency( sourceRing, destRing, vperm );
79      omFreeSize( (ADDRESS)vperm, (currRing->N+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    rChangeCurrRing(destRing);
114
115    switch (state) {
116        case WalkOk:
117          destIdeal=idrMoveR(destIdeal,currRing,almostDestRing);
118          break;
119
120        case WalkIncompatibleRings:
121          Werror("ring %s and current ring are incompatible\n",
122                 first->Name() );
123          destIdeal= NULL;
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= NULL;
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          rChangeCurrRing(destRing);
134          destIdeal= NULL;
135          break;
136
137        case WalkNoIdeal:
138          Werror( "Can't find ideal %s in ring %s.\n",
139                   second->Name(), first->Name() );
140          destIdeal= NULL;
141          break;
142
143        case WalkOverFlowError:
144          Werror( "Overflow occured.\n");
145          destIdeal= NULL;
146          break;
147
148        default:
149           destIdeal= NULL;
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    ring destRing = currRing;
183    ideal destIdeal = NULL;
184    idhdl sourceRingHdl = (idhdl)first->data;
185    rSetHdl( sourceRingHdl );
186    ring sourceRing = currRing;
187
188    int * vperm = (int *)omAlloc0( (currRing->N+1)*sizeof( int ) );
189    state= fractalWalkConsistency( sourceRing, destRing, vperm );
190    omFreeSize( (ADDRESS)vperm, (currRing->N+1)*sizeof(int) );
191
192    ideal sourceIdeal;
193    BOOLEAN sourcIdealIsSB=FALSE;
194    if ( state == WalkOk ) {
195      idhdl ih = currRing->idroot->get( second->Name(), myynest );
196      if ( (ih != NULL) && (IDTYP(ih)==IDEAL_CMD) ) {
197           sourceIdeal = IDIDEAL( ih );
198           if(hasFlag((leftv)ih,FLAG_STD)){
199              sourcIdealIsSB=TRUE;
200           }
201      }
202      else {
203        state=WalkNoIdeal;
204      }
205    }
206
207    if ( state == WalkOk ) {
208      // Now the settings are compatible with Walk
209      state=fractalWalk64(sourceIdeal,destRing,destIdeal,
210                          sourcIdealIsSB,
211                          unperturbedStartVectorStrategy);
212    }
213
214    test=saveTest;//making sure options are as before functiocall
215
216     if ( state == WalkOk )
217     {
218       ring almostDestRing=currRing;
219       rChangeCurrRing(destRing);
220       destIdeal=idrMoveR(destIdeal,destRing,almostDestRing);
221     }
222
223
224     switch (state) {
225
226        case WalkOk:
227            destIdeal=sortRedSB(destIdeal);
228            return(destIdeal);
229            break;
230
231        case WalkIncompatibleRings:
232            Werror( "ring %s and current ring are incompatible\n",
233                     first->Name() );
234            rChangeCurrRing(destRing);
235            destIdeal= NULL;
236            return destIdeal;
237            break;
238
239        case WalkIncompatibleDestRing:
240            Werror( "Order of basering not allowed,\n must be a combination of lp,dp,Dp,wp,Wp and C or just M.\n");
241            rChangeCurrRing(destRing);
242            destIdeal= NULL;
243            return destIdeal;
244            break;
245
246        case WalkIncompatibleSourceRing:
247            Werror( "Order of %s not allowed,\n must be a combination of lp,dp,Dp,wp,Wp and C or just M.\n",
248                     first->Name());
249            rChangeCurrRing(destRing);
250            destIdeal= NULL;
251            return destIdeal;
252            break;
253
254        case WalkNoIdeal:
255            Werror( "Can't find ideal %s in ring %s.\n",
256                     second->Name(), first->Name() );
257            rChangeCurrRing(destRing);
258            destIdeal= NULL;
259            return destIdeal;
260            break;
261
262        case WalkOverFlowError:
263            Werror( "Overflow occured in ring %s.\n", first->Name() );
264            rChangeCurrRing(destRing);
265            destIdeal= NULL;
266            return destIdeal;
267            break;
268
269        default:
270            rChangeCurrRing(destRing);
271            destIdeal= idInit(1,1);
272            return destIdeal;
273    }
274
275
276  return NULL;
277}
278
279
280///////////////////////////////////////////////////////////////////
281//getiv64
282///////////////////////////////////////////////////////////////////
283//Description: retrieves the int64vec from input list l
284///////////////////////////////////////////////////////////////////
285//Assumes: that the first entry of l is an int64vec
286///////////////////////////////////////////////////////////////////
287//Uses: none
288///////////////////////////////////////////////////////////////////
289
290int64vec* getiv64(lists l)
291{
292  return (int64vec*)(l->m[0].data);
293}
294
295///////////////////////////////////////////////////////////////////
296
297
298///////////////////////////////////////////////////////////////////
299//getint64
300///////////////////////////////////////////////////////////////////
301//Description: retrieves the int64 from input list l
302///////////////////////////////////////////////////////////////////
303//Assumes: that the second entry of l is an int64
304///////////////////////////////////////////////////////////////////
305//Uses: none
306///////////////////////////////////////////////////////////////////
307
308// not used, bad impl.
309//int64 getint64(lists l)
310//{
311//  return (int64)(long)(l->m[1].data);
312//}
313
314///////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.