source: git/Singular/LIB/elim.lib @ ec1a0f

spielwiese
Last change on this file since ec1a0f was ec1a0f, checked in by Hans Schönemann <hannes@…>, 20 years ago
*hannes: is_homog removed git-svn-id: file:///usr/local/Singular/svn/trunk@7234 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 10.7 KB
Line 
1// $Id: elim.lib,v 1.16 2004-06-21 10:13:48 Singular Exp $
2// (GMG, last modified 22.06.96)
3///////////////////////////////////////////////////////////////////////////////
4version="$Id: elim.lib,v 1.16 2004-06-21 10:13:48 Singular Exp $";
5category="Commutative Algebra";
6info="
7LIBRARY:  elim.lib      Elimination, Saturation and Blowing up
8
9PROCEDURES:
10 blowup0(j[,s1,s2]);    create presentation of blownup ring of ideal j
11 elim(id,n,m);          variable n..m eliminated from id (ideal/module)
12 elim1(id,p);           p=product of vars to be eliminated from id
13 nselect(id,n[,m]);     select generators not containing nth [..mth] variable
14 sat(id,j);             saturated quotient of ideal/module id by ideal j
15 select(id,n[,m]);      select generators containing all variables n...m
16 select1(id,n[,m]);     select generators containing one variable n...m
17           (parameters in square brackets [] are optional)
18";
19
20LIB "inout.lib";
21LIB "general.lib";
22LIB "poly.lib";
23
24///////////////////////////////////////////////////////////////////////////////
25
26proc blowup0 (ideal j,list #)
27"USAGE:   blowup0(j[,s1,s2]); j ideal, s1,s2 nonempty strings
28CREATE:  Create a presentation of the blowup ring of j
29RETURN:  no return value
30NOTE:    s1 and s2 are used to give names to the blownup ring and the blownup
31         ideal (default: s1=\"j\", s2=\"A\")
32         Assume R = char,x(1..n),ord is the basering of j, and s1=\"j\", s2=\"A\"
33         then the procedure creates a new ring with name Bl_jR
34         (equal to R[A,B,...])
35               Bl_jR = char,(A,B,...,x(1..n)),(dp(k),ord)
36         with k=ncols(j) new variables A,B,... and ordering wp(d1..dk) if j is
37         homogeneous with deg(j[i])=di resp. dp otherwise for these vars.
38         If k>26 or size(s2)>1, say s2=\"A()\", the new vars are A(1),...,A(k).
39         Let j_ be the kernel of the ring map Bl_jR -> R defined by A(i)->j[i],
40         x(i)->x(i), then the quotient ring Bl_jR/j_ is the blowup ring of j
41         in R (being isomorphic to R+j+j^2+...). Moreover the procedure creates
42         a std basis of j_ with name j_ in Bl_jR.
43         This proc uses 'execute' or calls a procedure using 'execute'.
44DISPLAY: printlevel >=0: explain created objects (default)
45EXAMPLE: example blowup0; shows examples
46"{
47   string bsr = nameof(basering);
48   def br = basering;
49   string cr,vr,o = charstr(br),varstr(br),ordstr(br);
50   int n,k,i = nvars(br),ncols(j),0;
51   int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
52//---------------- create coordinate ring of blown up space -------------------
53   if( size(#)==0 ) { #[1] = "j"; #[2] = "A"; }
54   if( size(#)==1 ) { #[2] = "A"; }
55   if( k<=26 and size(#[2])==1 ) { string nv = A_Z(#[2],k)+","; }
56   else { string nv = (#[2])[1]+"(1.."+string(k)+"),"; }
57   intvec v;
58   if( homog(j) )
59   {
60      v=1;
61      for( i=1; i<=k; i=i+1) { v[i+1]=deg(j[i]); }
62      string nor = "),(wp(v),";
63   }
64   else { string nor = "),(dp(1+k),";}
65   execute("ring Bl=("+cr+"),(t,"+nv+vr+nor+o+");");
66//---------- map to new ring, eliminate and create blown up ideal -------------
67   ideal j=imap(br,j);
68   for( i=1; i<=k; i=i+1) { j[i]=var(1+i)-t*j[i]; }
69   j=eliminate(j,t);
70   v=v[2..size(v)];
71   execute("ring Bl_"+#[1]+bsr+"=("+cr+"),("+nv+vr+nor+o+");");
72   ideal `#[1]+"_"`=imap(Bl,j);
73   export basering;
74   export `#[1]+"_"`;
75   //keepring basering;
76   setring br;
77//------------------- some comments about usage and names  --------------------
78dbprint(p,"",
79"// The proc created the ring Bl_"+#[1]+bsr+" (equal to "+bsr+"["+nv[1,size(nv)-1]+"])",
80"// it contains the ideal "+#[1]+"_ , such that",
81"//             Bl_"+#[1]+bsr+"/"+#[1]+"_ is the blowup ring",
82"// show(Bl_"+#[1]+bsr+"); shows this ring.",
83"// Make Bl_"+#[1]+bsr+" the basering and see "+#[1]+"_ by typing:",
84"   setring Bl_"+#[1]+bsr+";","   "+#[1]+"_;");
85   return();
86}
87example
88{ "EXAMPLE:"; echo = 2;
89   ring R=0,(x,y),dp;
90   poly f=y2+x3; ideal j=jacob(f);
91   blowup0(j);
92   show(Bl_jR);
93   setring Bl_jR;
94   j_;"";
95   ring r=32003,(x,y,z),ds;
96   blowup0(maxideal(1),"m","T()");
97   show(Bl_mr);
98   setring Bl_mr;
99   m_;
100   kill Bl_jR, Bl_mr;
101}
102///////////////////////////////////////////////////////////////////////////////
103
104proc elim (id, int n, int m)
105"USAGE:   elim(id,n,m);  id ideal/module, n,m integers
106RETURNS: ideal/module obtained from id by eliminating variables n..m
107NOTE:    no special monomial ordering is required, result is a SB with
108         respect to ordering dp (resp. ls) if the first var not to be
109         eliminated belongs to a -p (resp. -s) blockordering
110         This proc uses 'execute' or calls a procedure using 'execute'.
111SEE ALSO: elim1, eliminate
112EXAMPLE: example elim; shows examples
113"
114{
115//---- get variables to be eliminated and create string for new ordering ------
116   int ii; poly vars=1;
117   for( ii=n; ii<=m; ii=ii+1 ) { vars=vars*var(ii); }
118   if( n>1 ) { poly p = 1+var(1); }
119   else { poly p = 1+var(m+1); }
120   if( ord(p)==0 ) { string ordering = "),ls;"; }
121   if( ord(p)>0 ) { string ordering = "),dp;"; }
122   string mpoly=string(minpoly);
123//-------------- create new ring and map objects to new ring ------------------
124   def br = basering;
125   string str = "ring @newr = ("+charstr(br)+"),("+varstr(br)+ordering;
126   execute(str);
127   if (mpoly!="0") { execute("minpoly="+mpoly+";"); }
128   def i = imap(br,id);
129   poly vars = imap(br,vars);
130//---------- now eliminate in new ring and map back to old ring ---------------
131   i = eliminate(i,vars);
132   setring br;
133   return(imap(@newr,i));
134}
135example
136{ "EXAMPLE:"; echo = 2;
137   ring r=0,(x,y,u,v,w),dp;
138   ideal i=x-u,y-u2,w-u3,v-x+y3;
139   elim(i,3,4);
140   module m=i*gen(1)+i*gen(2);
141   m=elim(m,3,4);show(m);
142}
143///////////////////////////////////////////////////////////////////////////////
144
145proc elim1 (id, poly vars)
146"USAGE:   elim1(id,p); id ideal/module, p product of vars to be eliminated
147RETURN:  ideal/module obtained from id by eliminating vars occuring in poly
148NOTE:    no special monomial ordering is required, result is a SB with
149         respect to ordering dp (resp. ls) if the first var not to be
150         eliminated belongs to a -p (resp. -s) blockordering
151         This proc uses 'execute' or calls a procedure using 'execute'.
152SEE ALSO: elim, eliminate
153EXAMPLE: example elim1; shows examples
154"
155{
156//---- get variables to be eliminated and create string for new ordering ------
157   int ii;
158   for( ii=1; ii<=nvars(basering); ii=ii+1 )
159   {
160      if( vars/var(ii)==0 ) { poly p = 1+var(ii); break;}
161   }
162   if( ord(p)==0 ) { string ordering = "),ls;"; }
163   if( ord(p)>0 ) { string ordering = "),dp;"; }
164//-------------- create new ring and map objects to new ring ------------------
165   def br = basering;
166   string str = "ring @newr = ("+charstr(br)+"),("+varstr(br)+ordering;
167   execute(str);
168   def id = fetch(br,id);
169   poly vars = fetch(br,vars);
170//---------- now eliminate in new ring and map back to old ring ---------------
171   id = eliminate(id,vars);
172   setring br;
173   return(imap(@newr,id));
174}
175example
176{ "EXAMPLE:"; echo = 2;
177   ring r=0,(x,y,t,s,z),dp;
178   ideal i=x-t,y-t2,z-t3,s-x+y3;
179   elim1(i,ts);
180   module m=i*gen(1)+i*gen(2);
181   m=elim1(m,st); show(m);
182}
183///////////////////////////////////////////////////////////////////////////////
184
185proc nselect (id, int n, list#)
186"USAGE:   nselect(id,n[,m]); id a module or ideal, n, m integers
187RETURN:  generators of id not containing the variable n [up to m]
188SEE ALSO: select, select1
189EXAMPLE: example nselect; shows examples
190"{
191   int j,k;
192   if( size(#)==0 ) { #[1]=n; }
193   for( k=1; k<=ncols(id); k=k+1 )
194   {  for( j=n; j<=#[1]; j=j+1 )
195      {  if( size(id[k]/var(j))!=0) { id[k]=0; break; }
196      }
197   }
198   return(simplify(id,2));
199}
200example
201{ "EXAMPLE:"; echo = 2;
202   ring r=0,(x,y,t,s,z),(c,dp);
203   ideal i=x-y,y-z2,z-t3,s-x+y3;
204   nselect(i,3);
205   module m=i*(gen(1)+gen(2));
206   show(m);
207   show(nselect(m,3,4));
208}
209///////////////////////////////////////////////////////////////////////////////
210
211proc sat (id, ideal j)
212"USAGE:   sat(id,j);  id=ideal/module, j=ideal
213RETURN:  list of an ideal/module [1] and an integer [2]:
214         [1] = saturation of id with respect to j (= union_(k=1...) of id:j^k)
215         [2] = saturation exponent (= min( k | id:j^k = id:j^(k+1) ))
216NOTE:    [1] is a standard basis in the basering
217DISPLAY: saturation exponent during computation if printlevel >=1
218EXAMPLE: example sat; shows an example
219"{
220   int ii,kk;
221   def i=id;
222   id=std(id);
223   int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
224   while( ii<=size(i) )
225   {
226      dbprint(p-1,"// compute quotient "+string(kk+1));
227      i=quotient(id,j);
228      for( ii=1; ii<=size(i); ii=ii+1 )
229      {
230         if( reduce(i[ii],id,1)!=0 ) break;
231      }
232      id=std(i); kk=kk+1;
233   }
234   dbprint(p-1,"// saturation becomes stable after "+string(kk-1)+" iteration(s)","");
235   list L = id,kk-1;
236   return (L);
237}
238example
239{ "EXAMPLE:"; echo = 2;
240   int p      = printlevel;
241   ring r     = 2,(x,y,z),dp;
242   poly F     = x5+y5+(x-y)^2*xyz;
243   ideal j    = jacob(F);
244   sat(j,maxideal(1));
245   printlevel = 2;
246   sat(j,maxideal(2));
247   printlevel = p;
248}
249///////////////////////////////////////////////////////////////////////////////
250
251proc select (id, int n, list#)
252"USAGE:   select(id,n[,m]); id ideal/module, n, m integers
253RETURN:  generators of id containing the variable n [all variables up to m]
254NOTE:    use 'select1' for selecting generators containing at least one of the
255         variables between n and m
256SEE ALSO: select1, nselect
257EXAMPLE: example select; shows examples
258"{
259   if( size(#)==0 ) { #[1]=n; }
260   int j,k;
261   for( k=1; k<=ncols(id); k=k+1 )
262   {  for( j=n; j<=#[1]; j=j+1 )
263      {   if( size(id[k]/var(j))==0) { id[k]=0; break; }
264      }
265   }
266   return(simplify(id,2));
267}
268example
269{ "EXAMPLE:"; echo = 2;
270   ring r=0,(x,y,t,s,z),(c,dp);
271   ideal i=x-y,y-z2,z-t3,s-x+y3;
272   ideal j=select(i,1);
273   j;
274   module m=i*(gen(1)+gen(2));
275   m;
276   select(m,1,2);
277}
278///////////////////////////////////////////////////////////////////////////////
279
280proc select1 (id, int n, list#)
281"USAGE:   select1(id,n[,m]); id ideal/module, n, m integers
282RETURN:  generators of id containing the variable n
283         [at least one of the variables up to m]
284NOTE:    use 'select' for selecting generators containing all the
285         variables between n and m
286SEE ALSO: select, nselect
287EXAMPLE: example select1; shows examples
288"{
289   if( size(#)==0 ) { #[1]=n; }
290   int j,k;
291   execute (typeof(id)+" I;");
292   for( k=1; k<=ncols(id); k=k+1 )
293   {  for( j=n; j<=#[1]; j=j+1 )
294      {
295         if( size(subst(id[k],var(j),0)) != size(id[k]) )
296         { I=I,id[k]; break; }
297      }
298   }
299   return(simplify(I,2));
300}
301example
302{ "EXAMPLE:"; echo = 2;
303   ring r=0,(x,y,t,s,z),(c,dp);
304   ideal i=x-y,y-z2,z-t3,s-x+y3;
305   ideal j=select1(i,1);
306   j;
307   module m=i*(gen(1)+gen(2));
308   m;
309   select1(m,1,2);
310}
311///////////////////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.