[380a17b] | 1 | ///////////////////////////////////////////////////////////////////////////// |
---|
[3686937] | 2 | version="version ring.lib 4.0.0.0 Jun_2013 "; // $Id$ |
---|
[49998f] | 3 | category="General purpose"; |
---|
[5480da] | 4 | info=" |
---|
[8942a5] | 5 | LIBRARY: ring.lib Manipulating Rings and Maps |
---|
[3d124a7] | 6 | |
---|
[f34c37c] | 7 | PROCEDURES: |
---|
[1e1ec4] | 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 |
---|
[5480da] | 11 | defring(\"R\",c,n,v,o); define a ring R in specified char c, n vars v, ord o |
---|
[8942a5] | 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 |
---|
[5480da] | 14 | extendring(\"R\",n,v,o); extend given ring by n vars v, ord o and name it R |
---|
[8942a5] | 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 |
---|
[1e1ec4] | 19 | ringtensor(s,t,..); create ring, tensor product of rings s,t,... |
---|
[4cb6b8] | 20 | ringweights(r); intvec of weights of ring variables of ring r |
---|
[430001] | 21 | preimageLoc(R,phi,Q) computes preimage for non-global orderings |
---|
[1e1ec4] | 22 | rootofUnity(n); the minimal polynomial for the n-th primitive root of unity |
---|
[55a5c0e] | 23 | (parameters in square brackets [] are optional) |
---|
[5480da] | 24 | "; |
---|
[3d124a7] | 25 | |
---|
| 26 | LIB "inout.lib"; |
---|
| 27 | LIB "general.lib"; |
---|
[2761f3] | 28 | LIB "primdec.lib"; |
---|
[3d124a7] | 29 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 30 | |
---|
[1e1ec4] | 31 | proc changechar (list @L, list #) |
---|
| 32 | "USAGE: changechar(c[,r]); c=list, r=ring |
---|
[8647dd] | 33 | RETURN: ring R, obtained from the ring r [default: r=basering], by changing |
---|
[1e1ec4] | 34 | ringlist(r)[1] to c. |
---|
[3d124a7] | 35 | EXAMPLE: example changechar; shows an example |
---|
[d2b2a7] | 36 | " |
---|
[3d124a7] | 37 | { |
---|
[1e1ec4] | 38 | def save_ring=basering; |
---|
[3d124a7] | 39 | if( size(#)==0 ) { def @r=basering; } |
---|
[8647dd] | 40 | if(( size(#)==1 ) and (typeof(#[1])=="ring")) { def @r=#[1]; } |
---|
[3d124a7] | 41 | setring @r; |
---|
[1e1ec4] | 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; |
---|
[8647dd] | 47 | return(Rnew); |
---|
[3d124a7] | 48 | } |
---|
| 49 | example |
---|
| 50 | { "EXAMPLE:"; echo = 2; |
---|
[1e1ec4] | 51 | ring rr=2,A,dp; |
---|
[3d124a7] | 52 | ring r=0,(x,y,u,v),(dp(2),ds); |
---|
[1e1ec4] | 53 | def R=changechar(ringlist(rr)); R;""; |
---|
| 54 | def R1=changechar(32003,R); setring R1; R1; |
---|
[8647dd] | 55 | kill R,R1; |
---|
[3d124a7] | 56 | } |
---|
| 57 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 58 | |
---|
[1e1ec4] | 59 | proc changeord (list @o, list #) |
---|
| 60 | "USAGE: changeord(neword[,r]); newordstr=list, r=ring/qring |
---|
[8647dd] | 61 | RETURN: ring R, obtained from the ring r [default: r=basering], by changing |
---|
[1e1ec4] | 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 |
---|
[8647dd] | 65 | equipped with the monomial ordering wp(2,3),dp. |
---|
[3d124a7] | 66 | EXAMPLE: example changeord; shows an example |
---|
[d2b2a7] | 67 | " |
---|
[3d124a7] | 68 | { |
---|
[1e1ec4] | 69 | def save_ring=basering; |
---|
[3d124a7] | 70 | if( size(#)==0 ) { def @r=basering; } |
---|
| 71 | if( size(#)==1 ) { def @r=#[1]; } |
---|
| 72 | setring @r; |
---|
[1e1ec4] | 73 | list rl=ringlist(@r); |
---|
| 74 | rl[3]=@o; |
---|
| 75 | def Rnew=ring(rl); |
---|
| 76 | setring save_ring; |
---|
[8647dd] | 77 | return(Rnew); |
---|
[3d124a7] | 78 | } |
---|
| 79 | example |
---|
| 80 | { "EXAMPLE:"; echo = 2; |
---|
| 81 | ring r=0,(x,y,u,v),(dp(2),ds); |
---|
[1e1ec4] | 82 | def R=changeord(list(list("wp",intvec(2,3)),list("dp",1:2))); R; ""; |
---|
[3d124a7] | 83 | ideal i = x^2,y^2-u^3,v; |
---|
| 84 | qring Q = std(i); |
---|
[1e1ec4] | 85 | def Q'=changeord(list(list("lp",nvars(Q))),Q); setring Q'; Q'; |
---|
[8647dd] | 86 | kill R,Q,Q'; |
---|
[3d124a7] | 87 | } |
---|
| 88 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 89 | |
---|
[8647dd] | 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 |
---|
[6f2edc] | 95 | variables, the new basering will have name R and variables |
---|
[3d124a7] | 96 | t(1),...,t(n). |
---|
[d2b2a7] | 97 | If vars = \"a,b,c,d\", the new ring will have the variables a,b,c,d. |
---|
[3d124a7] | 98 | NOTE: This procedure is useful in connection with the procedure ringtensor, |
---|
| 99 | when a conflict between variable names must be avoided. |
---|
[6f2edc] | 100 | This proc uses 'execute' or calls a procedure using 'execute'. |
---|
[3d124a7] | 101 | EXAMPLE: example changevar; shows an example |
---|
[d2b2a7] | 102 | " |
---|
[3d124a7] | 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); |
---|
[6f2edc] | 108 | if( @q!=0 ) |
---|
[8647dd] | 109 | { string @s = "Rnew1"; } |
---|
[6f2edc] | 110 | else |
---|
[8647dd] | 111 | { string @s = "Rnew"; } |
---|
[3d124a7] | 112 | string @newring = @s+"=("+charstr(@r)+"),("; |
---|
| 113 | if( vars[size(vars)-1]=="(" and vars[size(vars)]==")" ) |
---|
[6f2edc] | 114 | { |
---|
| 115 | @newring = @newring+vars[1,size(vars)-2]+"(1.."+string(nvars(@r))+")"; |
---|
[3d124a7] | 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 ? |
---|
[8647dd] | 125 | qring Rnew=i; |
---|
[3d124a7] | 126 | } |
---|
[8647dd] | 127 | return(Rnew); |
---|
[3d124a7] | 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); |
---|
[8647dd] | 135 | def R=changevar("A()"); R; ""; |
---|
[3c4dcc] | 136 | def Q'=changevar("a,b,c,d",Q); setring Q'; Q'; |
---|
[8647dd] | 137 | kill R,Q,Q'; |
---|
[3d124a7] | 138 | } |
---|
| 139 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 140 | |
---|
[6fe3a0] | 141 | proc defring (string s2, int n, string s3, string s4) |
---|
| 142 | "USAGE: defring(ch,n,va,or); ch,va,or=strings, n=integer |
---|
[3c4dcc] | 143 | RETURN: ring R with characteristic 'ch', ordering 'or' and n variables with |
---|
[6fe3a0] | 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). |
---|
[3d124a7] | 149 | NOTE: This proc is useful for defining a ring in a procedure. |
---|
[6f2edc] | 150 | This proc uses 'execute' or calls a procedure using 'execute'. |
---|
[3d124a7] | 151 | EXAMPLE: example defring; shows an example |
---|
[d2b2a7] | 152 | " |
---|
[3d124a7] | 153 | { |
---|
[6fe3a0] | 154 | string @newring = "ring newring =("+s2+"),("; |
---|
[3d124a7] | 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); |
---|
[6fe3a0] | 159 | return(newring); |
---|
[3d124a7] | 160 | } |
---|
| 161 | example |
---|
| 162 | { "EXAMPLE:"; echo = 2; |
---|
[6fe3a0] | 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; |
---|
[3d124a7] | 166 | } |
---|
| 167 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 168 | |
---|
| 169 | proc defrings (int n, list #) |
---|
[d2b2a7] | 170 | "USAGE: defrings(n,[p]); n,p integers |
---|
[8647dd] | 171 | RETURN: ring R with characteristic p [default: p=32003], ordering ds and n |
---|
[3c4dcc] | 172 | variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26) |
---|
[8647dd] | 173 | NOTE: This proc uses 'execute' or calls a procedure using 'execute'. |
---|
[3d124a7] | 174 | EXAMPLE: example defrings; shows an example |
---|
[d2b2a7] | 175 | " |
---|
[3d124a7] | 176 | { |
---|
| 177 | int p; |
---|
| 178 | if (size(#)==0) { p=32003; } |
---|
| 179 | else { p=#[1]; } |
---|
| 180 | if (n >26) |
---|
| 181 | { |
---|
[8647dd] | 182 | string s="ring S ="+string(p)+",x(1.."+string(n)+"),ds;"; |
---|
[3d124a7] | 183 | } |
---|
| 184 | else |
---|
| 185 | { |
---|
[8647dd] | 186 | string s="ring S ="+string(p)+",("+A_Z("x",n)+"),ds;"; |
---|
[3d124a7] | 187 | } |
---|
| 188 | execute(s); |
---|
[8647dd] | 189 | dbprint(printlevel-voice+2," |
---|
[3c4dcc] | 190 | // 'defrings' created a ring. To see the ring, type (if the name R was |
---|
[8647dd] | 191 | // assigned to the return value): |
---|
| 192 | show R; |
---|
[3c4dcc] | 193 | // To make the ring the active basering, type |
---|
[8647dd] | 194 | setring R; "); |
---|
| 195 | return(S); |
---|
[3d124a7] | 196 | } |
---|
| 197 | example |
---|
| 198 | { "EXAMPLE:"; echo = 2; |
---|
[8647dd] | 199 | def S5=defrings(5,0); S5; ""; |
---|
| 200 | def S30=defrings(30); S30; |
---|
| 201 | kill S5,S30; |
---|
[3d124a7] | 202 | } |
---|
| 203 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 204 | |
---|
| 205 | proc defringp (int n,list #) |
---|
[d2b2a7] | 206 | "USAGE: defringp(n,[p]); n,p=integers |
---|
[8647dd] | 207 | RETURN: ring R with characteristic p [default: p=32003], ordering dp and n |
---|
[3c4dcc] | 208 | variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26) |
---|
[8647dd] | 209 | NOTE: This proc uses 'execute' or calls a procedure using 'execute'. |
---|
[3d124a7] | 210 | EXAMPLE: example defringp; shows an example |
---|
[d2b2a7] | 211 | " |
---|
[3d124a7] | 212 | { |
---|
| 213 | int p; |
---|
| 214 | if (size(#)==0) { p=32003; } |
---|
| 215 | else { p=#[1]; } |
---|
| 216 | if (n >26) |
---|
| 217 | { |
---|
[8647dd] | 218 | string s="ring P="+string(p)+",x(1.."+string(n)+"),dp;"; |
---|
[3d124a7] | 219 | } |
---|
| 220 | else |
---|
| 221 | { |
---|
[8647dd] | 222 | string s="ring P="+string(p)+",("+A_Z("x",n)+"),dp;"; |
---|
[3d124a7] | 223 | } |
---|
| 224 | execute(s); |
---|
[8647dd] | 225 | dbprint(printlevel-voice+2," |
---|
[3c4dcc] | 226 | // 'defringp' created a ring. To see the ring, type (if the name R was |
---|
[8647dd] | 227 | // assigned to the return value): |
---|
| 228 | show R; |
---|
[3c4dcc] | 229 | // To make the ring the active basering, type |
---|
[8647dd] | 230 | setring R; "); |
---|
| 231 | return(P); |
---|
[6f2edc] | 232 | } |
---|
[3d124a7] | 233 | example |
---|
| 234 | { "EXAMPLE:"; echo = 2; |
---|
[8647dd] | 235 | def P5=defringp(5,0); P5; ""; |
---|
| 236 | def P30=defringp(30); P30; |
---|
| 237 | kill P5,P30; |
---|
[3d124a7] | 238 | } |
---|
| 239 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 240 | |
---|
[6fe3a0] | 241 | proc extendring (int n, string va, string o, list #) |
---|
[9fcd0c] | 242 | "USAGE: extendring(n,va,o[,iv,i,r]); va,o=strings, n,i=integers, r=ring, |
---|
[6fe3a0] | 243 | iv=intvec of positive integers or iv=0 |
---|
[3c4dcc] | 244 | RETURN: ring R, which extends the ring r by adding n new variables in front |
---|
[6fe3a0] | 245 | of (resp. after, if i!=0) the old variables. |
---|
| 246 | [default: (i,r)=(0,basering)]. |
---|
[bb7da7] | 247 | @* -- The characteristic is the characteristic of r. |
---|
| 248 | @* -- The new vars are derived from va. If va is a single letter, say |
---|
[d2b2a7] | 249 | va=\"T\", and if n<=26 then T and the following n-1 letters from |
---|
[6f2edc] | 250 | T..Z..T (resp. T(1..n) if n>26) are taken as additional variables. |
---|
[3c4dcc] | 251 | If va is a single letter followed by a bracket, say va=\"x(\", |
---|
[6fe3a0] | 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 |
---|
[3d124a7] | 257 | not contain a 'c' or a 'C' the same rule applies to ordstr(r). |
---|
[bb7da7] | 258 | @* - If no intvec iv is given, or if iv=0, o may be any allowed ordstr, |
---|
[b9b906] | 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. |
---|
[3ca4229] | 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 |
---|
[0bc582c] | 263 | @* - If a non-zero intvec iv is given, iv[1],iv[2],... are taken for the |
---|
[bb7da7] | 264 | 1st, 2nd,... block of o, if o contains no substring \"w\" or \"W\" |
---|
[b9b906] | 265 | i.e. no weighted ordering (in the above case o=\"ds,dp,ls\" |
---|
[bb7da7] | 266 | and iv=a,b). |
---|
[6f2edc] | 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 |
---|
[3d124a7] | 269 | iv[1] values of iv are taken as weights and the remaining values of |
---|
[0bc582c] | 270 | iv as block size for the remaining non-weighted blocks. |
---|
[d2b2a7] | 271 | e.g. o=\"dp,ws,Dp,ds\", iv=3,2,3,4,2,5 creates the ordering |
---|
[3d124a7] | 272 | dp(2),ws(2,3,4),Dp(5),ds |
---|
| 273 | NOTE: This proc is useful for adding deformation parameters. |
---|
[6f2edc] | 274 | This proc uses 'execute' or calls a procedure using 'execute'. |
---|
[3c4dcc] | 275 | If you use it in your own proc, it may be advisable to let the local |
---|
[9fcd0c] | 276 | names of your proc start with a @ |
---|
[3ca4229] | 277 | EXAMPLE: example extendring; shows an example |
---|
[d2b2a7] | 278 | " |
---|
[3d124a7] | 279 | { |
---|
| 280 | //--------------- initialization and place c/C of ordering properly ----------- |
---|
[6f2edc] | 281 | string @o1,@o2,@ro,@wstr,@v,@newring; |
---|
[3d124a7] | 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); |
---|
[6f2edc] | 305 | if( @ro[1]=="c" or @ro[1]=="C" ) |
---|
[3d124a7] | 306 | { @v=@ro[1,2]; @ro=@ro[3..size(@ro)]; } |
---|
[6f2edc] | 307 | else |
---|
[3d124a7] | 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 | { |
---|
[bb7da7] | 313 | @k=n; //@k counts no of vars not yet ordered |
---|
[3d124a7] | 314 | @w=find(o,"w")+find(o,"W");o=o+" "; |
---|
[6f2edc] | 315 | if( @w!=0 ) |
---|
| 316 | { |
---|
| 317 | @wstr=o[@w..@w+1]; |
---|
[3d124a7] | 318 | o=o[1,@w-1]+"@"+o[@w+2,size(o)]; |
---|
| 319 | @iw=@iv[2..@iv[1]+1]; |
---|
| 320 | @wstr=@wstr+"("+string(@iw)+")"; |
---|
[6f2edc] | 321 | @k=@k-@iv[1]; |
---|
[3d124a7] | 322 | @iv=@iv[@iv[1]+2..size(@iv)]; |
---|
| 323 | @w=0; |
---|
| 324 | } |
---|
[6f2edc] | 325 | for( @ii=1; @ii<=size(@iv); @ii=@ii+1 ) |
---|
[3d124a7] | 326 | { |
---|
| 327 | if( find(o,",",@w+1)!=0 ) |
---|
| 328 | { |
---|
| 329 | @w=find(o,",",@w+1); |
---|
| 330 | if( o[@w-1]!="@" ) |
---|
[6f2edc] | 331 | { |
---|
| 332 | o=o[1,@w-1]+"("+string(@iv[@ii])+")"+o[@w,size(o)]; |
---|
[3d124a7] | 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 ------------------------- |
---|
[6fe3a0] | 344 | @newring = "ring na =("+charstr(@r)+"),("; |
---|
[3ca4229] | 345 | if( n>26 or va[2]=="(" ) { @v = va[1]+"(1.."+string(n)+")"; } |
---|
| 346 | else { @v = A_Z(va,n); } |
---|
[6f2edc] | 347 | if( @i==0 ) |
---|
| 348 | { |
---|
| 349 | @v=@v+","+varstr(@r); |
---|
| 350 | o=@o1+o+","+@ro+@o2; |
---|
[3d124a7] | 351 | } |
---|
[6f2edc] | 352 | else |
---|
| 353 | { |
---|
| 354 | @v=varstr(@r)+","+@v; |
---|
| 355 | o=@o1+@ro+","+o+@o2; |
---|
[3d124a7] | 356 | } |
---|
| 357 | @newring=@newring+@v+"),("+o+");"; |
---|
| 358 | //---------------------------- execute and export ----------------------------- |
---|
| 359 | execute(@newring); |
---|
[6fe3a0] | 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); |
---|
[3d124a7] | 367 | } |
---|
| 368 | example |
---|
| 369 | { "EXAMPLE:"; echo = 2; |
---|
| 370 | ring r=0,(x,y,z),ds; |
---|
[6f2edc] | 371 | show(r);""; |
---|
[6fe3a0] | 372 | // blocksize is derived from no of vars: |
---|
[6f2edc] | 373 | int t=5; |
---|
[6fe3a0] | 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; ""; |
---|
[3d124a7] | 378 | |
---|
[6fe3a0] | 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; ""; |
---|
[3d124a7] | 382 | |
---|
[6fe3a0] | 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 |
---|
[6f2edc] | 388 | intvec v=3,2,3,4,1,3; |
---|
[6fe3a0] | 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 |
---|
[3d124a7] | 393 | show(R4); |
---|
[6fe3a0] | 394 | kill r,R1,R2,R3,R4; |
---|
[3d124a7] | 395 | } |
---|
| 396 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 397 | |
---|
[0463d5c] | 398 | proc fetchall (def R, list #) |
---|
[d2b2a7] | 399 | "USAGE: fetchall(R[,s]); R=ring/qring, s=string |
---|
[0bc582c] | 400 | CREATE: fetch all objects of ring R (of type poly/ideal/vector/module/number/matrix) |
---|
| 401 | into the basering. |
---|
[9fcd0c] | 402 | If no 2nd argument is present, the names are the same as in R. If, |
---|
[3754ca] | 403 | say, f is a polynomial in R and the 2nd argument is the string \"R\", then f |
---|
[0bc582c] | 404 | is mapped to f_R etc. |
---|
[3d124a7] | 405 | RETURN: no return value |
---|
| 406 | NOTE: As fetch, this procedure maps the 1st, 2nd, ... variable of R to the |
---|
[6f2edc] | 407 | 1st, 2nd, ... variable of the basering. |
---|
[9fcd0c] | 408 | The 2nd argument is useful in order to avoid conflicts of names, the |
---|
[3d124a7] | 409 | empty string is allowed |
---|
[1e1ec4] | 410 | CAUTION: fetchall does not work for locally defined names. |
---|
[bb7da7] | 411 | It does not work if R contains a map. |
---|
[9fcd0c] | 412 | SEE ALSO: imapall |
---|
[3d124a7] | 413 | EXAMPLE: example fetchall; shows an example |
---|
[d2b2a7] | 414 | " |
---|
[6f2edc] | 415 | { |
---|
[3d124a7] | 416 | list @L@=names(R); |
---|
| 417 | int @ii@; string @s@; |
---|
| 418 | if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; } |
---|
[1e1ec4] | 419 | for( @ii@=size(@L@); @ii@>0; @ii@-- ) |
---|
[6f2edc] | 420 | { |
---|
[3d124a7] | 421 | execute("def "+@L@[@ii@]+@s@+"=fetch(R,`@L@[@ii@]`);"); |
---|
| 422 | execute("export "+@L@[@ii@]+@s@+";"); |
---|
| 423 | } |
---|
| 424 | return(); |
---|
| 425 | } |
---|
| 426 | example |
---|
[dc3a44] | 427 | { "EXAMPLE:"; echo=2; |
---|
[bb7da7] | 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: |
---|
[dc3a44] | 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; |
---|
[bb7da7] | 435 | // fetchall(R); //map from R to S: x->a, y->b, z->c; |
---|
[dc3a44] | 436 | // names(S); |
---|
| 437 | // j; print(M); |
---|
[bb7da7] | 438 | // fetchall(S,"1"); //identity map of S: copy objects, change names |
---|
[dc3a44] | 439 | // names(S); |
---|
| 440 | // kill R,S; |
---|
[3d124a7] | 441 | } |
---|
| 442 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 443 | |
---|
[0463d5c] | 444 | proc imapall (def R, list #) |
---|
[d2b2a7] | 445 | "USAGE: imapall(R[,s]); R=ring/qring, s=string |
---|
[0bc582c] | 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. |
---|
[9fcd0c] | 448 | If no 2nd argument is present, the names are the same as in R. If, |
---|
[3754ca] | 449 | say, f is a polynomial in R and the 3rd argument is the string \"R\", then f |
---|
[0bc582c] | 450 | is mapped to f_R etc. |
---|
[3d124a7] | 451 | RETURN: no return value |
---|
| 452 | NOTE: As imap, this procedure maps the variables of R to the variables with |
---|
[0bc582c] | 453 | the same name in the basering, the other variables are mapped to 0. |
---|
[9fcd0c] | 454 | The 2nd argument is useful in order to avoid conflicts of names, the |
---|
[3d124a7] | 455 | empty string is allowed |
---|
[1e1ec4] | 456 | CAUTION: imapall does not work for locally defined names. |
---|
[bb7da7] | 457 | It does not work if R contains a map |
---|
[9fcd0c] | 458 | SEE ALSO: fetchall |
---|
[3d124a7] | 459 | EXAMPLE: example imapall; shows an example |
---|
[d2b2a7] | 460 | " |
---|
[6f2edc] | 461 | { |
---|
[3d124a7] | 462 | list @L@=names(R); |
---|
| 463 | int @ii@; string @s@; |
---|
| 464 | if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; } |
---|
[1e1ec4] | 465 | for( @ii@=size(@L@); @ii@>0; @ii@-- ) |
---|
[6f2edc] | 466 | { |
---|
[3d124a7] | 467 | execute("def "+@L@[@ii@]+@s@+"=imap(R,`@L@[@ii@]`);"); |
---|
| 468 | execute("export "+@L@[@ii@]+@s@+";"); |
---|
| 469 | } |
---|
| 470 | return(); |
---|
| 471 | } |
---|
| 472 | example |
---|
[dc3a44] | 473 | { "EXAMPLE:"; echo = 2; |
---|
[bb7da7] | 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: |
---|
[dc3a44] | 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; |
---|
[bb7da7] | 481 | // imapall(R); //map from R to S: x->x, y->y, z->z, u->0 |
---|
[dc3a44] | 482 | // names(S); |
---|
| 483 | // j; print(M); |
---|
[bb7da7] | 484 | // imapall(S,"1"); //identity map of S: copy objects, change names |
---|
[dc3a44] | 485 | // names(S); |
---|
| 486 | // kill R,S; |
---|
[3d124a7] | 487 | } |
---|
| 488 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 489 | |
---|
[0463d5c] | 490 | proc mapall (def R, ideal i, list #) |
---|
[d2b2a7] | 491 | "USAGE: mapall(R,i[,s]); R=ring/qring, i=ideal of basering, s=string |
---|
[6f2edc] | 492 | CREATE: map all objects of ring R (of type poly/ideal/vector/module/number/ |
---|
[0bc582c] | 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 |
---|
[3754ca] | 495 | names are the same as in R. If, say, f is a polynomial in R and the 3rd |
---|
[0bc582c] | 496 | argument is the string \"R\", then f is mapped to f_R etc. |
---|
[bb7da7] | 497 | RETURN: no return value. |
---|
[3d124a7] | 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 |
---|
[6f2edc] | 501 | from the basering to S. |
---|
[3d124a7] | 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 |
---|
[bb7da7] | 504 | empty string is allowed. |
---|
[1e1ec4] | 505 | CAUTION: mapall does not work for locally defined names. |
---|
[3d124a7] | 506 | EXAMPLE: example mapall; shows an example |
---|
[d2b2a7] | 507 | " |
---|
[6f2edc] | 508 | { |
---|
[3d124a7] | 509 | list @L@=names(R); map @psi@ = R,i; |
---|
| 510 | int @ii@; string @s@; |
---|
| 511 | if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; } |
---|
[1e1ec4] | 512 | for( @ii@=size(@L@); @ii@>0; @ii@-- ) |
---|
[6f2edc] | 513 | { |
---|
[3d124a7] | 514 | execute("def "+@L@[@ii@]+@s@+"=@psi@(`@L@[@ii@]`);"); |
---|
| 515 | execute("export "+@L@[@ii@]+@s@+";"); |
---|
| 516 | } |
---|
| 517 | return(); |
---|
| 518 | } |
---|
| 519 | example |
---|
[dc3a44] | 520 | { "EXAMPLE:"; echo = 2; |
---|
[bb7da7] | 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: |
---|
[dc3a44] | 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; |
---|
[b9b906] | 526 | // map phi=R,x2,y2,z2; |
---|
[dc3a44] | 527 | // ring S=0,(a,b,c),ds; |
---|
| 528 | // ideal i=c,a,b; |
---|
[bb7da7] | 529 | // mapall(R,i); //map from R to S: x->c, y->a, z->b |
---|
[dc3a44] | 530 | // names(S); |
---|
[bb7da7] | 531 | // j; print(M); phi; //phi maps R to S: x->c2, y->a2, z->b2 |
---|
[dc3a44] | 532 | // ideal i1=a2,a+b,1; |
---|
[0bc582c] | 533 | // mapall(R,i1,\"\"); //map from R to S: x->a2, y->a+b, z->1 |
---|
[dc3a44] | 534 | // names(S); |
---|
| 535 | // j_; print(M_); phi_; |
---|
[bb7da7] | 536 | // changevar(\"T\",\"x()\",R); //change vars in R and call result T |
---|
[0bc582c] | 537 | // mapall(R,maxideal(1)); //identity map from R to T |
---|
[dc3a44] | 538 | // names(T); |
---|
| 539 | // j; print(M); phi; |
---|
| 540 | // kill R,S,T; |
---|
[3d124a7] | 541 | } |
---|
| 542 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 543 | |
---|
[0463d5c] | 544 | proc ord_test (def r) |
---|
[29299e] | 545 | "USAGE: ord_test(r); r ring/qring |
---|
[2211fc] | 546 | RETURN: int 1 (resp. -1, resp. 0) if ordering of r is global (resp. local, |
---|
| 547 | resp. mixed) |
---|
[1e1ec4] | 548 | SEE ALSO: attrib |
---|
[2211fc] | 549 | EXAMPLE: example ord_test; shows an example |
---|
| 550 | " |
---|
| 551 | { |
---|
[11a441] | 552 | if ((typeof(r) != "ring") and (typeof(r) != "qring")) |
---|
[2211fc] | 553 | { |
---|
[11a441] | 554 | ERROR("ord_test requires a ring/qring as input"); |
---|
[2211fc] | 555 | } |
---|
[29299e] | 556 | if (attrib(r,"global")==1) { return(1);} |
---|
[2211fc] | 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); |
---|
[b9b906] | 579 | ord_test(R+S); |
---|
[2211fc] | 580 | } |
---|
| 581 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 582 | |
---|
[8647dd] | 583 | proc ringtensor (list #) |
---|
[9fcd0c] | 584 | "USAGE: ringtensor(r1,r2,...); r1,r2,...=rings |
---|
[3c4dcc] | 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 |
---|
[8647dd] | 587 | respective monomial orderings of r1,r2,... . Hence, R |
---|
[3d124a7] | 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,... |
---|
[701f0a0] | 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. |
---|
[3d124a7] | 593 | The procedure works also for quotient rings ri, if the characteristic |
---|
[701f0a0] | 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 |
---|
[3d124a7] | 597 | EXAMPLE: example ringtensor; shows an example |
---|
[d2b2a7] | 598 | " |
---|
[3d124a7] | 599 | { |
---|
[701f0a0] | 600 | int @i; |
---|
[3d124a7] | 601 | int @n = size(#); |
---|
[701f0a0] | 602 | if (@n<=1) { ERROR("at least 2 rings required"); } |
---|
| 603 | def @s=#[1]+#[2]; |
---|
| 604 | for (@i=3; @i<=@n;@i++) |
---|
[3d124a7] | 605 | { |
---|
[701f0a0] | 606 | def @ss=@s+#[@i]; |
---|
| 607 | kill @s; |
---|
| 608 | def @s=@ss; |
---|
| 609 | kill @ss; |
---|
[3d124a7] | 610 | } |
---|
[8647dd] | 611 | dbprint(printlevel-voice+2," |
---|
[3c4dcc] | 612 | // 'ringtensor' created a ring. To see the ring, type (if the name R was |
---|
[8647dd] | 613 | // assigned to the return value): |
---|
[701f0a0] | 614 | show(R); |
---|
[3c4dcc] | 615 | // To make the ring the active basering, type |
---|
[8647dd] | 616 | setring R; "); |
---|
[701f0a0] | 617 | return(@s); |
---|
[3d124a7] | 618 | } |
---|
[6f2edc] | 619 | example |
---|
[3d124a7] | 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); |
---|
[8647dd] | 624 | def R=ringtensor(r,s,t); |
---|
[3c4dcc] | 625 | type R; |
---|
[3d124a7] | 626 | setring s; |
---|
| 627 | ideal i = a2+b3+c5; |
---|
[8647dd] | 628 | def S=changevar("x,y,z"); //change vars of s |
---|
| 629 | setring S; |
---|
[0bc582c] | 630 | qring qS =std(fetch(s,i)); //create qring of S mod i (mapped to S) |
---|
[8647dd] | 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); |
---|
[01cc3b2] | 635 | setring Q; type Q; |
---|
[8647dd] | 636 | kill R,S,T,Q; |
---|
[3d124a7] | 637 | } |
---|
| 638 | /////////////////////////////////////////////////////////////////////////////// |
---|
[4cb6b8] | 639 | |
---|
[f67865] | 640 | proc ringweights (def P) |
---|
[4cb6b8] | 641 | "USAGE: ringweights(P); P=name of an existing ring (true name, not a string) |
---|
[b9b906] | 642 | RETURN: intvec consisting of the weights of the variables of P, as they |
---|
[4cb6b8] | 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 | { |
---|
[f67865] | 649 | int i; |
---|
| 650 | intvec rw; |
---|
| 651 | //------------------------- find weights ------------------------- |
---|
| 652 | for(i=nvars(P);i>0;i--) |
---|
| 653 | { rw[i]=ord(var(i)); } |
---|
[4cb6b8] | 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 | /////////////////////////////////////////////////////////////////////////////// |
---|
[430001] | 668 | proc preimageLoc(string R_name,string phi_name,string Q_name ) |
---|
[9fcd0c] | 669 | "USAGE: preimageLoc ( ring_name, map_name, ideal_name ); |
---|
[430001] | 670 | all input parameters of type string |
---|
[9fcd0c] | 671 | RETURN: ideal |
---|
[0bc582c] | 672 | PURPOSE: compute the preimage of an ideal under a given map for non-global |
---|
[430001] | 673 | orderings. |
---|
[0bc582c] | 674 | The 2nd argument has to be the name of a map from the basering to |
---|
[3c4dcc] | 675 | the given ring (or the name of an ideal defining such a map), and |
---|
[430001] | 676 | the ideal has to be an ideal in the given ring. |
---|
| 677 | SEE ALSO: preimage |
---|
[46f16d] | 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 | "{ |
---|
[430001] | 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 | } |
---|
[4508b59] | 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 | } |
---|
[738208] | 851 | |
---|
| 852 | |
---|
| 853 | |
---|
| 854 | |
---|
| 855 | proc isQuotientRing( rng ) |
---|
| 856 | "USAGE: isQuotientRing ( rng ); |
---|
| 857 | RETURN: 1 if rng is a quotient ring, 0 otherwise. |
---|
| 858 | PURPOSE: check if typeof a rng "qring" |
---|
| 859 | KEYWORDS: qring ring ideal 'factor ring' |
---|
| 860 | EXAMPLE: example isQuotientRing ; shows an example |
---|
| 861 | " |
---|
| 862 | { |
---|
| 863 | return ( size(ideal(rng)) != 0 ); |
---|
| 864 | } |
---|
| 865 | example |
---|
| 866 | { |
---|
| 867 | ring rng = 0,x,dp; |
---|
| 868 | isQuotientRing(rng); //no |
---|
| 869 | // if a certain method does not support quotient rings, |
---|
| 870 | // then a parameter test could be performed: |
---|
| 871 | ASSUME( 0, 0==isQuotientRing(basering)); |
---|
| 872 | |
---|
| 873 | qring q= ideal(x); // constructs rng/ideal(x) |
---|
| 874 | isQuotientRing(q); // yes |
---|
| 875 | } |
---|
| 876 | |
---|
| 877 | static proc testIsQuotientRing() |
---|
| 878 | { |
---|
| 879 | ring rng = real,x,dp; |
---|
| 880 | ASSUME(0, 0== isQuotientRing(rng) ) ; |
---|
| 881 | |
---|
| 882 | qring qrng = 1; |
---|
| 883 | ASSUME(0, isQuotientRing(qrng) ) ; |
---|
| 884 | |
---|
| 885 | ring rng2 = integer,x,dp; |
---|
| 886 | ASSUME(0, 0 == isQuotientRing(rng2) ) ; |
---|
| 887 | |
---|
| 888 | qring qrng2=0; |
---|
| 889 | ASSUME(0, isQuotientRing(qrng2) ) ; |
---|
| 890 | |
---|
| 891 | ring rng3 = 0,x,dp; |
---|
| 892 | ASSUME(0, 0 == isQuotientRing(rng3) ) ; |
---|
| 893 | |
---|
| 894 | qring qrng3=1; |
---|
| 895 | ASSUME(0, isQuotientRing(qrng3) ) ; |
---|
| 896 | } |
---|
| 897 | |
---|
| 898 | |
---|
| 899 | |
---|
| 900 | |
---|
| 901 | |
---|
| 902 | proc hasIntegerCoefficientRing( rng ) |
---|
| 903 | "USAGE: hasIntegerCoefficientRing ( rng ); |
---|
| 904 | RETURN: 1 if rng is has integer ring coefficients, 0 otherwise. |
---|
| 905 | KEYWORDS: integer ring coefficients |
---|
| 906 | EXAMPLE: example hasIntegerCoefficientRing ; shows an example |
---|
| 907 | " |
---|
| 908 | proc hasIntegerCoefficientRing(rng) |
---|
| 909 | { |
---|
| 910 | def rl = ringlist(rng); |
---|
| 911 | if ( not (typeof(rl[1][1])=="string") ) { return (0); } |
---|
| 912 | return ( rl[1][1]=="integer" ); |
---|
| 913 | } |
---|
| 914 | example |
---|
| 915 | { |
---|
| 916 | ring rng = integer,x,dp; |
---|
| 917 | hasIntegerCoefficientRing(rng); //yes |
---|
| 918 | // if a certain method supports only rings with integer coefficients, |
---|
| 919 | // then a parameter test could be performed: |
---|
| 920 | ASSUME( 0, hasIntegerCoefficientRing(basering)); //ok |
---|
| 921 | |
---|
| 922 | ring rng2 = 0, x, dp; |
---|
| 923 | hasIntegerCoefficientRing(rng2); // no |
---|
| 924 | } |
---|
| 925 | |
---|
| 926 | |
---|
| 927 | static proc testHasIntegerCoefficientRing() |
---|
| 928 | { |
---|
| 929 | ring rng = integer,x,dp; |
---|
| 930 | ASSUME(0, hasIntegerCoefficientRing( rng ) ); |
---|
| 931 | |
---|
| 932 | qring q = ideal(x); |
---|
| 933 | ASSUME(0, hasIntegerCoefficientRing( q ) ); |
---|
| 934 | |
---|
| 935 | ring rng2 = 0,x,dp; |
---|
| 936 | ASSUME(0, 0==hasIntegerCoefficientRing( rng2 ) ); |
---|
| 937 | |
---|
| 938 | ring rng3 = (0,a),x,dp; |
---|
| 939 | ASSUME(0, 0==hasIntegerCoefficientRing( rng3 ) ); |
---|
| 940 | |
---|
| 941 | ring rng4 = (real,a),x,dp; |
---|
| 942 | ASSUME(0, 0==hasIntegerCoefficientRing( rng4 ) ); |
---|
| 943 | |
---|
| 944 | ring rng5 = (real),x,dp; |
---|
| 945 | ASSUME(0, 0==hasIntegerCoefficientRing( rng5 ) ); |
---|
| 946 | } |
---|
| 947 | |
---|
| 948 | |
---|
| 949 | |
---|
| 950 | |
---|