source: git/Singular/LIB/presolve.lib @ 8942a5

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