# source:git/Singular/LIB/presolve.lib@c91bb9

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