Ignore:
Timestamp:
Jan 14, 2009, 5:07:05 PM (14 years ago)
Branches:
(u'spielwiese', '828514cf6e480e4bafc26df99217bf2a1ed1ef45')
Children:
0721816437af5ddabc83aa203a12d9b58b42a33c
Parents:
95edd5641377e851d4a1d4e986853687991d0895
Message:
```*hannes: format

Location:
Singular/LIB
Files:
23 edited

Unmodified
Removed
• ## Singular/LIB/bfct.lib

 r95edd5 ////////////////////////////////////////////////////////////////////////////// version="\$Id: bfct.lib,v 1.10 2009-01-12 19:31:23 Singular Exp \$"; version="\$Id: bfct.lib,v 1.11 2009-01-14 16:07:03 Singular Exp \$"; category="Noncommutative"; info=" AUXILIARY PROCEDURES: allPositive(v);  checks whether all entries of an intvec are positive allPositive(v);  checks whether all entries of an intvec are positive scalarProd(v,w); computes the standard scalar product of two intvecs vec2poly(v[,i]); constructs an univariate poly with given coefficients EXAMPLE: example gradedWeyl; shows examples NOTE:    u[i] is the weight of x(i), v[i] the weight of D(i). @*       u+v has to be a non-negative intvec. @*       u+v has to be a non-negative intvec. " { { ERROR("weight vectors have wrong dimension"); } } intvec uv,gr; uv = u+v; if (uv[i]==0) { gr[i] = 0; gr[i] = 0; } else { gr[i] = 1; gr[i] = 1; } } for (i=1; i<=n; i++) { if (gr[i] == 1) if (gr[i] == 1) { l2[n+i] = "xi("+string(i)+")"; RETURN:  ideal/list, linear reductum (over field) of f by elements from I PURPOSE: reduce a poly only by linear reductions (no monomial multiplications) NOTE:    If s<>0, a list consisting of the reduced ideal and the coefficient NOTE:    If s<>0, a list consisting of the reduced ideal and the coefficient @*       vectors of the used reductions given as module is returned. @*       Otherwise (and by default), only the reduced ideal is returned. if (typeof(#[2])=="int" || typeof(#[2])=="number") { redtail = #[2]; redtail = #[2]; } } for (i=1; i<=sI; i++) { if (I[i] == 0) { j++; J[j] = 0; ordJ[j] = -1; M[j] = gen(i); } else { M[i+sZeros-j] = gen(lJ[2][i-j]+j); } if (I[i] == 0) { j++; J[j] = 0; ordJ[j] = -1; M[j] = gen(i); } else { M[i+sZeros-j] = gen(lJ[2][i-j]+j); } } } for (i=1; i<=sZeros; i++) { J[i] = 0; ordJ[i] = -1; J[i] = 0; ordJ[i] = -1; } } for (j=sZeros+1; j maxordJ) { break; } if (ordlm == ordJ[j]) { if (lm > maxlmJ) { break; } if (lm == lmJ[j]) { dbprint(ppl,"reducing " + string(redpoly)); dbprint(ppl," with " + string(J[j])); c = leadcoef(redpoly)/leadcoef(J[j]); redpoly = redpoly - c*J[j]; dbprint(ppl," to " + string(redpoly)); lm = leadmonom(redpoly); ordlm = ord(lm); if (remembercoeffs <> 0) { M[i] = M[i] - c * M[j]; } reduction = 1; } } if (lm == 0) { break; } if (ordlm > maxordJ) { break; } if (ordlm == ordJ[j]) { if (lm > maxlmJ) { break; } if (lm == lmJ[j]) { dbprint(ppl,"reducing " + string(redpoly)); dbprint(ppl," with " + string(J[j])); c = leadcoef(redpoly)/leadcoef(J[j]); redpoly = redpoly - c*J[j]; dbprint(ppl," to " + string(redpoly)); lm = leadmonom(redpoly); ordlm = ord(lm); if (remembercoeffs <> 0) { M[i] = M[i] - c * M[j]; } reduction = 1; } } } } lmJ = insertGenerator(lmJ,lm,j); ordJ = insertGenerator(ordJ,poly(ordlm),j); if (remembercoeffs <> 0) if (remembercoeffs <> 0) { v = M[i]; for (j=i+1; j<=sI; j++) { for (k=2; k<=size(J[j]); k++) // run over all terms in J[j] { if (ordJ[i] == ord(J[j][k])) { if (lm == normalize(J[j][k])) { c = leadcoef(J[j][k])/leadcoef(J[i]); dbprint(ppl,"reducing " + string(J[j])); dbprint(ppl," with " + string(J[i])); J[j] = J[j] - c*J[i]; dbprint(ppl," to " + string(J[j])); if (remembercoeffs <> 0) { M[j] = M[j] - c * M[i]; } } } } for (k=2; k<=size(J[j]); k++) // run over all terms in J[j] { if (ordJ[i] == ord(J[j][k])) { if (lm == normalize(J[j][k])) { c = leadcoef(J[j][k])/leadcoef(J[i]); dbprint(ppl,"reducing " + string(J[j])); dbprint(ppl," with " + string(J[i])); J[j] = J[j] - c*J[i]; dbprint(ppl," to " + string(J[j])); if (remembercoeffs <> 0) { M[j] = M[j] - c * M[i]; } } } } } } RETURN:  poly/list, linear reductum (over field) of f by elements from I PURPOSE: reduce a poly only by linear reductions (no monomial multiplications) NOTE:    If s<>0, a list consisting of the reduced poly and the coefficient NOTE:    If s<>0, a list consisting of the reduced poly and the coefficient @*       vector of the used reductions is returned, otherwise (and by default) @*       only reduced poly is returned. if (typeof(#[2])=="int" || typeof(#[2])=="number") { redtail = #[2]; redtail = #[2]; } if (size(#)>2) { if (typeof(#[3])=="int" || typeof(#[3])=="number") if (typeof(#[3])=="int" || typeof(#[3])=="number") { prepareideal = #[3]; } prepareideal = #[3]; } } } for (i=1; i<=sI; i++) { M[i] = gen(i); M[i] = gen(i); } } if (ordf == ordI[i]) { if (lm == lmI[i]) { c = leadcoef(f)/lcI[i]; f = f - c*I[i]; lm = leadmonom(f); ordf = ord(lm); if (remembercoeffs <> 0) { v = v - c * M[i]; } } if (lm == lmI[i]) { c = leadcoef(f)/lcI[i]; f = f - c*I[i]; lm = leadmonom(f); ordf = ord(lm); if (remembercoeffs <> 0) { v = v - c * M[i]; } } } } for (j=1; j<=size(f); j++) { if (ord(f[j]) == ordI[i]) { if (normalize(f[j]) == lmI[i]) { c = leadcoef(f[j])/lcI[i]; f = f - c*I[i]; dbprint(ppl,"reducing poly to ",f); if (remembercoeffs <> 0) { v = v - c * M[i]; } } } if (ord(f[j]) == ordI[i]) { if (normalize(f[j]) == lmI[i]) { c = leadcoef(f[j])/lcI[i]; f = f - c*I[i]; dbprint(ppl,"reducing poly to ",f); if (remembercoeffs <> 0) { v = v - c * M[i]; } } } } } f = x3 + y2 + x2 + y + x; I = x3 - y3, y3 - x2, x3 - y2, x2 - y, y2-x; list l = linReduce(f, I, 1); list l = linReduce(f, I, 1); l; module M = I; if (p <> 0) { whichengine = 1; whichengine = 1; } } proc pIntersect (poly s, ideal I) "USAGE:  pIntersect(f, I);  f a poly, I an ideal RETURN:  vector, coefficient vector of the monic polynomial RETURN:  vector, coefficient vector of the monic polynomial PURPOSE: compute the intersection of ideal I with the subalgebra K[f] ASSUME:  I is given as Groebner basis. if (degs[j] == 0) { if (degI[i][j] <> 0) { break; } if (degI[i][j] <> 0) { break; } } if (j == n) { k++; possdegbounds[k] = Max(degI[i]); k++; possdegbounds[k] = Max(degI[i]); } } if (tobracket==0) // todo bug in bracket? { toNF = 0; toNF = 0; } else { toNF = bracket(tobracket,secNF); toNF = bracket(tobracket,secNF); } newNF = NF(toNF+oldNF*secNF,I);  // = NF(s^i,I) v = v + m[j,1]*gen(j); } setring save; setring save; v = imap(@R,v); kill @R; if (size(#)>2) { if (typeof(#[3])=="int" || typeof(#[3])=="number") { modengine = int(#[3]); } if (typeof(#[3])=="int" || typeof(#[3])=="number") { modengine = int(#[3]); } } } if (tobracket!=0) { toNF = bracket(tobracket,NI[2]) + NI[i]*NI[2]; toNF = bracket(tobracket,NI[2]) + NI[i]*NI[2]; } else { toNF = NI[i]*NI[2]; toNF = NI[i]*NI[2]; } newNF =  NF(toNF,I); if (v!=0) // there is a modular solution { dbprint(ppl,"got solution in char ",solveincharp," of degree " ,i); setring save; v = linSyzSolve(NI,whichengine); if (v==0) { break; } dbprint(ppl,"got solution in char ",solveincharp," of degree " ,i); setring save; v = linSyzSolve(NI,whichengine); if (v==0) { break; } } else // no modular solution { setring save; v = 0; setring save; v = 0; } } { dbprint(ppl,"linSyzSolve: got solution!"); // "got solution!"; // "got solution!"; break; } if (typeof(#[2])=="int" || typeof(#[2])=="number") { ringvar = int(#[2]); ringvar = int(#[2]); } } while (b == 0) { dbprint(ppl,"number of run in the loop: "+string(i)); int q = prime(random(lb,ub)); if (findFirst(usedprimes,q)==0) // if q was not already used dbprint(ppl,"number of run in the loop: "+string(i)); int q = prime(random(lb,ub)); if (findFirst(usedprimes,q)==0) // if q was not already used { usedprimes = usedprimes,q; dbprint(ppl,"used prime is: "+string(q)); b = pIntersectSyz(s,J,q,whichengine,modengine); } i++; } } else // pIntersectSyz::non-modular usedprimes = usedprimes,q; dbprint(ppl,"used prime is: "+string(q)); b = pIntersectSyz(s,J,q,whichengine,modengine); } i++; } } else // pIntersectSyz::non-modular { b = pIntersectSyz(s,J,0,whichengine); RETURN:  list of ideal and intvec PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s) @*       for the hypersurface defined by f. @*       for the hypersurface defined by f. ASSUME:  The basering is a commutative polynomial ring in char 0. BACKGROUND: In this proc, the initial Malgrange ideal is computed according to the algorithm BACKGROUND: In this proc, the initial Malgrange ideal is computed according to the algorithm @*       by Masayuki Noro and then a system of linear equations is solved by linear reductions. NOTE:    In the output list, the ideal contains all the roots NOTE:    In the output list, the ideal contains all the roots @*       and the intvec their multiplicities. @*       If s<>0, @code{std} is used for GB computations, @*       otherwise, and by default, @code{slimgb} is used. @*       otherwise, and by default, @code{slimgb} is used. @*       If t<>0, a matrix ordering is used for Groebner basis computations, @*       otherwise, and by default, a block ordering is used. @*       If v is a positive weight vector, v is used for homogenization computations, @*       If v is a positive weight vector, v is used for homogenization computations, @*       otherwise and by default, no weights are used. DISPLAY: If printlevel=1, progress debug messages will be printed, if (size(#)>2) { if (typeof(#[3])=="intvec" && size(#[3])==n && allPositive(#[3])==1) if (typeof(#[3])=="intvec" && size(#[3])==n && allPositive(#[3])==1) { u0 = #[3]; } u0 = #[3]; } } } "USAGE:  bfctSyz(f [,r,s,t,u,v]);  f a poly, r,s,t,u optional ints, v an optional intvec RETURN:  list of ideal and intvec PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s) PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s) @*       for the hypersurface defined by f ASSUME:  The basering is a commutative polynomial ring in char 0. BACKGROUND: In this proc, the initial Malgrange ideal is computed according to the algorithm BACKGROUND: In this proc, the initial Malgrange ideal is computed according to the algorithm @*       by Masayuki Noro and then a system of linear equations is solved by computing syzygies. NOTE:    In the output list, the ideal contains all the roots NOTE:    In the output list, the ideal contains all the roots @*       and the intvec their multiplicities. @*       If r<>0, @code{std} is used for GB computations in characteristic 0, @*       otherwise, and by default, @code{slimgb} is used. @*       If s<>0, a matrix ordering is used for GB computations, otherwise, @*       If r<>0, @code{std} is used for GB computations in characteristic 0, @*       otherwise, and by default, @code{slimgb} is used. @*       If s<>0, a matrix ordering is used for GB computations, otherwise, @*       and by default, a block ordering is used. @*       If t<>0, the computation of the intersection is solely performed over @*       If t<>0, the computation of the intersection is solely performed over @*       charasteristic 0, otherwise and by default, a modular method is used. @*       If u<>0 and by default, @code{std} is used for GB computations in @*       characteristic >0, otherwise, @code{slimgb} is used. @*       If v is a positive weight vector, v is used for homogenization @*       If u<>0 and by default, @code{std} is used for GB computations in @*       characteristic >0, otherwise, @code{slimgb} is used. @*       If v is a positive weight vector, v is used for homogenization @*       computations, otherwise and by default, no weights are used. DISPLAY: If printlevel=1, progress debug messages will be printed, if (typeof(#[3])=="int" || typeof(#[3])=="number") { pIntersectchar = int(#[3]); } if (size(#)>3) pIntersectchar = int(#[3]); } if (size(#)>3) { if (typeof(#[4])=="int" || typeof(#[4])=="number") if (typeof(#[4])=="int" || typeof(#[4])=="number") { modengine = int(#[4]); } if (size(#)>4) { if (typeof(#[5])=="intvec" && size(#[5])==n && allPositive(#[5])==1) { u0 = #[5]; } } } modengine = int(#[4]); } if (size(#)>4) { if (typeof(#[5])=="intvec" && size(#[5])==n && allPositive(#[5])==1) { u0 = #[5]; } } } } } BACKGROUND:  In this proc, the initial ideal of I is computed according to the algorithm by @*       Masayuki Noro and then a system of linear equations is solved by linear reductions. NOTE:    In the output list, the ideal contains all the roots NOTE:    In the output list, the ideal contains all the roots @*       and the intvec their multiplicities. @*       If s<>0, @code{std} is used for GB computations in characteristic 0, @*       otherwise, and by default, @code{slimgb} is used. @*       otherwise, and by default, @code{slimgb} is used. @*       If t<>0, a matrix ordering is used for GB computations, otherwise, @*       and by default, a block ordering is used. "USAGE:  bfctOneGB(f [,s,t]);  f a poly, s,t optional ints RETURN:  list of ideal and intvec PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s) for the PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s) for the @*       hypersurface defined by f, using only one GB computation ASSUME:  The basering is a commutative polynomial ring in char 0. BACKGROUND: In this proc, the initial Malgrange ideal is computed based on the BACKGROUND: In this proc, the initial Malgrange ideal is computed based on the @*       algorithm by Masayuki Noro and combined with an elimination ordering. NOTE:    In the output list, the ideal contains all the roots NOTE:    In the output list, the ideal contains all the roots @*       and the intvec their multiplicities. @*       If s<>0, @code{std} is used for the GB computation, otherwise, @*       and by default, @code{slimgb} is used. @*       and by default, @code{slimgb} is used. @*       If t<>0, a matrix ordering is used for GB computations, @*       otherwise, and by default, a block ordering is used. "USAGE:  bfctAnn(f [,r]);  f a poly, r an optional int RETURN:  list of ideal and intvec PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s) PURPOSE: computes the roots of the Bernstein-Sato polynomial b(s) @*       for the hypersurface defined by f ASSUME:  The basering is a commutative polynomial ring in char 0. BACKGROUND: In this proc, ann(f^s) is computed and then a system of linear @*       equations is solved by linear reductions. NOTE:    In the output list, the ideal contains all the roots NOTE:    In the output list, the ideal contains all the roots @*       and the intvec their multiplicities. @*       If r<>0, @code{std} is used for GB computations, @*       otherwise, and by default, @code{slimgb} is used. @*       otherwise, and by default, @code{slimgb} is used. DISPLAY: If printlevel=1, progress debug messages will be printed, @*       if printlevel>=2, all the debug messages will be printed.
• ## Singular/LIB/classify.lib

 r95edd5 // KK,GMG last modified: 17.12.00 /////////////////////////////////////////////////////////////////////////////// version  = "\$Id: classify.lib,v 1.54 2008-12-08 14:24:41 dreyer Exp \$"; version  = "\$Id: classify.lib,v 1.55 2009-01-14 16:07:03 Singular Exp \$"; category="Singularities"; info=" s = s +" has 4-jet equal to zero. (F47), mu="+string(Mu); s; // +"  ("+SG_Typ+")"; s = "No further classification available."; list v; if(sg[1]==1 && sg[2]==0 && sg[3]==1) { v=HKclass7_teil_1(sg, SG_Typ, cnt); if(sg[1]==1 && sg[2]==0 && sg[3]==1) { v=HKclass7_teil_1(sg, SG_Typ, cnt); } else {
• ## Singular/LIB/compregb.lib

 r95edd5 /////////////////////////////////////////////////////////////////////////////// version="\$Id: compregb.lib,v 1.2 2007-06-20 15:39:44 Singular Exp \$"; version="\$Id: compregb.lib,v 1.3 2009-01-14 16:07:03 Singular Exp \$"; category="General purpose"; info=" for (j = 1; j <= size(CoefLsub); j ++) { if (CoefLsub[j] > 1) if (CoefLsub[j] > 1) { CoefL = insert(CoefL, CoefLsub[j]); } CoefL = insert(CoefL, CoefLsub[j]); } } } if (Coef == CoefL[j]) { CoefL = delete(CoefL, j); j --; CoefL = delete(CoefL, j); j --; } }

• ## Singular/LIB/discretize.lib

 r95edd5 /////////////////////////////////////////////////////////////////////////////// version="\$Id: discretize.lib,v 1.4 2009-01-07 16:11:35 Singular Exp \$"; version="\$Id: discretize.lib,v 1.5 2009-01-14 16:07:04 Singular Exp \$"; category="Applications"; info=" RETURN:  string PURPOSE: replaces in 's' all the substrings 'what' with substring 'with' NOTE: NOTE: EXAMPLE: example replace; shows examples "{ if ( (sout[i]=="+") || (sout[i]=="-") ) { NisPoly = 1; NisPoly = 1; } } " ideal I = decoef(p,dt);"; " difpoly2tex(I,L);"; difpoly2tex(I,L); // the nodal form of the scheme in TeX difpoly2tex(I,L); // the nodal form of the scheme in TeX "* Preparations for the semi-factorized form: "; poly pi1 = subst(I[2],B,0);
• ## Singular/LIB/dmod.lib

 r95edd5 ////////////////////////////////////////////////////////////////////////////// version="\$Id: dmod.lib,v 1.33 2008-12-23 21:39:31 levandov Exp \$"; version="\$Id: dmod.lib,v 1.34 2009-01-14 16:07:04 Singular Exp \$"; category="Noncommutative"; info=" { bs[i-1] = P[1][i]; bs[i-1] = subst(bs[i-1],s,-s-1); m[i-1]  = P[2][i]; m[i-1]  = P[2][i]; } int sP = minIntRoot(bs,1); dbprint(ppl,"// -2-1- the ring @R3 i.e. K[s] is ready"); ideal K3 = imap(@R2,K2); poly p = K3[1]; poly p = K3[1]; p = s*p; // mult with the lost (s+1) factor dbprint(ppl,"// -2-2- factorization"); { bs[i-1] = P[1][i]; bs[i-1] = subst(bs[i-1],s,-s-1); m[i-1]  = P[2][i]; m[i-1]  = P[2][i]; } int sP = minIntRoot(bs,1); if ( leadmonom(K[i,2]) == 1) { t = K[i,1]; n = leadcoef(K[i,2]); t = t/n; //        J = J, K[i][2]; break; t = K[i,1]; n = leadcoef(K[i,2]); t = t/n; //        J = J, K[i][2]; break; } } kill s; kill NName; tmp[1]      = "C"; tmp[1]      = "C"; Lord[2]     = tmp;  tmp = 0; L[3]        = Lord;
• ## Singular/LIB/dmodapp.lib

 r95edd5 ////////////////////////////////////////////////////////////////////////////// version="\$Id: dmodapp.lib,v 1.15 2009-01-12 19:31:23 Singular Exp \$"; version="\$Id: dmodapp.lib,v 1.16 2009-01-14 16:07:04 Singular Exp \$"; category="Noncommutative"; info=" GUIDE: Let R = K[x1,..xN] and D be the Weyl algebra in variables x1,..xN,d1,..dN. In this library there are the following procedures for algebraic D-modules: @* - localization of a holonomic module D/I with respect to a mult. closed set @* - localization of a holonomic module D/I with respect to a mult. closed set of all powers of a given polynomial F from R. Our aim is to compute an ideal L in D, such that D/L is a presentation of a localized module. Such L always exists, since such localizations are known to be holonomic and thus cyclic modules. in D, such that D/L is a presentation of a localized module. Such L always exists, since such localizations are known to be holonomic and thus cyclic modules. The procedures for the localization are DLoc, SDLoc and DLoc0. { return(I); } } int j,i,s,m; list l; else { if (s > m) { m = s; g = l[i][2]; } if (s > m) { m = s; g = l[i][2]; } } } proc appelF1() proc appelF1() "USAGE:  appelF1(); RETURN:  ring "EXAMPLE:"; echo = 2; ring r = 0,x,dp; def A = appelF1(); def A = appelF1(); setring A; IAppel1; "EXAMPLE:"; echo = 2; ring r = 0,x,dp; def A = appelF2(); def A = appelF2(); setring A; IAppel2; } proc appelF4() proc appelF4() "USAGE:  appelF4(); RETURN:  ring "EXAMPLE:"; echo = 2; ring r = 0,x,dp; def A = appelF4(); def A = appelF4(); setring A; IAppel4; PURPOSE: check whether the ideal I is F-saturated NOTE:    1 is returned if I is F-saturated, otherwise 0 is returned. @*   we check indeed that Ker(D --F--> D/I) is (0) @*   we check indeed that Ker(D --F--> D/I) is (0) EXAMPLE: example isFsat; shows examples " LD; // Now, compare with the output of Macaulay2: ideal tst = 3*x*Dx + 2*y*Dy + 1, y^3*Dy^2 - x^2*Dy^2 + 6*y^2*Dy + 6*y, 9*y^2*Dx^2*Dy - 4*y*Dy^3 + 27*y*Dx^2 + 2*Dy^2, 9*y^3*Dx^2 - 4*y^2*Dy^2 + 10*y*Dy -10; ideal tst = 3*x*Dx + 2*y*Dy + 1, y^3*Dy^2 - x^2*Dy^2 + 6*y^2*Dy + 6*y, 9*y^2*Dx^2*Dy - 4*y*Dy^3 + 27*y*Dx^2 + 2*Dy^2, 9*y^3*Dx^2 - 4*y^2*Dy^2 + 10*y*Dy -10; option(redSB); option(redTail); LD = groebner(LD); } /* DIFFERENT EXAMPLES /* DIFFERENT EXAMPLES //static proc exCusp() */ proc engine(ideal I, int i) proc engine(ideal I, int i) "USAGE:  engine(I,i);  I an ideal, i an int RETURN:  ideal return(J); } example example { "EXAMPLE:"; echo = 2; else { if (inp1 == "ideal") if (inp1 == "ideal") { ERROR("second argument has to be a poly if first argument is an ideal"); ERROR("second argument has to be a poly if first argument is an ideal"); } else { vector f = #[2]; } if (k<=0) { ERROR("third argument has to be positive"); ERROR("third argument has to be positive"); } }
• ## Singular/LIB/elim.lib

 r95edd5 // \$Id: elim.lib,v 1.25 2008-11-13 10:50:17 Singular Exp \$ /////////////////////////////////////////////////////////////////////////////// version="\$Id: elim.lib,v 1.25 2008-11-13 10:50:17 Singular Exp \$"; // \$Id: elim.lib,v 1.26 2009-01-14 16:07:04 Singular Exp \$ /////////////////////////////////////////////////////////////////////////////// version="\$Id: elim.lib,v 1.26 2009-01-14 16:07:04 Singular Exp \$"; category="Commutative Algebra"; info=" /////////////////////////////////////////////////////////////////////////////// proc elimRing ( poly vars, list #) "USAGE:   elimRing(vars [,w]); vars = product of variables to be eliminated "USAGE:   elimRing(vars [,w]); vars = product of variables to be eliminated (type poly), w = intvec (specifying weights for all variables) RETURN:  a ring, say R, s.t. the monomial ordering of R has 2 blocks. RETURN:  a ring, say R, s.t. the monomial ordering of R has 2 blocks. The first block corresponds to the (given) variables to be eliminated and has ordering dp if these variables have weight all 1; if w is given or if not all variables in vars have weight 1 the ordering is wp(w1) where w1 is the intvec of weights of the variables to be eliminated. The second block corresponds to variables not to be eliminated. @*       If the first variable not to be eliminated is global (i.e. > 1), resp. local (i.e. < 1), the second block has ordering dp, resp. ds, (or wp(w2), resp. ws(w2), where w2 is the intvec of weights of the and has ordering dp if these variables have weight all 1; if w is given or if not all variables in vars have weight 1 the ordering is wp(w1) where w1 is the intvec of weights of the variables to be eliminated. The second block corresponds to variables not to be eliminated. @*       If the first variable not to be eliminated is global (i.e. > 1), resp. local (i.e. < 1), the second block has ordering dp, resp. ds, (or wp(w2), resp. ws(w2), where w2 is the intvec of weights of the variables not to be eliminated). @*       If the basering is a quotient ring P/Q, then R a quotient ring @*       If the basering is a quotient ring P/Q, then R a quotient ring with Q replaced by a standard basis of Q w.r.t. the new ordering (parameters are not touched). (parameters are not touched). NOTE:    The ordering in R is an elimination ordering for the variables appearing in vars. PURPOSE: Prepare a ring for eliminating vars from an ideal/moduel by computing a standard basis in R with a fast monomial ordering. PURPOSE: Prepare a ring for eliminating vars from an ideal/moduel by computing a standard basis in R with a fast monomial ordering. This procedure is used by the procedure elim. EXAMPLE: example elimRing; shows an example { if ( typeof(#[1]) == "intvec" ) { { @w = #[1];              //take the given weights } { if( vars/var(ii)==0 )    //treat variables not to be eliminated { { w2 = w2,@w[ii]; v2 = v2+list(string(var(ii))); } } else else { w1 = w1,@w[ii]; w1 = w1[2..size(w1)]; w2 = w2[2..size(w2)]; w2 = w2[2..size(w2)]; //--- put variables to be eliminated in front: BRlist[2] = v1 + v2; BRlist[2] = v1 + v2; //--- create a block ordering with two blocks and weights: int nblock = size(BRlist[3]);      //number of blocks } def eRing = ring(quotientList(BRlist)); def eRing = ring(quotientList(BRlist)); return (eRing); } intvec w = 1,1,3,4,5; elimRing(yu,w); ring S =  (0,a),(x,y,z,u,v),ws(1,2,3,4,5); minpoly = a2+1; qring T = std(ideal(x+y2+v3,(x+v)^2)); def Q = elimRing(yv); def Q = elimRing(yv); setring Q; Q; } proc elim (id, list #) "USAGE:   elim(id,arg[,\"withWeights\"]);  id ideal/module, arg can be either an intvec vor a product p of variables (type poly) RETURN: ideal/module obtained from id by eliminating either the variables with indices appearing in v or the variables appearing in p. "USAGE:   elim(id,arg[,\"withWeights\"]);  id ideal/module, arg can be either an intvec vor a product p of variables (type poly) RETURN: ideal/module obtained from id by eliminating either the variables with indices appearing in v or the variables appearing in p. Works also in a qring. METHOD: elim uses elimRing to create a ring with block ordering with two blocks where the first block contains the variables to be eliminated blocks where the first block contains the variables to be eliminated and then uses groebner. If the variables in the basering have weights these weights are used in elimRing. @*      If a string \"withWeigts\" as second, optional argument is given, Singular computes weights for the variables to make the input as @*      If a string \"withWeigts\" as second, optional argument is given, Singular computes weights for the variables to make the input as homogeneous as possible. @*      The method is different from that used by eliminate and elim1; in some examples elim can be significantly faster. NOTE:   No special monomial ordering is required, i.e. the ordering can be local or mixed. The result is a SB with respect to the ordering of the second block used by elimRing. E.g. if the first var not to be eliminated is global, resp. local, this ordering is dp, resp. ds (or wp, resp. ws, with the given weights for these variables). If printlevel > 0 the ring for which the output is a SB is shown. NOTE:   No special monomial ordering is required, i.e. the ordering can be local or mixed. The result is a SB with respect to the ordering of the second block used by elimRing. E.g. if the first var not to be eliminated is global, resp. local, this ordering is dp, resp. ds (or wp, resp. ws, with the given weights for these variables). If printlevel > 0 the ring for which the output is a SB is shown. SEE ALSO: eliminate, elim1 EXAMPLE: example elim; shows an example " { { if (size(#) == 0) { //-------------------------------- check input ------------------------------- poly vars; int ii; int ii; if (size(#) > 0) { if ( typeof(#[1]) == "poly" ) { { vars = #[1]; } if ( typeof(#[1]) == "intvec") { { vars=1; for( ii=1; ii<=size(#[1]); ii++ ) { vars=vars*var(#[1][ii]); for( ii=1; ii<=size(#[1]); ii++ ) { vars=vars*var(#[1][ii]); } } { if ( typeof(#[2]) == "string" ) { { if ( #[2] == "withWeights" ) { { intvec @w = weight(id); } id = groebner(id); id = nselect(id,1..size(ringlist(ER)[3][1][2])); if ( pr > 0 ) { if ( pr > 0 ) { "// result is a SB in the following ring:"; ER; ideal i=x-u,y-u2,w-u3,v-x+y3; elim(i,3..4); elim(i,uv); elim(i,uv); int p = printlevel; printlevel = 2;
• ## Singular/LIB/findifs.lib

 r95edd5 /////////////////////////////////////////////////////////////////////////////// version="\$Id: findifs.lib,v 1.3 2009-01-07 16:11:35 Singular Exp \$"; version="\$Id: findifs.lib,v 1.4 2009-01-14 16:07:04 Singular Exp \$"; category="Applications"; info=" AUTHORS: Viktor Levandovskyy,     levandov@risc.uni-linz.ac.at THEORY: We provide the presentation of difference operators in a polynomial, semi-factorized and a nodal form. Running @code{findifs_example();} will show how we generate finite difference schemes of linear PDE's THEORY: We provide the presentation of difference operators in a polynomial, semi-factorized and a nodal form. Running @code{findifs_example();} will show how we generate finite difference schemes of linear PDE's from given approximations. RETURN:  string PURPOSE: converts special characters to TeX in s NOTE: the convention is the following: 'Tx' goes to 'T_x', NOTE: the convention is the following: 'Tx' goes to 'T_x', 'dx' to '\\tri x' (the same for dt, dy, dz), 'theta', 'ro', 'A', 'V' are converted to greek letters. RETURN:  string PURPOSE: replaces in 's' all the substrings 'what' with substring 'with' NOTE: NOTE: EXAMPLE: example replace; shows examples "{ if ( (sout[i]=="+") || (sout[i]=="-") ) { NisPoly = 1; NisPoly = 1; } } " ideal I = decoef(p,dt);"; " difpoly2tex(I,L);"; difpoly2tex(I,L); // the nodal form of the scheme in TeX difpoly2tex(I,L); // the nodal form of the scheme in TeX "* Preparations for the semi-factorized form: "; poly pi1 = subst(I[2],B,0);
• ## Singular/LIB/freegb.lib

 r95edd5 ////////////////////////////////////////////////////////////////////////////// version="\$Id: freegb.lib,v 1.14 2009-01-14 15:48:37 Singular Exp \$"; version="\$Id: freegb.lib,v 1.15 2009-01-14 16:07:04 Singular Exp \$"; category="Noncommutative"; info=" freegbasis(L, int n);   compute two-sided Groebner basis of ideal, encoded via L, up to degree n AUXILIARY PROCEDURES: AUXILIARY PROCEDURES: lp2lstr(K, s);      convert letter-place ideal to a list of modules "USAGE:  isVar(p);  poly p RETURN:  int PURPOSE: checks whether p is a power of a single variable from the basering. PURPOSE: checks whether p is a power of a single variable from the basering. @* Returns the exponent or 0 is p is not a power of  a single variable. EXAMPLE: example isVar; shows examples } /* EXAMPLES: /* EXAMPLES: //static proc ex_shift() } // END COMMENTED EXAMPLES // END COMMENTED EXAMPLES */ // Adem rels modulo 2 are interesting //static //static proc stringpoly2lplace(string s) { } //static //static proc sent2lplace(string s) { { "EXAMPLE:"; echo = 2; intmat A[3][3] = intmat A[3][3] = 2, -1, 0, -1, 2, -3, } /* EXAMPLES AGAIN: /* EXAMPLES AGAIN: //static proc get_ls3nilp() {
• ## Singular/LIB/general.lib

 r95edd5 //eric, added absValue 11.04.2002 /////////////////////////////////////////////////////////////////////////////// version="\$Id: general.lib,v 1.58 2008-12-12 11:26:34 Singular Exp \$"; version="\$Id: general.lib,v 1.59 2009-01-14 16:07:04 Singular Exp \$"; category="General purpose"; info=" binomial(200,100);"";                 //type bigint int n,k = 200,100; bigint b1 = binomial(n,k); bigint b1 = binomial(n,k); ring r = 0,x,dp; poly b2 = coeffs((x+1)^n,x)[k+1,1];  //coefficient of x^k in (x+1)^n def watchdog_rneu=basering; setring rsave; if (!defined(result)) { def result=fetch(watchdog_rneu,result); } if (!defined(result)) { def result=fetch(watchdog_rneu,result); } } if(defined(watchdog_interrupt))
• ## Singular/LIB/jacobson.lib

 r95edd5 ////////////////////////////////////////////////////////////////////////////// version="\$Id: jacobson.lib,v 1.7 2009-01-07 16:11:37 Singular Exp \$"; version="\$Id: jacobson.lib,v 1.8 2009-01-14 16:07:04 Singular Exp \$"; category="System and Control Theory"; info=" AUTHOR: Kristina Schindelar,     Kristina.Schindelar@math.rwth-aachen.de THEORY: We work over a ring R, that is a principal ideal domain. THEORY: We work over a ring R, that is a principal ideal domain. @*   If R is commutative, we suppose R to be a polynomial ring in one variable. @* If R is non-commutative, we suppose R to be in two variables, say x and d. @* If R is non-commutative, we suppose R to be in two variables, say x and d. @* We treat then the basering as principal ideal ring with d a polynomial @* variable and x an invertible one. That is, we work in the Ore localization of R @* with respect to the mult. closed set S = K[x] without 0. @* variable and x an invertible one. That is, we work in the Ore localization of R @* with respect to the mult. closed set S = K[x] without 0. @* Note, that in computations no division by x will actually happen. @*   Given a rectangular matrix M over R, one can compute unimodular (that is invertible) @* square matrices U and V, such that U*M*V=D is a diagonal matrix. @*   Given a rectangular matrix M over R, one can compute unimodular (that is invertible) @* square matrices U and V, such that U*M*V=D is a diagonal matrix. @*   Depending on the ring, the diagonal entries of D have certain properties. REFERENCES: REFERENCES: @* N. Jacobson, 'The theory of rings', AMS, 1943. @* Manuel Avelino Insua Hermo, 'Varias perspectives sobre las bases de Groebner: Forma normal de Smith, Algorithme de Berlekamp y algebras de Leibniz'. PhD thesis, Universidad de Santiago de Compostela, 2005. "USAGE: smith(M[, eng1, eng2]);  M matrix, eng1 and eng2 are optional integers RETURN: matrix or list ASSUME: The current ring is assumed to be the commutative polynomial ring in ASSUME: The current ring is assumed to be the commutative polynomial ring in one variable PURPOSE: compute the Smith Normal Form of M with transformation matrices (optionally) NOTE: If the optional integer eng1 is non-zero, returns the list {U,D,V}, NOTE: If the optional integer eng1 is non-zero, returns the list {U,D,V}, where U*M*V = D and the diagonal field entries of D are not normalized. @*    Otherwise only the matrix D, that is the Smith Normal Form of M, is returned. EXAMPLE: example smith; shows examples " { { def R = basering; // check assume: R must be a polynomial ring in 1 variable { BASIS=#[2]; } } else{BASIS=0;} int ROW=ncols(MA); if(eng==1) { list rueckLI=diagonal_with_trafo(R,MA,BASIS); list rueckLI=diagonal_with_trafo(R,MA,BASIS); list rueckLII=divisibility(rueckLI[2]); matrix CON=divideByContent(rueckLII[2]); else { matrix rueckm=diagonal_without_trafo(R,MA,BASIS); matrix rueckm=diagonal_without_trafo(R,MA,BASIS); list rueckL=divisibility(rueckm); matrix CON=divideByContent(rueckm); if(k==0){adrow++;} } m=transpose(m); for(i=1;i<=adrow;i++){m=m,0;} int s,st,p,ff; module LT,TSTD; module STD=transpose(m); matrix END; matrix ENDSTD; matrix STDFIN; STDFIN=STD; matrix STDFIN; STDFIN=STD; list COMPARE=STDFIN; { STD_EX=EXL,transpose(STD); } else } else { STD_EX=EXR,transpose(STD); } dbprint(ppl,"Computing Groebner basis: start"); dbprint(ppl-1,STD); dbprint(ppl,"Computing Groebner basis: start"); dbprint(ppl-1,STD); STD=engine(STD,BASIS); dbprint(ppl,"Computing Groebner basis: finished"); dbprint(ppl-1,STD); dbprint(ppl,"Computing Groebner basis: finished"); dbprint(ppl-1,STD); if(flag mod 2==1){s=ROW; st=COL;}else{s=COL; st=ROW;} dbprint(ppl,"Computing Groebner basis for transformation matrix: start"); dbprint(ppl-1,STD_EX); dbprint(ppl,"Computing Groebner basis for transformation matrix: start"); dbprint(ppl-1,STD_EX); STD_EX=transpose(STD_EX); STD_EX=engine(STD_EX,BASIS); dbprint(ppl,"Computing Groebner basis for transformation matrix: finished"); dbprint(ppl-1,STD_EX); dbprint(ppl,"Computing Groebner basis for transformation matrix: finished"); dbprint(ppl-1,STD_EX); //////// split STD_EX in STD and the transformation matrix ////////////////////// compute the transformation matrices if (flag mod 2 ==1) { { TrafoL=transpose(LT)*TrafoL; } else { else { TrafoR=TrafoR*LT; } STDFIN=STD; STDFIN=STD; /////////////////////////////////// check if the D-th row is finished /////////////////////////////////// COMPARE=insert(COMPARE,STDFIN); if(size(COMPARE)>=3) { if(size(COMPARE)>=3) { if(STD==COMPARE[3]){finish=1;} } if (flag mod 2!=0) { STD=transpose(STD); } //zero colums to the end matrix STDMM=STD; for(i=1; i<=ncols(STDMM); i++) { ff=0; ff=0; for(j=1; j<=nrows(STDMM); j++) { int fehlposc=fehlpos; module SORT; for(i=1; i<=fehlpos; i++) for(i=1; i<=fehlpos; i++) { SORT=gen(2); for (j=3;j<=ROW;j++) { { SORT=SORT,gen(j); } fehlpos=0; while( size(transpose(STD))+fehlpos-ncols(STDMM) < 0) { { for(i=1; i<=ncols(STDMM); i++) { int fehlposr=fehlpos; for(i=1; i<=fehlpos; i++) for(i=1; i<=fehlpos; i++) { SORT=gen(2); TrafoL=SORT*TrafoL; } setring R; map MAPinv=r,var(1); matrix STDM=STD; //Test //Test if(TrafoLM*m*TrafoRM!=STDM){ return(0); } list RUECK=TrafoRM; RUECK=insert(RUECK,STDM); for(j=i+1; j<=Sort; j++) { GCDL=UNITL; GCDR=UNITR; G=gcd(STDM[i,i],STDM[j,j]); ideal Z=STDM[i,i],STDM[j,j]; matrix T=lift(Z,G); GCDL[i,i]=T[1,1]; GCDL[i,j]=T[2,1]; GCDL[j,i]=-STDM[j,j]/G; GCDL[j,j]=STDM[i,i]/G; GCDR[i,j]=T[2,1]*STDM[j,j]/G; GCDR[j,j]=T[2,1]*STDM[j,j]/G-1; GCDR[j,i]=1; STDM=GCDL*STDM*GCDR; TrafoLM=GCDL*TrafoLM; TrafoRM=TrafoRM*GCDR; GCDL=UNITL; GCDR=UNITR; G=gcd(STDM[i,i],STDM[j,j]); ideal Z=STDM[i,i],STDM[j,j]; matrix T=lift(Z,G); GCDL[i,i]=T[1,1]; GCDL[i,j]=T[2,1]; GCDL[j,i]=-STDM[j,j]/G; GCDL[j,j]=STDM[i,i]/G; GCDR[i,j]=T[2,1]*STDM[j,j]/G; GCDR[j,j]=T[2,1]*STDM[j,j]/G-1; GCDR[j,i]=1; STDM=GCDL*STDM*GCDR; TrafoLM=GCDL*TrafoLM; TrafoRM=TrafoRM*GCDR; } } static proc diagonal_without_trafo( R, matrix MA, int B) { int ppl = printlevel-voice+2; int ppl = printlevel-voice+2; int BASIS=B; int finish=0; matrix STDFIN; STDFIN=STD; STDFIN=STD; list COMPARE=STDFIN; dbprint(ppl,"Computing Groebner basis: finished"); dbprint(ppl-1,STD); STDFIN=STD; STDFIN=STD; /////////////////////////////////// check if the D-th row is finished /////////////////////////////////// COMPARE=insert(COMPARE,STDFIN); if(size(COMPARE)>=3) { if(size(COMPARE)>=3) { if(STD==COMPARE[3]){finish=1;} } ////////////////////////////////// change to the opposite module TSTD=transpose(STD); STD=TSTD; flag++; } ////////////////////////////////// change to the opposite module TSTD=transpose(STD); STD=TSTD; flag++; dbprint(ppl,"Finished one while cycle"); } for(i=1; i<=ncols(STDMM); i++) { ff=0; ff=0; for(j=1; j<=nrows(STDMM); j++) { int fehlposc=fehlpos; module SORT; for(i=1; i<=fehlpos; i++) for(i=1; i<=fehlpos; i++) { SORT=gen(2); for (j=3;j<=ROW;j++) { { SORT=SORT,gen(j); } fehlpos=0; while( size(transpose(STD))+fehlpos-ncols(STDMM) < 0) { { for(i=1; i<=ncols(STDMM); i++) { int fehlposr=fehlpos; for(i=1; i<=fehlpos; i++) for(i=1; i<=fehlpos; i++) { SORT=gen(2); STD=SORT*STD; } //add zero rows or columns proc jacobson(matrix MA, list #) "USAGE:  jacobson(M, eng);  M matrix, eng an optional int RETURN: list RETURN: list ASSUME: Basering is a noncommutative ring in two variables. PURPOSE: compute a weak Jacobson Normal Form of M over a noncommutative ring EXAMPLE: example jacobson; shows examples " { { def R = basering; // check assume: R must be a polynomial ring in 2 variables def r=ring(RINGLIST); setring r; //fix the required ordering map MAP=R,var(1),var(2); module m=TRIANGLE[2]; //back to the ring //back to the ring setring R; map MAPR=r,var(1),var(2); module TR=MAPR(TrafoR); matrix CON=divideByContent(MAA); list RUECK=CON*TL, CON*MAA, TR; return(RUECK); } example { { "EXAMPLE:"; echo = 2; ring r = 0,(x,d),Dp; def R2 = nc_algebra(1,s);   setring R2; // the 1st shift algebra matrix m[2][2] = s,x,0,s; print(m); // matrix of the same for as above list J = jacobson(m); list J = jacobson(m); print(J[2]); // a Jacobson Form D, quite different from above print(J[1]*m*J[3] - J[2]); // check that U*M*V = D static proc triangle( matrix MA, int B) { int ppl = printlevel-voice+2; int ppl = printlevel-voice+2; map inv=ncdetection(); module STD_EX,LT,TSTD, L, Trafo; module STD=transpose(m); int finish=0; dbprint(ppl-1,STD); if(flag mod 2==1){s=ROW; st=COL;}else{s=COL; st=ROW;} STD_EX=transpose(STD_EX); dbprint(ppl,"Computing Groebner basis for transformation matrix: start"); COM_EX=1; for(i=2; i<=size(STD); i++) { COM=COM[1..size(COM)],i; COM_EX=COM_EX[1..size(COM_EX)],i; } nz=size(STD_EX)-size(STD); //zero rows in the begining { COM=COM[1..size(COM)],i; COM_EX=COM_EX[1..size(COM_EX)],i; } nz=size(STD_EX)-size(STD); //zero rows in the begining if(size(STD)!=size(STD_EX) ) COM_EX=0,COM_EX[1..size(COM_EX)]; } } } for(i=nz+1; i<=size(STD_EX); i++ ) {if( leadcoef(STD[i-nz])!=leadcoef(STD_EX[i]) )   {STD[i-nz]=leadcoef(STD_EX[i])*STD[i-nz];} } //assign the zero rows in STD_EX {if( leadcoef(STD[i-nz])!=leadcoef(STD_EX[i]) )          {STD[i-nz]=leadcoef(STD_EX[i])*STD[i-nz];} } //assign the zero rows in STD_EX for (j=2; j<=nz; j++) { p=0; p=0; i=1; while(STD_EX[j-1][i]==0){i++;}; if (k==p){ COM_EX[j]=-1; } } //assign the zero rows in STD for (j=2; j<=size(STD); j++) { i=size(transpose(STD)); i=size(transpose(STD)); while(STD[j-1][i]==0){i--;} p=i; if(COM[j]<0){COM=delete(COM,j);} } for(i=1; i<=size(COM_EX); i++) {ff=0; LT=L[1]; for(i=2; i<=s+st; i++) { ////////////////////// compute the transformation matrices if (flag mod 2 ==1) { { TrafoL=transpose(LT)*TrafoL; } else { else { TrafoR=TrafoR*involution(LT,inv); } ///////////////////////// check whether the alg termined ///////////////// if(size(COMPARE)>=3) { { if(STD==COMPARE[3]){finish=1;} } } ////////////////////////////////// change to the opposite module TSTD=transpose(STD); } if (flag mod 2 ==0){ STD = involution(STD,inv);} else { STD = transpose(STD);  } if (flag mod 2 ==0){ STD = involution(STD,inv);} else { STD = transpose(STD);  } list REVERSE=TrafoL,STD,TrafoR; return(REVERSE); if(leadcoef(M[i])!=0){CON=CON+leadcoef(M[i])*gen(k); k++;} } poly con=content(CON); poly con=content(CON); matrix TL=1/con*freemodule(nrows(M)); return(TL); //static proc Ex_One_wheeled_bicycle() { { ring RA=(0,m), D, lp; matrix bicycle[2][3]=(1+m)*D^2, D^2, 1, D^2, D^2-1, 0; //static proc Ex_RLC-circuit() //static proc Ex_RLC-circuit() { ring RA=(0,m,R1,R2,L,C), D, lp; /* //static proc Ex_compare_output_with_maple_package_JanetOre() { //static proc Ex_compare_output_with_maple_package_JanetOre() { ring w = 0,(x,d),Dp; def W=nc_algebra(1,1); setring W; matrix m[3][3]=[d2,d+1,0],[d+1,0,d3-x2*d],[2d+1, d3+d2, d2]; matrix m[3][3]=[d2,d+1,0],[d+1,0,d3-x2*d],[2d+1, d3+d2, d2]; list J=jacobson(m,0); print(J[1]*m*J[3]); print(J[1]*m*J[3]); print(J[2]); print(J[1]); def W=nc_algebra(1,s); setring W; matrix m[3][3]=[s^2,s+1,0],[s+1,0,s^3-x^2*s],[2*s+1, s^3+s^2, s^2]; matrix m[3][3]=[s^2,s+1,0],[s+1,0,s^3-x^2*s],[2*s+1, s^3+s^2, s^2]; list J=jacobson(m,0); print(J[1]*m*J[3]); print(J[1]*m*J[3]); print(J[2]); print(J[1]); //static proc Ex_cyclic() { { ring w = 0,(x,d),Dp; def W=nc_algebra(1,1); matrix m[3][3]=d,0,0,x*d+1,d,0,0,x*d,d; list J=jacobson(m,0); print(J[1]*m*J[3]); print(J[1]*m*J[3]); print(J[2]); print(J[1]); matrix m[3][3]=s,0,0,x*s+1,s,0,0,x*s,s; list J=jacobson(m,0); print(J[1]*m*J[3]); print(J[1]*m*J[3]); print(J[2]); print(J[1]); matrix m[3][3]=s,0,0,x*s+s,s,0,0,x*s,s; list J=jacobson(m,0); print(J[1]*m*J[3]); print(J[1]*m*J[3]); print(J[2]); print(J[1]);
• ## Singular/LIB/latex.lib

 r95edd5 /////////////////////////////////////////////////////////////////////////////// version="\$Id: latex.lib,v 1.29 2007-06-20 22:30:41 levandov Exp \$"; version="\$Id: latex.lib,v 1.30 2009-01-14 16:07:05 Singular Exp \$"; category="Visualization"; info=" if (size(#)==1) { if (typeof(#[1])=="int" or typeof(#[1])=="intvec" or typeof(#[1])=="vector" or typeof(#[1])=="number" or typeof(#[1])=="bigint" or defined(TeXaligned)) { DA = D; DE = D; } or typeof(#[1])=="number" or typeof(#[1])=="bigint" or defined(TeXaligned)) { DA = D; DE = D; } } else {s = s + obj + newline;} } if (typeof(obj) == "int" or typeof(#[1])=="bigint") if (typeof(obj) == "int" or typeof(#[1])=="bigint") { s = s + "  " + string(obj) + "  ";} //if(defined(TeXreplace)){ short =0;}   // hier ueberfluessig 31.5.07 if (short) { j = 0;  // 31.5.07 { j = 0;  // 31.5.07 while(s[i]<>"!") { b=i; if (s[i]=="+" or s[i]=="-") {j++;}  // 31.5.07
• ## Singular/LIB/matrix.lib

 r95edd5 /////////////////////////////////////////////////////////////////////////////// version="\$Id: matrix.lib,v 1.45 2008-12-08 14:31:46 motsak Exp \$"; version="\$Id: matrix.lib,v 1.46 2009-01-14 16:07:05 Singular Exp \$"; category="Linear Algebra"; info=" rowred(A[,any]);       reduction of matrix A with elementary row-operations colred(A[,any]);       reduction of matrix A with elementary col-operations linear_relations(E);   find linear relations between homogeneous vectors linear_relations(E);   find linear relations between homogeneous vectors rm_unitrow(A);         remove unit rows and associated columns of A rm_unitcol(A);         remove unit columns and associated rows of A exteriorBasis(n,k[,s]); basis of k-th exterior power of n-dim v.space symmetricPower(A,k);   k-th symmetric power of a module/matrix A exteriorPower(A,k);    k-th exterior power of a module/matrix A exteriorPower(A,k);    k-th exterior power of a module/matrix A (parameters in square brackets [] are optional) "; "USAGE:   linear_relations(M); M: a module ASSUME:  All non-zero entries of M are homogeneous polynomials of the same positife degree. The base field must be an exact field (not real ASSUME:  All non-zero entries of M are homogeneous polynomials of the same positife degree. The base field must be an exact field (not real or complex). It is not checked whether these assumptions hold. pmat(REL); pmat(M*REL); } } ////////////////////////////////////////////////////////////////////////////// proc symmetricBasis(int n, int k, list #) "USAGE:    symmetricBasis(n, k[,s]); n int, k int, s string RETURN:   ring, poynomial ring containing the ideal \"symBasis\", RETURN:   ring, poynomial ring containing the ideal \"symBasis\", being a basis of the k-th symmetric power of an n-dim vector space. NOTE:     The output polynomial ring has characteristics 0 and n variables NOTE:     The output polynomial ring has characteristics 0 and n variables named \"S(i)\", where the base variable name S is either given by the optional string argument(which must not contain brackets) or equal to if( (find(S, "(") + find(S, ")")) > 0 ) { ERROR("Wrong optional argument: must be a string without brackets"); ERROR("Wrong optional argument: must be a string without brackets"); } } // basis of the 3-rd symmetricPower of a 4-dim vector space: def R = symmetricBasis(4, 3, "@e"); setring R; def R = symmetricBasis(4, 3, "@e"); setring R; R;  // container ring: symBasis; // symmetric basis: proc exteriorBasis(int n, int k, list #) "USAGE:    exteriorBasis(n, k[,s]); n int, k int, s string RETURN:   qring, an exterior algebra containing the ideal \"extBasis\", RETURN:   qring, an exterior algebra containing the ideal \"extBasis\", being a basis of the k-th exterior power of an n-dim vector space. NOTE:     The output polynomial ring has characteristics 0 and n variables NOTE:     The output polynomial ring has characteristics 0 and n variables named \"S(i)\", where the base variable name S is either given by the optional string argument(which must not contain brackets) or equal to if( (find(S, "(") + find(S, ")")) > 0 ) { ERROR("Wrong optional argument: must be a string without brackets"); ERROR("Wrong optional argument: must be a string without brackets"); } } { "EXAMPLE:"; echo = 2; // basis of the 3-rd symmetricPower of a 4-dim vector space: def r = exteriorBasis(4, 3, "@e"); setring r; def r = exteriorBasis(4, 3, "@e"); setring r; r; // container ring: extBasis; // exterior basis: rings Tn is source- and Tm is image-ring with bases resp. Ink and Imk. M = max dim of Image, N - dim. of source M = max dim of Image, N - dim. of source SEE ALSO: symmetricPower, exteriorPower" { //------------------------- compute matrix of single images ------------------ def Rm = save + Tm;  setring Rm; def Rm = save + Tm;  setring Rm; dbprint(p-2, "Temporary Working Ring", Rm); //------------------------- compute image --------------------- // apply S^k(A): Tn -> Rm  to Source basis vectors Ink: map TMap = Tn, B; ideal C = NF(TMap(Ink), std(0)); map TMap = Tn, B; ideal C = NF(TMap(Ink), std(0)); dbprint(p-1, "Image Matrix: ", C); "USAGE:    symmetricPower(A, k); A module, k int RETURN:   module: the k-th symmetric power of A NOTE:     the chosen bases and most of intermediate data will be shown if NOTE:     the chosen bases and most of intermediate data will be shown if printlevel is big enough SEE ALSO: exteriorPower //------------------------- compute and return S^k(A) in chosen bases -- setring save; setring save; return(mapPower(p, A, k, Tn, Tm)); "USAGE:    exteriorPower(A, k); A module, k int RETURN:   module: the k-th exterior power of A NOTE:     the chosen bases and most of intermediate data will be shown if NOTE:     the chosen bases and most of intermediate data will be shown if printlevel is big enough. Last rows will be invisible if zero. SEE ALSO: symmetricPower example { "EXAMPLE:"; echo = 2; ring r = (0),(a, b, c, d, e, f), dp; ring r = (0),(a, b, c, d, e, f), dp; r; "base ring:"; module B = a*gen(1) + c*gen(2) + e*gen(3), b*gen(1) + d*gen(2) + f*gen(3), module B = a*gen(1) + c*gen(2) + e*gen(3), b*gen(1) + d*gen(2) + f*gen(3), e*gen(1) + f*gen(3); print(B); print(exteriorPower(B, 2)); print(exteriorPower(B, 3)); print(exteriorPower(B, 2)); print(exteriorPower(B, 3)); def g = SuperCommutative(); setring g; g; print(exteriorPower(A, 2)); module B = a*gen(1) + c*gen(2) + e*gen(3), b*gen(1) + d*gen(2) + f*gen(3), module B = a*gen(1) + c*gen(2) + e*gen(3), b*gen(1) + d*gen(2) + f*gen(3), e*gen(1) + f*gen(3); print(B);
• ## Singular/LIB/nchomolog.lib

 r95edd5 version="\$Id: nchomolog.lib,v 1.8 2008-08-07 21:15:02 levandov Exp \$"; version="\$Id: nchomolog.lib,v 1.9 2009-01-14 16:07:05 Singular Exp \$"; category="Noncommutative"; info=" ring A=0,(x,t,dx,dt),dp; def W = Weyl(); setring W; matrix M[2][2] = matrix M[2][2] = dt,  dx, t*dx,x*dt; "{ if (i==0) { { return(ncHom_R(Ps)); // the rest is not needed } // assumed to be basering // returns the difference between M and Ext^n_D(Ext^n_D(M,D),D) def save = basering; def save = basering; setring save; module Md = ncExt_R(n,M); // right module ring R   = 0,(x,y),dp; poly F   = x3-y2; def A    = annfs(F); def A    = annfs(F); setring A; dmodualtest(LD,2); proc dmodoublext(module M, list #) "USAGE:   dmodoublext(M [,i]);  M module, i optional int "USAGE:   dmodoublext(M [,i]);  M module, i optional int COMPUTE:  a presentation of Ext^i(Ext^i(M,D),D); for basering D RETURN:   left module { // assume: basering is a Weyl algebra? def save = basering; def save = basering; setring save; // if a list is nonempty and contains an integer N, n = N; otherwise n = nvars/2 n = nvars(save); n = n div 2; } // returns Ext^i_D(Ext^i_D(M,D),D), that is // returns Ext^i_D(Ext^i_D(M,D),D), that is // computes the "dual" of the "dual" of a d-mod M (for n = nvars/2) module Md = ncExt_R(n,M); // right module ring R   = 0,(x,y),dp; poly F   = x3-y2; def A    = annfs(F); def A    = annfs(F); setring A; dmodoublext(LD);
• ## Singular/LIB/nctools.lib

 r95edd5 /////////////////////////////////////////////////////////////////////////////// version="\$Id: nctools.lib,v 1.39 2008-04-23 14:06:10 motsak Exp \$"; version="\$Id: nctools.lib,v 1.40 2009-01-14 16:07:05 Singular Exp \$"; category="Noncommutative"; info=" execute (newringstring); def lnewring=imap(r,lr); return( nc_algebra(lnewring[1],lnewring[2]) ); return( nc_algebra(lnewring[1],lnewring[2]) ); } else D[1,3]=2*x; D[2,3]=-2*y; def S = nc_algebra(1,D); setring S; def S = nc_algebra(1,D); setring S; S; // this is U(sl_2) poly c = 4*x*y+z^2-2*z; matrix D[3][3]; D[1,2]=x; D[1,3]=z; def S = nc_algebra(C,D); setring S; def S = nc_algebra(C,D); setring S; S; ideal j=ndcond(); // the silent version "EXAMPLE:";echo=2; ring A1=0,(x(1..2),d(1..2)),dp; def S=Weyl(); def S=Weyl(); setring S;  S; kill A1,S; RETURN:  qring PURPOSE:  create the super-commutative algebra (as a GR-algebra) 'over' a basering, NOTE: activate this qring with the \"setring\" command. NOTE: activate this qring with the \"setring\" command. NOTE: if b==e then the resulting ring is commutative unles 'flag' is given and non-zero. THEORY: given a basering, this procedure introduces the anticommutative relations x(j)x(i)=-x(i)x(j) for all e>=j>i>=b, // NOTE: as a side effect the basering will be changed (if not in a commutative case) to bo the ground G-algebra (without factor). int fprot = (find(option(),"prot") != 0); string rname=nameof(basering); if ( rname == "basering") // i.e. no ring has been set yet { def saveRing = basering; int N = nvars(saveRing); int b = 1; int e = N; int flag = 0; ideal Q = 0; ERROR("The argument 'b' must be an integer!"); return(); } } b = #[1]; ERROR("The argument 'b' must within [1..nvars(basering)]!"); return(); } } } return(); } if(e < b) { Q = #[3]; } if(size(#)>3) { } int iSavedDegBoung = degBound; int iSavedDegBoung = degBound; if( (b == e) && (flag == 0) ) // commutative ring!!! print("Warning: (b==e) means that the resulting ring will be commutative!"); } degBound=0; Q = std(Q + (var(b)^2)); degBound = iSavedDegBoung; qring @EA = Q; // and it will be internally commutative as well!!! return(@EA); return(@EA); } /* // Singular'(H.S.) politics: no ring copies! // Singular'(H.S.) politics: no ring copies! // in future nc_algebra() should return a new ring!!! list CurrRing = ringlist(basering); print("Warning: (char == 2) means that the resulting ring will be commutative!"); } int j = ncols(Q) + 1; for ( int i=e; i>=b; i--, j++ ) { Q[j] = var(i)^2; } degBound=0; degBound=0; Q = std(Q); degBound = iSavedDegBoung; qring @EA = Q; // and it will be internally commutative as well!!! return(@EA); } return(@EA); } int i, j; if( (b == 1) && (e == N) ) // just an exterior algebra? { { def S = nc_algebra(-1, 0); // define ground G-algebra! setring S; setring S; } else { matrix @E = UpOneMatrix(N); for ( i = b; i < e; i++ ) { ideal @Q = fetch(saveRing, Q); j = ncols(@Q) + 1; } degBound=0; degBound=0; @Q = twostd(@Q); // must be computed within the ground G-algebra => problems with local orderings! degBound = iSavedDegBoung; qring @EA = @Q; return("SCA rings are factors by (at least) squares!"); // no squares in the factor ideal! } list L = ringlist(saveRing); { if( (fprot == 1) and (i > 1) ) { { print("Warning: the SCA representation of the current commutative factor ring may be ambiguous!"); } return( list(i, i) ); // this is not unique in this case! there may be other squares in the factor ideal! } } } return("The current commutative ring is not SCA! (Wrong quotient ideal)"); // no squares in the factor ideal! if(i < b) { b = i; b = i; } if(j > e) { e = j; e = j; } } else { if( (fprot == 1) and (i > 1) ) { { print("Warning: the SCA representation of the current factor ring may be ambiguous!"); } return( list(i, i) ); // this is not unique in this case! there may be other squares in the factor ideal! } def S = nc_algebra(E,0); setring S; S; if(IsSCA()) { "Alternating variables: [", AltVarStart(), ",", AltVarEnd(), "]."; }