Changeset 0fbdd1 in git


Ignore:
Timestamp:
Sep 12, 1997, 9:40:37 AM (27 years ago)
Author:
Hans Schönemann <hannes@…>
Branches:
(u'spielwiese', '17f1d200f27c5bd38f5dfc6e8a0879242279d1d8')
Children:
3ca4229c4e4d8d84ca999ef93aec635eb84259c6
Parents:
4a81eccd72975057d29a44244958cdc9a450eb71
Message:
* hannes/greuel: all.lib: update
                 homolog.lib: changed printing
                 inout.lib: added showrec, changed show
                 ring.lib: added substitute,copyring,swapvars,extendring1
                 sing.lib: changed spectrum, T1, codim
                 standard.lib: changed help


git-svn-id: file:///usr/local/Singular/svn/trunk@709 2c84dea3-7e68-4137-9b89-c4e89433aadc
Location:
Singular/LIB
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • Singular/LIB/all.lib

    r4a81ec r0fbdd1  
    1 // $Id: all.lib,v 1.3 1997-08-14 13:10:47 Singular Exp $
     1// $Id: all.lib,v 1.4 1997-09-12 07:40:33 Singular Exp $
    22///////////////////////////////////////////////////////////////////////////////
    33
    44LIBRARY:  all.lib   Load all libraries
     5         
     6          classify.lib  PROCEDURES FOR THE ARNOLD-CLASSIFIER OF SINGULARITIES 
     7          deform.lib    PROCEDURES FOR COMPUTING MINIVERSAL DEFORMATION
     8          elim.lib      PROCEDURES FOR ELIMINATION, SATURATION AND BLOWING UP
     9          factor.lib    PROCEDURES FOR CALLING EXTERNAL FACTORIZER
     10          finvar.lib    PROCEDURES TO CALCULATE INVARIANT RINGS & MORE
     11          general.lib   PROCEDURES OF GENERAL TYPE
     12          hnoether.lib  PROCEDURES FOR THE HAMBURGER-NOETHER-DEVELOPMENT
     13          homolog.lib   PROCEDURES FOR HOMOLOGICAL ALGEBRA
     14          inout.lib     PROCEDURES FOR MANIPULATING IN- AND OUTPUT
     15          invar.lib     PROCEDURES FOR COMPUTING INVARIANTS OF (C,+)-ACTIONS
     16          matrix.lib    PROCEDURES FOR MATRIX OPERATIONS
     17          poly.lib      PROCEDURES FOR MANIPULATING POLYS, IDEALS, MODULES       
     18          presolve.lib  PROCEDURES FOR PRE-SOLVING POLYNOMIAL EQUATIONS
     19          primdec.lib   PROCEDURES FOR PRIMARY DECOMPOSITION (G/T/Z)
     20          primitiv.lib  PROCEDURES FOR FINDING A PRIMITIVE ELEMENT
     21          prim_dec.lib  PROCEDURES FOR PRIMARY DECOMPOSITION (S/Y)
     22          random.lib    PROCEDURES OF RANDOM MATRIX AND POLY OPERATIONS
     23          ring.lib      PROCEDURES FOR MANIPULATING RINGS AND MAPS
     24          sing.lib      PROCEDURES FOR SINGULARITIES
     25          standard.lib  PROCEDURES WHICH ARE ALWAYS LOADED AT START-UP
     26          tex.lib       PROCEDURES FOR TYPESET OF SINGULAROBJECTS IN TEX
    527
    628///////////////////////////////////////////////////////////////////////////////
    729
     30LIB "classify.lib";
    831LIB "deform.lib";
    932LIB "elim.lib";
    … …  
    1134LIB "finvar.lib";
    1235LIB "general.lib";
     36LIB "hnoether.lib";
    1337LIB "homolog.lib";
    1438LIB "inout.lib";
     39LIB "invar.lib";
    1540LIB "matrix.lib";
    1641LIB "poly.lib";
     42LIB "presolve.lib";
    1743LIB "primdec.lib";
     44LIB "primitiv.lib";
    1845LIB "prim_dec.lib";
    1946LIB "random.lib";
    2047LIB "ring.lib";
    2148LIB "sing.lib";
    22 LIB "hnoether.lib";
     49LIB "tex.lib";
     50LIB "tools.lib";

  • Singular/LIB/homolog.lib

    r4a81ec r0fbdd1  
    1 // $Id: homolog.lib,v 1.3 1997-05-06 13:08:33 Singular Exp $
     1// $Id: homolog.lib,v 1.4 1997-09-12 07:40:34 Singular Exp $
    22//(BM/GMG, last modified 22.06.96)
    33///////////////////////////////////////////////////////////////////////////////
    … …  
    566566                 (if finite dimensional)
    567567DISPLAY: printlevel >=0: degree of Ext^k for each k  (default)
    568          printlevel >=1: Ak, Ak+1 and kbase of Ext^k in Hom(Fk,G0)
     568         printlevel >=1: matrices Ak, Ak+1 and kbase of Ext^k in Hom(Fk,G0)
    569569                            (if finite dimensional)
    570570NOTE:    In order to compute Ext^k(M,N) use the command Ext(k,syz(M),syz(N));
    … …  
    641641        imag  = imag,D;
    642642        extMN = modulo(ker,imag);
    643         dbprint(p-1,"// Computing Ext^"+string(k)+":",
     643        dbprint(p-1,"// Computing Ext^"+string(k)+" (help Ext; gives an explanation):",
    644644         "// Let 0<--coker(M)<--F0<--F1<--F2<--... be a resolution of coker(M),",
    645645         "// and 0<--coker(N)<--G0<--G1 a presentation of coker(N),",

  • Singular/LIB/inout.lib

    r4a81ec r0fbdd1  
    1 // $Id: inout.lib,v 1.2 1997-04-28 19:27:20 obachman Exp $
     1// $Id: inout.lib,v 1.3 1997-09-12 07:40:35 Singular Exp $
    22// system("random",787422842);
    33// (GMG/BM, last modified 22.06.96)
    … …  
    1212 rMacaulay(string);     read Macaulay_1 output and return its Singular format
    1313 show(any);             display any object in a compact format
     14 showrecursive(id,p);   display id recursively with respect to variables in p
    1415 split(string,n);       split given string into lines of length n
    1516 tab(n);                string of n space tabs
    … …  
    333334USAGE:   show(id);   id any object of basering or of type ring/qring
    334335         show(R,s);  R=ring, s=string (s = name of an object belonging to R)
    335 CREATE: display id/s in a compact format together with some information
     336DISPLAY: display id/s in a compact format together with some information
    336337RETURN:  no return value
    337338NOTE:    objects of type string, int, intvec, intmat belong to any ring.
    … …  
    378379   {
    379380      @@s = tab(@li@)+"// list, "+string(size(id))+" element(s):";
    380       @@s;
     381      @@s;"";
    381382      for ( @ii=1; @ii<=size(id); @ii++ )
    382383      {
    … …  
    412413   if( typeof(@id@)=="poly" or typeof(@id@)=="ideal" or typeof(@id@)=="matrix" )
    413414   {
     415      @@s = tab(@li@)+"// "+ typeof(@id@);
    414416      if( typeof(@id@)=="ideal" )
    415417      {
    416          @s@=", "+string(ncols(@id@))+" generator(s)";
     418         @@s=@@s + ", "+string(ncols(@id@))+" generator(s)";
     419         @@s;
     420         print(ideal(@id@));
     421      }
     422      if( typeof(@id@)=="poly" )
     423      {
     424         @@s=@@s + ", "+string(size(@id@))+" monomial(s)";
     425         @@s;
     426         print(poly(@id@));
    417427      }
    418428      if( typeof(@id@)=="matrix")
    419429      {
    420          @s@=", "+string(nrows(@id@))+"x"+string(ncols(@id@));
    421       }
    422       @@s = tab(@li@)+"// "+ typeof(@id@)+ @s@;
    423       @@s;
    424       print(matrix(@id@));
     430         @@s=@@s + ", "+string(nrows(@id@))+"x"+string(ncols(@id@));
     431         @@s;
     432         print(matrix(@id@));
     433      }
    425434      short=@short@; return();
    426435   }
    … …  
    502511///////////////////////////////////////////////////////////////////////////////
    503512
     513proc showrecursive (id,poly p,list #)
     514USAGE:   showrecursive(id,p[ord]); id=any object of basering, p=product of
     515         variables and ord=string (any allowed ordstr)
     516DISPLAY: display 'id' in a recursive format as a polynomial in the variables
     517         occuring in p with coefficients in the remaining variables. Do this
     518         by mapping in a ring with parameters [and ordering 'ord', if a 3rd
     519         argument is present (default: ord="dp")] and applying procedure 'show'
     520RETURN:  no return value
     521EXAMPLE: example showrecursive; shows an example
     522{
     523   def P = basering;
     524   int ii;
     525   string newchar = charstr(P);
     526   string neword = "dp";
     527   if( size(#) == 1 ) { neword = #[1]; }
     528   string newvar;
     529   for( ii=1; ii <= nvars(P); ii++ )
     530   {
     531      if( p/var(ii) == 0 )
     532      {
     533         newchar = newchar + ","+varstr(ii);
     534      }
     535      else
     536      {
     537         newvar = newvar + ","+varstr(ii);
     538      }
     539   }
     540   newvar = newvar[2,size(newvar)-1];
     541   
     542   execute "ring newP=("+newchar+"),("+newvar+"),("+neword+");";
     543   def id = imap(P,id);
     544   show(id);
     545   return();
     546}
     547example
     548{ "EXAMPLE:"; echo=2;
     549   ring r=2,(t(1..15),x,y),ds;
     550   poly f=y+t(15)*x^2+t(14)*x^3+t(13)*x^2*y^2+t(12)*x*y^3;
     551   showrecursive(f,xy);
     552   showrecursive(f,xy,"ds");
     553}
     554///////////////////////////////////////////////////////////////////////////////
     555
    504556proc split (string s, list #)
    505557USAGE:    split(s[,n]); s string, n integer

  • Singular/LIB/ring.lib

    r4a81ec r0fbdd1  
    1 // $Id: ring.lib,v 1.2 1997-04-28 19:27:25 obachman Exp $
     1// $Id: ring.lib,v 1.3 1997-09-12 07:40:36 Singular Exp $
    22//(GMG, last modified 03.11.95)
    33///////////////////////////////////////////////////////////////////////////////
    … …  
    88 changeord("R",o[,r]);  make a copy R of basering [ring r] with new ord o
    99 changevar("R",v[,r]);  make a copy R of basering [ring r] with new vars v
     10 copyring("R"[,r]);     make an exact copy R of basering [ring r]
    1011 defring("R",c,n,v,o);  define a ring R in specified char c, n vars v, ord o
    1112 defrings(n[,p]);       define ring Sn in n vars, char 32003 [p], ord ds
    1213 defringp(n[,p]);       define ring Pn in n vars, char 32003 [p], ord dp
    1314 extendring("R",n,v,o); extend given ring by n vars v, ord o and name it R
     15 extendring1("R",n,v,o); similair to extendring but different ordering
    1416 fetchall(R[,str]);     fetch all objects of ring R to basering
    1517 imapall(R[,str]);      imap all objects of ring R to basering
    1618 mapall(R,i[,str]);     map all objects of ring R via ideal i to basering
    1719 ringtensor("R",s,t,..);create ring R, tensor product of rings s,t,...
    18            (parameters in square brackets [] are optional)
     20 substitute(id,p,list); substitute in id i-th factor of p by i-th poly of list
     21 swapvars(id,p1,p2);    return id with variables p1 and p2 interchanged
     22          (parameters in square brackets [] are optional)
    1923
    2024LIB "inout.lib";
    … …  
    170174///////////////////////////////////////////////////////////////////////////////
    171175
     176proc copyring (string newr,list #)
     177USAGE:   copyring(newr[,r]);  newr=string, r=ring/qring
     178CREATE:  create a new ring with name `newr` and make it the basering if r is
     179         an existing ring [default: r=basering].
     180         The new ring is a copy of r but with a new name R1 if, say, newr="R1"
     181RETURN:  No return value
     182NOTE:    This proc uses 'execute' or calls a procedure using 'execute'.
     183         If you use it in your own proc, let the local names of your proc
     184         start with @ (see the file HelpForProc)
     185EXAMPLE: example copyring; shows an example
     186{
     187   if( size(#)==0 ) { def @r=basering; }
     188   if( size(#)==1 ) { def @r=#[1]; }
     189   string @o=ordstr(@r);
     190   changeord(newr,@o,@r);
     191   keepring(basering);
     192   if (voice==2) { "// basering is now",newr; }
     193   return();
     194}
     195example
     196{  "EXAMPLE:"; echo = 2;
     197   ring r=0,(x,y,u,v),(dp(2),ds);
     198   copyring("R"); R;"";
     199   copyring("R1",r); R1;
     200   kill R,R1;
     201}
     202///////////////////////////////////////////////////////////////////////////////
     203
    172204proc defring (string s1, string s2, int n, string s3, string s4)
    173205USAGE:   defring(s1,s2,n,s3,s4);  s1..s4=strings, n=integer
    … …  
    269301
    270302proc extendring (string na, int n, string va, string o, list #)
    271 USAGE:   extendring(na,n,va,o[iv,i,r]);  na,va,o=strings,
     303USAGE:   extendring(na,n,va,o[,i,r]);  na,va,o=strings (name, new vars,
     304         ordering of the new ring),  n,i=integers, r=ring
     305CREATE:  Define a ring with name `na` which extends the ring r by adding n new
     306         variables in front of [after, if i!=0] the old variables and make it
     307         the basering [default: (i,r)=(0,basering)]
     308         -- The characteristic is the characteristic of r
     309         -- The new vars are derived from va. If va is a single letter, say
     310            va="T", and if n<=26 then T and the following n-1 letters from
     311            T..Z..T (resp. T(1..n) if n>26) are taken as additional variables.
     312            If va is a single letter followed by (, say va="x(", the new
     313            variables are x(1),...,x(n).
     314            If va is a string that contains a comma (e.g. "x,z,u,w"), the
     315            comma-separated symbols are taken as new variables
     316         -- The ordering is the ordering given by `o` [any allowed ordstr]
     317RETURN:  No return value
     318NOTE:    This proc is useful for adding deformation parameters.
     319         This proc uses 'execute' or calls a procedure using 'execute'.
     320         If you use it in your own proc, let the local names of your proc
     321         start with @ (see the file HelpForProc)
     322EXAMPLE: example extendring; shows an example
     323{
     324//--------------- initialization and place c/C of ordering properly -----------
     325   string @v,@newring;
     326   int @i;
     327   if( size(#)==0 ) { #[1]=0; def @r=basering; }
     328   else
     329   {
     330     if( size(#)==1 ) { @i=#[1]; def @r=basering; }
     331     if( size(#)==2 ) { @i=#[1]; def @r=#[2]; }
     332   }
     333//------------------------ prepare string of new ring -------------------------
     334   @newring = "ring "+na+"=("+charstr(@r)+"),(";
     335   if( find(va,",") != 0 )       
     336      { @v = va; }
     337   else
     338   {
     339      if( n>26 or va[2]=="(" )
     340         { @v = va[1]+"(1.."+string(n)+")"; }
     341      else                     
     342         { @v = A_Z(va,n); }
     343   }
     344
     345   if( @i==0 )
     346   {
     347      @v=@v+","+varstr(@r);
     348   }
     349   else
     350   {
     351      @v=varstr(@r)+","+@v;
     352   }
     353   @newring=@newring+@v+"),("+o+");";
     354//---------------------------- execute and export -----------------------------
     355   execute(@newring);
     356   export(basering);
     357   keepring(basering);
     358   if (voice==2) { "// basering is now",basering; }
     359   return();
     360}
     361example
     362{ "EXAMPLE:"; echo = 2;
     363   ring r=0,(x,y,z),ds;
     364   show(r);"";
     365   extendring("R0",2,"u","ds");
     366   show(R0); "";
     367   extendring("R1",2,"a,w","ds(2),dp");
     368   show(R1); "";
     369   extendring("R2",5,"b","dp");         
     370   show(R2); "";
     371   extendring("R3",4,"T()","c,dp",1,r);   
     372   show(R3);"";
     373   kill R0,R1,R2,R3;
     374}
     375///////////////////////////////////////////////////////////////////////////////
     376
     377proc extendring1 (string na, int n, string va, string o, list #)
     378USAGE:   extendring1(na,n,va,o[iv,i,r]);  na,va,o=strings,
    272379         n,i=integers, r=ring, iv=intvec of positive integers or iv=0
    273380CREATE:  Define a ring with name `na` which extends the ring r by adding n new
    … …  
    279386            T..Z..T (resp. T(1..n) if n>26) are taken as additional variables.
    280387            If va is a single letter followed by (, say va="x(", the new
    281             variables are x(1),...,x(n)
     388            variables are x(1),...,x(n).
     389            If va is a string that contains a comma (e.g. "x,z,u,w"), the
     390            comma-separated symbols are taken as new variables
    282391         -- The ordering is the product ordering between the ordering of r and
    283392            an ordering derived from `o` [and iv]
    … …  
    288397            like "ds" or "dp(2),wp(1,2,3),Ds(2)" or "ds(a),dp(b),ls" if a and b
    289398            are globally (!) defined integers and if a+b+1<=n
    290             If, however, a and b are local to a proc calling extendring, the
    291             intvec iv must be used to let extendring know the values of a and b
     399            If, however, a and b are local to a proc calling extendring1, the
     400            intvec iv must be used to let extendring1 know the values of a, b
    292401         -  If an intvec iv !=0 is given, iv[1],iv[2],... is taken for the 1st,
    293402            2nd,... block of o, if o contains no substring "w" or "W" i.e. no
    … …  
    304413         If you use it in your own proc, let the local names of your proc
    305414         start with @ (see the file HelpForProc)
    306 EXAMPLE: example extendring; shows an example
     415EXAMPLE: example extendring1; shows an example
    307416{
    308417//--------------- initialization and place c/C of ordering properly -----------
    … …  
    371480//------------------------ prepare string of new ring -------------------------
    372481   @newring = "ring "+na+"=("+charstr(@r)+"),(";
    373    if( n>26 or va[2]=="(" ) { @v = va[1]+"(1.."+string(n)+")"; }
    374    else                     { @v = A_Z(va,n); }
     482   if( find(va,",") != 0 )       
     483      { @v = va; }
     484   else
     485   {
     486      if( n>26 or va[2]=="(" )
     487         { @v = va[1]+"(1.."+string(n)+")"; }
     488      else                     
     489         { @v = A_Z(va,n); }
     490   }
     491
    375492   if( @i==0 )
    376493   {
    … …  
    395512   ring r=0,(x,y,z),ds;
    396513   show(r);"";
     514   extendring1("S",2,"u","ds");
     515   setring r;
     516   show(S); "";
     517   extendring1("R0",2,"a,w","ds");
     518   show(R0); "";
    397519   //no intvec given, no blocksize given: blocksize is derived from no of vars
    398520   int t=5;
    399    extendring("R1",t,"a","dp");         //t global: "dp" -> "dp(5)"
     521   extendring1("R1",t,"a","dp");         //t global: "dp" -> "dp(5)"
    400522   show(R1); "";
    401    extendring("R2",4,"T(","c,dp",1,r);    //"dp" -> "c,..,dp(4)"
     523   extendring1("R2",4,"T(","c,dp",1,r);    //"dp" -> "c,..,dp(4)"
    402524   show(R2);"";
    403525
    404526   //no intvec given, blocksize given: given blocksize is used
    405    extendring("R3",4,"T(","dp(2)",0,r);   // "dp(2)" -> "dp(2)"
     527   extendring1("R3",4,"T(","dp(2)",0,r);   // "dp(2)" -> "dp(2)"
    406528   show(R3);"";
    407529
    … …  
    412534   //ones are ignored
    413535   intvec v=3,2,3,4,1,3;
    414    extendring("R4",10,"A","ds,ws,Dp,dp",v,0,r);
     536   extendring1("R4",10,"A","ds,ws,Dp,dp",v,0,r);
    415537         //v covers 3 blocks: v[1] (=3) : no of components of ws
    416538         //next v[1] values (=v[2..4]) give weights
    417539         //remaining components of v are used for the remaining blocks
    418540   show(R4);
    419    kill r,R1,R2,R3,R4;
     541   kill S,R0,R1,R2,R3,R4;
    420542}
    421543///////////////////////////////////////////////////////////////////////////////
    … …  
    644766}
    645767///////////////////////////////////////////////////////////////////////////////
     768
     769proc substitute (id, vars, list #)
     770USAGE:    substitute(id,vars,li); id = object in basering which can be mapped,
     771          vars = ideal expression which must be a list of variables
     772          (not counting zeroes and costant factors),
     773          li = list of ideal expressions
     774RETURN:   id, with i-th entry of vars substituted by i-th polynomial of the
     775          ideal (say, conli) obtained by concatenatin of the lists in li;
     776          if conli has less polys than size(vars), the last element of conli
     777          substitutes the remaining variables in vars
     778EXAMPLE:  example substitute; shows an example
     779{
     780   int ii,jj,k;
     781   def P = basering;
     782   int n = nvars(P);
     783   ideal va = simplify(vars,3);
     784   int sa = size(va);
     785   ideal all = #[1..size(#)];
     786   int na = ncols(all);
     787   ideal m = maxideal(1);
     788   for( jj=1; jj<=sa; jj++)
     789   {
     790      if( size(va[jj]) > 1)
     791      {
     792         "// object to be substituted must be a variable";
     793         return();
     794      }
     795      for( ii=1; ii<=n; ii++ )
     796      {
     797         if( va[jj]/var(ii) != 0 )
     798         {
     799            if( jj <= na ) { m[ii] = all[jj]; }
     800            else { m[ii] = all[na]; }
     801         }
     802      }
     803   }
     804   map phi = P,m;
     805   return(phi(id));
     806}
     807example
     808{ "EXAMPLE:"; echo=2;
     809   ring r=0,(a,b,t,s,u,v,x,y),ds;
     810   poly f=b+y+ax+sx+vy2+ux;
     811   ideal vars = a,y,b;
     812   ideal subs = t4,1,y+t;
     813   // the following commands all define the substitution:
     814   //        a -> t4, y -> 1, b -> y+t
     815   substitute(f,vars,subs);
     816   substitute(f,vars,t4,1,y+t);
     817   substitute(f,ideal(a)+y+b,t4,1,y+t);
     818   // substitute all variables in vars by 1:
     819   substitute(f,vars,1);
     820   // substitute all variables by 1, except those in vars:
     821   substitute(f,substitute(maxideal(1),vars,0),1);
     822}
     823///////////////////////////////////////////////////////////////////////////////
     824
     825proc swapvars (id,poly p1,poly p2)
     826USAGE:    swapvars(id,p1,p2); id = object in basering which can be mapped
     827          p1,  p2 = variables which shall be interchanged
     828RETURN:   id, with p1 and p2 interchanged
     829EXAMPLE:  example swapvars; shows an example
     830{
     831   def bR = basering;
     832   execute " ring @newR = ("+charstr(bR)+"),("+varstr(bR)+",@t),dp;";
     833   def id = imap(bR,id);
     834   poly p1 = imap(bR,p1);
     835   poly p2 = imap(bR,p2);
     836   id = substitute(id,p2,@t);
     837   id = substitute(id,p1,p2);
     838   id = substitute(id,@t,p1);
     839   setring bR;
     840   id = imap(@newR,id);
     841   return(id);
     842}
     843}
     844example
     845{ "EXAMPLE:"; echo=2;
     846   ring r;
     847   poly f = x5+y3+z2;
     848   swapvars(f,x,y);
     849}
     850///////////////////////////////////////////////////////////////////////////////

  • Singular/LIB/sing.lib

    r4a81ec r0fbdd1  
    1 // $Id: sing.lib,v 1.3 1997-05-01 17:49:56 Singular Exp $
     1// $Id: sing.lib,v 1.4 1997-09-12 07:40:37 Singular Exp $
    22//system("random",787422842);
    33//(GMG/BM, last modified 26.06.96)
    … …  
    66LIBRARY:  sing.lib      PROCEDURES FOR SINGULARITIES
    77
     8 codim (id1, id2);      vector space dimension of of id2/id1 if finite
    89 deform(i);             infinitesimal deformations of ideal i
    910 dim_slocus(i);         dimension of singular locus of ideal i
    … …  
    1617 nf_icis(i);            generic combinations of generators; get ICIS in nf
    1718 slocus(i);             ideal of singular locus of ideal i
     19 spectrum(f,w);         spectrum numbers of w-homogeneous polynomial f
    1820 Tjurina(i);            SB of Tjurina module of ideal i (assume i is ICIS)
    1921 tjurina(i);            Tjurina number of ideal i (assume i is ICIS)
    … …  
    2123 T2((i);                T2-module of ideal i
    2224 T12(i);                T1- and T2-module of ideal i
    23  codim (id1, id2);      codimension of of id2 in id1
    2425
    2526LIB "inout.lib";
    2627LIB "random.lib";
     28///////////////////////////////////////////////////////////////////////////////
     29
     30proc codim (id1, id2)
     31USAGE:   codim(id1,id2); id1,id2 ideal or module
     32ASSUME:  both must be standard bases w.r.t. ordering ds or Ds or homogeneous
     33         and standardbases w.r.t. ordering dp or Dp
     34RETURN:  int, which is:
     35         1. the codimension of id2 in id1, i.e. the vectorspace dimension of
     36            id1/id2 if id2 is contained in id1 and if this number is finite
     37         2. -1 if the dimension of id1/id2 is infinite
     38         3. -2 if id2 is not contained in id1,
     39COMPUTE: consider the two hilberseries iv1(t) and iv2(t), then, in case 1.,
     40         q(t)=(iv2(t)-iv1(t))/(1-t)^n must be rational, and the result is the
     41         sum of the coefficients of q(t) (n number of variables)
     42NOTE:    As always, id1 and id2 must be consider as ideals in the localization
     43         of the polynomial ring w.r.t. the monomial ordering
     44EXAMPLE: example codim; shows an example
     45{
     46   intvec iv1, iv2, iv;
     47   int i, d1, d2, dd, i1, i2, ia, ie;
     48  //--------------------------- check id2 < id1 -------------------------------
     49   ideal led = lead(id1);
     50   attrib(led, "isSB",1);
     51   i = size(NF(lead(id2),led));
     52   if ( i > 0 )
     53   {
     54     return(-2);
     55   }
     56  //--------------------------- 1. check finiteness ---------------------------
     57   i1 = dim(id1);
     58   i2 = dim(id2);
     59   if (i1 < 0)
     60   {
     61     if (i2 == 0)
     62     {
     63       return vdim(id2);
     64     }
     65     else
     66     {
     67       return(-1);
     68     }
     69   }
     70   if (i2 != i1)
     71   {
     72     return(-1);
     73   }
     74   if (i2 <= 0)
     75   {
     76     return(vdim(id2)-vdim(id1));
     77   }
     78  //--------------------------- module ---------------------------------------
     79   d1 = nrows(id1);
     80   d2 = nrows(id2);
     81   dd = 0;
     82   if (d1 > d2)
     83   {
     84     id2=id2,maxideal(1)*gen(d1);
     85     dd = -1;
     86   }
     87   if (d2 > d1)
     88   {
     89     id1=id1,maxideal(1)*gen(d2);
     90     dd = 1;
     91   }
     92  //--------------------------- compute first hilbertseries ------------------
     93   iv1 = hilb(id1,1);
     94   i1 = size(iv1);
     95   iv2 = hilb(id2,1);
     96   i2 = size(iv2);
     97  //--------------------------- difference of hilbertseries ------------------
     98   if (i2 > i1)
     99   {
     100     for ( i=1; i<=i1; i=i+1)
     101     {
     102       iv2[i] = iv2[i]-iv1[i];
     103     }
     104     ie = i2;
     105     iv = iv2;
     106   }
     107   else
     108   {
     109     for ( i=1; i<=i2; i=i+1)
     110     {
     111       iv1[i] = iv2[i]-iv1[i];
     112     }
     113     iv = iv1;
     114     for (ie=i1;ie>=0;ie=ie-1)
     115     {
     116       if (ie == 0)
     117       {
     118         return(0);
     119       }
     120       if (iv[ie] != 0)
     121       {
     122         break;
     123       }
     124     }
     125   }
     126   ia = 1;
     127   while (iv[ia] == 0) { ia=ia+1; }
     128  //--------------------------- ia <= nonzeros <= ie -------------------------
     129   iv1 = iv[ia];
     130   for(i=ia+1;i<=ie;i=i+1)
     131   {
     132     iv1=iv1,iv[i];
     133   }
     134  //--------------------------- compute second hilbertseries -----------------
     135   iv2 = hilb(iv1);
     136  //--------------------------- check finitenes ------------------------------
     137   i2 = size(iv2);
     138   i1 = ie - ia + 1 - i2;
     139   if (i1 != nvars(basering))
     140   {
     141     return(-1);
     142   }
     143  //--------------------------- compute result -------------------------------
     144   i1 = 0;
     145   for ( i=1; i<=i2; i=i+1)
     146   {
     147     i1 = i1 + iv2[i];
     148   }
     149   return(i1+dd);
     150}
     151example
     152{ "EXAMPLE:"; echo = 2;
     153   ring r  = 0,(x,y,z),dp;
     154   ideal j = y6,x4;
     155   ideal m = x,y;
     156   attrib(m,"isSB",1);  //let Singular know that ideals are a standard basis
     157   attrib(j,"isSB",1); 
     158   codim(m,j);          // should be 23 (Milnor number -1 of y7-x5)
     159}
    27160///////////////////////////////////////////////////////////////////////////////
    28161
    … …  
    362495///////////////////////////////////////////////////////////////////////////////
    363496
     497proc spectrum (poly f, intvec w)
     498USAGE:   spectrum(f,w);  f=poly, w=intvec;
     499ASSUME:  f is a weighted homogeneous isolated singularity w.r.t. the weights
     500         given by w; w must consist of as many positive integers as there
     501         are variables of the basering
     502COMPUTE: the spectral numbers of the w-homogeneous polynomial f, computed in a
     503         ring of charcteristik 0
     504RETURN:  intvec  d,s1,...,su  where:
     505         d = w-degree(f)  and  si/d = ith spectral-number(f)
     506         No return value if basering has parameters or if f is no isolated
     507         singularity, displays a warning in this case
     508EXAMPLE: example spectrum; shows an example
     509{
     510   int i,d,W;
     511   intvec sp;
     512   def r   = basering;
     513   if( find(charstr(r),",")!=0 )
     514   {
     515       "// coefficient field must not have parameters!";
     516       return();
     517    }
     518   ring s  = 0,x(1..nvars(r)),ws(w);
     519   map phi = r,maxideal(1);
     520   poly f  = phi(f);
     521   d       = ord(f);
     522   W       = sum(w)-d;
     523   ideal k = std(jacob(f));
     524   if( vdim(k) == -1 )
     525   {
     526       "// f is no isolated singuarity!";
     527       return();
     528    }
     529   k = kbase(k);
     530   for (i=1; i<=size(k); i++)
     531   {
     532      sp[i]=W+ord(k[i]);
     533   }
     534   list L  = sort(sp);
     535   sp      = d,L[1];
     536   return(sp);
     537}
     538example
     539{ "EXAMPLE:"; echo = 2;
     540   ring r;
     541   poly f=x3+y5+z2;
     542   intvec w=10,6,15;
     543   spectrum(f,w);
     544   // the spectrum numbers are:
     545   // 1/30,7/30,11/30,13/30,17/30,19/30,23/30,29/30
     546}
     547///////////////////////////////////////////////////////////////////////////////
     548
    364549proc Tjurina (id, list #)
    365550USAGE:   Tjurina(id[,<any>]);  id=ideal or poly
    … …  
    459644     module nb = [1]; module pnb;
    460645     dbprint(printlevel-voice+3,"// dim T1 = "+string(vdim(t1)));
    461      if( size(#)>0 ) { return(t1*gen(1),nb,pnb); }
     646     if( size(#)>0 )
     647     {
     648        module st1 = t1*gen(1);
     649        attrib(st1,"isSB",1);
     650        return(st1,nb,pnb);
     651     }
    462652     return(t1);
    463653  }
    … …  
    656846///////////////////////////////////////////////////////////////////////////////
    657847proc codim (id1, id2)
    658 USAGE:  codim(id1,id2); id1,id2 ideal or module, both result of std
    659 RETURN:  result is the number of elements in id1 but not in id2 if finite,
    660          conditions:
    661          1.  id2 is contained in id1, if not return -2
    662          2.  finiteness
    663              consider the two hilberseries iv1(t) and iv2(t)
    664              q(t)=(iv2(t)-iv1(t))/(1-t)^n must be rational, if not return -1
    665              (n dimension of basering)
    666          then the result is the sum of the coeff. of q(t)
     848USAGE:   codim(id1,id2); id1,id2 ideal or module, both must be standard bases
     849RETURN:  int, which is:
     850         1. the codimension of id2 in id1, i.e. the vectorspace dimension of
     851            id1/id2 if id2 is contained in id1 and if this number is finite
     852         2. -1 if the dimension of id1/id2 is infinite
     853         3. -2 if id2 is not contained in id1,
     854COMPUTE: consider the two hilberseries iv1(t) and iv2(t), then, in case 1.,
     855         q(t)=(iv2(t)-iv1(t))/(1-t)^n must be rational, and the result is the
     856         sum of the coefficients of q(t) (n dimension of basering)
     857EXAMPLE: example codim; shows an example
    667858{
    668859   intvec iv1, iv2, iv;
    669860   int i, d1, d2, dd, i1, i2, ia, ie;
    670   //--------------------------- check id2 < id1 ------------------------------
    671    i = size(NF(lead(id2),lead(id1)));
     861  //--------------------------- check id2 < id1 -------------------------------
     862   ideal led = lead(id1);
     863   attrib(led, "isSB",1);
     864   i = size(NF(lead(id2),led));
    672865   if ( i > 0 )
    673866   {
    … …  
    696889     return(vdim(id2)-vdim(id1));
    697890   }
    698    if (mult(id2) != mult(id1))
    699    {
    700      return(-1);
    701    }
     891 // if (mult(id2) != mult(id1))
     892 //{
     893 //  return(-1);
     894 // }
    702895  //--------------------------- module ---------------------------------------
    703896   d1 = nrows(id1);
    … …  
    773966   return(i1+dd);
    774967}
    775 
     968example
     969{ "EXAMPLE:"; echo = 2;
     970   ring r  = 0,(x,y,z),dp;
     971   ideal j = y6,x4;
     972   ideal m = x,y;
     973   attrib(m,"isSB",1);  //let Singular know that ideals are a standard basis
     974   attrib(j,"isSB",1); 
     975   codim(m,j);          // should be 23 (Milnor number -1 of y7-x5)
     976}

  • Singular/LIB/standard.lib

    r4a81ec r0fbdd1  
    1 // $Id: standard.lib,v 1.3 1997-08-01 13:42:14 obachman Exp $
     1// $Id: standard.lib,v 1.4 1997-09-12 07:40:37 Singular Exp $
    22///////////////////////////////////////////////////////////////////////////////
    33
    … …  
    1010proc stdfglm (ideal i, list #)
    1111USAGE:   stdfglm(i[,s]); i ideal, s string (any allowed ordstr of a ring)
    12 RETURN:  stdfglm(i);    standard basis of i in the given ring, calculated via
    13                         fglm from ordering "dp" to the current ordering.
    14          stdfglm(i,s);  standard basis of i in the given ring, calculated via
    15                         fglm from ordering s (as a string) to the given
    16                         ordering.
     12RETURN:  stdfglm(i): standard basis of i in the basering, calculated via fglm
     13                     from ordering "dp" to the ordering of the basering.
     14         stdfglm(i,s): standard basis of i in the basering, calculated via
     15                     fglm from ordering s to the ordering of the basering.
    1716EXAMPLE: example stdfglm; shows an example
    1817{
    … …  
    4342example
    4443{ "EXAMPLE:"; echo = 2;
    45    ring r=0,(x,y,z), lp; ideal i=y3+x2, x2y+x2, x3-x2, z4-x2-y;
    46    ideal is=stdfglm(i,"Dp"); is;
     44   ring r  = 0,(x,y,z),lp;
     45   ideal i = y3+x2, x2y+x2, x3-x2, z4-x2-y;
     46   ideal i1= stdfglm(i);         //uses fglm from "dp" to "lp"
     47   i1;     
     48   ideal i2= stdfglm(i,"Dp");    //uses fglm from "Dp" to "lp"
     49   i2;
    4750}
    4851///////////////////////////////////////////////////////////////////////////////
    4952
    5053proc stdhilbert(ideal i,list #)
    51 USAGE:  stdhilbert(i);  i ideal
    52         stdhilbert(i,v); i homogeneous ideal, v intvec (the Hilbert function)
    53 RETURN: stdhilbert(i);  standard basis of i computed using the Hilbert function
     54USAGE:   stdhilbert(i);  i ideal
     55         stdhilbert(i,v); i homogeneous ideal, v intvec (the Hilbert function)
     56RETURN:  stdhilbert(i): a standard basis of i (computing v internally)
     57         stdhilbert(i,v): standard basis of i, using the given Hilbert function
    5458EXAMPLE: example stdhilbert; shows an example
    5559{
    … …  
    103107example
    104108{ "EXAMPLE:"; echo = 2;
    105    ring r=0,(x,y,z), lp; ideal i=y3+x2, x2y+x2, x3-x2, z4-x2-y;
    106    ideal is=stdhilbert(i); is;
     109   ring  r = 0,(x,y,z),lp;
     110   ideal i = y3+x2, x2y+x2, x3-x2, z4-x2-y;
     111   ideal i1= stdhilbert(i); i1;
     112   // is in this case equivalent to:
     113   intvec v=1,0,0,-3,0,1,0,3,-1,-1;
     114   ideal i2=stdhilbert(i,v);
    107115}
    108116///////////////////////////////////////////////////////////////////////////////
Note: See TracChangeset for help on using the changeset viewer.