source: git/Singular/LIB/presolve.lib @ 9d06efc

spielwiese
Last change on this file since 9d06efc was 9d06efc, checked in by Hans Schönemann <hannes@…>, 18 years ago
*hannes: timing in example git-svn-id: file:///usr/local/Singular/svn/trunk@7987 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 45.0 KB
Line 
1//last change: 13.02.2001 (Eric Westenberger)
2///////////////////////////////////////////////////////////////////////////////
3version="$Id: presolve.lib,v 1.22 2005-05-02 11:53:42 Singular Exp $";
4category="Symbolic-numerical solving";
5info="
6LIBRARY:  presolve.lib     Pre-Solving of Polynomial Equations
7AUTHOR:   Gert-Martin Greuel, email: greuel@mathematik.uni-kl.de,
8
9PROCEDURES:
10 degreepart(id,d1,d2);  elements of id of total degree >= d1 and <= d2
11 elimlinearpart(id);    linear part eliminated from id
12 elimpart(id[,n]);      partial elimination of vars [among first n vars]
13 elimpartanyr(i,p);     factors of p partially eliminated from i in any ring
14 fastelim(i,p[..]);     fast elimination of factors of p from i [options]
15 faststd(id,[..]);      fast std for ideal id [options]
16 findvars(id[..]);      ideal of variables occuring in id [more information]
17 hilbvec(id[,c,o]);     intvec of Hilberseries of id [in char c and ord o]
18 linearpart(id);        elements of id of total degree <=1
19 tolessvars(id[,]);     maps id to new basering having only vars occuring in id
20 solvelinearpart(id);   reduced std-basis of linear part of id
21 sortandmap(id [..]);   map to new basering with vars sorted w.r.t. complexity
22 sortvars(id[n1,p1..]); sort vars w.r.t. complexity in id [different blocks]
23 valvars(id[..]);       valuation of vars w.r.t. to their complexity in id
24 idealsSimplify(id);    ideal I = eliminate(Id,m) m is a product of variables
25                       which are only linearly involved in the generators of id
26 idealSplit(id,tF,fS);  a list of ideals such that their intersection
27                        has the same radical as id
28                       ( parameters in square brackets [] are optional)
29";
30
31LIB "inout.lib";
32LIB "general.lib";
33LIB "matrix.lib";
34LIB "ring.lib";
35LIB "elim.lib";
36///////////////////////////////////////////////////////////////////////////////
37
38proc degreepart (id,int d1,int d2,list #)
39"USAGE:   degreepart(id,d1,d2[,v]);  id=ideal/module, d1,d1=integers, v=intvec
40RETURN:  generators of id of [v-weighted] total degree >= d1 and <= d2
41         (default: v = 1,...,1)
42EXAMPLE: example degreepart; shows an example
43"
44{
45   def dpart = id;
46   int s,ii = size(id),0;
47   if ( size(#)==0 )
48   {
49      for ( ii=1; ii<=s; ii=ii+1 )
50      {
51         dpart[ii] = (jet(id[ii],d1-1)==0)*(id[ii]==jet(id[ii],d2))*id[ii];
52      }
53   }
54   else
55   {
56      for ( ii=1; ii<=s; ii=ii+1 )
57      {
58         dpart[ii]=(jet(id[ii],d1-1,#[1])==0)*(id[ii]==jet(id[ii],d2,#[1]))*id[ii];
59      }
60   }
61   return(simplify(dpart,2));
62}
63example
64{ "EXAMPLE:"; echo = 2;
65   ring r=0,(x,y,z),dp;
66   ideal i=1+x+x2+x3+x4,3,xz+y3+z8;
67   degreepart(i,0,4);
68   module m=[x,y,z],x*[x3,y2,z],[1,x2,z3,0,1];
69   intvec v=2,3,6;
70   show(degreepart(m,8,8,v));
71}
72///////////////////////////////////////////////////////////////////////////////
73
74proc elimlinearpart (ideal i,list #)
75"USAGE:   elimlinearpart(i[,n]);  i=ideal, n=integer,@*
76          default: n=nvars(basering)
77RETURN:   list L with 5 entries:
78  @format
79  L[1]: (interreduced) ideal obtained from i by substituing
80        from the first n variables those, which appear in a linear part
81        of i, by putting this part into triangular form
82  L[2]: ideal of variables which have been substituted
83  L[3]: ideal, j-th element defines substitution of j-th var in [2]
84  L[4]: ideal of variables of basering, eliminated ones are set to 0
85  L[5]: ideal, describing the map from the basering to itself such that
86        L[1] is the image of i
87  @end format
88NOTE:    the procedure does always interreduce the ideal i internally w.r.t.
89         ordering dp.
90EXAMPLE: example elimlinearpart; shows an example
91"
92{
93   int ii,n,fi,k;
94   string o, newo;
95   intvec getoption = option(get);
96   option(redSB);
97   def P = basering;
98   n = nvars(P);
99//--------------- replace ordering by dp-ordering if necessary ----------------
100   o = "dp("+string(n)+")";
101   fi = find(ordstr(P),o);
102   if( fi == 0 or find(ordstr(P),"a") != 0 )
103   {
104      execute("ring newP = ("+charstr(P)+"),("+varstr(P)+"),dp;");
105      ideal i = imap(P,i);
106   }
107//---------------------------------- start ------------------------------------
108   if ( size(#)!=0 ) {  n=#[1]; }
109   ideal maxi,rest = maxideal(1),0;
110   if ( n < nvars(P) ) { rest = maxi[n+1..nvars(P)]; }
111   attrib(rest,"isSB",1);
112//-------------------- interreduce and find linear part  ----------------------
113// interred does the only real work. Because of ordering dp the linear part is
114// within the first elements after interreduction
115// **: perhaps Bareiss to constant matrix of linear part instead of interred,
116// and/or for big systems, interred only those generators of id
117// which do not contain elements not to be eliminated
118
119   ideal id = interred(i);
120
121   if(id[1] == 1 )                          //special case of unit ideal
122   {
123     setring P;
124     list L = ideal(1), ideal(0), ideal(0), maxideal(1), maxideal(1);
125     option(set,getoption);
126     return(L);
127   }
128
129   for ( ii=1; ii<=size(id); ii++ )
130   {
131      if( deg(id[ii]) > 1) { break; }
132      k=ii;
133   }
134   if( k == 0 )       { ideal lin; }
135   else               { ideal lin = id[1..k];}
136   if( k < size(id) ) { id = id[k+1..size(id)]; }
137   else               { id = 0; }
138//----- remove generators from lin containing vars not to be eliminated  ------
139   if ( n < nvars(P) )
140   {
141      for ( ii=1; ii<=size(lin); ii++ )
142      {
143         if ( reduce(lead(lin[ii]),rest) == 0 )
144         {
145            id=lin[ii],id;
146            lin[ii] = 0;
147         }
148      }
149   }
150   lin = simplify(lin,2);
151   attrib(lin,"isSB",1);
152   ideal eva = lead(lin);
153   attrib(eva,"isSB",1);
154   ideal neva = reduce(maxideal(1),eva);
155//------------------ go back to original ring end return  ---------------------
156   if( fi == 0 or find(ordstr(P),"a") != 0 )
157   {
158      setring P;
159      ideal id = imap(newP,id);
160      ideal eva = imap(newP,eva);
161      ideal lin = imap(newP,lin);
162      ideal neva = imap(newP,neva);
163   }
164
165   eva = eva[ncols(eva)..1];  // sorting according to variables in basering
166   lin = lin[ncols(lin)..1];
167   ideal phi= neva;
168   k = 1;
169   for( ii=1; ii<=n; ii++ )
170   {
171      if( neva[ii] == 0 )
172      {
173         phi[ii] = eva[k]-lin[k];
174         k=k+1;
175      }
176   }
177   list L = id, eva, lin, neva, phi;
178   option(set,getoption);
179   return(L);
180}
181example
182{ "EXAMPLE:"; echo = 2;
183   ring s=0,(x,y,z),dp;
184   ideal i = x3+y2+z,x2y2+z3,y+z+1;
185  elimlinearpart(i);
186}
187///////////////////////////////////////////////////////////////////////////////
188
189proc elimpart (ideal i,list #)
190"USAGE:   elimpart(i [,n,e] );  i=ideal, n,e=integers
191         n   : only the first n vars are considered for substitution,@*
192         e =0: substitute from linear part of i (same as elimlinearpart)@*
193         e!=0: eliminate also by direct substitution@*
194         (default: n = nvars(basering), e = 1)
195RETURN:  list of 5 objects:
196  @format
197  [1]: ideal obtained by substituting from the first n variables those
198       from i, which appear in the linear part of i (or, if e!=0, which
199       can be expressed directly in the remaining vars)
200  [2]: ideal, variables which have been substituted
201  [3]: ideal, i-th element defines substitution of i-th var in [2]
202  [4]: ideal of variables of basering, substituted ones are set to 0
203  [5]: ideal, describing the map from the basering, say k[x(1..m)], to
204       itself onto k[..variables fom [4]..] and [1] is the image of i
205  @end format
206  The ideal i is generated by [1] and [3] in k[x(1..m)], the map [5]
207  maps [3] to 0, hence induces an isomorphism
208  @format
209            k[x(1..m)]/i -> k[..variables fom [4]..]/[1]
210  @end format
211NOTE:    If the basering has ordering (c,dp), this is faster for big ideals,
212         since it avoids internal ring change and mapping.
213EXAMPLE: example elimpart; shows an example
214"
215{
216   def P = basering;
217   int n,e = nvars(P),1;
218   if ( size(#)==1 ) {  n=#[1]; }
219   if ( size(#)==2 ) {  n=#[1]; e=#[2];}
220//----------- interreduce linear part with proc elimlinearpart ----------------
221// lin = ideal after interreduction of linear part
222// eva = eliminated (substituted) variables
223// sub = polynomials defining substitution
224// neva= not eliminated variables
225// phi = map describing substitution
226   list L = elimlinearpart(i,n);
227   ideal lin, eva, sub, neva, phi = L[1], L[2], L[3], L[4], L[5];
228//-------- direct substitution of variables if possible and if e!=0 -----------
229// first find terms lin1 of pure degree 1 in each poly of lin
230// k1 = pure degree 1 part, k1+k2 = those polys of lin which contained a pure
231// degree 1 part.
232// Then go to ring newP with ordering c,dp(n) and create a matrix with size(k1)
233// colums and 2 rows, such that if [f1,f2] is a column of M then f1+f2 is one
234// of the polys of lin containing a pure degree 1 part and f1 is this part
235// interreduce this matrix (i.e. Gauss elimination on linear part, with rest
236// transformed accordingly).
237   int ii, kk;
238   if ( e!=0 )
239   {
240      ideal k1,k2;
241      int l = size(lin);
242      ideal lin1 = jet(lin,1) - jet(lin,0);  // part of pure degree 1
243      lin = lin - lin1;                      // rest, part of degree 1 substracted
244
245      for( ii=1; ii<=l; ii++ )
246      {
247         if( lin1[ii] != 0 )
248         {
249            kk = kk+1;
250            k1[kk] = lin1[ii];    // part of pure degree 1, renumbered
251            k2[kk] = lin[ii];     // rest of those polys which had a degree 1 part
252            lin[ii] = 0;
253         }
254      }
255
256      if( kk != 0 )
257      {
258         if( ordstr(P) != "c,dp(n)" )
259         {
260            execute("ring newP = ("+charstr(P)+"),("+varstr(P)+"),(c,dp);");
261            ideal k1 = imap(P,k1);
262            ideal k2 = imap(P,k2);
263            ideal lin = imap(P,lin);
264            ideal eva = imap(P,eva);
265            ideal sub = imap(P,sub);
266            ideal neva = imap(P,neva);
267         }
268         ideal k12 = k1,k2;
269         matrix M = matrix(k12,2,kk);
270        // M = interred(M);
271         l = ncols(M);
272         k1 = M[1,1..l];
273         k2 = M[2,1..l];
274         ideal kin = matrix(k1)+matrix(k2);
275         lin = simplify(lin,2);
276
277         l = size(kin);
278         poly p; map phi; ideal max;
279         for ( ii=1; ii<=n; ii++  )
280         {
281            for (kk=1; kk<=l; kk++ )
282            {
283               p = kin[kk]/var(ii);
284               if ( deg(p) == 0 )
285               {
286                  eva = eva+var(ii);
287                  neva[ii] = 0;
288                  sub = sub+kin[kk]/p;
289                  max = maxideal(1);
290                  max[ii] = var(ii) - (kin[kk]/p);
291                  phi = basering,max;
292                  lin = phi(lin);
293                  kin = simplify(phi(kin),2);
294                  l = size(kin);
295                  ii=ii+1;
296                  break;
297               }
298            }
299         }
300         lin = kin+lin;
301      }
302   }
303   for( ii=1; ii<=size(lin); ii++ )
304   {
305      lin[ii] = cleardenom(lin[ii]);
306   }
307   if( defined(newP) )
308   {
309      setring P;
310      lin = imap(newP,lin);
311      eva = imap(newP,eva);
312      sub = imap(newP,sub);
313      neva = imap(newP,neva);
314   }
315   for( ii=1; ii<=n; ii++ )
316   {
317      for( kk=1; kk<=size(eva); kk++ )
318      {
319         if (phi[ii] == eva[kk] )
320         {  phi[ii] = eva[kk]-sub[kk]; break; }
321      }
322   }
323   L = lin, eva, sub, neva, phi;
324  return(L);
325}
326example
327{ "EXAMPLE:"; echo = 2;
328   ring s=0,(x,y,z),dp;
329   ideal i =x2+y2,x2+y+1;
330   elimpart(i,3,0);
331   elimpart(i,3,1);
332}
333
334///////////////////////////////////////////////////////////////////////////////
335
336proc elimpartanyr (ideal i, list #)
337"USAGE:   elimpartanyr(i [,p,e] );  i=ideal, p=polynomial, e=integer@*
338         p: product of vars to be eliminated,@*
339         e =0: substitute from linear part of i (same as elimlinearpart)@*
340         e!=0: eliminate also by direct substitution@*
341         (default: p=product of all vars, e=1)
342RETURN:  list of 6 objects:
343  @format
344  [1]: (interreduced) ideal obtained by substituting from i those vars
345       appearing in p, which occur in the linear part of i (or which can
346       be expressed directly in the remaining variables, if e!=0)
347  [2]: ideal, variables which have been substituted
348  [3]: ideal, i-th element defines substitution of i-th var in [2]
349  [4]: ideal of variables of basering, substituted ones are set to 0
350  [5]: ideal, describing the map from the basering, say k[x(1..m)], to
351       itself onto k[..variables fom [4]..] and [1] is the image of i
352  [6]: int, # of vars considered for substitution (= # of factors of p)
353  @end format
354  The ideal i is generated by [1] and [3] in k[x(1..m)], the map [5]
355  maps [3] to 0, hence induces an isomorphism
356  @format
357            k[x(1..m)]/i -> k[..variables fom [4]..]/[1]
358  @end format
359NOTE:    the proc uses @code{execute} to create a ring with ordering dp and vars
360         placed correctly and then applies @code{elimpart}.
361EXAMPLE: example elimpartanyr; shows an example
362"
363{
364   def P = basering;
365   int j,n,e = 0,0,1;
366   poly p = product(maxideal(1));
367   if ( size(#)==1 ) { p=#[1]; }
368   if ( size(#)==2 ) { p=#[1]; e=#[2]; }
369   string a,b;
370   for ( j=1; j<=nvars(P); j++ )
371   {
372      if (deg(p/var(j))>=0) { a = a+varstr(j)+","; n = n+1; }
373      else { b = b+varstr(j)+","; }
374   }
375   if ( size(b) != 0 ) { b = b[1,size(b)-1]; }
376   else { a = a[1,size(a)-1]; }
377   execute("ring gnir ="+charstr(P)+",("+a+b+"),dp;");
378   ideal i = imap(P,i);
379   list L = elimpart(i,n,e)+list(n);
380   setring P;
381   list L = imap(gnir,L);
382   return(L);
383}
384example
385{ "EXAMPLE:"; echo = 2;
386   ring s=0,(x,y,z),dp;
387   ideal i = x3+y2+z,x2y2+z3,y+z+1;
388   elimpartanyr(i,z);
389}
390///////////////////////////////////////////////////////////////////////////////
391
392proc fastelim (ideal i, poly p, list #)
393"USAGE:   fastelim(i,p[h,o,a,b,e,m]); i=ideal, p=polynomial; h,o,a,b,e=integers
394          p: product of variables to be eliminated;@*
395  Optional parameters:
396  @format
397  - h !=0: use Hilbert-series driven std-basis computation
398  - o !=0: use proc @code{valvars} for a - hopefully - optimal ordering of vars
399  - a !=0: order vars to be eliminated w.r.t. increasing complexity
400  - b !=0: order vars not to be eliminated w.r.t. increasing complexity
401  - e !=0: use @code{elimpart} first to eliminate easy part
402  - m !=0: compute a minimal system of generators
403  @end format
404  (default: h,o,a,b,e,m = 0,1,0,0,0,0)
405RETURN:  ideal obtained from i by eliminating those variables, which occur in p
406EXAMPLE: example fastelim; shows an example.
407"
408{
409   def P = basering;
410   int h,o,a,b,e,m = 0,1,0,0,0,0;
411   if ( size(#) == 1 ) { h=#[1]; }
412   if ( size(#) == 2 ) { h=#[1]; o=#[2]; }
413   if ( size(#) == 3 ) { h=#[1]; o=#[2]; a=#[3]; }
414   if ( size(#) == 4 ) { h=#[1]; o=#[2]; a=#[3]; b=#[4];}
415   if ( size(#) == 5 ) { h=#[1]; o=#[2]; a=#[3]; b=#[4]; e=#[5]; }
416   if ( size(#) == 6 ) { h=#[1]; o=#[2]; a=#[3]; b=#[4]; e=#[5]; m=#[6]; }
417   list L = elimpartanyr(i,p,e);
418   poly q = product(L[2]);     //product of vars which are already eliminated
419   if ( q==0 ) { q=1; }
420   p = p/q;                    //product of vars which must still be eliminated
421   int nu = size(L[5])-size(L[2]);   //number of vars which must still be eliminated
422   if ( p==1 )                 //ready if no vars are left
423   {                           //compute minbase if 3-rd argument !=0
424      if ( m != 0 ) { L[1]=minbase(L[1]); }
425      return(L);
426   }
427//---------------- create new ring with remaining variables -------------------
428   string newvar = string(L[4]);
429   L = L[1],p;
430   execute("ring r1=("+charstr(P)+"),("+newvar+"),"+"dp;");
431   list L = imap(P,L);
432//------------------- find "best" ordering of variables  ----------------------
433   newvar = string(maxideal(1));
434   if ( o != 0 )
435   {
436      list ordevar = valvars(L[1],a,L[2],b);
437      intvec v = ordevar[1];
438      newvar=string(sort(maxideal(1),v)[1]);
439//------------ create new ring with "best" ordering of variables --------------
440      def r0=changevar(newvar);
441      setring r0;
442      list L = imap(r1,L);
443      kill r1;
444      def r1 = r0;
445      kill r0;
446   }
447//----------------- h==0: eliminate remaining vars directly -------------------
448   if ( h == 0 )
449   {
450      L[1] = eliminate(L[1],L[2]);
451      def r2 = r1;
452   }
453   else
454//------- h!=0: homogenize and compute Hilbert series using hilbvec ----------
455   {
456      intvec hi = hilbvec(L[1]);         // Hilbert series of i
457      execute("ring r2=("+charstr(P)+"),("+varstr(basering)+",@homo),dp;");
458      list L = imap(r1,L);
459      L[1] = homog(L[1],@homo);          // @homo = homogenizing var
460//---- use Hilbert-series to eliminate variables with Hilbert-driven std -----
461      L[1] = eliminate(L[1],L[2],hi);
462      L[1]=subst(L[1],@homo,1);          // dehomogenize by setting @homo=1
463   }
464   if ( m != 0 )                         // compute minbase
465   {
466      if ( #[1] != 0 ) { L[1] = minbase(L[1]); }
467   }
468   def id = L[1];
469   setring P;
470   return(imap(r2,id));
471}
472example
473{ "EXAMPLE:"; echo = 2;
474   ring s=31991,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp;
475   ideal i = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
476            d2+e2-1, f4+2u, wa+tf, xy+tu+ab;
477   fastelim(i,xytua,1,1);       //with hilb,valvars
478   fastelim(i,xytua,1,0,1);     //with hilb,minbase
479}
480///////////////////////////////////////////////////////////////////////////////
481
482proc faststd (@id, list #)
483"USAGE:   faststd(id [,\"hilb\",\"sort\",\"dec\",o,\"blocks\"]);
484         id=ideal/module, o=string (allowed:\"lp\",\"dp\",\"Dp\",\"ls\",
485         \"ds\",\"Ds\"),  \"hilb\",\"sort\",\"dec\",\"block\" options for
486         Hilbert-driven std, and the procedure sortandmap
487RETURN:  a ring R, in which an ideal STD_id is stored: @*
488         - the ring R differs from the active basering only in the choice
489         of monomial ordering and in the sorting of the variables.
490         - STD_id is a standard basis for the image (under imap) of the input
491         ideal/module id with respect to the new monomial ordering. @*
492NOTE:    Using the optional input parameters, we may modify the computations
493         performed: @*
494         - \"hilb\"  : use Hilbert-driven standard basis computation@*
495         - \"sort\"  : use 'sortandmap' for a best sorting of the variables@*
496         - \"dec\"   : order vars w.r.t. decreasing complexity (with \"sort\")@*
497         - \"block\" : create block ordering, each block having ordstr=o, s.t.
498                     vars of same complexity are in one block (with \"sort\")@*
499         - o       : defines the basic ordering of the resulting ring@*
500         [default: o=ordering of 1st block of basering (if allowed, else o=\"dp\"],
501                  \"sort\", if none of the optional parameters is given @*
502         This proc is only useful for hard problems where other methods fail.@*
503         \"hilb\" is useful for hard orderings (as \"lp\") or for characteristic 0,@*
504         it is correct for \"lp\",\"dp\",\"Dp\" (and for block orderings combining
505         these) but not for s-orderings or if the vars have different weights.@*
506         There seem to be only few cases in which \"dec\" is fast
507EXAMPLE: example faststd; shows an example.
508"
509{
510   def @P = basering;
511   int @h,@s,@n,@m,@ii = 0,0,0,0,0;
512   string @o,@va,@c = ordstr(basering),"","";
513//-------------------- prepare ordering and set options -----------------------
514   if ( @o[1]=="c" or @o[1]=="C")
515      {  @o = @o[3,2]; }
516   else
517      { @o = @o[1,2]; }
518   if( @o[1]!="d" and @o[1]!="D" and @o[1]!="l")
519      { @o="dp"; }
520
521   if (size(#) == 0 )
522      { @s = 1; }
523   for ( @ii=1; @ii<=size(#); @ii++ )
524   {
525      if ( typeof(#[@ii]) != "string" )
526      {
527         "// wrong syntax! type: help faststd";
528         return();
529      }
530      else
531      {
532         if ( #[@ii] == "hilb"  ) { @h = 1; }
533         if ( #[@ii] == "dec"   ) { @n = 1; }
534         if ( #[@ii] == "block" ) { @m = 1; }
535         if ( #[@ii] == "sort"  ) { @s = 1; }
536         if ( #[@ii]=="lp" or #[@ii]=="dp" or #[@ii]=="Dp" or #[@ii]=="ls"
537              or #[@ii]=="ds" or #[@ii]=="Ds" ) { @o = #[@ii]; }
538      }
539   }
540   if( voice==2 ) { "// chosen options, hilb sort dec block:",@h,@s,@n,@m; }
541
542//-------------------- nosort: create ring with new name ----------------------
543   if ( @s==0 )
544   {
545      execute("ring @S1 =("+charstr(@P)+"),("+varstr(@P)+"),("+@o+");");
546      def STD_id = imap(@P,@id);
547      if ( @h==0 ) { STD_id = std(STD_id); }
548   }
549
550//---------------------- no hilb: compute SB directly -------------------------
551   if ( @s != 0 and @h == 0 )
552   {
553      intvec getoption = option(get);
554      option(redSB);
555      @id = interred(sort(@id)[1]);
556      poly @p = product(maxideal(1),1..nvars(@P));
557      def @S1=sortandmap(@id,@n,@p,0,@o,@m);
558      setring @S1;
559      option(set,getoption);
560      def STD_id=imap(@S1,IMAG);
561      STD_id = std(STD_id);
562   }
563//------- hilb: homogenize and compute Hilbert-series using hilbvec -----------
564// this uses another standardbasis computation
565   if ( @h != 0 )
566   {
567      execute("ring @Q=("+charstr(@P)+"),("+varstr(@P)+",@homo),("+@o+");"); 
568      def @id = imap(@P,@id);
569      @id = homog(@id,@homo);               // @homo = homogenizing var
570      if ( @s != 0 )
571      {
572        intvec getoption = option(get);
573        option(redSB);
574        @id = interred(sort(@id)[1]);
575        poly @p = product(maxideal(1),1..(nvars(@Q)-1));
576        def @S1=sortandmap(@id,@n,@p,0,@o,@m);
577        setring @S1;
578        option(set,getoption);
579        kill @Q;
580        def @Q= basering;
581        def @id = IMAG;
582      }
583      intvec @hi;                     // encoding of Hilbert-series of i
584      @hi = hilbvec(@id);
585      //if ( @s!=0 ) { @hi = hilbvec(@id,"32003",ordstr(@Q)); }
586      //else { @hi = hilbvec(@id); }
587//-------------------------- use Hilbert-driven std --------------------------
588      @id = std(@id,@hi);
589      @id = subst(@id,@homo,1);             // dehomogenize by setting @homo=1
590      @va = varstr(@Q)[1,size(varstr(@Q))-6];
591      if ( @s!=0 )
592      {
593         @o = ordstr(@Q);
594         if ( @o[1]=="c" or @o[1]=="C") { @o = @o[1,size(@o)-6]; }
595         else { @o = @o[1,size(@o)-8] + @o[size(@o)-1,2]; }
596      }
597      kill @S1;     
598      execute("ring @S1=("+charstr(@Q)+"),("+@va+"),("+@o+");");
599      def STD_id = imap(@Q,@id);
600   }
601   attrib(STD_id,"isSB",1);
602   export STD_id;
603   if (defined(IMAG)) { kill IMAG; }
604   setring @P;
605   dbprint(printlevel-voice+3,"
606// 'faststd' created a ring, in which an object STD_id is stored.
607// To access the object, type (if the name R was assigned to the return value):
608        setring R; STD_id; ");
609   return(@S1);
610}
611example
612{ "EXAMPLE:"; echo = 2;
613   system("--ticks-per-sec",100); // show time in 1/100 sec
614   ring s = 0,(e,f,x,y,z,t,u,v,w,a,b,c,d),(c,lp);
615   ideal i = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
616            d2+e2-1, f4+2u, wa+tf, xy+tu+ab;
617   option(prot); timer=1;
618   int time = timer;
619   ideal j=std(i);
620   timer-time;
621   dim(j),mult(j);
622
623   time = timer;
624   def R=faststd(i);                      // use "best" ordering of vars
625   timer-time;
626   show(R);setring R;dim(STD_id),mult(STD_id);
627
628   setring s;kill R;time = timer;
629   def R=faststd(i,"hilb");                // hilb-std only
630   timer-time;
631   show(R);setring R;dim(STD_id),mult(STD_id);
632
633   setring s;kill R;time = timer;
634   def R=faststd(i,"hilb","sort");         // hilb-std,"best" ordering
635   timer-time;
636   show(R);setring R;dim(STD_id),mult(STD_id);
637
638   setring s;kill R;time = timer;
639   def R=faststd(i,"hilb","sort","block","dec"); // hilb-std,"best",blocks
640   timer-time;
641   show(R);setring R;dim(STD_id),mult(STD_id);
642
643   setring s;kill R;time = timer;
644   timer-time;time = timer;
645   def R=faststd(i,"sort","block","Dp"); //"best",decreasing,Dp-blocks
646   timer-time;
647   show(R);setring R;dim(STD_id),mult(STD_id);
648}
649///////////////////////////////////////////////////////////////////////////////
650
651proc findvars(id, list #)
652"USAGE:   findvars(id [,any] ); id=poly/ideal/vector/module/matrix, any=any type
653RETURN:  if no second argument is present: ideal of variables occuring in id,@*
654         if a second argument is given (of any type): list L with 4 entries:
655  @format
656  L[1]: ideal of variables occuring in id
657  L[2]: intvec of variables occuring in id
658  L[3]: ideal of variables not occuring in id
659  L[4]: intvec of variables not occuring in id
660  @end format
661EXAMPLE: example findvars; shows an example
662"
663{
664   int ii,n;
665   ideal found, notfound;
666   intvec f,nf;
667   n = nvars(basering);
668   ideal i = simplify(ideal(matrix(id)),10);
669   matrix M[ncols(i)][1] = i;
670   vector v = module(M)[1];
671   ideal max = maxideal(1);
672
673   for (ii=1; ii<=n; ii++)
674   {
675      if ( v != subst(v,var(ii),0) )
676      {
677         found = found+var(ii);
678         f = f,ii;
679      }
680      else
681      {
682         notfound = notfound+var(ii);
683         nf = nf,ii;
684      }
685   }
686   if ( size(f)>1 ) { f = f[2..size(f)]; }      //intvec of found vars
687   if ( size(nf)>1 ) { nf = nf[2..size(nf)]; }  //intvec of vars not found
688   if( size(#)==0 )  { return(found); }
689   if( size(#)!=0 )  { list L = found,f,notfound,nf; return(L); }
690}
691example
692{ "EXAMPLE:"; echo = 2;
693   ring s  = 0,(e,f,x,y,t,u,v,w,a,d),dp;
694   ideal i = w2+f2-1, x2+t2+a2-1;
695   findvars(i);
696   findvars(i,1);
697}
698///////////////////////////////////////////////////////////////////////////////
699
700proc hilbvec (@id, list #)
701"USAGE:   hilbvec(id[,c,o]); id=poly/ideal/vector/module/matrix, c,o=strings,@*
702          c=char, o=ordering used by @code{hilb}@*
703          (default: c=\"32003\", o=\"dp\")
704RETURN:  intvec of 1-st Hilbert-series of id, computed in char c and ordering o
705NOTE:    id must be homogeneous (i.e. all vars have weight 1)
706EXAMPLE: example hilbvec; shows an example
707"
708{
709   def @P = basering;
710   string @c,@o = "32003", "dp";
711   if ( size(#) == 1 ) {  @c = #[1]; }
712   if ( size(#) == 2 ) {  @c = #[1]; @o = #[2]; }
713   string @si = typeof(@id)+" @i = "+string(@id)+";";  //** weg
714   execute("ring @r=("+@c+"),("+varstr(basering)+"),("+@o+");");
715   //**def i = imap(P,@id);
716   execute(@si);                   //** weg
717   //show(basering);
718   @i = std(@i);
719   intvec @hi = hilb(@i,1);         // intvec of 1-st Hilbert-series of id
720   return(@hi);
721}
722example
723{ "EXAMPLE:"; echo = 2;
724   ring s   = 0,(e,f,x,y,z,t,u,v,w,a,b,c,d,H),dp;
725   ideal id = w2+f2-1, x2+t2+a2-1,  y2+u2+b2-1, z2+v2+c2-1,
726              d2+e2-1, f4+2u, wa+tf, xy+tu+ab;
727   id = homog(id,H);
728   hilbvec(id);
729}
730///////////////////////////////////////////////////////////////////////////////
731
732proc linearpart (id)
733"USAGE:   linearpart(id);  id=ideal/module
734RETURN:  generators of id of total degree <= 1
735EXAMPLE: example linearpart; shows an example
736"
737{
738   return(degreepart(id,0,1));
739}
740example
741{ "EXAMPLE:"; echo = 2;
742   ring r=0,(x,y,z),dp;
743   ideal i=1+x+x2+x3,3,x+3y+5z;
744   linearpart(i);
745   module m=[x,y,z],x*[x3,y2,z],[1,x2,z3,0,1];
746   show(linearpart(m));
747}
748///////////////////////////////////////////////////////////////////////////////
749
750proc tolessvars (id ,list #)
751"USAGE:   tolessvars(id [,s1,s2] ); id poly/ideal/vector/module/matrix,
752          s1=string (new ordering)@*
753          [default: s1=\"dp\" or \"ds\" depending on whether the first block
754          of the old ordering is a p- resp. an s-ordering)
755RETURN:  If id contains all vars of the basering: empty list. @*
756         Else: ring R with the same char as the basering, but possibly less
757         variables (only those variables which actually occur in id). In R
758         an object IMAG (image of id under imap) is stored. 
759DISPLAY: If printlevel >=0, display ideal of vars, which have been ommitted
760         from the old ring.
761EXAMPLE: example tolessvars; shows an example
762"
763{
764//---------------- initialisation and check occurence of vars -----------------
765   int s,ii,n,fp,fs;
766   string s2,newvar;
767   int pr = printlevel-voice+3;  // p = printlevel+1 (default: p=1)
768   def P = basering;
769   s2 = ordstr(P);
770
771   list L = findvars(id,1);
772   newvar = string(L[1]);    // string of new variables
773   n = size(L[1]);           // number of new variables
774   if( n == 0 )
775   {
776      dbprint( pr,"","// no variable occured in "+typeof(id)+", no change of ring!");
777      return(id);
778   }
779   if( n == nvars(P) )
780   {
781     dbprint(printlevel-voice+3,"
782// All variables appear in input object.
783// empty list returned. ");
784     return(list());
785   }
786//----------------- prepare new ring, map to it and return --------------------
787   if ( size(#) == 0 )
788   {
789       fp = find(s2,"p");
790       fs = find(s2,"s");
791       if( fs==0 or (fs>=fp && fp!=0) ) { s2="dp"; }
792       else {  s2="ds"; }
793   }
794   if ( size(#) ==1 ) { s2=#[1]; }
795   dbprint( pr,"","// variables which did not occur:",L[3] );
796   execute("ring S1=("+charstr(P)+"),("+newvar+"),("+s2+");");
797   def IMAG = imap(P,id);
798   export IMAG;
799   dbprint(printlevel-voice+3,"
800// 'tolessvars' created a ring, in which an object IMAG is stored.
801// To access the object, type (if the name R was assigned to the return value):
802        setring R; IMAG; ");
803   return(S1);
804}
805example
806{ "EXAMPLE:"; echo = 2;
807   ring r  = 0,(x,y,z),dp;
808   ideal i = y2-x3,x-3,y-2x;
809   def R_r = tolessvars(i,"lp");
810   setring R_r;
811   show(basering);
812   IMAG;
813   kill R_r;
814}
815///////////////////////////////////////////////////////////////////////////////
816
817proc solvelinearpart (id,list #)
818"USAGE:   solvelinearpart(id [,n] );  id=ideal/module, n=integer,@*
819          (default: n=0)
820RETURN:  (interreduced) generators of id of degree <=1 in reduced triangular
821         form if n=0 [non-reduced triangular form if n!=0]
822ASSUME:  monomial ordering is a global ordering (p-ordering)
823NOTE:    may be used to solve a system of linear equations
824         see proc @code{gauss_row} from 'matrix.lib' for a different method
825WARNING: the result is very likely to be false for 'real' coefficients, use
826         char 0 instead!
827EXAMPLE: example solvelinearpart; shows an example
828"
829{
830   intvec getoption = option(get);
831   option(redSB);
832   if ( size(#)!=0 )
833   {
834      if(#[1]!=0) { option(noredSB); }
835   }
836   def lin = interred(degreepart(id,0,1));
837   if ( size(#)!=0 )
838   {
839      if(#[1]!=0)
840      {
841         return(lin);
842      }
843   }
844   option(set,getoption);
845   return(simplify(lin,1));
846}
847example
848{ "EXAMPLE:"; echo = 2;
849   // Solve the system of linear equations:
850   //         3x +   y +  z -  u = 2
851   //         3x +  8y + 6z - 7u = 1
852   //        14x + 10y + 6z - 7u = 0
853   //         7x +  4y + 3z - 3u = 3
854   ring r = 0,(x,y,z,u),lp;
855   ideal i= 3x +   y +  z -  u,
856           13x +  8y + 6z - 7u,
857           14x + 10y + 6z - 7u,
858            7x +  4y + 3z - 3u;
859   ideal j= 2,1,0,3;
860   j = i-j;                        // difference of 1x4 matrices
861                                   // compute reduced triangular form, setting
862   solvelinearpart(j);             // the RHS equal 0 gives the solutions!
863   solvelinearpart(j,1); "";       // triangular form, not reduced
864}
865///////////////////////////////////////////////////////////////////////////////
866
867proc sortandmap (@id, list #)
868"USAGE:   sortandmap(id [,n1,p1,n2,p2...,o1,m1,o2,m2...]);@*
869         id=poly/ideal/vector/module,@*
870         p1,p2,...= polynomials (product of variables),@*
871         n1,n2,...= integers,@*
872         o1,o2,...= strings,@*
873         m1,m2,...= integers@*
874         (default: p1=product of all vars, n1=0, o1=\"dp\",m1=0)
875         the last pi (containing the remaining vars) may be omitted
876RETURN:  a ring R, in which a poly/ideal/vector/module IMAG is stored: @*
877         - the ring R differs from the active basering only in the choice
878         of monomial ordering and in the sorting of the variables.@*
879         - IMAG is the image (under imap) of the input ideal/module id @*
880         The new monomial ordering and sorting of vars is as follows:
881  @format
882  - each block of vars occuring in pi is sorted w.r.t. its complexity in id,
883  - ni controls the sorting in i-th block (= vars occuring in pi):
884    ni=0 (resp.!=0) means that least complex (resp. most complex) vars come
885    first @*
886  - oi and mi define the monomial ordering of the i-th block:
887    if mi =0, oi=ordstr(i-th block)
888    if mi!=0, the ordering of the i-th block itself is a blockordering,
889      each subblock having ordstr=oi, such that vars of same complexity are
890      in one block
891  @end format
892         Note that only simple ordstrings oi are allowed: \"lp\",\"dp\",\"Dp\",
893         \"ls\",\"ds\",\"Ds\". @*
894NOTE:    We define a variable x to be more complex than y (with respect to id)
895         if val(x) > val(y) lexicographically, where val(x) denotes the
896         valuation vector of x:@*
897         consider id as list of polynomials in x with coefficients in the
898         remaining variables. Then:@*
899         val(x) = (maximal occuring power of x,  # of all monomials in leading
900         coefficient, # of all monomials in coefficient of next smaller power
901         of x,...).
902EXAMPLE: example sortandmap; shows an example
903"
904{
905   def @P = basering;
906   int @ii,@jj;
907   intvec @v;
908   string @o;
909//----------------- find o in # and split # into 2 lists ---------------------
910   # = # +list("dp",0);
911   for ( @ii=1; @ii<=size(#); @ii++)
912   {
913      if ( typeof(#[@ii])=="string" )  break;
914   }
915   if ( @ii==1 ) { list @L1 = list(); }
916   else { list @L1 = #[1..@ii-1]; }
917   list @L2 = #[@ii..size(#)];
918   list @L = sortvars(@id,@L1);
919   string @va = string(@L[1]);
920   list @l = @L[2];   //e.g. @l[4]=intvec describing permutation of 1-st block
921//----------------- construct correct ordering with oi and mi ----------------
922   for ( @ii=4; @ii<=size(@l); @ii=@ii+4 )
923   {
924      @L2=@L2+list("dp",0);
925      if ( @L2[@ii/2] != 0)
926      {
927         @v = @l[@ii];
928         for ( @jj=1; @jj<=size(@v); @jj++ )
929         {
930           @o = @o+@L2[@ii/2 -1]+"("+string(@v[@jj])+"),";
931         }
932      }
933      else
934      {
935         @o = @o+@L2[@ii/2 -1]+"("+string(size(@l[@ii/2]))+"),";
936      }
937   }
938   @o=@o[1..size(@o)-1];
939   execute("ring @S1 =("+charstr(@P)+"),("+@va+"),("+@o+");");
940   def IMAG = imap(@P,@id);
941   export IMAG;
942   dbprint(printlevel-voice+3,"
943// 'sortandmap' created a ring, in which an object IMAG is stored.
944// To access the object, type (if the name R was assigned to the return value):
945        setring R; IMAG; ");
946   return(@S1);
947}
948example
949{ "EXAMPLE:"; echo = 2;
950   ring s = 32003,(x,y,z),dp;
951   ideal i=x3+y2,xz+z2;
952   def R_r=sortandmap(i); 
953   show(R_r);
954   setring R_r; IMAG;
955   kill R_r; setring s;
956   def R_r=sortandmap(i,1,xy,0,z,0,"ds",0,"lp",0);
957   show(R_r);
958   setring R_r; IMAG;
959   kill R_r;
960}
961///////////////////////////////////////////////////////////////////////////////
962
963proc sortvars (id, list #)
964"USAGE:   sortvars(id[,n1,p1,n2,p2,...]);@*
965         id=poly/ideal/vector/module,@*
966         p1,p2,...= polynomials (product of vars),@*
967         n1,n2,...=integers@*
968         (default: p1=product of all vars, n1=0)
969         the last pi (containing the remaining vars) may be omitted
970COMPUTE: sort variables with respect to their complexity in id
971RETURN:  list of two elements, an ideal and a list:
972  @format
973  [1]: ideal, variables of basering sorted w.r.t their complexity in id
974       ni controls the ordering in i-th block (= vars occuring in pi):
975       ni=0 (resp.!=0) means that less (resp. more) complex vars come first
976  [2]: a list with 4 entries for each pi:
977       ideal ai : vars of pi in correct order,
978       intvec vi: permutation vector describing the ordering in ai,
979       intmat Mi: valuation matrix of ai, the columns of Mi being the
980                  valuation vectors of the vars in ai
981       intvec wi: size of 1-st, 2-nd,... block of identical columns of Mi
982                  (vars with same valuation)
983  @end format
984NOTE:    We define a variable x to be more complex than y (with respect to id)
985         if val(x) > val(y) lexicographically, where val(x) denotes the
986         valuation vector of x:@*
987         consider id as list of polynomials in x with coefficients in the
988         remaining variables. Then:@*
989         val(x) = (maximal occuring power of x,  # of all monomials in leading
990         coefficient, # of all monomials in coefficient of next smaller power
991         of x,...).
992EXAMPLE: example sortvars; shows an example
993"
994{
995   int ii,jj,n,s;
996   list L = valvars(id,#);
997   list L2, L3 = L[2], L[3];
998   list K; intmat M; intvec v1,v2,w;
999   ideal i = sort(maxideal(1),L[1])[1];
1000   for ( ii=1; ii<=size(L2); ii++ )
1001   {
1002      M = transpose(L3[2*ii]);
1003      M = M[L2[ii],1..nrows(L3[2*ii])];
1004      w = 0; s = 0;
1005      for ( jj=1; jj<=nrows(M)-1; jj++ )
1006      {
1007         v1 = M[jj,1..ncols(M)];
1008         v2 = M[jj+1,1..ncols(M)];
1009         if ( v1 != v2 ) { n=jj-s; s=s+n; w = w,n; }
1010      }
1011      w=w,nrows(M)-s; w=w[2..size(w)];
1012      K = K+sort(L3[2*ii-1],L2[ii])+list(transpose(M))+list(w);
1013   }
1014   L = i,K;
1015   return(L);
1016}
1017example
1018{ "EXAMPLE:"; echo = 2;
1019   ring s=0,(x,y,z,w),dp;
1020   ideal i = x3+y2+yw2,xz+z2,xyz-w2;
1021   sortvars(i,0,xy,1,zw);
1022}
1023///////////////////////////////////////////////////////////////////////////////
1024
1025proc valvars (id, list #)
1026"USAGE:   valvars(id[,n1,p1,n2,p2,...]);@*
1027         id=poly/ideal/vector/module,@*
1028         p1,p2,...= polynomials (product of vars),@*
1029         n1,n2,...= integers,
1030
1031         ni controls the ordering of vars occuring in pi: ni=0 (resp.!=0) means
1032         that less (resp. more) complex vars come first@*
1033         (default: p1=product of all vars, n1=0)
1034         the last pi (containing the remaining vars) may be omitted
1035COMPUTE: valuation (complexity) of variables with respect to id.@*
1036         ni controls the ordering of vars occuring in pi:@*
1037         ni=0 (resp.!=0) means that less (resp. more) complex vars come first.
1038RETURN:  list with 3 entries:
1039  @format
1040  [1]: intvec, say v, describing the permutation such that the permuted
1041       ringvariables are ordered with respect to their complexity in id
1042  [2]: list of intvecs, i-th intvec, say v(i) describing permutation
1043       of vars in a(i) such that v=v(1),v(2),...
1044  [3]: list of ideals and intmat's, say a(i) and M(i), where
1045       a(i): factors of pi,
1046       M(i): valuation matrix of a(i), such that the j-th column of M(i)
1047             is the valuation vector of j-th generator of a(i)
1048         @end format
1049NOTE:    Use @code{sortvars} in order to actually sort the variables!
1050         We define a variable x to be more complex than y (with respect to id)
1051         if val(x) > val(y) lexicographically, where val(x) denotes the
1052         valuation vector of x:@*
1053         consider id as list of polynomials in x with coefficients in the
1054         remaining variables. Then:@*
1055         val(x) = (maximal occuring power of x,  # of all monomials in leading
1056         coefficient, # of all monomials in coefficient of next smaller power
1057         of x,...).
1058EXAMPLE: example valvars; shows an example
1059"
1060{
1061//---------------------------- initialization ---------------------------------
1062   int ii,jj,kk,n;
1063   list L;                    // list of valuation vectors in one block
1064   intvec vec;                // describes permutation of vars (in one block)
1065   list blockvec;             // i-th element = vec of i-th block
1066   intvec varvec;             // result intvector
1067   list Li;                   // result list of ideals
1068   list LM;                   // result list of intmat's
1069   intvec v,w,s;              // w valuation vector for one variable
1070   matrix C;                  // coefficient matrix for different variables
1071   ideal i = simplify(ideal(matrix(id)),10);
1072
1073//---- for each pii in # create ideal a(ii) intvec v(ii) and list L(ii) -------
1074// a(ii) = ideal of vars in product, v(ii)[j]=k <=> a(ii)[j]=var(k)
1075
1076   v = 1..nvars(basering);
1077   int l = size(#);
1078   if ( l >= 2 )
1079   {
1080      ideal m=maxideal(1);
1081      for ( ii=2; ii<=l; ii=ii+2 )
1082      {
1083         int n(ii) = #[ii-1];
1084         ideal a(ii);
1085         intvec v(ii);
1086         for ( jj=1; jj<=nvars(basering); jj++ )
1087         {
1088            if ( #[ii]/var(jj) != 0)
1089            {
1090               a(ii) = a(ii) + var(jj);
1091               v(ii)=v(ii),jj;
1092               m[jj]=0;
1093               v[jj]=0;
1094            }
1095         }
1096         v(ii)=v(ii)[2..size(v(ii))];
1097      }
1098      if ( size(m)!=0 )
1099      {
1100         l = 2*(l/2)+2;
1101         ideal a(l) = simplify(m,2);
1102         intvec v(l) = compress(v);
1103         int n(l);
1104         if ( size(#)==l-1 ) { n(l) = #[l-1]; }
1105      }
1106   }
1107   else
1108   {
1109      l = 2;
1110      ideal a(2) = maxideal(1);
1111      intvec v(2) = v;
1112      int n(2);
1113      if ( size(#)==1 ) { n(2) = #[1]; }
1114   }
1115//------------- start loop to order variables in each a(ii) -------------------
1116
1117   for ( kk=2; kk<=l; kk=kk+2 )
1118   {
1119      L = list();
1120      n = 0;
1121//---------------- get valuation of all variables in a(kk) --------------------
1122      for ( ii=1; ii<=size(a(kk)); ii++ )
1123      {
1124         C = coeffs(i,a(kk)[ii]);
1125         w = nrows(C); // =(maximal occuring power of a(kk)[ii])+1
1126         for ( jj=w[1]; jj>1; jj-- )
1127         {
1128            s = size(C[jj,1..ncols(C)]);
1129            w[w[1]-jj+2] = sum(s);
1130         }
1131         // w[1] should represent the maximal occuring power of a(kk)[ii] so it
1132         // has to be decreased by 1 since otherwise the constant term is also
1133         // counted
1134         w[1]=w[1]-1;
1135
1136         L[ii]=w;
1137         n = size(w)*(size(w) > n) + n*(size(w) <= n);
1138      }
1139      intmat M(kk)[size(a(kk))][n];
1140      for ( ii=1; ii<=size(a(kk)); ii++ )
1141      {
1142         if ( n==1 ) { w = L[ii]; M(kk)[ii,1] = w[1]; }
1143         else  { M(kk)[ii,1..n] = L[ii]; }
1144      }
1145      LM[kk-1] = a(kk);
1146      LM[kk] = transpose(compress(M(kk)));
1147//------------------- compare valuation and insert in vec ---------------------
1148      vec = sort(L)[2];
1149      if ( n(kk) != 0 ) { vec = vec[size(vec)..1]; }
1150      blockvec[kk/2] = vec;
1151      vec = sort(v(kk),vec)[1];
1152      varvec = varvec,vec;
1153   }
1154   varvec = varvec[2..size(varvec)];
1155   list result = varvec,blockvec,LM;
1156   return(result);
1157}
1158example
1159{ "EXAMPLE:"; echo = 2;
1160   ring s=0,(x,y,z,a,b),dp;
1161   ideal i=ax2+ay3-b2x,abz+by2;
1162   valvars (i,0,xyz);
1163}
1164///////////////////////////////////////////////////////////////////////////////
1165proc idealSplit(ideal I,list #)
1166"USAGE:  idealSplit(id,timeF,timeS);  id ideal and optioonal
1167         timeF ,timeS integers to bound the time which can be used
1168         for factorization resp. standard basis computation
1169RETURN:  a list of ideals such that their intersection
1170         has the same radical as id
1171EXAMPLE: example idealSplit; shows an example
1172"
1173{
1174   option(redSB);
1175   int j,k,e;
1176   int i=1;
1177   int l=attrib(I,"isSB");
1178   ideal J;
1179   int timeF;
1180   int timeS;
1181   list re,fac,te;
1182
1183   if(size(#)==1)
1184   {
1185     if(typeof(#[1])=="ideal")
1186     {
1187        re=#;
1188     }
1189     else
1190     {
1191       timeF=#[1];
1192     }
1193   }
1194   if(size(#)==2)
1195   {
1196     if(typeof(#[1])=="list")
1197     {
1198        re=#[1];
1199        timeF=#[2];
1200     }
1201     else
1202     {
1203       timeF=#[1];
1204       timeS=#[2];
1205     }
1206   }
1207   if(size(#)==3){re=#[1];timeF=#[2];timeS=#[3];}
1208
1209   fac=timeFactorize(I[1],timeF);
1210
1211   while((size(fac[1])==2)&&(i<size(I)))
1212   {
1213      i++;
1214      fac=timeFactorize(I[i],timeF);
1215   }
1216   if(size(fac[1])>2)
1217   {
1218      for(j=2;j<=size(fac[1]);j++)
1219      {
1220         I[i]=fac[1][j];
1221         attrib(I,"isSB",1);
1222         e=1;
1223         k=0;
1224         while(k<size(re))
1225         {
1226            k++;
1227            if(size(reduce(re[k],I))==0){e=0;break;}
1228            attrib(re[k],"isSB",1);
1229            if(size(reduce(I,re[k]))==0){re=delete(re,k);k--;}
1230         }
1231         if(e)
1232         {
1233            if(l)
1234            {
1235               J=I;
1236               J[i]=0;
1237               J=simplify(J,2);
1238               attrib(J,"isSB",1);
1239               re=idealSplit(std(J,fac[1][j]),re,timeF,timeS);
1240            }
1241            else
1242            {
1243               re=idealSplit(timeStd(I,timeS),re,timeF,timeS);
1244            }
1245         }
1246      }
1247      return(re);
1248   }
1249   J=timeStd(I,timeS);
1250   attrib(I,"isSB",1);
1251   if(size(reduce(J,I))==0){return(re+list(I));}
1252   return(re+idealSplit(J,re,timeF,timeS));
1253}
1254example
1255{ "EXAMPLE:"; echo = 2;
1256   ring r=32003,(b,s,t,u,v,w,x,y,z),dp;
1257   ideal i=
1258   bv+su,
1259   bw+tu,
1260   sw+tv,
1261   by+sx,
1262   bz+tx,
1263   sz+ty,
1264   uy+vx,
1265   uz+wx,
1266   vz+wy,
1267   bvz;
1268   idealSplit(i);
1269}
1270///////////////////////////////////////////////////////////////////////////////
1271proc idealSimplify(ideal J,list #)
1272"USAGE:  idealSimplify(id);  id ideal
1273RETURN:  ideal I = eliminate(Id,m) m is a product of variables
1274         which are only linearly involved in the generators of id
1275EXAMPLE: example idealSimplify; shows an example
1276"
1277{
1278   ideal I=J;
1279   if(size(#)!=0){I=#[1];}
1280   def R=basering;
1281   matrix M=jacob(I);
1282   ideal ma=maxideal(1);
1283   int i,j,k;
1284   map phi;
1285
1286   for(i=1;i<=nrows(M);i++)
1287   {
1288      for(j=1;j<=ncols(M);j++)
1289      {       
1290         if(deg(M[i,j])==0)
1291         {
1292            ma[j]=(-1/M[i,j])*(I[i]-M[i,j]*var(j));
1293            phi=R,ma;
1294            I=phi(I);
1295            J=phi(J);
1296            for(k=1;k<=ncols(I);k++){I[k]=cleardenom(I[k]);}
1297            M=jacob(I);
1298         }
1299      }
1300   }
1301   J=simplify(J,2);
1302   for(i=1;i<=size(J);i++){J[i]=cleardenom(J[i]);}
1303   return(J);
1304}
1305example
1306{ "EXAMPLE:"; echo = 2;
1307   ring r=0,(x,y,z,w,t),dp;
1308   ideal i=
1309   t,
1310   x3+y2+2z,
1311   x2+3y,
1312   x2+y2+z2,
1313   w2+z;
1314   ideal j=idealSimplify(i);
1315   ideal k=eliminate(i,zyt);
1316   reduce(k,std(j));
1317   reduce(j,std(k));
1318}
1319
1320///////////////////////////////////////////////////////////////////////////////
1321
1322/*
1323
1324 ring s=31991,(e,f,x,y,z,t,u,v,w,a,b,c,d),dp;
1325 ring s=31991,(x,y,z,t,u,v,w,a,b,c,d,f,e,h),dp; //standard
1326 ring s1=31991,(y,u,b,c,a,z,t,x,v,d,w,e,f,h),dp; //gut
1327v;
132813,12,11,10,8,7,6,5,4,3,2,1,9,14
1329print(matrix(sort(maxideal(1),v)));
1330f,e,w,d,x,t,z,a,c,b,u,y,v,h
1331print(matrix(maxideal(1)));
1332y,u,b,c,a,z,t,x,v,d,w,e,f,h
1333v0;
133414,9,12,11,10,8,7,6,5,4,3,2,1,13
1335print(matrix(sort(maxideal(1),v0)));
1336h,v,e,w,d,x,t,z,a,c,b,u,y,f
1337v1;v2;
13389,12,11,10,8,7,6,5,4,3,2,1,13,14
133913,12,11,10,8,7,6,5,4,3,2,1,9,14
1340
1341Ev. Gute Ordnung fuer i:
1342========================
1343i=ad*x^d+ad-1*x^(d-1)+...+a1*x+a0, ad!=0
1344mit ar=(ar1,...,ark), k=size(i)
1345    arj in K[..x^..]
1346d=deg_x(i) := max{deg_x(i[k]) | k=1..size(i)}
1347size_x(i,deg_x(i)..0) := size(ad),...,size(a0)
1348x>y  <==
1349  1. deg_x(i)>deg_y(i)
1350  2. "=" in 1. und size_x lexikographisch
1351
1352hier im Beispiel:
1353f: 5,1,0,1,2
1354
1355u: 3,1,4
1356
1357y: 3,1,3
1358b: 3,1,3
1359c: 3,1,3
1360a: 3,1,3
1361z: 3,1,3
1362t: 3,1,3
1363
1364x: 3,1,2
1365v: 3,1,2
1366d: 3,1,2
1367w: 3,1,2
1368e: 3,1,2
1369probier mal:
1370 ring s=31991,(f,u,y,z,t,a,b,c,v,w,d,e,h),dp; //standard
1371
1372*/
Note: See TracBrowser for help on using the repository browser.