Changeset 11ddde in git


Ignore:
Timestamp:
Feb 23, 2004, 11:19:13 AM (20 years ago)
Author:
Hans Schönemann <hannes@…>
Branches:
(u'spielwiese', '8e0ad00ce244dfd0756200662572aef8402f13d5')
Children:
dd8844f86c84ceb5f72e448153ac7a2d0daf5a00
Parents:
c229324983bbffba788eee2e34c2f5428261bb0f
Message:
*hannes: from V2-0


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

Legend:

Unmodified
Added
Removed

  • Singular/LIB/deform.lib

    rc22932 r11ddde  
    1 // $Id: deform.lib,v 1.27 2003-11-04 16:43:50 Singular Exp $
     1// $Id: deform.lib,v 1.28 2004-02-23 10:19:09 Singular Exp $
    22// author: Bernd Martin email: martin@math.tu-cottbus.de
    33//(bm, last modified 4/98)
    44///////////////////////////////////////////////////////////////////////////////
    5 version="$Id: deform.lib,v 1.27 2003-11-04 16:43:50 Singular Exp $";
     5version="$Id: deform.lib,v 1.28 2004-02-23 10:19:09 Singular Exp $";
    66category="Singularities";
    77info="
    … …  
    2626proc versal (ideal Fo,list #)
    2727"USAGE:   versal(Fo[,d,any]); Fo=ideal, d=int, any=list
    28 COMUPTE: miniversal deformation of Fo up to degree d (default d=100),
     28COMPUTE: miniversal deformation of Fo up to degree d (default d=100),
    2929CREATE:  Rings (exported):
    3030         'my'Px = extending the basering Po by new variables given by
    … …  
    104104  kill Ls;
    105105  t1' = @t1;
    106   if( @t1==0) { dbprint(p,"// rigit!"); return();}
     106  if( @t1==0) { dbprint(p,"// rigid!"); return();}
    107107  if( @t2==0) { @smooth=1; dbprint(p,"// smooth base space");}
    108108  dbprint(p,"// ready: T_1 and T_2");
    … …  
    117117  if (defined(@active))
    118118  { "// matrix of infinitesimal deformations:";print(InfD);
    119     "// weights of infinitesimal deformations (  emty ='not qhomog'):";
     119    "// weights of infinitesimal deformations (  empty ='not qhomog'):";
    120120     @degrees;
    121121     matrix dummy;
    … …  
    297297proc mod_versal(matrix Mo, ideal I, list #)
    298298"USAGE:   mod_versal(Mo,I[,d,any]); I=ideal, M=module, d=int, any =list
    299 COMUPTE: miniversal deformation of coker(Mo) over Qo=Po/Io, Po=basering;
     299COMPUTE: miniversal deformation of coker(Mo) over Qo=Po/Io, Po=basering;
    300300CREATE:  Ringsr (exported):
    301301         'my'Px  = extending the basering by new variables (deformation
    … …  
    317317      (\"my\" prefix-string, \"param\" is a letter (e.g. \"A\")  for the name of
    318318      first parameter or (e.g. \"A(\") for index parameter variables, \"ord\"
    319       ordering string for ringextension), \"out\" name of output-file).
     319      ordering string for ring extension), \"out\" name of output-file).
    320320NOTE:   printlevel < 0        no output at all,
    321321        printlevel >=0,1,2,.. informs you, what is going on,
    … …  
    325325{
    326326//------- prepare -------------------------------------------------------------
     327  intvec save_opt=option(get);
     328  option(cancelunit);
    327329  string str,@param,@order,@my,@out,@degrees;
    328330  int @d,d_max,f0,f1,f2,e1,e1',e2,ok_ann,@smooth,@noObstr,@size,@j;
    … …  
    525527  "// NOTE: rings "+myQx+", "+myOx+", "+mySo+" are still alive!",
    526528  "// (use: 'kill_rings("+@my+");' to remove them)");
     529  option(set,save_opt);
    527530  return();
    528531}
    … …  
    818821  ">>Do you want all deformations? (ENTER=yes)";
    819822  string str = read("");
    820   if (size(str)>1)
    821   { ">> Choose columnes of the matrix";
    822     ">> (Enter = all columnes)";
    823     "INPUT (number of columnes to use as integer-list 'i_1,i_2,.. ,i_t' ):";
     823  if ((size(str)>1) and (str<>"yes"))
     824  { ">> Choose columns of the matrix";
     825    ">> (Enter = all columns)";
     826    "INPUT (number of columns to use as integer-list 'i_1,i_2,.. ,i_t' ):";
    824827    string columnes = read("");
    825     if (size(columnes)<2) {columnes=string(col_vec);}
    826     t1 = size(columnes)/2;
     828
     829// improved: CL
     830// ==========================================================
     831// old:   if (size(columnes)<2) {columnes=string(col_vec);}
     832//        t1 = size(columnes)/2;
     833// new:
     834    if (columnes=="")
     835    {
     836      intvec vvvv=1..ncols(A);
     837    }
     838    else
     839    {
     840      execute("intvec vvvv="+columnes);
     841    }
     842    t1=size(vvvv);
     843// ==========================================================
     844   
    827845    int l,l1;
    828846    for (l=1;l<=t1;l=l+1)
    829847    {
    830       execute("l1= "+columnes[2*l-1]+";");
     848// old:   execute("l1= "+columnes[2*l-1]+";");
     849      l1=vvvv[l];
    831850      B[l] = A[l1];
    832851      if(flag) { C[l]=D[l1];}
    … …  
    876895  }
    877896 setring br;
    878   //if(system("with","Namespaces")) { kill Ring::nr; }
    879   //else { kill nr;}
     897  if(system("with","Namespaces")) { kill Ring::nr; }
     898  kill nr;
    880899  return(degA);
    881900}
    … …  
    883902proc homog_test(intvec w_vec, matrix Mo, matrix A)
    884903"
    885 Sub proc: return relative weight string of columnes of A with respect
     904Sub proc: return relative weight string of columns of A with respect
    886905          to the given w_vec and to Mo, or \"\" if not qh
    887906    NOTE: * means weight is not determined
    … …  
    909928    if (size(tv)>1)
    910929    { k = tv[2];
    911       tv = tv[2..size(tv)]; tv = tv -k;
     930      tv = tv[2..size(tv)];
     931      tv = tv -k;
    912932      if (tv==0) { @nv = @nv+string(-k)+",";}
    913933      else {return("");}
    … …  
    922942"
    923943Sub-procedure: Computing relative (with respect to flatten(Fo)) weight_vec
    924                of columnes of A (return zero if Fo or A not qh)
     944               of columns of A (return zero if Fo or A not qh)
    925945"
    926946{
    … …  
    937957     setring br;
    938958     if(system("with","Namespaces")) { kill Ring::nr; }
    939      else { kill nr;}
     959     kill nr;
    940960     return(l);
    941961   }
    … …  
    946966 setring br;
    947967   if(system("with","Namespaces")) { kill Ring::nr; }
    948    else { kill nr;}
     968   kill nr;
    949969   return(dv);
    950970}

  • Singular/LIB/latex.lib

    rc22932 r11ddde  
    11///////////////////////////////////////////////////////////////////////////////
    2 version="$Id: latex.lib,v 1.20 2001-08-27 14:47:53 Singular Exp $";
     2version="$Id: latex.lib,v 1.21 2004-02-23 10:19:10 Singular Exp $";
    33category="Visualization";
    44info="
    … …  
    3030  @code{TeXwidth} (int) -1, 0, 1..9, >9:  controls breaking of long polynomials
    3131  @code{TeXnofrac} (int) flag:  write 1/2 instead of \\frac@{1@}@{2@}
    32   @code{TeXbrack} (string) \"@{\", \"(\", \"<\", \"|\", empty string:
     32  @code{TeXbrack} (string) \"@{\", \"(\", \"<\", \"|\", empty string: 
    3333                                   controls brackets around ideals and matrices
    3434  @code{TeXproj} (int) flag:  write \":\" instead of \",\" in vectors
    … …  
    4646"USAGE:   closetex(fname); fname string
    4747RETURN:  nothing; writes a LaTeX2e closing line into file @code{<fname>}.
    48 NOTE:    preceeding \">>\" are deleted and suffix \".tex\" (if not given)
     48NOTE:    preceding \">>\" are deleted and suffix \".tex\" (if not given)
    4949         is added to @code{fname}.
    5050EXAMPLE: example closetex; shows an example
    … …  
    9090"USAGE:   tex(fname); fname string
    9191RETURN:  nothing; calls latex (LaTeX2e) for compiling the file fname
    92 NOTE:    preceeding \">>\" are deleted and suffix \".tex\" (if not given)
     92NOTE:    preceding \">>\" are deleted and suffix \".tex\" (if not given)
    9393         is added to @code{fname}.
    9494EXAMPLE: example tex; shows an example
    … …  
    131131  texobj("exp001","An ideal ",I);
    132132  closetex("exp001");
    133   tex("exp001");
     133  tex("exp001"); 
    134134  echo=0;
    135135  pause("the created files will be deleted after pressing <RETURN>");
    … …  
    141141"USAGE:   opentex(fname); fname string
    142142RETURN:  nothing; writes a LaTeX2e header into a new file @code{<fname>}.
    143 NOTE:    preceeding \">>\" are deleted and suffix \".tex\" (if not given)
     143NOTE:    preceding \">>\" are deleted and suffix \".tex\" (if not given)
    144144         is added to @code{fname}.
    145145EXAMPLE: example opentex; shows an example
    … …  
    284284proc texfactorize(string fname, poly f, list #)
    285285"USAGE:   texfactorize(fname,f); fname string, f poly
    286 RETURN:  if @code{fname=\"\"}: string, f as a product of its irreducible
     286RETURN:  if @code{fname=\"\"}: string, f as a product of its irreducible 
    287287         factors@*
    288          otherwise: append this string to the file @code{<fname>}, and
     288         otherwise: append this string to the file @code{<fname>}, and 
    289289         return nothing.
    290 NOTE:    preceeding \">>\" are deleted and suffix \".tex\" (if not given)
     290NOTE:    preceding \">>\" are deleted and suffix \".tex\" (if not given)
    291291         is added to @code{fname}.
    292292EXAMPLE: example texfactorize; shows an example
    … …  
    369369proc texmap(string fname, def m, def @r1, def @r2, list #)
    370370"USAGE:   texmap(fname,m,@r1,@r2); fname string, m string/map, @r1,@r2 rings
    371 RETURN:  if @code{fname=\"\"}: string, the map m from @r1 to @r2 (preceeded
     371RETURN:  if @code{fname=\"\"}: string, the map m from @r1 to @r2 (preceded
    372372         by its name if m = string) in TeX-typesetting;@*
    373          otherwise: append this string to the file @code{<fname>}, and
     373         otherwise: append this string to the file @code{<fname>}, and 
    374374         return nothing.
    375 NOTE:    preceeding \">>\" are deleted in @code{fname}, and suffix \".tex\"
     375NOTE:    preceding \">>\" are deleted in @code{fname}, and suffix \".tex\"
    376376         (if not given) is added to @code{fname}.
    377377         If m is a string then it has to be the name of an existing map
    … …  
    561561  n = n+5*(i-anf);
    562562  anf =i;            // the next text in ( , ) as exponent
    563   if (op)
    564   {
     563  if (op) 
     564  { 
    565565    if (s[i]== ","){anf = anf+1;}
    566566    while(s[i] !=")"){ i++;}
    … …  
    580580"USAGE:   texname(fname,s);  fname,s  strings
    581581RETURN:  if @code{fname=\"\"}: string, the transformed string s, where the
    582          following rules apply:
    583 @example
     582         following rules apply: 
     583@example 
    584584      s' + \"~\"             -->  \"\\tilde@{\"+ s' +\"@}\"
    585      \"_\" + int             -->       \"_@{\" + int +\"@}\"
     585     \"_\" + int             -->       \"_@{\" + int +\"@}\" 
    586586  \"[\" + s' + \"]\"           -->      \"_@{\" + s' + \"@}\"
    587    \"A..Z\" + int            --> \"A..Z\" + \"^@{\" + int + \"@}\"
     587   \"A..Z\" + int            --> \"A..Z\" + \"^@{\" + int + \"@}\"   
    588588   \"a..z\" + int            --> \"a..z\" + \"_@{\" + int + \"@}\"
    589589\"(\" + int + \",\" + s' + \")\" --> \"_@{\"+ int +\"@}\" + \"^@{\" + s'+\"@}\"
    590590@end example
    591591         Anyhow, strings which begin with a @code{\"@{\"} are only changed
    592          by deleting the first and last character (intended to remove the
     592         by deleting the first and last character (intended to remove the 
    593593         surrounding curly brackets).
    594594
    595          if @code{fname!=\"\"}: append the transformed string s to the file
     595         if @code{fname!=\"\"}: append the transformed string s to the file 
    596596         @code{<fname>}, and return nothing.
    597 NOTE:    preceeding \">>\" are deleted in @code{fname}, and suffix \".tex\"
     597NOTE:    preceding \">>\" are deleted in @code{fname}, and suffix \".tex\"
    598598         (if not given) is added to @code{fname}.
    599599EXAMPLE: example texname; shows an example
    … …  
    603603  st=manipul(s);
    604604  if (size(fname))
    605   {
     605  { 
    606606    int i=1;
    607607    while (fname[i]==">"){i++;}
    608608    fname = fname[i,size(fname)-i+1];
    609609    if (size(fname)>=4)            // check if filename is ending with ".tex"
    610     {
     610    { 
    611611      if(fname[size(fname)-3,4]!=".tex") {fname = fname +".tex"; }
    612612    }
    … …  
    634634
    635635static proc absterm(poly f)
    636 {
     636{ 
    637637  int k;
    638638  for (k=1; k<=nvars(basering); k++)
    … …  
    645645"USAGE:   texobj(fname,l); fname string, l list
    646646RETURN:  if @code{fname=\"\"}: string, the entries of l in LaTeX-typesetting;@*
    647          otherwise: append this string to the file @code{<fname>}, and
     647         otherwise: append this string to the file @code{<fname>}, and 
    648648         return nothing.
    649 NOTE:    preceeding \">>\" are deleted in @code{fname}, and suffix \".tex\"
     649NOTE:    preceding \">>\" are deleted in @code{fname}, and suffix \".tex\"
    650650         (if not given) is added to @code{fname}.
    651651EXAMPLE: example texobj; shows an example
    … …  
    687687   { if (defined(`obj`))
    688688     { if (typeof(`obj`)=="ideal")
    689        {
     689       { 
    690690         Iname = obj; def e = `obj`;     //convert to correct type ideal
    691691         kill obj; def obj = e; kill e;
    … …  
    900900}
    901901example
    902 {
     902{ 
    903903   echo=0;
    904904   // -------- prepare for example ---------
    … …  
    942942"USAGE:   texproc(fname,pname); fname,pname strings
    943943ASSUME:  @code{`pname`} is a procedure.
    944 RETURN:  if @code{fname=\"\"}: string, the proc @code{`pname`} in a verbatim
     944RETURN:  if @code{fname=\"\"}: string, the proc @code{`pname`} in a verbatim 
    945945         environment in LaTeX-typesetting;@*
    946          otherwise: append this string to the file @code{<fname>}, and
     946         otherwise: append this string to the file @code{<fname>}, and 
    947947         return nothing.
    948 NOTE:    preceeding \">>\" are deleted in @code{fname}, and suffix \".tex\"
     948NOTE:    preceding \">>\" are deleted in @code{fname}, and suffix \".tex\"
    949949         (if not given) is added to @code{fname}.@*
    950950         @code{texproc} cannot be applied to itself correctly.
    … …  
    10441044"USAGE:   texring(fname, r[,L]); fname string, r ring, L list
    10451045RETURN:  if @code{fname=\"\"}: string, the ring in TeX-typesetting;@*
    1046          otherwise: append this string to the file @code{<fname>} and
     1046         otherwise: append this string to the file @code{<fname>} and 
    10471047         return nothing.
    1048 NOTE:    preceeding \">>\" are deleted and suffix \".tex\" (if not given)
     1048NOTE:    preceding \">>\" are deleted and suffix \".tex\" (if not given)
    10491049         is added to @code{fname}.@*
    10501050         The optional list L is assumed to be a list of strings which control,
    … …  
    11771177  texring("",ralg,"mipo");
    11781178  //
    1179   ring r49=(49,a),x,dp;                // Galois field
     1179  ring r49=(49,a),x,dp;                // Galois field 
    11801180  texring("",r49);
    11811181  //
    … …  
    12001200proc rmx(string fname)
    12011201"USAGE:   rmx(fname); fname string
    1202 RETURN:  nothing; removes the @code{.log} and @code{.aux} files associated to
     1202RETURN:  nothing; removes the @code{.log} and @code{.aux} files associated to 
    12031203         the LaTeX file <fname>.@*
    1204 NOTE:    If @code{fname} ends by @code{\".dvi\"} or @code{\".tex\"}, the
     1204NOTE:    If @code{fname} ends by @code{\".dvi\"} or @code{\".tex\"}, the 
    12051205         @code{.dvi} or @code{.tex} file will be deleted, too.
    12061206EXAMPLE: example rmx; shows an example
    … …  
    12861286{ "EXAMPLE:"; echo = 2;
    12871287  intmat m[3][4] = 9,2,4,5,2,5,-2,4,-6,10,-1,2,7;
    1288   opentex("exp001");
     1288  opentex("exp001"); 
    12891289  texobj("exp001","An intmat:  ",m);
    12901290  closetex("exp001");
    … …  
    13001300
    13011301static proc parsr(string s)                     // parse real
    1302 {
     1302{ 
    13031303  string t;
    13041304  if (s=="      Inf") { return("\\infty",3);}
    … …  
    13121312    else {return(s[1,5]+"*10^"+t,23);}
    13131313  }
    1314   else
     1314  else 
    13151315  {
    13161316    return(s[1,5],12);
    … …  
    13191319
    13201320static proc parsg(string s)                  // parse Galois field
    1321 {
     1321{ 
    13221322  int i,j = 1,1;
    13231323  string t;
    13241324  if (short)
    1325   {
     1325  { 
    13261326    t =s[1];
    13271327    if(size(s)>1) {return(t+"^{" + s[2,size(s)-1] + "}",3+2*(size(s)-1));}
    … …  
    13291329  }
    13301330  else
    1331   {
     1331  { 
    13321332    return(parselong(s+"!"));
    13331333  }
    … …  
    13381338"USAGE:   texpoly(fname,p); fname string, p poly
    13391339RETURN:  if @code{fname=\"\"}: string, the poly p in LaTeX-typesetting;@*
    1340          otherwise: append this string to the file @code{<fname>}, and
     1340         otherwise: append this string to the file @code{<fname>}, and 
    13411341         return nothing.
    1342 NOTE:    preceeding \">>\" are deleted in @code{fname}, and suffix \".tex\"
     1342NOTE:    preceding \">>\" are deleted in @code{fname}, and suffix \".tex\"
    13431343         (if not given) is added to @code{fname}.
    13441344EXAMPLE: example texpoly; shows an example
    … …  
    18471847 This document illustrates the functionality of the library."+"\\\\" +  nl);
    18481848 write(fname,"\\begin{tabular}{ll}" + nl +
    1849 "LIBRARY: {\\tt latex.lib} &   PROCEDURES FOR TYPESETTING SINGULAR" +
     1849"LIBRARY: {\\tt latex.lib} &   PROCEDURES FOR TYPESETTING SINGULAR" + 
    18501850"\\\\" +  nl +
    18511851" & OBJECTS IN LATEX2E"+
    … …  
    18591859"{\\tt  texdemo([n]);} & produces a file explaining the features of this lib"+
    18601860"\\\\" +  nl +
    1861 "{\\tt  texfactorize(fnm,f);} & creates string in \\LaTeX-format for
     1861"{\\tt  texfactorize(fnm,f);} & creates string in \\LaTeX-format for 
    18621862factors of poly f"+ "\\\\" +  nl +
    18631863"{\\tt  texmap(fnm,m,r1,r2);} & creates string in \\LaTeX-format for
    18641864map m:r1$\\rightarrow$r2"+ "\\\\" +  nl +
    1865 "{\\tt  texname(fnm,s);} &      creates string in \\LaTeX-format for
     1865"{\\tt  texname(fnm,s);} &      creates string in \\LaTeX-format for 
    18661866identifier"+ "\\\\" +  nl +
    18671867"{\\tt  texobj(l);} &           creates string in \\LaTeX-format for
    … …  
    18711871"{\\tt  texproc(fnm,p);} &      creates string in \\LaTeX-format of
    18721872text from proc p"+ "\\\\" +  nl +
    1873 "{\\tt  texring(fnm,r[,l]);} &  creates string in \\LaTeX-lformat for
     1873"{\\tt  texring(fnm,r[,l]);} &  creates string in \\LaTeX-lformat for 
    18741874ring/qring"+ "\\\\" +  nl +
    18751875"{\\tt  rmx(s);} &              removes .aux and .log files of \\LaTeX-files"+
    … …  
    18811881"\\\\" +  nl2 + "\\vspace{0.2cm}" + nl2 +
    18821882"The global variables {\\tt TeXwidth}, {\\tt TeXnofrac}, {\\tt
    1883  TeXbrack}, {\\tt TeXproj}, {\\tt TeXaligned}, {\\tt TeXreplace}, {\\tt
     1883 TeXbrack}, {\\tt TeXproj}, {\\tt TeXaligned}, {\\tt TeXreplace}, {\\tt 
    18841884 NoDollars} are used to control the typesetting: "
    18851885);
    … …  
    19011901write(fname,"Notice that none of these global variables are defined when
    19021902loading \\verb|latex.lib|. A flag variable is set as soon as it is defined.");
    1903 
     1903 
    19041904
    19051905//% The procs and
    … …  
    19091909   write(fname,"\\section{Opening a \\LaTeX\\ file}");
    19101910   write(fname,"In order to create a \\LaTeX\\ document and write a standard
    1911 header into it, use the following command."+
     1911header into it, use the following command."+ 
    19121912bv+
    19131913"> string fname = \"" + fname + "\";" + nl +
    1914 "> texopen(fname);" +
     1914"> texopen(fname);" + 
    19151915ev + nl);
    19161916
    … …  
    19341934
    19351935static proc part1(string fname)
    1936 {
     1936{ 
    19371937
    19381938  int st = defined(texdemopart);
    … …  
    19561956// -1a------ a ring in char 0, short varnames and poly. ordering ----------
    19571957write(fname,
    1958 " A ring in characteristic 0 with short names of variables and polynomial
     1958" A ring in characteristic 0 with short names of variables and polynomial 
    19591959ordering." +nl);
    19601960 ring r0=0,(x,y,z),dp;
    … …  
    19651965"> texring(fname,r0);" +
    19661966ev);
    1967   texring(fname,r0);
     1967  texring(fname,r0);             
    19681968  write(fname,nl2);
    19691969write(fname,
    … …  
    19721972"> texpoly(fname,g);" +nl +
    19731973ev);
    1974   texpoly(fname,g);
     1974  texpoly(fname,g); 
    19751975  write(fname,"\\\\"+nl2);
    19761976
    … …  
    19861986ev
    19871987);
    1988   texpoly(fname,g/280);
     1988  texpoly(fname,g/280);             
    19891989  kill r0;
    1990 
     1990 
    19911991write(fname,"\\\\"+nl2);
    19921992write(fname,"\\Line");
    19931993// -2-------- a ring in char 7, indexed varnames and series ordering ----------
    19941994write(fname,
    1995 " A ring in characteristic 7 with indexed names of variables and local
     1995" A ring in characteristic 7 with indexed names of variables and local 
    19961996ordering." +nl);
    19971997 ring r1=7,(x1,x2,x3,x4),Ds;
    1998  poly g=-2*x1+x4-1;
    1999 write(fname,
    2000 bv +
    2001 "> ring r1=7,(x1,x2,x3,x4),Ds;" +nl +
     1998 poly g=-2*x1+x4-1; 
     1999write(fname,
     2000bv +
     2001"> ring r1=7,(x1,x2,x3,x4),Ds;" +nl +               
    20022002"> texring(fname,r1);" +nl +
    20032003ev);
    2004 texring(fname,r1);
     2004texring(fname,r1);             
    20052005write(fname,lb);
    20062006
    20072007write(fname, bv +
    2008 "> poly g=-2*x1+x4-1;  g;" +nl +
     2008"> poly g=-2*x1+x4-1;  g;" +nl +               
    20092009"> texpoly(fname,g);" +nl +
    20102010ev);
    20112011
    20122012  texpoly(fname,g);
    2013 
     2013 
    20142014write(fname,lb);
    20152015write(fname,"\\Line");
    … …  
    20172017// -3-------- a ring in char 0, indexed varnames and local ordering ----------
    20182018write(fname,
    2019 " A ring in characteristic 0 with indexed names of variables and local
     2019" A ring in characteristic 0 with indexed names of variables and local 
    20202020ordering.
    20212021" +nl);
    … …  
    20272027"> texring(fname,r2);" +nl +
    20282028ev);
    2029   texring(fname,r2);
     2029  texring(fname,r2);             
    20302030
    20312031write(fname,
    20322032bv +
    20332033"> poly g=-y(1)^3*x(5)+y(1)*x(2);  g;" +nl+
    2034  string(g) + nl +
     2034 string(g) + nl +         
    20352035"> texpoly(fname,g);"  +nl +
    20362036ev
    20372037);
    2038   texpoly(fname,g);
     2038  texpoly(fname,g);             
    20392039  write(fname,lb);
    2040 
     2040 
    20412041write(fname,"\\Line");
    20422042
    … …  
    20612061);
    20622062  texpoly(fname,g); write(fname,lb);
    2063 
     2063 
    20642064write(fname,"\\Line");
    20652065
    … …  
    20992099ev);
    21002100 texring(fname,r0t);
    2101 write(fname,
     2101write(fname, 
    21022102bv +
    21032103"> poly g=8*(-s+2t)/(st+t3)*x+t2*x-1;  g;"+nl+
    … …  
    21732173
    21742174write(fname,
    2175 bv +
     2175bv + 
    21762176"> poly g=-(2a13+a)*x2+a2*x-a+1;  g;" +nl+
    21772177 string(g) +nl +
    … …  
    21982198
    21992199write(fname,
    2200 bv +
     2200bv + 
    22012201"> poly g=-(i+1)*x+2i2y2+i+x;  g;" +nl+
    22022202 string(g) +nl +
    … …  
    22952295"It is possible to display a ground field different from the
    22962296actual one by passing any letter in \\LaTeX \\ notation as additional
    2297 argument.  Predefined values are \\verb|\"\\\\C\"|, \\verb|\"\\\\R\"|,
     2297argument.  Predefined values are \\verb|\"\\\\C\"|, \\verb|\"\\\\R\"|, 
    22982298\\verb|\"k\"|, \\verb|\"K\"| and \\verb|\"R\"|."+nl+
    22992299"If for example a ground field of characteristic 0 should be written as
    … …  
    23112311 special role when the ground field is an algebraic extension. In this case
    23122312the parameters will be omitted.");
    2313 
     2313 
    23142314write(fname,
    23152315bv +
    … …  
    23582358
    23592359write(fname,nl+ "\\vspace{0.2cm}" + nl2);
    2360 
     2360 
    23612361write(fname,"The first and the last variable will always be printed.
    23622362In order to print only these it is sufficient to give a 1 as third argument.");
    … …  
    23892389write(fname,"It is also possible to pass several of the arguments described
    23902390above at once (in any order).");
    2391 
     2391 
    23922392
    23932393write(fname,
    … …  
    24072407
    24082408static proc part2(string fname)
    2409 {
     2409{ 
    24102410
    24112411  int st = defined(texdemopart);
    … …  
    24272427write(fname,"\\subsection{Factorized polynomials}");
    24282428
    2429 write(fname,"The command \\verb|texfactorize| calls internally the
    2430 {\\sc Singular} command \\verb|factorize| and returns the product of the
    2431 irreducible factors. Note that, at the moment, it is not possible to pass
     2429write(fname,"The command \\verb|texfactorize| calls internally the 
     2430{\\sc Singular} command \\verb|factorize| and returns the product of the 
     2431irreducible factors. Note that, at the moment, it is not possible to pass 
    24322432any optional arguments for \\verb|factorize| through \\verb|texfactorize|.");
    24332433
    … …  
    24662466// ---------------------------------------------
    24672467write(fname,"By setting the global variable \\verb|TeXreplace| it is possible
    2468 to define rules for replacing strings or variable names.
     2468to define rules for replacing strings or variable names. 
    24692469\\verb|TeXreplace| has to be a list of twoelemented lists where the first
    24702470entry is the text which should be replaced by the second entry.
    2471 This may be applied to replace names of variables, but is also used
     2471This may be applied to replace names of variables, but is also used 
    24722472when calling \\verb|texname| or \\verb|texmap|. Note that it
    24732473is necessary to write a double backslash \\verb|\\\\\| at the beginning of
    … …  
    25342534"\\]",nl);
    25352535
    2536 write(fname,"Note that the size of terms is calculated with certain
     2536write(fname,"Note that the size of terms is calculated with certain 
    25372537multiplicities.",nl);
    25382538
    … …  
    25502550ev);
    25512551
    2552   setring r0;
     2552  setring r0; 
    25532553  poly g=-x2y+2y13z+1;
    25542554  poly f=g^2;
    … …  
    25902590write(fname,nl2,"\\Line");
    25912591
    2592 write(fname,"There are two possibilities to convert a polynomial into
     2592write(fname,"There are two possibilities to convert a polynomial into 
    25932593\\LaTeX \\ code: either by using \\verb|texpoly| or by calling \\verb|texobj|.
    25942594The difference is that \\verb|texpoly| puts the polynomial in textmode
    … …  
    26032603
    26042604// setring r3;
    2605 
     2605 
    26062606  ring r3=0,(x_1,x_2,x_3),wp(3,2,1);
    26072607  poly g=-x_1*x_2+2*x_2*x_3+x_1*x_3;
    … …  
    26412641write(fname,"If the global variable \\verb|Texaligned| is set then the ideal
    26422642is displayed as a row vector.");
    2643 
     2643 
    26442644write(fname,
    26452645bv +
    … …  
    27252725
    27262726static proc part3(string fname)
    2727 {
     2727{ 
    27282728  int st=defined(texdemopart);
    27292729  string nl=newline;
    … …  
    27342734
    27352735  if (not(st) or st>=3)
    2736   {
     2736  { 
    27372737    print(" Call part2 first");
    27382738    return();
    … …  
    27462746write(fname,"\\section{Typeseting maps between rings}");
    27472747write(fname,"By default, maps are displayed in the following way:");
    2748 
     2748 
    27492749write(fname,
    27502750bv +
    … …  
    27542754"> texmap(fname,phi,r4,r5);" + nl +
    27552755ev);
    2756 
     2756 
    27572757  ring @r4_h=0,(x,y,z),dp;
    27582758  if(system("with","Namespaces")) { exportto(Current, @r4_h); }
    … …  
    27672767write(fname,"If the global variable \\verb|TeXaligned| is set, then the
    27682768map is displayed in one line.");
    2769 
     2769 
    27702770write(fname,
    27712771bv +
    … …  
    27862786the second one contains the parameters for the domain. Note that if only one
    27872787list is present then it is applied to both of the rings.");
    2788 
     2788 
    27892789write(fname,
    27902790bv +
    … …  
    28022802ev );
    28032803
    2804  texmap(fname,@phi_h,@r4_h,r5,list(),list("{"));
     2804 texmap(fname,@phi_h,@r4_h,r5,list(),list("{")); 
    28052805
    28062806write(fname,nl+"\\Line");
    … …  
    28362836write(fname, "Complex data structures such as matrices, vectors or modules
    28372837can be displayed by using the procedure \\verb|texobj|.");
    2838 
     2838 
    28392839write(fname,"\\subsection{Matrices and vectors}");
    28402840//=======================================================================
    … …  
    29372937ev );
    29382938
    2939   setring r;
     2939  setring r; 
    29402940  ideal I=3xz5+x2y3-3z,7xz5+y3z+x-z,-xyz2+4yz+2x;
    29412941  int TeXproj; export TeXproj;
    2942 
     2942 
    29432943  texobj(fname,V);
    29442944  kill TeXproj;
    … …  
    29482948"> kill TeXproj;"+nl+
    29492949ev);
    2950 
     2950 
    29512951write(fname,"\\subsection{Modules}",nl2);
    29522952
    … …  
    29842984
    29852985write(fname,"Integer matrices are displayed in the following way.");
    2986 
     2986 
    29872987intmat m[3][4]=-1,3,5,2,-2,8,6,0,2,5,8,7;
    29882988
    … …  
    30653065      "// not an isolated singularity";
    30663066    }
    3067     return(m_nr);
     3067    return(m_nr); 
    30683068  }
    30693069  export(milnor_number);
    … …  
    30723072write(fname,"The following procedure allows to include the source code
    30733073of procedures into a \\LaTeX document.");
    3074 write(fname,
     3074write(fname, 
    30753075bv +
    30763076"> texproc(fname,\"milnor\_number\");" +nl+
    30773077ev);
    3078 
     3078 
    30793079 texproc(fname,"milnor_number");
    30803080
    30813081  kill(milnor_number);
    3082 
     3082 
    30833083// ------------------------------ closing the tex file -------------------
    30843084write(fname,"\\section{Closing the \\LaTeX\\ file}");

  • Singular/LIB/normal.lib

    rc22932 r11ddde  
    11///////////////////////////////////////////////////////////////////////////////
    2 version="$Id: normal.lib,v 1.37 2001-10-23 10:26:24 pfister Exp $";
     2version="$Id: normal.lib,v 1.38 2004-02-23 10:19:11 Singular Exp $";
    33category="Commutative Algebra";
    44info="
    … …  
    77@*        G. Pfister,    pfister@mathematik.uni-kl.de
    88
    9 PROCEDURES:
    10  normal(I[,wd]);        computes the normalization of basering/I
    11                         resp. computes the normalization of basering/I and
    12                         the delta-invariante
    13  HomJJ(L);              presentation of End_R(J) as affine ring, L a list
    14  genus(I);              computes the genus of the projective curve defined
    15                         by I
     9MAIN PROCEDURES:
     10 normal(I[,wd]);     computes the normalization of basering/I,
     11                     resp. computes the normalization of basering/I and
     12                     the delta invariant
     13 HomJJ(L);           presentation of End_R(J) as affine ring, L a list
     14 genus(I);           computes genus of the projective curve defined by I
     15
     16AUXILIARY PROCEDURE:
     17 deltaLoc(f,S);      (sum of) delta invariant(s) at conjugated singular points
    1618";
    1719
    1820LIB "general.lib";
     21LIB "poly.lib";
    1922LIB "sing.lib";
    2023LIB "primdec.lib";
    … …  
    184187   f=mstd(f)[2];
    185188   ideal ann=quotient(f2,f);
    186    int delta;
    187    if(isIso&&isEq){delta=vdim(std(modulo(f,ideal(p))));}
     189   int delt;
     190   if(isIso&&isEq){delt=vdim(std(modulo(f,ideal(p))));}
    188191
    189192   f = p,rf;          // generates pJ:J mod(p), i.e. p*Hom(J,J)/p*R as R-module
    … …  
    325328   L = lastRing;
    326329   L = insert(L,0,1);
    327    L[3]=delta;
     330   L[3]=delt;
    328331   return(L);
    329332}
    … …  
    347350
    348351proc normal(ideal id, list #)
    349 "USAGE:   normal(i [,choose]);  i a radical ideal, choose empty, 1 or "wd"
     352"USAGE:   normal(i [,choose]);  i a radical ideal, choose empty, 1 or \"wd\"
    350353         if choose=1 the normalization of the associated primes is computed
    351          (which is sometimes more efficient)
    352          if choose="wd" the delta-invariant is computed simultaneously
    353          this may take much more time in the reducible case because the
    354          factorizing standardbasis algorithm cannot be used.
    355 ASSUME:  The ideal must be radical, for non radical ideals the output may
     354         (which is sometimes more efficient);
     355         if @code{choose=\"wd\"} the delta invariant is computed
     356         simultaneously; this may take much more time in the reducible case,
     357         since the factorizing standard basis algorithm cannot be used.
     358ASSUME:  The ideal must be radical, for non-radical ideals the output may
    356359         be wrong (i=radical(i); makes i radical)
    357 RETURN:   a list of rings, say nor and in case of choose="wd" an integer
    358 @format
    359          at the end of the list.
    360          each ring nor[i] contains two ideals
    361          with given names norid and normap such that
    362            - the direct sum of the rings nor[i]/norid is
    363              the normalization of basering/id;
    364            - normap gives the normalization map from basering/id
    365              to nor[i]/norid (for each i)
    366 @end format
    367 NOTE:    to use the i-th ring type: def R=nor[i]; setring R;.
    368 @*       Increasing printlevel displays more comments (default: printlevel=0)
     360RETURN:  a list of rings, say nor and in case of @code{choose=\"wd\"} an
     361         integer at the end of the list.
     362         Each ring @code{nor[i]} contains two ideals with given names
     363         @code{norid} and @code{normap} such that@*
     364         - the direct sum of the rings @code{nor[i]/norid} is the
     365         normalization of basering/id;@*
     366         - @code{normap} gives the normalization map from basering/id to
     367         @code{nor[i]/norid} (for each i).
     368NOTE:    to use the i-th ring type: @code{def R=nor[i]; setring R;}.
     369@*       Increasing printlevel displays more comments (default: printlevel=0).
    369370@*       Not implemented for local or mixed orderings.
    370371@*       If the input ideal i is weighted homogeneous a weighted ordering may
    371372         be used (qhweight(i); computes weights).
     373KEYWORDS: normalization; delta invariant.
    372374EXAMPLE: example normal; shows an example
    373375"
    … …  
    527529   }
    528530      dbprint(y+1,"
    529 // 'normal' created a list of "+sr+" ring(s).
    530 // nor["+sr+"+1] is the delta-invariant in case of choose=wd.
    531 // To see the rings, type (if the name of your list is nor):
     531// 'normal' created a list of "+sr+" ring(s).");
     532      if(withdelta)
     533      {
     534        dbprint(y+1,"// nor["+sr+"+1] is the delta-invariant.");
     535      }
     536      dbprint(y+1,"// To see the rings, type (if the name of your list is nor):
    532537     show( nor);
    533538// To access the 1-st ring and map (similar for the others), type:
    … …  
    558563
    559564///////////////////////////////////////////////////////////////////////////////
    560 static proc normalizationPrimes(ideal i,ideal ihp,int delta, list #)
     565static proc normalizationPrimes(ideal i,ideal ihp,int delt, list #)
    561566"USAGE:   normalizationPrimes(i,ihp[,si]);  i equidimensional ideal, ihp map
    562567         (partial normalization),delta partial delta-invariant,
    … …  
    605610         export normap;
    606611         result=newR7;
    607          result[size(result)+1]=delta;
     612         result[size(result)+1]=delt;
    608613         setring BAS;
    609614         return(result);
    … …  
    633638         export normap;
    634639         result=newR6;
    635          result[size(result)+1]=delta;
     640         result[size(result)+1]=delt;
    636641         setring BAS;
    637642         return(result);
    … …  
    744749         export normap;
    745750         result=newR6;
    746          result[size(result)+1]=delta;
     751         result[size(result)+1]=delt;
    747752         setring BAS;
    748753         return(result);
    … …  
    768773      export normap;
    769774      result=newR5;
    770       result[size(result)+1]=delta;
     775      result[size(result)+1]=delt;
    771776      setring BAS;
    772777      return(result);
    … …  
    794799      export normap;
    795800      result=newR4;
    796       result[size(result)+1]=delta;
     801      result[size(result)+1]=delt;
    797802      setring BAS;
    798803      return(result);
    … …  
    864869         export normap;
    865870         result=newR3;
    866          result[size(result)+1]=delta;
     871         result[size(result)+1]=delt;
    867872         setring BAS;
    868873         return(result);
    … …  
    905910      export normap;
    906911      result=newR6;
    907       result[size(result)+1]=delta;
     912      result[size(result)+1]=delt;
    908913      setring BAS;
    909914      return(result);
    … …  
    941946            setring newR;
    942947            map psi=BAS,endphi;
    943             list tluser=normalizationPrimes(endid,psi(ihp),delta+RR[3],an);
     948            list tluser=normalizationPrimes(endid,psi(ihp),delt+RR[3],an);
    944949            setring BAS;
    945950            return(tluser);
    … …  
    950955         ideal norid=fetch(BAS,MB);
    951956         ideal normap=fetch(BAS,ihp);
    952          delta=delta+RR[3];
     957         delt=delt+RR[3];
    953958         export norid;
    954959         export normap;
    955960         result=newR7;
    956          result[size(result)+1]=delta;
     961         result[size(result)+1]=delt;
    957962         setring BAS;
    958963         return(result);
    … …  
    992997          keepresult2=normalizationPrimes(id1,ihp,0);
    993998           
    994           delta=delta+mul+keepresult1[size(keepresult1)]
     999          delt=delt+mul+keepresult1[size(keepresult1)]
    9951000                         +keepresult1[size(keepresult1)];
    9961001
    … …  
    9991004             keepresult1=insert(keepresult1,keepresult2[lauf]);
    10001005          }
    1001           keepresult1[size(keepresult1)]=delta;
     1006          keepresult1[size(keepresult1)]=delt;
    10021007          return(keepresult1);
    10031008       }
    … …  
    10641069         export normap;
    10651070         result=lastR;
    1066          result[size(result)+1]=delta+RS[3];
     1071         result[size(result)+1]=delt+RS[3];
    10671072         setring BAS;
    10681073         return(result);
    … …  
    10761081      map psi=BAS,endphi;
    10771082      list tluser=
    1078              normalizationPrimes(endid,psi(ihp),delta+RS[3],psi(MJ));
     1083             normalizationPrimes(endid,psi(ihp),delt+RS[3],psi(MJ));
    10791084      setring BAS;
    10801085      return(tluser);
    … …  
    10991104         export normap;
    11001105         result=newR6;
    1101          result[size(result)+1]=delta;
     1106         result[size(result)+1]=delt;
    11021107         setring BAS;
    11031108         return(result);
    … …  
    11611166         keepresult1=insert(keepresult1,keepresult2[lauf]);
    11621167      }
    1163       keepresult1[size(keepresult1)]=delta+mul+delta1+delta2;
     1168      keepresult1[size(keepresult1)]=delt+mul+delta1+delta2;
    11641169      return(keepresult1);
    11651170   }
    … …  
    12731278/////////////////////////////////////////////////////////////////////////////
    12741279
    1275 proc genus(ideal K,list #)
     1280proc genus(ideal I,list #)
    12761281"USAGE:   genus(I) or genus(i,1); I a 1-dimensional ideal
    12771282RETURN:  an integer, the geometric genus p_g = p_a - delta of the projective
    … …  
    12881293
    12891294   def R=basering;
    1290    K=std(K);
    1291  
    1292    if(nvars(R)==3)
    1293    {
    1294       if((dim(K)!=2)||(!homog(K))||(size(K)>1)){ERROR("Input is not a curve");}
    1295       execute("ring newR=("+charstr(R)+"),(x,y),dp;"); 
    1296       map kappa=R,x,y,1;
    1297       ideal K=kappa(K); 
    1298    }
    1299    if((nvars(R)>3)||(size(K)>1))
    1300    {  // hier geeignet projezieren
    1301       ERROR("This case is not implemented yet");
    1302    }
    1303    if(nvars(R)==2)
    1304    {
    1305       execute("ring newR=("+charstr(R)+"),(x,y),dp;"); 
    1306       map kappa=R,x,y;
    1307       ideal K=kappa(K); 
     1295
     1296   if(homog(I))
     1297   {
     1298      execute("ring newR=("+charstr(R)+"),("+varstr(R)+"),dp;");
     1299      ideal I=imap(R,I); 
     1300   }
     1301   else
     1302   {
     1303      execute("ring newR=("+charstr(R)+"),("+varstr(R)+",@t),dp;");
     1304      ideal I=imap(R,I); 
     1305      I=homog(std(I),@t);
     1306   }
     1307   ideal J=std(I);
     1308   if((dim(J)!=2)||((nvars(basering)==2)&&(dim(J)!=1)))
     1309   {
     1310      ERROR("This is not a curve");
     1311   }
     1312   if((nvars(basering)<=3)&&(size(J)>1))
     1313   {
     1314       ERROR("This is not equidimensional");
    13081315   }
    13091316   
    1310    // assume now that R is a ring with two variables 
    1311    poly p=K[1];   
    1312    ideal I;
    1313    if(homog(p))
     1317   intvec hp=hilbPoly(J);
     1318   int p_a=1-hp[1];
     1319   int d=hp[2];
     1320
     1321   if(w>=1)
     1322   {
     1323      "";"The ideal of the projective curve:";"";J;"";
     1324      "The coefficients of the Hilbert polynomial";hp;
     1325      "arithmetic genus:";p_a;
     1326      "degree:";d;"";
     1327   }
     1328   
     1329   intvec v = hilb(J,1);
     1330   int o,i;
     1331   
     1332   if(nvars(basering)>3)
     1333   {
     1334      map phi=newR,maxideal(1);
     1335      int de;
     1336      ideal K,L;
     1337      poly m=var(4);
     1338      for(i=5;i<=nvars(basering);i++){m=m*var(i);}
     1339      K=eliminate(J,m,v);
     1340      if(size(K)==1){de=deg(K[1]);}
     1341      m=var(1);
     1342      for(i=2;i<=nvars(basering)-3;i++){m=m*var(i);}
     1343      i=0;
     1344      while(d!=de)
     1345      {
     1346         o=1;
     1347         i++;
     1348         K=phi(J);
     1349         K=eliminate(K,m,v);
     1350         if(size(K)==1){de=deg(K[1]);}
     1351         if(i==5)
     1352         {
     1353            K=reduce(equidimMax(J),J);
     1354            if(size(K)!=0){ERROR("This is not equidimensional");}
     1355          }
     1356          if(i==10){ERROR("did not find a good projection");}
     1357          L=sparsetriag(nvars(newR),nvars(newR),80-5*i,i)*transpose(maxideal(1));
     1358          phi=newR,L;
     1359      }
     1360      J=K;
     1361   }
     1362   poly p=J[1];
     1363   
     1364   if(nvars(basering)==2)
    13141365   {
    13151366      if(deg(squarefree(p))<deg(p)){ERROR("Curve is not reduced");}
    13161367      return(-deg(p)+1);
    13171368   }
     1369   
    13181370   execute("ring S=("+charstr(R)+"),(x,y,t),dp;");
     1371   ideal L=maxideal(1);
    13191372   execute("ring C=("+charstr(R)+"),(x,y),ds;");
    13201373   ideal I;
    … …  
    13271380   
    13281381   setring S;
    1329    poly F=imap(newR,p);
    1330    F=homog(F,t);
    1331    int d=deg(F);
     1382   if(o)
     1383   {
     1384     for(i=1;i<=nvars(newR)-3;i++){L[i]=0;}
     1385     L=L,maxideal(1);
     1386   }   
     1387   map sigma=newR,L;
     1388   poly F=sigma(p);
     1389   if(w>=1){"the projected curve:";"";F;"";}
     1390   
     1391   kill newR;
     1392   
    13321393   int genus=(d-1)*(d-2)/2;
    1333    
    1334 //   if(w>=1){"test for smoothness";}
    1335 //   if(dim(std(jacob(F)))==0)  //the smooth case
    1336 //   {
    1337 //      setring R;
    1338 //      return(genus);
    1339 //   }
     1394   if(w>=1){"the arithmetic genus of the plane curve:";genus;pause();}
    13401395 
    1341    int delta,deltaloc,deltainf,tau,tauinf,cusps,iloc,iglob,
    1342        tauloc,tausing,k,rat,nbranchinf,nbranch,nodes;
     1396   int delt,deltaloc,deltainf,tau,tauinf,cusps,iloc,iglob,l,nsing,
     1397       tauloc,tausing,k,rat,nbranchinf,nbranch,nodes,cuspsinf,nodesinf;
    13431398   list inv;
    13441399
    1345    if(w>=1){"singularities at oo";}
     1400   if(w>=1)
     1401     {"";"analyse the singularities at oo";"";"singular locus at (1,x,0):";"";}
    13461402   setring A;       
    13471403   g=phi(F);
    … …  
    13521408   {
    13531409      list qr=minAssGTZ(I);
     1410      if(w>=1){qr;"";}
     1411     
    13541412      for(k=1;k<=size(qr);k++)
    13551413      {
     1414         if(w>=1){ nsing=nsing+vdim(std(qr[k]));}
    13561415         inv=deltaLoc(g,qr[k]);
    13571416         deltainf=deltainf+inv[1];
    13581417         tauinf=tauinf+inv[2];
     1418         l=vdim(std(qr[k]));
     1419         if(inv[2]==l){nodesinf=nodesinf+l;}
     1420         if(inv[2]==2*l){cuspsinf=cuspsinf+l;}         
    13591421         nbranchinf=nbranchinf+inv[3];
    13601422      }
    13611423   }
     1424   else
     1425   {
     1426     if(w>=1){"            the curve is smooth at (1,x,0)";"";}
     1427   }
     1428   if(w>=1){"singular locus at (0,1,0):";"";}
    13621429   inv=deltaLoc(h,maxideal(1));
     1430   if((w>=1)&&(inv[2]!=0)){ nsing++;}
    13631431   deltainf=deltainf+inv[1];
    13641432   tauinf=tauinf+inv[2];
     1433   if(inv[2]==1){nodesinf=nodeainf++;}
     1434   if(inv[2]==2){cuspsinf=cuspsinf++;}         
     1435   
     1436   if((w>=1)&&(inv[2]==0)){"            the curve is smooth at (0,1,0)";"";}
    13651437   if(inv[2]>0){nbranchinf=nbranchinf+inv[3];}
    13661438 
    13671439   if(w>=1)
    13681440   {
    1369       "branches at oo:";nbranchinf;
    1370       "tau at oo:";tauinf;
    1371       "delta at oo:";deltainf;
    1372       "singularities not at oo";
    1373    }
    1374                          
    1375    setring newR;         //the singularities at the affine part
     1441      if(tauinf==0)
     1442      {
     1443        "            the curve is smooth at oo";"";
     1444      }
     1445      else
     1446      {
     1447         "number of singularities at oo:";nsing;
     1448         "nodes at oo:";nodesinf;
     1449         "cusps at oo:";cuspsinf;
     1450         "branches at oo:";nbranchinf;
     1451         "Tjurina number at oo:";tauinf;
     1452         "delta at oo:";deltainf;
     1453         "Milnor number at oo:";2*deltainf-nbranchinf+nsing;
     1454         pause();
     1455      }
     1456      "singularities at (x,y,1):";"";
     1457   }
     1458   execute("ring newR=("+charstr(R)+"),(x,y),dp;");
     1459   //the singularities at the affine part
    13761460   map sigma=S,var(1),var(2),1;
    1377    I=sigma(F);
    1378 
    1379    if((size(#)!=0)||((char(basering)<181)&&(char(basering)!=0)))     
     1461   ideal I=sigma(F);
     1462
     1463   if(size(#)!=0)     
    13801464   {                              //uses the normalization to compute delta
    13811465      list nor=normal(I,"wd");
    1382       delta=nor[size(nor)];
    1383       genus=genus-delta-deltainf;
     1466      delt=nor[size(nor)];
     1467      genus=genus-delt-deltainf;
    13841468      setring R;
    13851469      return(genus);
    … …  
    13881472   ideal I1=jacob(I);
    13891473   matrix Hess[2][2]=jacob(I1);
    1390    ideal ID=I+I1+ideal(det(Hess));
    1391 
    1392    if(w>=1){"the cusps and nodes";}
     1474   ideal ID=I+I1+ideal(det(Hess));//singular locus of I+I1
    13931475   
    1394    ideal radID=std(radical(ID));
    1395    ideal IDsing=minor(jacob(ID),2)+radID;
     1476   ideal radID=std(radical(ID));//the non-nodal locus
     1477   if(w>=1){"the non-nodal locus:";"";radID;pause();"";}
     1478   if(deg(radID[1])==0)
     1479   {
     1480     ideal IDsing=1;
     1481   }
     1482   else
     1483   {
     1484     ideal IDsing=minor(jacob(ID),2)+radID;//singular locus of ID
     1485   }
     1486   
    13961487   iglob=vdim(std(IDsing));
    13971488
    1398    if(iglob!=0)
     1489   if(iglob!=0)//computation of the radical of IDsing
    13991490   {
    14001491      ideal radIDsing=reduce(IDsing,radID);
    … …  
    14091500      }
    14101501      iglob=vdim(radIDsing);
    1411    }
    1412    cusps=vdim(radID)-iglob;
    1413        
    1414    if(w>=1){"the other singularities";}
    1415  
    1416    if(iglob==0)   //only cusps and double points
    1417    {
     1502      if((w>=1)&&(iglob))
     1503          {"the non-nodal-cuspidal locus:";radIDsing;pause();"";}
     1504   }
     1505   cusps=vdim(radID)-iglob;
     1506   nsing=nsing+cusps;
     1507   
     1508   if(iglob==0)
     1509   {
     1510      if(w>=1){"             there are only cusps and nodes";"";}
    14181511      tau=vdim(std(I+jacob(I)));
     1512      tauinf=tauinf+tau;
    14191513      nodes=tau-2*cusps;
    1420       delta=nodes+cusps;
    1421       nbranch=2*tau-3*cusps;   
     1514      delt=nodes+cusps;
     1515      nbranch=2*tau-3*cusps;
     1516      nsing=nsing+nodes;
    14221517   }
    14231518   else
    14241519   {
     1520       if(w>=1){"the non-nodal-cuspidal singularities";"";}
    14251521       setring C;                     
    14261522       ideal I1=imap(newR,IDsing);
    14271523       iloc=vdim(std(I1));
    1428        if(iglob==iloc)  // only cusps and nodes outside 0
     1524       if(iglob==iloc)
    14291525       {
     1526          if(w>=1){"only cusps and nodes outside (0,0,1)";}
    14301527          setring newR;
    14311528          tau=vdim(std(I+jacob(I)));
     1529          tauinf=tauinf+tau;
    14321530          inv=deltaLoc(I[1],maxideal(1));
    1433           delta=inv[1];
     1531          delt=inv[1];
    14341532          tauloc=inv[2];
    14351533          nodes=tau-tauloc-2*cusps;
    1436           nbranch=inv[3]+ 2*nodes+cusps;         
    1437           delta=delta+nodes+cusps;
     1534          nsing=nsing+nodes;
     1535          nbranch=inv[3]+ 2*nodes+cusps;         
     1536          delt=delt+nodes+cusps;
     1537          if((w>=1)&&(inv[2]==0)){"smooth at (0,0,1)";}
    14381538        }
    14391539        else
    14401540        {
    14411541           setring newR;
    1442            list pr=minAssGTZ(IDsing);                   
     1542           list pr=minAssGTZ(IDsing);
     1543           if(w>=1){pr;}
     1544           
    14431545           for(k=1;k<=size(pr);k++)
    14441546           {
     1547              if(w>=1){nsing=nsing+vdim(std(pr[k]));}
    14451548              inv=deltaLoc(I[1],pr[k]);
    1446               delta=delta+inv[1];
     1549              delt=delt+inv[1];
    14471550              tausing=tausing+inv[2];
    14481551              nbranch=nbranch+inv[3];
    14491552           }
    14501553           tau=vdim(std(I+jacob(I)));
    1451 
     1554           tauinf=tauinf+tau;
    14521555           nodes=tau-tausing-2*cusps;
    1453            delta=delta+nodes+cusps; 
     1556           nsing=nsing+nodes;
     1557           delt=delt+nodes+cusps; 
    14541558           nbranch=nbranch+2*nodes+cusps;           
    14551559        }
    14561560   }
    1457 
     1561   genus=genus-delt-deltainf;
    14581562   if(w>=1)
    14591563   {
    1460       "branches :";nbranch;
    1461       "nodes:"; nodes;
    1462       "cusps:";cusps;
    1463       "tau :";tau;
    1464       "delta:";delta;
    1465    }
    1466    genus=genus-delta-deltainf;
     1564      "The projected plane curve has locally:";"";
     1565      "singularities:";nsing;
     1566      "branches:";nbranch+nbranchinf;
     1567      "nodes:"; nodes+nodesinf;
     1568      "cusps:";cusps+cuspsinf;
     1569      "Tjurina number:";tauinf;
     1570      "Milnor number:";2*(delt+deltainf)-nbranch-nbranchinf+nsing;
     1571      "delta of the projected curve:";delt+deltainf;
     1572      "delta of the curve:";p_a-genus;
     1573      "genus:";genus;
     1574      "====================================================";
     1575      "";
     1576   }
    14671577   setring R;
    14681578   return(genus);
    … …  
    14741584   genus(i);
    14751585}
    1476 ///////////////////////////////////////////////////////////////////////////
     1586
     1587///////////////////////////////////////////////////////////////////////////////
    14771588proc deltaLoc(poly f,ideal singL)
     1589"USAGE:  deltaLoc(f,J);  f poly, J ideal
     1590ASSUME: f is reduced bivariate polynomial; basering has exactly two variables;
     1591        J is irreducible prime component of the singular locus of f (e.g., one
     1592        entry of the output of @code{minAssGTZ(I);}, I = <f,jacob(f)>).
     1593RETURN:  list L:
     1594@texinfo
     1595@table @asis
     1596@item @code{L[1]}; int:
     1597         the sum of (local) delta invariants of f at the (conjugated) singular
     1598         points given by J.
     1599@item @code{L[2]}; int:
     1600         the sum of (local) Tjurina numbers of f at the (conjugated) singular
     1601         points given by J.
     1602@item @code{L[3]}; int:
     1603         the sum of (local) number of branches of f at the (conjugated)
     1604         singular points given by J.
     1605@end table
     1606@end texinfo
     1607NOTE:    procedure makes use of @code{execute}; increasing printlevel displays
     1608         more comments (default: printlevel=0).
     1609SEE ALSO: delta, tjurina
     1610KEYWORDS: delta invariant; Tjurina number
     1611EXAMPLE: example deltaLoc;  shows an example
     1612"
    14781613{
     1614   option(redSB);
    14791615   def R=basering;
    14801616   execute("ring S=("+charstr(R)+"),(x,y),lp;");
    … …  
    14851621   poly f=phi(f);
    14861622   int i;
    1487 
     1623   int w = printlevel-voice+2;  // w=printlevel (default: w=0)
    14881624   if(d==1)
    14891625   {
    14901626      map alpha=S,var(1)-singL[2][2],var(2)-singL[1][2];
    14911627      f=alpha(f);
     1628
    14921629      execute("ring C=("+charstr(S)+"),("+varstr(S)+"),ds;");
    14931630      poly f=imap(S,f);
     1631      ideal singL=imap(S,singL);
     1632      if((w>=1)&&(ord(f)>=2))
     1633      {
     1634        "local analysis of the singularities";"";
     1635        basering;
     1636        singL;
     1637        f;
     1638        pause();
     1639      }
    14941640   }
    14951641   else
    … …  
    14981644      poly c;
    14991645      map psi;
    1500       while((deg(singL[1])>1)&&(deg(singL[2])>1))
     1646      number co;
     1647     
     1648      while((deg(lead(singL[1]))>1)&&(deg(lead(singL[2]))>1))
    15011649      {
    15021650         psi=S,x,y+random(-100,100)*x;
    15031651         singL=psi(singL);
    15041652         singL=std(singL);
    1505       }
    1506       if(deg(singL[2])==1){p=singL[1];c=singL[2][2];}
    1507       if(deg(singL[1])==1)
     1653          f=psi(f);
     1654      }
     1655     
     1656      if(deg(lead(singL[2]))==1)
     1657      {
     1658         p=singL[1];
     1659         c=singL[2]-lead(singL[2]);
     1660         co=leadcoef(singL[2]);
     1661      }
     1662      if(deg(lead(singL[1]))==1)
    15081663      {
    15091664         psi=S,y,x;
    … …  
    15111666         singL=psi(singL);
    15121667         p=singL[2];
    1513          c=singL[1][2];
    1514       }
     1668         c=singL[1]-lead(singL[1]);;
     1669         co=leadcoef(singL[1]);
     1670      }
     1671     
    15151672      execute("ring B=("+charstr(S)+"),a,dp;");
    15161673      map beta=S,a,a;
    15171674      poly p=beta(p);
     1675     
    15181676      execute("ring C=("+charstr(S)+",a),("+varstr(S)+"),ds;");
    15191677      number p=number(imap(B,p));
     1678     
    15201679      minpoly=p;
    1521       number c=number(imap(S,c));
    1522       map alpha=S,x-c,y+a;
    1523      
     1680      //number c=number(imap(S,c));
     1681      map iota=S,a,a;
     1682      number c=number(iota(c));
     1683      number co=iota(co);
     1684     
     1685      map alpha=S,x-c/co,y+a;
    15241686      poly f=alpha(f);
    15251687      f=cleardenom(f);
    1526    }
     1688      if((w>=1)&&(ord(f)>=2))
     1689      {
     1690        "local analysis of the singularities";"";
     1691        basering;
     1692        alpha;
     1693        f;
     1694        pause();
     1695        "";
     1696      }
     1697   }
     1698   option(noredSB);
    15271699   ideal fstd=std(ideal(f)+jacob(f));
    15281700   poly hc=highcorner(fstd);
    15291701   int tau=vdim(fstd);     
    15301702   int o=ord(f);
    1531    int delta,nb;
    1532 
     1703   int delt,nb;
     1704   
    15331705   if(tau==0)                 //smooth case
    15341706   {
    … …  
    15401712      if(o==2)                //A_k-singularity
    15411713      {
     1714        if(w>=1){"A_k-singularity";"";}       
    15421715         setring R;
    1543          delta=(tau+1)/2;
    1544          return(list(d*delta,d*tau,d*(2*delta-tau+1)));   
     1716         delt=(tau+1)/2;
     1717         return(list(d*delt,d*tau,d*(2*delt-tau+1)));   
    15451718      }
    15461719      if((lead(f)==var(1)*var(2)^2)||(lead(f)==var(1)^2*var(2)))
    1547       {//D_k- singularity
     1720      {
     1721        if(w>=1){"D_k- singularity";"";}
     1722       
    15481723         setring R;
    1549          delta=(tau+2)/2;
    1550          return(list(d*delta,d*tau,d*(2*delta-tau+1)));
     1724         delt=(tau+2)/2;
     1725         return(list(d*delt,d*tau,d*(2*delt-tau+1)));
    15511726      }
    15521727
    15531728      int mu=vdim(std(jacob(f)));
    1554       poly g=f+var(1)^mu+var(2)^mu;  //to obtain a convinient Newton-polygon
     1729      poly g=f+var(1)^mu+var(2)^mu;  //to obtain a convenient Newton-polygon
    15551730 
    1556       list NP=newton(g);
    1557 
     1731      list NP=newtonpoly(g);
     1732      if(w>=1){"Newton-Polygon:";NP;"";}
    15581733      int s=size(NP);
    1559       int nN=-NP[1][2]-NP[s][1]+1;  // computation of the Newton-number
    1560       intmat m[2][2];
    1561       for(i=1;i<=s-1;i++)
    1562       {
    1563          m=NP[i+1],NP[i];
    1564          nN=nN+det(m);
    1565       }
    1566 
    1567       if(mu==nN)                   // the Newton-polygon is non-degenerate
    1568       {                            // compute nb, the number of branches
     1734       
     1735      if(is_NND(f,mu,NP))     
     1736      { // the Newton-polygon is non-degenerate                           
     1737        // compute nb, the number of branches
    15691738        for(i=1;i<=s-1;i++)
    15701739        {
    15711740          nb=nb+gcd(NP[i][2]-NP[i+1][2],NP[i][1]-NP[i+1][1]);
    15721741        }
     1742        if(w>=1){"Newton-Polygon is non-degenerated";"";}
    15731743        return(list(d*(mu+nb-1)/2,d*tau,d*nb));
    15741744      }
    15751745
    1576    //da reddevelop nur benutzt wird, um die Anzahl der Zweige zu bestimmen
    1577    //kann man das sicher schneller machen:
    1578    //die Aufblasung durchfuehren und stets testen, ob das Newton-polyeder
    1579    //nicht ausgeartet ist.
    1580 
     1746      if(w>=1){"Newton-Polygon is degenerated";"";}
     1747
     1748      // the following can certainly be made more efficient when replacing
     1749      // 'reddevelop' (used only for computing number of branches) by
     1750      // successive blowing-up + test if Newton polygon degenerate:
    15811751      if(s>2)    //  splitting of f
    15821752      {
     1753         if(w>=1){"Newton polygon can be used for splitting";"";}
    15831754         intvec v=NP[1][2]-NP[2][2],NP[2][1];
    15841755         int de=w_deg(g,v);
    … …  
    16051776
    16061777      f=jet(f,deg(hc)+2);
     1778      if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";}
    16071779      list hne=reddevelop(f);
    16081780      nb=size(hne);
    … …  
    16141786   {
    16151787      f=jet(f,deg(hc)+2);
    1616       list hne=reddevelop(f);
    1617       nb=size(hne);
    1618       if(nb==1)
    1619       {
    1620          delta=invariants(hne[1])[5]/2;
    1621          setring R;
    1622          kill HNEring;
    1623          return(list(d*delta,d*tau,d));
    1624       }
    1625       setring R;
    1626       kill HNEring;
    1627       //delta direkt aus reddevelop zurueckgeben
    1628       ERROR("the case of small characteristic is not fully implemented yet");
     1788      if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";}
     1789      delt=delta(f);
     1790      return(list(d*delt,d*tau,d));
    16291791   }
    16301792}
    1631 
    1632 proc w_deg(poly p, intvec v)
     1793example
     1794{ "EXAMPLE:"; echo = 2;
     1795  ring r=0,(x,y),dp;
     1796  poly f=(x2+y^2-1)^3 +27x2y2;
     1797  ideal I=f,jacob(f);
     1798  I=std(I);
     1799  list qr=minAssGTZ(I);
     1800  size(qr);
     1801  // each component of the singular locus either describes a cusp or a pair
     1802  // of conjugated nodes:
     1803  deltaLoc(f,qr[1]);
     1804  deltaLoc(f,qr[2]);
     1805  deltaLoc(f,qr[3]);
     1806  deltaLoc(f,qr[4]);
     1807  deltaLoc(f,qr[5]);
     1808  deltaLoc(f,qr[6]);
     1809}
     1810///////////////////////////////////////////////////////////////////////////////
     1811// compute the weighted degree of p
     1812static proc w_deg(poly p, intvec v)
    16331813{
    16341814   if(p==0){return(-1);}
    … …  
    16391819}
    16401820
    1641 proc newton (poly f)
    1642 {
    1643    def R1=basering;
    1644    execute("ring R2=("+charstr(R1)+"),("+varstr(R1)+"),ls;");
    1645    poly f=imap(R1,f);
    1646    intvec A=(0,ord(subst(f,var(1),0)));
    1647    intvec B=(ord(subst(f,var(2),0)),0);
    1648    intvec C,H; list L;
    1649    int abbruch,i;
    1650    poly hilf;
    1651    L[1]=A;
    1652    f=jet(f,A[2]*B[1]-1,intvec(A[2],B[1]));
    1653    map xytausch=R2,var(2),var(1);
    1654    for (i=2; f!=0; i++)
    1655    {
    1656       abbruch=0;
    1657       while (abbruch==0)
    1658       {
    1659          C=leadexp(f);         
    1660          if(jet(f,A[2]*C[1]-A[1]*C[2]-1,intvec(A[2]-C[2],C[1]-A[1]))==0)
    1661          {
    1662             abbruch=1;
    1663          }       
    1664          else
    1665          {
    1666             f=jet(f,-C[1]-1,intvec(-1,0));
    1667          }
    1668      }
    1669      hilf=jet(f,A[2]*C[1]-A[1]*C[2],intvec(A[2]-C[2],C[1]-A[1]));
    1670      H=leadexp(xytausch(hilf));
    1671      A=H[2],H[1];
    1672      L[i]=A;
    1673      f=jet(f,A[2]*B[1]-1,intvec(A[2],B[1]-A[1]));
    1674    }
    1675    L[i]=B;
    1676    setring R1;
    1677    return(L);
    1678 }
     1821//proc hilbPoly(ideal J)
     1822//{ 
     1823//   poly hp;
     1824//   int i;
     1825//   if(!attrib(J,"isSB")){J=std(J);}
     1826//   intvec v = hilb(J,2);
     1827//   for(i=1; i<=size(v); i++){ hp=hp+v[i]*(var(1)-i+2);}
     1828//   return(hp);
     1829//}
    16791830
    16801831///////////////////////////////////////////////////////////////////////////
    … …  
    19012052
    19022053
    1903 ring r=0,(x,y),dp;   // genuss 1  with 5 cusps
    1904 ideal i=57y5+516x4y-320x4+66y4-340x2y3+73y3+128x2-84x2y2-96x2y;;
     2054ring r=0,(x,y),dp;   // genus 1  with 5 cusps
     2055ideal i=57y5+516x4y-320x4+66y4-340x2y3+73y3+128x2-84x2y2-96x2y;
    19052056
    19062057//Mark van Hoeij
    … …  
    19172068ideal i=((x2+y3)^2+xy6)*((x3+y2)^2+x10y);
    19182069
     2070ring r=0,(y,z,w,u),dp; //genus -5
     2071ideal i=y2+z2+w2+u2,w4-u4;
     2072
     2073ring r=0,(x,y,t),dp; //genus -5
     2074ideal i=x8+8x7y+32x6y2+80x5y3+136x4y4+160x3y5+128x2y6+64xy7+16y8+4x6t2+24x5yt2+72x4y2t2+128x3y3t2+144x2y4t2+96xy5t2+32y6t2+14x4t4+56x3yt4+112x2y2t4+112xy3t4+40y4t4+20x2t6+40xyt6+8y2t6+9t8;
     2075
     2076ring r=0,(y,z,w,u),dp; //genus 9
     2077ideal i=y2+z2+w2+u2,z4+w4+u4;
     2078
     2079ring r=0,(x,y,t),dp;
     2080ideal i=
     208125x8+200x7y+720x6y2+1520x5y3+2064x4y4+1856x3y5+1088x2y6+384xy7+64y8-12x6t2-72x5yt2-184x4y2t2-256x3y3t2-192x2y4t2-64xy5t2-2x4t4-8x3yt4+16xy3t4+16y4t4+4x2t6+8xyt6+8y2t6+t8;
     2082
     2083ring r=0,(x,y,t),dp;
     2084ideal i=
     208532761x8+786264x7y+8314416x6y2+50590224x5y3+193727376x4y4+478146240x3y5+742996800x2y6+664848000xy7+262440000y8+524176x7t+11007696x6yt+99772992x5y2t+505902240x4y3t+1549819008x3y4t+2868877440x2y5t+2971987200xy6t+1329696000y7t+3674308x6t2+66137544x5yt2+499561128x4y2t2+2026480896x3y3t2+4656222144x2y4t2+5746386240xy5t2+2976652800y6t2+14737840x5t3+221067600x4yt3+1335875904x3y2t3+4064449536x2y3t3+6226336512xy4t3+3842432640y5t3+36997422x4t4+443969064x3yt4+2012198112x2y2t4+4081745520xy3t4+3126751632y4t4+59524208x3t5+535717872x2yt5+1618766208xy2t5+1641991392y3t5+59938996x2t6+359633976xyt6+543382632y2t6+34539344xt7+103618032yt7+8720497t8;
     2086
     2087ring r=32003,(x,y,z,w,u),dp;
     2088ideal i=x2+y2+z2+w2+u2,x3+y3+z3,z4+w4+u4;
     2089
    19192090*/
    19202091

  • Singular/LIB/poly.lib

    rc22932 r11ddde  
    11///////////////////////////////////////////////////////////////////////////////
    2 version="$Id: poly.lib,v 1.33 2001-01-16 13:48:36 Singular Exp $";
     2version="$Id: poly.lib,v 1.34 2004-02-23 10:19:13 Singular Exp $";
    33category="General purpose";
    44info="
    … …  
    1313 is_zero(poly/...);     int, =1 resp. =0 if coker(input) is 0 resp. not
    1414 lcm(ideal);            lcm of given generators of ideal
    15  maxcoef(poly/...);     maximal length of coefficient occuring in poly/...
     15 maxcoef(poly/...);     maximal length of coefficient occurring in poly/...
    1616 maxdeg(poly/...);      int/intmat = degree/s of terms of maximal order
    1717 maxdeg1(poly/...);     int = [weighted] maximal degree of input
    … …  
    2525 mod2id(M,iv);          conversion of a module M to an ideal
    2626 id2mod(i,iv);          conversion inverse to mod2id
     27 substitute(I,...)      substitute in I variables by polynomials
    2728 subrInterred(i1,i2,iv);interred w.r.t. a subset of variables
     29 hilbPoly( I)           Hilbert polynomial of basering/I
    2830          (parameters in square brackets [] are optional)
    2931";
    … …  
    3234LIB "ring.lib";
    3335///////////////////////////////////////////////////////////////////////////////
    34 
     36static proc bino(int a, int b)
     37{
     38//computes binomial var(1)+a over b
     39   int i;
     40   if(b==0){return(1);}
     41   poly p=(var(1)+a)/b;
     42   for(i=1;i<=b-1;i++)
     43   {
     44      p=p*(var(1)+a-i)/i;
     45   }
     46   return(p);
     47}
     48
     49proc hilbPoly(ideal I)
     50"USAGE: hilbPoly(I) I a homogeneous ideal
     51RETURN: the Hilbert polynomial of basering/I as an intvec v=v_0,...,v_r
     52        such that the Hilbert polynomial is (v_0+v_1*t+...v_r*t^r)/r!
     53EXAMPLE: example hilbPoly; shows an example
     54"
     55{
     56   def R=basering;
     57   if(!attrib(I,"isSB")){I=std(I);}
     58   intvec v=hilb(I,2);
     59   int s=dim(I);
     60   intvec hp;
     61   if(s==0){return(hp);}
     62   int d=size(v)-2;
     63   ring S=0,t,dp;
     64   poly p=v[1+d]*bino(s-1-d,s-1);
     65   int i;
     66   for(i=1;i<=d;i++)
     67   {
     68      p=p+v[d-i+1]*bino(s-1-d+i,s-1);
     69   }
     70   int n=1;
     71   for(i=2;i<=s-1;i++){n=n*i;}
     72   p=n*p;
     73   for(i=1;i<=s;i++)
     74   {
     75      hp[i]=int(leadcoef(p[s-i+1]));
     76   }
     77   setring R;
     78   return(hp);
     79}
     80example
     81{ "EXAMPLE:"; echo = 2;
     82   ring r = 0,(b,c,t,h),dp;
     83   ideal I=
     84   bct-t2h+2th2+h3,
     85   bt3-ct3-t4+b2th+c2th-2bt2h+2ct2h+2t3h-bch2-2bth2+2cth2+2th3,
     86   b2c2+bt2h-ct2h-t3h+b2h2+2bch2+c2h2-2bth2+2cth2+t2h2-2bh3+2ch3+2th3+3h4,
     87   c2t3+ct4-c3th-2c2t2h-2ct3h-t4h+bc2h2-2c2th2-bt2h2+4t3h2+2bth3-2cth3-t2h3
     88   +bh4-6th4-2h5;
     89   hilbPoly(I);
     90}
     91
     92///////////////////////////////////////////////////////////////////////////////
     93proc substitute (I,list #)
     94"USAGE:  - case 1: typeof(#[1])==poly:
     95           substitute (I,v,f[,v1,f1,v2,f2,...]); I object of basering which
     96           can be mapped, v,v1,v2,.. ring variables, f,f1,f2,... poly
     97@*       - case 2: typeof(#[1])==ideal:
     98           substitute1 (I,v,f); I object of basering which can be mapped,
     99           v ideal of ring variables, f ideal
     100RETURN:  object of same type as I,
     101@*       - case 1: ring variable v,v1,v2,... substituted by polynomials
     102           f,f1,f2,..., in this order
     103@*       - case 2: ring variables in v substituted by polynomials in f:
     104           v[i] is substituted by f[i], i=1,...,i=min(size(v),ncols(f))
     105NOTE:    this procedure extends the built-in command subst which substitutes
     106         ring variables only by monomials
     107EXAMPLE: example substitute; shows an example
     108"
     109
     110{
     111   def bas = basering;
     112   ideal m = maxideal(1);
     113   int i,ii;
     114   if(typeof(#[1])=="poly")
     115   {
     116     poly v = #[1];
     117     poly f = #[2];
     118     map phi = bas,m;
     119     def J = I;
     120     for (ii=1; ii<=size(#) - 1; ii=ii+2)
     121     {
     122        m = maxideal(1);
     123        i=rvar(#[ii]);
     124        m[i] = #[ii+1];
     125        phi = bas,m;
     126        J = phi(J);
     127     }
     128     return(J);
     129   }
     130   if(typeof(#[1])=="ideal")
     131   {
     132     ideal v = #[1];
     133     ideal f = #[2];
     134     int mi = size(v);
     135     if(ncols(f)<mi)
     136     {
     137        mi = ncols(f);
     138     }
     139     m[rvar(v[1])]=f[1];
     140     map phi = bas,m;
     141     def J = phi(I);
     142     for (ii=2; ii<=mi; ii++)
     143     {
     144        m = maxideal(1);
     145        m[rvar(v[ii])]=f[ii];
     146        phi = bas,m;
     147        J = phi(J);
     148     }
     149     return(J);
     150   }
     151}
     152example
     153{ "EXAMPLE:"; echo = 2;
     154   ring r = 0,(b,c,t),dp;
     155   ideal I = -bc+4b2c2t,bc2t-5b2c;
     156   substitute(I,c,b+c,t,0,b,b-1);
     157   ideal v = c,t,b;
     158   ideal f = b+c,0,b-1;
     159   substitute(I,v,f);
     160}
     161///////////////////////////////////////////////////////////////////////////////
    35162proc cyclic (int n)
    36163"USAGE:   cyclic(n);  n integer
    … …  
    278405         (maxdeg of each var is 1).
    279406         Of type int if id is of type poly, of type intmat else
    280 NOTE:    proc maxdeg1 returns 1 integer, the absolut maximum; moreover, it has
     407NOTE:    proc maxdeg1 returns 1 integer, the absolute maximum; moreover, it has
    281408         an option for computing weighted degrees
    282409EXAMPLE: example maxdeg; shows examples
    … …  
    317444example
    318445{ "EXAMPLE:"; echo = 2;
    319    ring r = 0,(x,y,z),wp(-1,-2,-3);
     446   ring r = 0,(x,y,z),wp(1,2,3);
    320447   poly f = x+y2+z3;
    321448   deg(f);             //deg; returns weighted degree (in case of 1 block)!
    … …  
    397524example
    398525{ "EXAMPLE:"; echo = 2;
    399    ring r = 0,(x,y,z),wp(-1,-2,-3);
     526   ring r = 0,(x,y,z),wp(1,2,3);
    400527   poly f = x+y2+z3;
    401528   deg(f);            //deg returns weighted degree (in case of 1 block)!
    … …  
    404531   maxdeg1(f,v);                        //weighted maximal degree
    405532   matrix m[2][2]=f+x10,1,0,f^2;
    406    maxdeg1(m,v);                        //absolut weighted maximal degree
     533   maxdeg1(m,v);                        //absolute weighted maximal degree
    407534}
    408535///////////////////////////////////////////////////////////////////////////////
    … …  
    413540         (mindeg of each variable is 1) of type int if id of type poly, else
    414541         of type intmat.
    415 NOTE:    proc mindeg1 returns one integer, the absolut minimum; moreover it
     542NOTE:    proc mindeg1 returns one integer, the absolute minimum; moreover it
    416543         has an option for computing weighted degrees.
    417544EXAMPLE: example mindeg; shows examples
    … …  
    539666   mindeg1(f,v);            // computes minimal weighted degree
    540667   matrix m[2][2]=x10,1,0,f^2;
    541    mindeg1(m,1..3);         // computes absolut minimum of weighted degrees
     668   mindeg1(m,1..3);         // computes absolute minimum of weighted degrees
    542669}
    543670///////////////////////////////////////////////////////////////////////////////
    … …  
    611738
    612739proc lcm (id, list #)
    613 "USAGE:   lcm(p[,q]); p int/intve q a list of integers or
     740"USAGE:   lcm(p[,q]); p int/intvec q a list of integers or
    614741          p poly/ideal q a list of polynomials
    615742RETURN:  the least common multiple of the common entries of p and q:
    … …  
    8971024          l[2]=their coefficients after interreduction
    8981025          l[3]=l[1]*l[2]
    899 PUPOSE:  Do interred only w.r.t. a subset of variables.
     1026PURPOSE:  Do interred only w.r.t. a subset of variables.
    9001027         The procedure returns an interreduced system of generators of
    9011028         sm considered as a k[t_1,..,t_s]-submodule of the free module
Note: See TracChangeset for help on using the changeset viewer.