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

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