Context Navigation

ring.lib @ 57d677

spielwiese

Last change on this file since 57d677 was 0463d5c, checked in by Hans Schoenemann <hannes@…>, 10 years ago
add data types to procedures, p4
Property mode set to `100644`
File size: 27.9 KB

Line
1	/////////////////////////////////////////////////////////////////////////////
2	version="version ring.lib 4.0.0.0 Jun_2013 "; // $Id$
3	category="General purpose";
4	info="
5	LIBRARY: ring.lib Manipulating Rings and Maps
6
7	PROCEDURES:
8	changechar(c[,r]); make a copy of basering [ring r] with new char c
9	changeord(o[,r]); make a copy of basering [ring r] with new ord o
10	changevar(v[,r]); make a copy of basering [ring r] with new vars v
11	defring(\"R\",c,n,v,o); define a ring R in specified char c, n vars v, ord o
12	defrings(n[,p]); define ring Sn in n vars, char 32003 [p], ord ds
13	defringp(n[,p]); define ring Pn in n vars, char 32003 [p], ord dp
14	extendring(\"R\",n,v,o); extend given ring by n vars v, ord o and name it R
15	fetchall(R[,str]); fetch all objects of ring R to basering
16	imapall(R[,str]); imap all objects of ring R to basering
17	mapall(R,i[,str]); map all objects of ring R via ideal i to basering
18	ord_test(R); test wether ordering of R is global, local or mixed
19	ringtensor(s,t,..); create ring, tensor product of rings s,t,...
20	ringweights(r); intvec of weights of ring variables of ring r
21	preimageLoc(R,phi,Q) computes preimage for non-global orderings
22	rootofUnity(n); the minimal polynomial for the n-th primitive root of unity
23	(parameters in square brackets [] are optional)
24	";
25
26	LIB "inout.lib";
27	LIB "general.lib";
28	LIB "primdec.lib";
29	///////////////////////////////////////////////////////////////////////////////
30
31	proc changechar (list @L, list #)
32	"USAGE: changechar(c[,r]); c=list, r=ring
33	RETURN: ring R, obtained from the ring r [default: r=basering], by changing
34	ringlist(r)[1] to c.
35	EXAMPLE: example changechar; shows an example
36	"
37	{
38	def save_ring=basering;
39	if( size(#)==0 ) { def @r=basering; }
40	if(( size(#)==1 ) and (typeof(#[1])=="ring")) { def @r=#[1]; }
41	setring @r;
42	list rl=ringlist(@r);
43	if(defined(@L)!=voice) { def @L=fetch(save_ring,@L); }
44	if (size(@L)==1) { rl[1]=@L[1];} else { rl[1]=@L;}
45	def Rnew=ring(rl);
46	setring save_ring;
47	return(Rnew);
48	}
49	example
50	{ "EXAMPLE:"; echo = 2;
51	ring rr=2,A,dp;
52	ring r=0,(x,y,u,v),(dp(2),ds);
53	def R=changechar(ringlist(rr)); R;"";
54	def R1=changechar(32003,R); setring R1; R1;
55	kill R,R1;
56	}
57	///////////////////////////////////////////////////////////////////////////////
58
59	proc changeord (list @o, list #)
60	"USAGE: changeord(neword[,r]); newordstr=list, r=ring/qring
61	RETURN: ring R, obtained from the ring r [default: r=basering], by changing
62	order(r) to neword.
63	If, say, neword=list(list(\"wp\",intvec(2,3)),list(list(\"dp\",1:(n-2))));
64	and if the ring r exists and has n variables, the ring R will be
65	equipped with the monomial ordering wp(2,3),dp.
66	EXAMPLE: example changeord; shows an example
67	"
68	{
69	def save_ring=basering;
70	if( size(#)==0 ) { def @r=basering; }
71	if( size(#)==1 ) { def @r=#[1]; }
72	setring @r;
73	list rl=ringlist(@r);
74	rl[3]=@o;
75	def Rnew=ring(rl);
76	setring save_ring;
77	return(Rnew);
78	}
79	example
80	{ "EXAMPLE:"; echo = 2;
81	ring r=0,(x,y,u,v),(dp(2),ds);
82	def R=changeord(list(list("wp",intvec(2,3)),list("dp",1:2))); R; "";
83	ideal i = x^2,y^2-u^3,v;
84	qring Q = std(i);
85	def Q'=changeord(list(list("lp",nvars(Q))),Q); setring Q'; Q';
86	kill R,Q,Q';
87	}
88	///////////////////////////////////////////////////////////////////////////////
89
90	proc changevar (string vars, list #)
91	"USAGE: changevar(vars[,r]); vars=string, r=ring/qring
92	RETURN: ring R, obtained from the ring r [default: r=basering], by changing
93	varstr(r) according to the value of vars.
94	If, say, vars = \"t()\" and the ring r exists and has n
95	variables, the new basering will have name R and variables
96	t(1),...,t(n).
97	If vars = \"a,b,c,d\", the new ring will have the variables a,b,c,d.
98	NOTE: This procedure is useful in connection with the procedure ringtensor,
99	when a conflict between variable names must be avoided.
100	This proc uses 'execute' or calls a procedure using 'execute'.
101	EXAMPLE: example changevar; shows an example
102	"
103	{
104	if( size(#)==0 ) { def @r=basering; }
105	if( size(#)==1 ) { def @r=#[1]; }
106	setring @r;
107	ideal i = ideal(@r); int @q = size(i);
108	if( @q!=0 )
109	{ string @s = "Rnew1"; }
110	else
111	{ string @s = "Rnew"; }
112	string @newring = @s+"=("+charstr(@r)+"),(";
113	if( vars[size(vars)-1]=="(" and vars[size(vars)]==")" )
114	{
115	@newring = @newring+vars[1,size(vars)-2]+"(1.."+string(nvars(@r))+")";
116	}
117	else { @newring = @newring+vars; }
118	@newring = @newring+"),("+ordstr(@r)+");";
119	execute("ring "+@newring);
120	if( @q!=0 )
121	{
122	map phi = @r,maxideal(1);
123	ideal i = phi(i);
124	attrib(i,"isSB",1); //*** attrib funktioniert ?
125	qring Rnew=i;
126	}
127	return(Rnew);
128	}
129	example
130	{ "EXAMPLE:"; echo = 2;
131	ring r=0,(x,y,u,v),(dp(2),ds);
132	ideal i = x^2,y^2-u^3,v;
133	qring Q = std(i);
134	setring(r);
135	def R=changevar("A()"); R; "";
136	def Q'=changevar("a,b,c,d",Q); setring Q'; Q';
137	kill R,Q,Q';
138	}
139	///////////////////////////////////////////////////////////////////////////////
140
141	proc defring (string s2, int n, string s3, string s4)
142	"USAGE: defring(ch,n,va,or); ch,va,or=strings, n=integer
143	RETURN: ring R with characteristic 'ch', ordering 'or' and n variables with
144	names derived from va.
145	If va is a single letter, say va=\"a\", and if n<=26 then a and the
146	following n-1 letters from the alphabet (cyclic order) are taken as
147	variables. If n>26 or if va is a single letter followed by a bracket,
148	say va=\"T(\", the variables are T(1),...,T(n).
149	NOTE: This proc is useful for defining a ring in a procedure.
150	This proc uses 'execute' or calls a procedure using 'execute'.
151	EXAMPLE: example defring; shows an example
152	"
153	{
154	string @newring = "ring newring =("+s2+"),(";
155	if( n>26 or s3[2]=="(" ) { string @v = s3[1]+"(1.."+string(n)+")"; }
156	else { string @v = A_Z(s3,n); }
157	@newring=@newring+@v+"),("+s4+");";
158	execute(@newring);
159	return(newring);
160	}
161	example
162	{ "EXAMPLE:"; echo = 2;
163	def r=defring("0",5,"u","ls"); r; setring r;"";
164	def R=defring("2,A",10,"x(","dp(3),ws(1,2,3),ds"); R; setring R;
165	kill R,r;
166	}
167	///////////////////////////////////////////////////////////////////////////////
168
169	proc defrings (int n, list #)
170	"USAGE: defrings(n,[p]); n,p integers
171	RETURN: ring R with characteristic p [default: p=32003], ordering ds and n
172	variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26)
173	NOTE: This proc uses 'execute' or calls a procedure using 'execute'.
174	EXAMPLE: example defrings; shows an example
175	"
176	{
177	int p;
178	if (size(#)==0) { p=32003; }
179	else { p=#[1]; }
180	if (n >26)
181	{
182	string s="ring S ="+string(p)+",x(1.."+string(n)+"),ds;";
183	}
184	else
185	{
186	string s="ring S ="+string(p)+",("+A_Z("x",n)+"),ds;";
187	}
188	execute(s);
189	dbprint(printlevel-voice+2,"
190	// 'defrings' created a ring. To see the ring, type (if the name R was
191	// assigned to the return value):
192	show R;
193	// To make the ring the active basering, type
194	setring R; ");
195	return(S);
196	}
197	example
198	{ "EXAMPLE:"; echo = 2;
199	def S5=defrings(5,0); S5; "";
200	def S30=defrings(30); S30;
201	kill S5,S30;
202	}
203	///////////////////////////////////////////////////////////////////////////////
204
205	proc defringp (int n,list #)
206	"USAGE: defringp(n,[p]); n,p=integers
207	RETURN: ring R with characteristic p [default: p=32003], ordering dp and n
208	variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26)
209	NOTE: This proc uses 'execute' or calls a procedure using 'execute'.
210	EXAMPLE: example defringp; shows an example
211	"
212	{
213	int p;
214	if (size(#)==0) { p=32003; }
215	else { p=#[1]; }
216	if (n >26)
217	{
218	string s="ring P="+string(p)+",x(1.."+string(n)+"),dp;";
219	}
220	else
221	{
222	string s="ring P="+string(p)+",("+A_Z("x",n)+"),dp;";
223	}
224	execute(s);
225	dbprint(printlevel-voice+2,"
226	// 'defringp' created a ring. To see the ring, type (if the name R was
227	// assigned to the return value):
228	show R;
229	// To make the ring the active basering, type
230	setring R; ");
231	return(P);
232	}
233	example
234	{ "EXAMPLE:"; echo = 2;
235	def P5=defringp(5,0); P5; "";
236	def P30=defringp(30); P30;
237	kill P5,P30;
238	}
239	///////////////////////////////////////////////////////////////////////////////
240
241	proc extendring (int n, string va, string o, list #)
242	"USAGE: extendring(n,va,o[,iv,i,r]); va,o=strings, n,i=integers, r=ring,
243	iv=intvec of positive integers or iv=0
244	RETURN: ring R, which extends the ring r by adding n new variables in front
245	of (resp. after, if i!=0) the old variables.
246	[default: (i,r)=(0,basering)].
247	@* -- The characteristic is the characteristic of r.
248	@* -- The new vars are derived from va. If va is a single letter, say
249	va=\"T\", and if n<=26 then T and the following n-1 letters from
250	T..Z..T (resp. T(1..n) if n>26) are taken as additional variables.
251	If va is a single letter followed by a bracket, say va=\"x(\",
252	the new variables are x(1),...,x(n).
253	@* -- The ordering is the product ordering of the ordering of r and of an
254	ordering derived from `o` [and iv].
255	@* - If o contains a 'c' or a 'C' in front resp. at the end, this is
256	taken for the whole ordering in front, resp. at the end. If o does
257	not contain a 'c' or a 'C' the same rule applies to ordstr(r).
258	@* - If no intvec iv is given, or if iv=0, o may be any allowed ordstr,
259	like \"ds\" or \"dp(2),wp(1,2,3),Ds(2)\" or \"ds(a),dp(b),ls\" if
260	a and b are globally (!) defined integers and if a+b+1<=n.
261	If, however, a and b are local to a proc calling extendring, the
262	intvec iv must be used to let extendring know the values of a and b
263	@* - If a non-zero intvec iv is given, iv[1],iv[2],... are taken for the
264	1st, 2nd,... block of o, if o contains no substring \"w\" or \"W\"
265	i.e. no weighted ordering (in the above case o=\"ds,dp,ls\"
266	and iv=a,b).
267	If o contains a weighted ordering (only one (!) weighted block is
268	allowed) iv[1] is taken as size for the weight-vector, the next
269	iv[1] values of iv are taken as weights and the remaining values of
270	iv as block size for the remaining non-weighted blocks.
271	e.g. o=\"dp,ws,Dp,ds\", iv=3,2,3,4,2,5 creates the ordering
272	dp(2),ws(2,3,4),Dp(5),ds
273	NOTE: This proc is useful for adding deformation parameters.
274	This proc uses 'execute' or calls a procedure using 'execute'.
275	If you use it in your own proc, it may be advisable to let the local
276	names of your proc start with a @
277	EXAMPLE: example extendring; shows an example
278	"
279	{
280	//--------------- initialization and place c/C of ordering properly -----------
281	string @o1,@o2,@ro,@wstr,@v,@newring;
282	int @i,@w,@ii,@k;
283	intvec @iv,@iw;
284	if( find(o,"c")+find(o,"C") != 0)
285	{
286	@k=1;
287	if( o[1]=="c" or o[1]=="C" ) { @o1=o[1,2]; o=o[3..size(o)]; }
288	else { @o2=o[size(o)-1,2]; o=o[1..size(o)-2]; }
289	}
290	if( size(#)==0 ) { #[1]=0; }
291	if( typeof(#[1])!="intvec" )
292	{
293	if( size(#)==1 ) { @i=#[1]; def @r=basering; }
294	if( size(#)==2 ) { @i=#[1]; def @r=#[2]; }
295	if( o[size(o)]!=")" and find(o,",")==0 ) { o=o+"("+string(n)+")"; }
296	}
297	else
298	{
299	@iv=#[1];
300	if( size(#)==2 ) { @i=#[2]; def @r=basering; }
301	if( size(#)==3 ) { @i=#[2]; def @r=#[3]; }
302	if( @iv==0 && o[size(o)]!=")" && find(o,",")==0 ) {o=o+"("+string(n)+")";}
303	}
304	@ro=ordstr(@r);
305	if( @ro[1]=="c" or @ro[1]=="C" )
306	{ @v=@ro[1,2]; @ro=@ro[3..size(@ro)]; }
307	else
308	{ @wstr=@ro[size(@ro)-1,2]; @ro=@ro[1..size(@ro)-2]; }
309	if( @k==0) { @o1=@v; @o2=@wstr; }
310	//----------------- prepare ordering if an intvec is given --------------------
311	if( typeof(#[1])=="intvec" and #[1]!=0 )
312	{
313	@k=n; //@k counts no of vars not yet ordered
314	@w=find(o,"w")+find(o,"W");o=o+" ";
315	if( @w!=0 )
316	{
317	@wstr=o[@w..@w+1];
318	o=o[1,@w-1]+"@"+o[@w+2,size(o)];
319	@iw=@iv[2..@iv[1]+1];
320	@wstr=@wstr+"("+string(@iw)+")";
321	@k=@k-@iv[1];
322	@iv=@iv[@iv[1]+2..size(@iv)];
323	@w=0;
324	}
325	for( @ii=1; @ii<=size(@iv); @ii=@ii+1 )
326	{
327	if( find(o,",",@w+1)!=0 )
328	{
329	@w=find(o,",",@w+1);
330	if( o[@w-1]!="@" )
331	{
332	o=o[1,@w-1]+"("+string(@iv[@ii])+")"+o[@w,size(o)];
333	@w=find(o,",",@w+1);
334	@k=@k-@iv[@ii];
335	}
336	else { @ii=@ii-1; }
337	}
338	}
339	@w=find(o,"@");
340	if( @w!=0 ) { o=o[1,@w-1] + @wstr + o[@w+1,size(o)]; }
341	if( @k>0 and o[size(o)]!=")" ) { o=o+"("+string(@k)+")"; }
342	}
343	//------------------------ prepare string of new ring -------------------------
344	@newring = "ring na =("+charstr(@r)+"),(";
345	if( n>26 or va[2]=="(" ) { @v = va[1]+"(1.."+string(n)+")"; }
346	else { @v = A_Z(va,n); }
347	if( @i==0 )
348	{
349	@v=@v+","+varstr(@r);
350	o=@o1+o+","+@ro+@o2;
351	}
352	else
353	{
354	@v=varstr(@r)+","+@v;
355	o=@o1+@ro+","+o+@o2;
356	}
357	@newring=@newring+@v+"),("+o+");";
358	//---------------------------- execute and export -----------------------------
359	execute(@newring);
360	dbprint(printlevel-voice+2,"
361	// 'extendring' created a new ring.
362	// To see the ring, type (if the name 'R' was assigned to the return value):
363	show(R);
364	");
365
366	return(na);
367	}
368	example
369	{ "EXAMPLE:"; echo = 2;
370	ring r=0,(x,y,z),ds;
371	show(r);"";
372	// blocksize is derived from no of vars:
373	int t=5;
374	def R1=extendring(t,"a","dp"); //t global: "dp" -> "dp(5)"
375	show(R1); setring R1; "";
376	def R2=extendring(4,"T(","c,dp",1,r); //"dp" -> "c,..,dp(4)"
377	show(R2); setring R2; "";
378
379	// no intvec given, blocksize given: given blocksize is used:
380	def R3=extendring(4,"T(","dp(2)",0,r); // "dp(2)" -> "dp(2)"
381	show(R3); setring R3; "";
382
383	// intvec given: weights and blocksize is derived from given intvec
384	// (no specification of a blocksize in the given ordstr is allowed!)
385	// if intvec does not cover all given blocks, the last block is used
386	// for the remaining variables, if intvec has too many components,
387	// the last ones are ignored
388	intvec v=3,2,3,4,1,3;
389	def R4=extendring(10,"A","ds,ws,Dp,dp",v,0,r);
390	// v covers 3 blocks: v[1] (=3) : no of components of ws
391	// next v[1] values (=v[2..4]) give weights
392	// remaining components of v are used for the remaining blocks
393	show(R4);
394	kill r,R1,R2,R3,R4;
395	}
396	///////////////////////////////////////////////////////////////////////////////
397
398	proc fetchall (def R, list #)
399	"USAGE: fetchall(R[,s]); R=ring/qring, s=string
400	CREATE: fetch all objects of ring R (of type poly/ideal/vector/module/number/matrix)
401	into the basering.
402	If no 2nd argument is present, the names are the same as in R. If,
403	say, f is a polynomial in R and the 2nd argument is the string \"R\", then f
404	is mapped to f_R etc.
405	RETURN: no return value
406	NOTE: As fetch, this procedure maps the 1st, 2nd, ... variable of R to the
407	1st, 2nd, ... variable of the basering.
408	The 2nd argument is useful in order to avoid conflicts of names, the
409	empty string is allowed
410	CAUTION: fetchall does not work for locally defined names.
411	It does not work if R contains a map.
412	SEE ALSO: imapall
413	EXAMPLE: example fetchall; shows an example
414	"
415	{
416	list @L@=names(R);
417	int @ii@; string @s@;
418	if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
419	for( @ii@=size(@L@); @ii@>0; @ii@-- )
420	{
421	execute("def "+@L@[@ii@]+@s@+"=fetch(R,`@L@[@ii@]`);");
422	execute("export "+@L@[@ii@]+@s@+";");
423	}
424	return();
425	}
426	example
427	{ "EXAMPLE:"; echo=2;
428	// The example is not shown since fetchall does not work in a procedure;
429	// (and hence not in the example procedure). Try the following commands:
430	// ring R=0,(x,y,z),dp;
431	// ideal j=x,y2,z2;
432	// matrix M[2][3]=1,2,3,x,y,z;
433	// j; print(M);
434	// ring S=0,(a,b,c),ds;
435	// fetchall(R); //map from R to S: x->a, y->b, z->c;
436	// names(S);
437	// j; print(M);
438	// fetchall(S,"1"); //identity map of S: copy objects, change names
439	// names(S);
440	// kill R,S;
441	}
442	///////////////////////////////////////////////////////////////////////////////
443
444	proc imapall (def R, list #)
445	"USAGE: imapall(R[,s]); R=ring/qring, s=string
446	CREATE: map all objects of ring R (of type poly/ideal/vector/module/number/matrix)
447	into the basering by applying imap to all objects of R.
448	If no 2nd argument is present, the names are the same as in R. If,
449	say, f is a polynomial in R and the 3rd argument is the string \"R\", then f
450	is mapped to f_R etc.
451	RETURN: no return value
452	NOTE: As imap, this procedure maps the variables of R to the variables with
453	the same name in the basering, the other variables are mapped to 0.
454	The 2nd argument is useful in order to avoid conflicts of names, the
455	empty string is allowed
456	CAUTION: imapall does not work for locally defined names.
457	It does not work if R contains a map
458	SEE ALSO: fetchall
459	EXAMPLE: example imapall; shows an example
460	"
461	{
462	list @L@=names(R);
463	int @ii@; string @s@;
464	if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
465	for( @ii@=size(@L@); @ii@>0; @ii@-- )
466	{
467	execute("def "+@L@[@ii@]+@s@+"=imap(R,`@L@[@ii@]`);");
468	execute("export "+@L@[@ii@]+@s@+";");
469	}
470	return();
471	}
472	example
473	{ "EXAMPLE:"; echo = 2;
474	// The example is not shown since imapall does not work in a procedure
475	// (and hence not in the example procedure). Try the following commands:
476	// ring R=0,(x,y,z,u),dp;
477	// ideal j=x,y,z,u2+ux+z;
478	// matrix M[2][3]=1,2,3,x,y,uz;
479	// j; print(M);
480	// ring S=0,(a,b,c,x,z,y),ds;
481	// imapall(R); //map from R to S: x->x, y->y, z->z, u->0
482	// names(S);
483	// j; print(M);
484	// imapall(S,"1"); //identity map of S: copy objects, change names
485	// names(S);
486	// kill R,S;
487	}
488	///////////////////////////////////////////////////////////////////////////////
489
490	proc mapall (def R, ideal i, list #)
491	"USAGE: mapall(R,i[,s]); R=ring/qring, i=ideal of basering, s=string
492	CREATE: map all objects of ring R (of type poly/ideal/vector/module/number/
493	matrix, map) into the basering by mapping the j-th variable of R to
494	the j-th generator of the ideal i. If no 3rd argument is present, the
495	names are the same as in R. If, say, f is a polynomial in R and the 3rd
496	argument is the string \"R\", then f is mapped to f_R etc.
497	RETURN: no return value.
498	NOTE: This procedure has the same effect as defining a map, say psi, by
499	map psi=R,i; and then applying psi to all objects of R. In particular,
500	maps from R to some ring S are composed with psi, creating thus a map
501	from the basering to S.
502	mapall may be combined with copyring to change vars for all objects.
503	The 3rd argument is useful in order to avoid conflicts of names, the
504	empty string is allowed.
505	CAUTION: mapall does not work for locally defined names.
506	EXAMPLE: example mapall; shows an example
507	"
508	{
509	list @L@=names(R); map @psi@ = R,i;
510	int @ii@; string @s@;
511	if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
512	for( @ii@=size(@L@); @ii@>0; @ii@-- )
513	{
514	execute("def "+@L@[@ii@]+@s@+"=@psi@(`@L@[@ii@]`);");
515	execute("export "+@L@[@ii@]+@s@+";");
516	}
517	return();
518	}
519	example
520	{ "EXAMPLE:"; echo = 2;
521	// The example is not shown since mapall does not work in a procedure
522	// (and hence not in the example procedure). Try the following commands:
523	// ring R=0,(x,y,z),dp;
524	// ideal j=x,y,z;
525	// matrix M[2][3]=1,2,3,x,y,z;
526	// map phi=R,x2,y2,z2;
527	// ring S=0,(a,b,c),ds;
528	// ideal i=c,a,b;
529	// mapall(R,i); //map from R to S: x->c, y->a, z->b
530	// names(S);
531	// j; print(M); phi; //phi maps R to S: x->c2, y->a2, z->b2
532	// ideal i1=a2,a+b,1;
533	// mapall(R,i1,\"\"); //map from R to S: x->a2, y->a+b, z->1
534	// names(S);
535	// j_; print(M_); phi_;
536	// changevar(\"T\",\"x()\",R); //change vars in R and call result T
537	// mapall(R,maxideal(1)); //identity map from R to T
538	// names(T);
539	// j; print(M); phi;
540	// kill R,S,T;
541	}
542	///////////////////////////////////////////////////////////////////////////////
543
544	proc ord_test (def r)
545	"USAGE: ord_test(r); r ring/qring
546	RETURN: int 1 (resp. -1, resp. 0) if ordering of r is global (resp. local,
547	resp. mixed)
548	SEE ALSO: attrib
549	EXAMPLE: example ord_test; shows an example
550	"
551	{
552	if ((typeof(r) != "ring") and (typeof(r) != "qring"))
553	{
554	ERROR("ord_test requires a ring/qring as input");
555	}
556	if (attrib(r,"global")==1) { return(1);}
557	def BAS = basering;
558	setring r;
559	poly f;
560	int n,o,u = nvars(r),1,1;
561	int ii;
562	for ( ii=1; ii<=n; ii++ )
563	{
564	f = 1+var(ii);
565	o = o*(lead(f) == var(ii));
566	u = u*(lead(f) == 1);
567	}
568	setring BAS;
569	if ( o==1 ) { return(1); }
570	if ( u==1 ) { return(-1); }
571	else { return(0); }
572	}
573	example
574	{ "EXAMPLE:"; echo = 2;
575	ring R = 0,(x,y),dp;
576	ring S = 0,(u,v),ls;
577	ord_test(R);
578	ord_test(S);
579	ord_test(R+S);
580	}
581	///////////////////////////////////////////////////////////////////////////////
582
583	proc ringtensor (list #)
584	"USAGE: ringtensor(r1,r2,...); r1,r2,...=rings
585	RETURN: ring R whose variables are the variables from all rings r1,r2,...
586	and whose monomial ordering is the block (product) ordering of the
587	respective monomial orderings of r1,r2,... . Hence, R
588	is the tensor product of the rings r1,r2,... with ordering matrix
589	equal to the direct sum of the ordering matrices of r1,r2,...
590	NOTE: The characteristic of the new ring will be p if one ring has
591	characteristic p. The names of variables in the rings r1,r2,...
592	must differ.
593	The procedure works also for quotient rings ri, if the characteristic
594	of ri is compatible with the characteristic of the result
595	(i.e. if imap from ri to the result is implemented)
596	SEE ALSO: ring operations
597	EXAMPLE: example ringtensor; shows an example
598	"
599	{
600	int @i;
601	int @n = size(#);
602	if (@n<=1) { ERROR("at least 2 rings required"); }
603	def @s=#[1]+#[2];
604	for (@i=3; @i<=@n;@i++)
605	{
606	def @ss=@s+#[@i];
607	kill @s;
608	def @s=@ss;
609	kill @ss;
610	}
611	dbprint(printlevel-voice+2,"
612	// 'ringtensor' created a ring. To see the ring, type (if the name R was
613	// assigned to the return value):
614	show(R);
615	// To make the ring the active basering, type
616	setring R; ");
617	return(@s);
618	}
619	example
620	{ "EXAMPLE:"; echo = 2;
621	ring r=32003,(x,y,u,v),dp;
622	ring s=0,(a,b,c),wp(1,2,3);
623	ring t=0,x(1..5),(c,ls);
624	def R=ringtensor(r,s,t);
625	type R;
626	setring s;
627	ideal i = a2+b3+c5;
628	def S=changevar("x,y,z"); //change vars of s
629	setring S;
630	qring qS =std(fetch(s,i)); //create qring of S mod i (mapped to S)
631	def T=changevar("d,e,f,g,h",t); //change vars of t
632	setring T;
633	qring qT=std(d2+e2-f3); //create qring of T mod d2+e2-f3
634	def Q=ringtensor(s,qS,t,qT);
635	setring Q; type Q;
636	kill R,S,T,Q;
637	}
638	///////////////////////////////////////////////////////////////////////////////
639
640	proc ringweights (def P)
641	"USAGE: ringweights(P); P=name of an existing ring (true name, not a string)
642	RETURN: intvec consisting of the weights of the variables of P, as they
643	appear when typing P;.
644	NOTE: This is useful when enlarging P but keeping the weights of the old
645	variables.
646	EXAMPLE: example ringweights; shows an example
647	"
648	{
649	int i;
650	intvec rw;
651	//------------------------- find weights -------------------------
652	for(i=nvars(P);i>0;i--)
653	{ rw[i]=ord(var(i)); }
654	return(rw);
655	}
656	example
657	{"EXAMPLE:"; echo = 2;
658	ring r0 = 0,(x,y,z),dp;
659	ringweights(r0);
660	ring r1 = 0,x(1..5),(ds(3),wp(2,3));
661	ringweights(r1);"";
662	// an example for enlarging the ring, keeping the first weights:
663	intvec v = ringweights(r1),6,2,3,4,5;
664	ring R = 0,x(1..10),(a(v),dp);
665	ordstr(R);
666	}
667	///////////////////////////////////////////////////////////////////////////////
668	proc preimageLoc(string R_name,string phi_name,string Q_name )
669	"USAGE: preimageLoc ( ring_name, map_name, ideal_name );
670	all input parameters of type string
671	RETURN: ideal
672	PURPOSE: compute the preimage of an ideal under a given map for non-global
673	orderings.
674	The 2nd argument has to be the name of a map from the basering to
675	the given ring (or the name of an ideal defining such a map), and
676	the ideal has to be an ideal in the given ring.
677	SEE ALSO: preimage
678	KEYWORDS: preimage under a map between local rings, map between local rings, map between local and global rings
679	EXAMPLE: example preimageLoc ; shows an example
680	"{
681	def S=basering;
682	int i;
683	string newRing,minpoly_string;
684	if(attrib(S,"global")!=1)
685	{
686	if(typeof(S)=="qring")
687	{
688	ideal I=ideal(S);
689	newRing="ring S0=("+charstr(S)+"),("+varstr(S)+"),dp;";
690	minpoly_string=string(minpoly);
691	execute(newRing);
692	execute("minpoly="+minpoly_string+";");
693	ideal I=imap(S,I);
694	list pr=primdecGTZ(I);
695	newRing="ring SL=("+charstr(S)+"),("+varstr(S)+"),("+ordstr(S)+");";
696	execute(newRing);
697	execute("minpoly="+minpoly_string+";");
698	list pr=imap(S0,pr);
699	ideal I0=std(pr[1][1]);
700	for(i=2;i<=size(pr);i++)
701	{
702	I0=intersect(I0,std(pr[i][1]));
703	}
704	setring S0;
705	ideal I0=imap(SL,I0);
706	qring S1=std(I0);
707	}
708	else
709	{
710	def S1=S;
711	}
712	}
713	else
714	{
715	def S1=S;
716	}
717	def @R=`R_name`;
718	setring @R;
719	def @phi=`phi_name`;
720	ideal phiId=ideal(@phi);
721	def Q=`Q_name`;
722	if(attrib(@R,"global")!=1)
723	{
724	if(typeof(@R)=="qring")
725	{
726	ideal J=ideal(@R);
727	newRing="ring R0=("+charstr(@R)+"),("+varstr(@R)+"),dp;";
728	minpoly_string=string(minpoly);
729	execute(newRing);
730	execute("minpoly="+minpoly_string+";");
731	ideal J=imap(@R,J);
732	list pr=primdecGTZ(J);
733	newRing="ring RL=("+charstr(@R)+"),("+varstr(@R)+"),("+ordstr(@R)+");";
734	execute(newRing);
735	execute("minpoly="+minpoly_string+";");
736	list pr=imap(R0,pr);
737	ideal J0=std(pr[1][1]);
738	for(i=2;i<=size(pr);i++)
739	{
740	J0=intersect(J0,std(pr[i][1]));
741	}
742	setring R0;
743	ideal J0=imap(RL,J0);
744	qring R1=std(J0);
745	ideal Q=imap(@R,Q);
746	map @phi=S1,imap(@R,phiId);
747	}
748	else
749	{
750	def R1=@R;
751	}
752	}
753	else
754	{
755	def R1=@R;
756	}
757	setring S1;
758	ideal preQ=preimage(R1,@phi,Q);
759	setring S;
760	ideal prQ=imap(S1,preQ);
761	return(prQ);
762	}
763	example
764	{ "EXAMPLE:"; echo=2;
765	ring S =0,(x,y,z),dp;
766	ring R0=0,(x,y,z),ds;
767	qring R=std(x+x2);
768	map psi=S,x,y,z;
769	ideal null;
770	setring S;
771	ideal nu=preimageLoc("R","psi","null");
772	nu;
773	}
774
775	//////////////////////////////////////////////////////////////////////////////
776	/* moved here from the nctools.lib */
777	///////////////////////////////////////////////////////////////////////////////
778	proc rootofUnity(int n)
779	"USAGE: rootofUnity(n); n an integer
780	RETURN: number
781	PURPOSE: compute the minimal polynomial for the n-th primitive root of unity
782	NOTE: works only in field extensions by one element
783	EXAMPLE: example rootofUnity; shows examples
784	"
785	{
786	if ( npars(basering) !=1 )
787	{
788	"the procedure works only with one parameter";
789	return(0);
790	}
791	if (n<1) { return(0); }
792	number mp = par(1);
793	if (n==1) { return(mp-1); }
794	if (n==2) { return(mp+1); }
795	def OldRing = basering;
796	string CH = charstr(basering);
797	string MCH;
798	int j=1;
799	while ( (CH[j] !=",") && (j<=size(CH)))
800	{
801	MCH=MCH+CH[j]; j++;
802	}
803	string SR = "ring @@rR="+MCH+","+parstr(basering)+",dp;";
804	execute(SR);
805	poly @t=var(1)^n-1; // (x^2i-1)=(x^i-1)(x^i+1)
806	list l=factorize(@t);
807	ideal @l=l[1];
808	list @d;
809	int s=size(@l);
810	int d=deg(@l[s]);
811	int cnt=1;
812	poly res;
813	for (j=s-1; j>=1; j--)
814	{
815	if ( deg(@l[j]) > d) { d=deg(@l[j]); }
816	}
817	for (j=1; j<=s; j++)
818	{
819	if ( deg(@l[j]) == d) { @d[cnt]=@l[j]; cnt++; }
820	}
821	if ( size(@d)==1 )
822	{
823	res = poly(@d[1]);
824	}
825	else
826	{
827	j=1;
828	while ( j <= size(@d) )
829	{
830	res = @d[j]-lead(@d[j]);
831	if ( leadcoef(res) >=0 ) { j++; }
832	else { break; }
833	}
834	res = @d[j];
835	}
836	setring OldRing;
837	poly I = imap(@@rR,res);
838	mp = leadcoef(I);
839	kill @@rR;
840	return(mp);
841	}
842	example
843	{
844	"EXAMPLE:";echo=2;
845	ring r = (0,q),(x,y,z),dp;
846	rootofUnity(6);
847	rootofUnity(7);
848	minpoly = rootofUnity(8);
849	r;
850	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format