source: git/Singular/LIB/fastsolv.lib @ 5480da

spielwiese
Last change on this file since 5480da was 5480da, checked in by Kai Krüger <krueger@…>, 26 years ago
Added new help for libraries git-svn-id: file:///usr/local/Singular/svn/trunk@1318 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 9.8 KB
Line 
1//
2version="$Id: fastsolv.lib,v 1.2 1998-04-03 22:47:01 krueger Exp $";
3info="";
4
5// ====================================================================
6//  library fast.lib
7//
8// ====================================================================
9
10proc Tsimplify
11USAGE:    simplify(id,n);  id ideal, n integer
12RETURNS:  list of two ideals the first containing the simplified
13          elements, the second the variables which already have
14          been eliminated
15ASSUME:   basering has ordering dp, the elimination of the variables
16          n+1,... is not supported
17EXAMPLE:  example simplify; shows an example
18
19{
20  def bsr=basering;
21  int @n, @m, @k;
22  option (redSB);
23  ideal @i = interred(#[1]);
24  ideal @j, @im, @va;
25  for (@n=1;@n<=size(@i);@n=@n+1)
26  {
27    if (deg(@i[@n])==1)
28    {
29      @k=0;
30      for (@m=#[2]+1;@m<=nvars(basering);@m=@m+1)
31      {
32        if (lead(@i[@n])/var(@m)!=0)
33        {
34          @k=1;
35          break;
36        }
37      }
38      if (@k==0)
39      {
40        @va=@va+lead(@i[@n]);
41        @i[@n]=0;
42      }
43    }
44  }
45  @i=@i+@j;
46  map @phi;
47  for (@m=1;@m<=#[2];@m=@m+1)
48  {
49    for (@n=size(@i);@n>=1;@n=@n-1)
50    {
51      if (deg(@i[@n]/var(@m))==0)
52      {
53        @im = maxideal(1);
54        @im[@m]=(-1/coeffs(@i[@n],var(@m))[2,1])*(@i[@n]-coeffs(@i[@n],var(@m))[2,1]*var(@m));
55        @phi = basering,@im;
56        @i=@phi(@i);
57        @i=@i+@j;
58        @va=@va+var(@m);
59        break;// hier muesste evt. sorgfaeltiger ausgewaehlt werden
60      }
61    }
62  }
63  @i=interred(@i);
64  option(noredSB);
65  return(@i,@va);
66}
67example
68{
69   ring s=181,(x,y,z,t,u,v,w,a,b,c,d,f,e),dp;
70   ideal j=
71            w2+f2-1,
72            x2+t2+a2-1,
73            y2+u2+b2-1,
74            z2+v2+c2-1,
75            d2+e2-1,
76            f4+2u,
77            wa+tf,
78            xy+tu+ab,
79            yz+uv+bc,
80            cd+ze,
81            x+y+z+e+1,
82            t+u+v+f-1,
83            w+a+b+c+d;
84    list l=Tsimplify(j,10);
85    l;
86}
87
88
89proc simplifyInBadRings
90USAGE:    simplify(id,n);  id ideal, n product of the variables
91          to be eliminated later
92RETURNS:  list of two ideals the first containing the simplified
93          elements, the second the variables which already have
94          been eliminated
95EXAMPLE:  example simplify; shows an example
96
97{
98  int @i,@j;
99  string @es=",(";
100  string @ns="),dp;";
101  for (@i=1;@i<=nvars(basering);@i=@i+1)
102  {
103    if (deg(#[2]/var(@i))>=0)
104    {
105      @es=@es+varstr(@i)+",";
106      @j=@j+1;
107    }
108    else
109    {
110      @ns=","+varstr(@i)+@ns;
111    }
112  }
113  string @s=@es[1,size(@es)-1]+@ns;
114  @ns=nameof(basering);
115  ideal i=#[1];
116  execute "ring @gnir ="+charstr(basering)+@s;
117  ideal @laedi=imap(`@ns`,i);
118  list @l=Tsimplify(@laedi,@j);
119  ideal @l1, @l2=@l[1], @l[2];
120  execute "setring "+@ns+";";
121  return(imap(@gnir,@l1),imap(@gnir,@l2));
122}
123example
124{
125   ring s=0,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp;
126   ideal j=
127            w2+f2-1,
128            x2+t2+a2-1,
129            y2+u2+b2-1,
130            z2+v2+c2-1,
131            d2+e2-1,
132            f4+2u,
133            wa+tf,
134            xy+tu+ab,
135            yz+uv+bc,
136            cd+ze,
137            x+y+z+e+1,
138            t+u+v+f-1,
139            w+a+b+c+d;
140    list l=simplifyInBadRings(j,xyztuvwabc);
141    l;
142}
143
144
145proc fastElim
146USAGE:    fastelim(id,v);  id ideal, v Product of variables to
147          be eliminated.
148RETURNS:  list of two ideals the first containing the simplified
149          elements, the second the variables which already have
150          been eliminated
151EXAMPLE:  example fastElim; shows an example.
152{
153   string @oldgnir = nameof(basering);  // Namen des alten Baserings merken
154   string @varnames;
155   int @i;
156   poly @testpoly=1;      // Variablen, die schon eliminiert sind (nach Simplify)
157   poly @elimvarspoly=#[2]; // Variablen, die noch eliminiert werden sollen
158
159   // das Ideal vereinfachen. Beachte: l[1] erzeugt nicht mehr id!
160   list @l=simplifyInBadRings(#[1],#[2]);
161   ideal @a, @b = @l[1], @l[2];
162
163   // ------------------------------------------------------------
164   // in einen Ring abbilden, der die in (2) angegebenen Variablen
165   // nicht mehr enthaelt.
166   // ------------------------------------------------------------
167
168
169   // Aus dem von simplifyInBadRings zurueckgegebenen Ideal(2), das die
170   // Variablen anthealt, die eliminiert sind, ein Polynom bauen:
171   for (@i=1; @i<=size(@b); @i=@i+1)
172   {
173     @testpoly=@testpoly*@b[@i];
174     @elimvarspoly = subst(@elimvarspoly, @b[@i], 1);
175   }
176
177   //Wenn keine Variablen mehr uebrig sind, sind wir fertig:
178   if (@elimvarspoly==1)
179   {
180     // Falls das 4. Argument 1 ist, eine minimale Basis berechnen
181     if (#[4]==1)
182     {
183       mres(@a,1,@a0);
184       @a=@a0(1);
185     }
186     return(@a);
187   }
188
189   // Anhand dieses Polynoms ueberpruefen, welche Variablen unser
190   // neuer Ring braucht: @varnames
191   for (@i=1; @i<=nvars(basering); @i=@i+1)
192   {
193     if (@testpoly/var(@i)==0)
194     {
195       @varnames=@varnames + nameof(var(@i)) + ",";
196     }
197   }
198   @varnames=@varnames[1, size(@varnames)-1];
199
200   // Den neuen Ring erzeugen und das Ideal a darin abbilden:
201   execute("ring @r1=" + charstr(basering) + ",(" + @varnames + ")," + "dp;" );
202   ideal @a=imap(`@oldgnir`, @a);
203   list #=imap(`@oldgnir`,#);
204
205   // Nun die beste Reihenfolge fuer die Variablen berechnen:
206   string @orderedvars=string(maxideal(1));
207   if (#[3]==1)
208   {
209      poly @elimvarspoly=imap(`@oldgnir`,@elimvarspoly);
210      intvec @v= valvars(@a,#[5], @elimvarspoly,#[6]);
211      @v;
212      @orderedvars=string(sort1(maxideal(1),@v));
213   }
214
215   // In einen Ring wechseln, der diese Reihenfolge beruecksichtig:
216   execute("ring @r2=" + charstr(basering) + ",(" + @orderedvars + ",@homo),dp;" );
217   ideal @a= imap(@r1, @a);
218   kill @r1;
219
220   //das ideal homogenisieren
221   @a=homog(@a,@homo);
222
223   // Die Variablen holen, die wirklich noch zu eliminieren sind, und
224   // danach eliminate aufrufen.
225   poly @elimvarspoly= imap(`@oldgnir`, @elimvarspoly);
226   ideal @b=eliminate(@a, @elimvarspoly);
227
228   // Falls das 4. Argument 1 ist, eine minimale Basis berechnen
229   if (#[4]==1)
230   {
231     mres(@b,1,@b0);
232     @b=@b0(1);
233   }
234
235   // dehomogenisieren (@homo=1) und zurueck in den alten Ring
236   @b=subst(@b,@homo,1);
237   execute "setring "+@oldgnir+";";
238   return(imap(@r2,@b));
239}
240example
241{
242   ring s=31991,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp;
243   ideal j=
244            w2+f2-1,
245            x2+t2+a2-1,
246            y2+u2+b2-1,
247            z2+v2+c2-1,
248            d2+e2-1,
249            f4+2u,
250            wa+tf,
251            xy+tu+ab,
252            yz+uv+bc,
253            cd+ze,
254            x+y+z+e+1,
255            t+u+v+f-1,
256            w+a+b+c+d;
257   fastElim(j,xyztuvwabcd,1,0,0,0);
258}
259
260
261proc sort1
262{
263  intvec @i=#[2];
264  int @ii=size(@i);
265  int @j;
266  string @s=string(typeof(#[1]))+" @m;";
267  execute(@s);
268  for (@j=1;@j<=@ii;@j=@j+1)
269  {
270    @m[@j] = #[1][@i[@j]];
271  }
272  return(@m);
273}
274
275
276proc valvars
277
278USAGE:    valvars(id, [n1, [m, [n2]]]); id (poly|ideal|vector|module);
279                                        m monom; n1,n2 int
280RETURNS:  an intvec describing the permutation such that the permuted
281          ringvariables are ordered with respect to inreasing complexity
282          [resp. decreasing complexity if n1 is present and non-zero].
283          If m is present, the variables occuring in m are sorted in one
284          block before all variables not occuring in m. n2 controls the
285          order of this block as n1 does for the other one.
286          A variable x is more complex than y (with respect to id) if, in the
287          input, either the maximal occuring power of x is bigger than that
288          of y or both are equal and the coefficient of x to this power
289          contains more monomials than that of y.
290EXAMPLE:  example valvars; shows an example
291
292{
293  int     @order1, @order2,     // order of vars not to elim resp. to elim
294          @i1,                  // runs through all variables
295          @i2,                  // # of vars to elim already found
296          @N, @M,               // N = total # of vars, M = # of vars to elim
297          @i, @j, @k, @size, @degree;
298  intvec  @varvec, @degvec, @sizevec;
299  poly    @m;
300  ideal   @id;
301  matrix  @C;
302
303  @id = matrix( #[1] ); @m = 0;
304  @N = nvars( basering ); @M = 0;
305  @order1 = 1; @order2 = 1;
306  if ( size(#) >= 4 )
307    { @order2 = not( #[4] ) * 2 - 1; }
308  if ( size(#) >= 3 )
309    { @m = #[3]; @M = deg( #[3] ); }
310  if ( size(#) >= 2 )
311    { @order1 = not( #[2] ) * 2 - 1; }
312
313  @i2 = 0;
314  for ( @i1 = 1; @i1 <= @N; @i1++ )
315  {
316    // get valuation of current variable.
317    @C = coeffs( @id, var( @i1 ));
318    @degree = nrows( @C );
319    @size = 0;
320    for ( @j = ncols( @C ); @j >= 1; @j-- )
321      { @size = @size + size( @C[ @degree, @j ] ); }
322
323    // mind order and calculate limits for search
324    if ( @M and size( @m / var( @i1 )))
325    {
326      @degree = @degree * @order2; @size = @size * @order2;
327      @i2++;
328      @i = @i2; @j = 1;
329    }
330    else
331    {
332      @degree = @degree * @order1; @size = @size * @order1;
333      @i = @i1 - @i2 + @M; @j = @M+1;
334    }
335
336    // look where we have to insert the variable
337    // "start = " + string( @j ) + ", end = " + string( @i );
338    @degvec[ @i ] = @degree + 1; @sizevec[ @i ] = @size + 1;
339    while ( @degvec[ @j ] < @degree )
340      { @j++; }
341    while ( @degvec[ @j ] == @degree and @sizevec[ @j ] < @size )
342      { @j++; }
343
344    // now shift the variables behind the current one back
345    // "inserting at " + string( @j );
346    for ( @k = @i-1; @k >= @j; @k-- )
347    {
348      @varvec[ @k+1 ] = @varvec[ @k ];
349      @degvec[ @k+1 ] = @degvec[ @k ];
350      @sizevec[ @k+1 ] = @sizevec[ @k ];
351    }
352    @varvec[ @j ] = @i1;             // print( @varvec );
353    @degvec[ @j ] = @degree;         // print( @degvec );
354    @sizevec[ @j ] = @size;          // print( @sizevec );
355  }
356
357  return( @varvec );
358}
359example
360{
361  echo = 1; ring @r=0,(a,b,c,x,y,z),lp;
362  poly @f=a3+b4+xyz2+xyz+yz+1;
363  valvars( @f );
364  valvars( @f, 1 );
365  valvars( @f, 0, abc );
366  valvars( @f, 0, xyz );
367  valvars( @f, 0, abc, 1 );
368  valvars( @f, 1, abc, 1 );
369  ideal @i=@f,z5,y5,-y5;
370  valvars( @i );
371  valvars( @i, 0, abcxyz );
372  kill @r; echo = 0;
373}
Note: See TracBrowser for help on using the repository browser.