Changeset cc9598 in git


Ignore:
Timestamp:
Oct 8, 1997, 10:57:21 AM (26 years ago)
Author:
Kai Krüger <krueger@…>
Branches:
(u'spielwiese', '5b153614cbc72bfa198d75b1e9e33dab2645d9fe')
Children:
ed1f771289e1b7f9e6c011032bb37775eedffaa9
Parents:
a3872e12ad2f5f7b36f8d1c0875192e5c8f7f97f
Message:
Wed Oct  8 10:51:49 MET DST 1997
  Modified Files:
 	classify.lib makedbm.lib
  Removed Files:
 	hilbert.lib morse.lib nflist.lib tools.lib
        * alles in einem File 'classify.lib'
        * 'export' minimiert
        * 'execute' minimiert
        * Endausgabe zentralisiert in printresult()
        * Procedurnamen angepasst
        * lokale Variable ohne '@', globale mit '@'
        * einiege Proceduren neu geschrieben.


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

Legend:

Unmodified
Added
Removed
  • Singular/LIB/classify.lib

    ra3872e rcc9598  
    1 // $Id: classify.lib,v 1.14 1997-09-29 11:30:33 krueger Exp $
     1// $Id: classify.lib,v 1.15 1997-10-08 08:57:15 krueger Exp $
    22//
    33//  A library for the classification of isolated hypersurface singularities
     
    1212LIBRARY:  classify.lib  PROCEDURES FOR THE ARNOLD-CLASSIFIER OF SINGULARITIES 
    1313
     14basicinvariants(f);  computes Milnor number, determinacy-bound and corank of f
    1415classify(f);         normal form of poly f determined with Arnold's method
     16corank(f);           computes the corank of f (i.e. of the Hessian of f)
     17Hcode(v);            coding of intvec v acoording to the number repetitions
     18init_debug([n]);     print trace and debugging information depending on int n 
     19internalfunctions(); display names of internal procedures of this library
     20milnorcode(f[,e]);   Hilbert poly of [e-th] Milnor algebra coded with Hcode
     21morsesplit(f);       residual part of f after applying the splitting lemma
    1522quickclass(f)        normal form of f determined by invariants (milnorcode)
    16 corank(f);           computes the corank of f (i.e. of the Hessian of f)
    17 basicinvariants(f);  computes Milnor number, determinacy-bound and corank of f
    18 milnorcode(f[,e]);   Hilbert poly of [e-th] Milnor algebra coded with Hcode
    19 Hcode(v);            coding of intvec v acoording to the number repetitions
    20 morsesplit(f);       residual part of f after applying the splitting lemma
    21 tschirnhaus(f,v);    Tschirnhaus transformation of f w.r.t. variable v
    2223singinfo(N,[k,]);    info about singularity given by its name N and index k
    2324singularity(s,[]);   normal form of singularity given by its name s and index 
    24 init_debug([n]);     print trace and debugging information depending on int n 
    25 internalfunctions(); display names of internal procedures of this library
     25tschirnhaus(f,v);    Tschirnhaus transformation of f w.r.t. variable v
    2626(parameters in square brackets [] are optional)
    2727
     28// required libraries
    2829LIB "inout.lib";
    29 
    30 // required libraries
    31 
    32 LIB "morse.lib";
    33 LIB "tools.lib";
    34 LIB "nflist.lib";
    35 LIB "hilbert.lib";
    3630LIB "elim.lib";
     31LIB "sing.lib";
    3732
    3833///////////////////////////////////////////////////////////////////////////////
     
    5954  int show_nf  = 1;                // return normal form if set to '1'
    6055  int i;
     56  int corank;
    6157
    6258  if(checkring()) { return(f_in); }
     
    6763  export @Rtop;
    6864
    69   map conv_ringtop2rtop=ring_top,maxideal(1);
     65  map conv_ringtop2Rtop=ring_top,maxideal(1);
    7066  setring ring_top;
    7167
     
    8278  string s2;
    8379  string s4;
    84   s1,s2=Klassifiziere(conv_ringtop2rtop(f_in));
     80  list v;
     81  v = Klassifiziere(conv_ringtop2Rtop(f_in));
     82  s1 = v[1];
     83  s2 = v[2];
     84  corank = v[3];
    8585  // s1: f nach saemtlichen Koordinatentransformationen
    8686  // s2: Typ des Polynoms f z.b: E[18]
     
    9595      return(f_in);
    9696    }
     97    "  T1";
     98    ring tmp_ring=char(basering),(x,y,z),ds;
     99    execute s4;
    97100    setring @Rtop;
    98     execute s4;
    99101    map ConvUp=@Rtop,maxideal(1);
    100102  }
    101103  else {
     104    "  T2";
    102105    setring RingB;
    103106    execute s4;
     
    107110  if(show_nf==1) {
    108111    poly f_nf = normalform(s2);
    109     for(i=4;i<=n;i=i+1) {
     112    for(i=corank+1;i<=n;i=i+1) {
    110113      f_nf = f_nf + x(i)^2;
    111114    }
    112     if(DeBug>1) { "Normal form NF(f)=", f_nf; }
     115    if(@DeBug>1) { "Normal form NF(f)=", f_nf; }
    113116  }
    114117  poly f_out = ConvUp(f_out);
    115   for(i=CoRang+1;i<=n;i=i+1) {
     118  for(i=corank+1;i<=n;i=i+1) {
    116119    f_out = f_out + x(i)^2;
    117120  }
    118121  setring ring_top;
    119   map conv_rtop2ringtop=@Rtop,maxideal(1);
     122  map conv_Rtop2ringtop=@Rtop,maxideal(1);
    120123
    121124  if(show_nf == 1) {
    122     return(conv_rtop2ringtop(f_nf));
    123   }
    124   else { return(conv_rtop2ringtop(f_out)); }
     125    return(conv_Rtop2ringtop(f_nf));
     126  }
     127  else { return(conv_Rtop2ringtop(f_out)); }
    125128}
    126129example
     
    134137
    135138///////////////////////////////////////////////////////////////////////////////
    136   proc Klassifiziere (poly f)
    137   {
     139proc Klassifiziere (poly f)
     140{
    138141  //-------------------------- initialisation ---------------------------------
    139142    string s1;
    140     int cnt;
    141   //  init(1);
     143    int cnt, corank_f, K, Mu;
    142144    int  n = nvars(basering);    // Zahl der Variablen des aktuellen Rings.
    143 
    144     // Define always '@ringdisplay' to be able to run 'Show(f)'
     145    def ring_top = basering;
     146
     147    // Define always 'ringdisplay' to be able to run 'Show(f)'
    145148    if( defined(@ringdisplay) == 0) {
    146149      string @ringdisplay;
     
    149152    @ringdisplay = "setring RingB;";
    150153
    151     if(defined(SG_Typ) == 1) { kill SG_Typ; } // Typ(s) von f nach Hilbert.
    152     string SG_Typ = "";
    153     export SG_Typ;
     154    if(defined(@SG_Typ) == 1) { kill @SG_Typ; } // Typ(s) von f nach Hilbert.
     155    string @SG_Typ = "";
     156    export @SG_Typ;
    154157
    155158    execute ("ring RingB="+charstr(basering)+",("+A_Z("x", n)+"),(c,ds);");
     159//    map @showpoly=@Rtop,maxideal(1);
    156160    execute("map @showpoly=@Rtop,"+A_Z("x", n)+";");
    157161    export @showpoly;
    158     setring @Rtop;                 // in den Ausgangs-ring zurueck.
     162//    setring @Rtop;                 // in den Ausgangs-ring zurueck.
     163    setring ring_top;
    159164    export RingB;
    160165
     
    162167
    163168    if(jet(f,0) != 0 ) {
    164       if(defined(CoRang) == 0) { int CoRang = CoRangf(f); }
    165       return("1", "f is a unit");
     169      corank_f = corank(f);
     170      return(printresult(1, f, "a unit", -1, -1, corank_f, 1));
    166171    }
    167172
    168173    debug_log(1, "Computing Basicinvariants of f ...");
    169     if(defined(Mu) == 1) { kill Mu; }
    170     if(defined(K) == 1) { kill K; }
    171     if(defined(CoRang) == 1) { kill CoRang; }
    172     int K;
    173     int Mu;
    174     int CoRang;
    175     K, Mu, CoRang = basicinvariants(f);
    176     "About the singularity :";
    177     "          Milnor number(f)   = "+string(Mu);
    178     "          Corank(f)          = "+string(CoRang);
    179     "          Determinacy       <= "+string(K);
    180     export CoRang, K, Mu;
    181 
    182   //  ideal Jf = Jf;
    183   //  if(dim(std(EH(Jf))) != n) { return("x(1)","A[0]"); }
     174    K, Mu, corank_f = basicinvariants(f);
     175    debug_log(0, "About the singularity :");
     176    debug_log(0, "          Milnor number(f)   = "+string(Mu));
     177    debug_log(0, "          Corank(f)          = "+string(corank_f));
     178    debug_log(0, "          Determinacy       <= "+string(K));
     179
    184180    if( Mu == 0) {
    185       CoRang=1;
    186       return("x(1)","A[0]");
     181      f;
     182      return(printresult(1, f, "A[0]", Mu, 0, 1, 1));
    187183    }
    188184
    189185    if(Mu<0) {
    190       "The Milnor number of the function is infinite.";
    191       "The singularity is not in Arnolds list.";
    192       return("", "Fehler!");
     186      debug_log(0, "The Milnor number of the function is infinite.");
     187      debug_log(0, "The singularity is not in Arnolds list.");
     188      return(printresult(1, 1, "Fehler!", Mu, -1, corank_f, K));
    193189    }
    194190
    195191    f = jet(f, K);
    196     s1,cnt = HKclass(Hilb(f));
    197     if(cnt>0) { "Guessing type via Hilbert polynomial: ", s1; }
    198     else { "Hilbert polynomial not recognised. Milnor code = ", Hilb(f); }
    199     "";
    200     "Computing normal form ...";
     192    s1,cnt = HKclass(milnorcode(f));
     193    if(cnt>0) { debug_log(0, "Guessing type via Hilbert polynomial: ", s1); }
     194    else {
     195      debug_log(0, "Hilbert polynomial not recognised. Milnor code = ",
     196                milnorcode(f));
     197    }
     198    debug_log(0, "");
     199    debug_log(0, "Computing normal form ...");
    201200
    202201    // Einteilung nach Corang
    203202    if( defined(ShowPhi) == 0) { int ShowPhi = 0; }
    204     if(CoRang == 0) { return(Funktion2(f, CoRang)); }
    205     if(CoRang == 1) { return(Funktion2(f, CoRang)); }
    206     if(CoRang == 2) { return(Funktion1bis(f, CoRang)); }
    207     if(CoRang == 3) { return(Funktion1bis(f, CoRang)); }
    208     return(Funktion105(f, CoRang));
    209   }
    210 
    211 ///////////////////////////////////////////////////////////////////////////////
    212   proc Funktion1bis (poly @f, int corank)
    213   { // pruefe ob abspaltung von Quadraten noetig, wenn ja tue dies.
     203    if(corank_f == 0) { return(Funktion2(f, corank_f, Mu, K)); }
     204    if(corank_f == 1) { return(Funktion2(f, corank_f, Mu, K)); }
     205    if(corank_f == 2) { return(Funktion1bis(f, corank_f, Mu, K)); }
     206    if(corank_f == 3) { return(Funktion1bis(f, corank_f, Mu, K)); }
     207    return(Funktion105(f, corank_f, Mu, K));
     208}
     209
     210///////////////////////////////////////////////////////////////////////////////
     211proc Funktion1bis (poly f, int corank, int Mu, int K)
     212{ // pruefe ob abspaltung von Quadraten noetig, wenn ja tue dies.
    214213 
    215     int  @n = nvars(basering);
    216     string @s1;
    217     string @RestRing = nameof(basering);
     214//---------------------------- initialisation ---------------------------------
     215    int  n = nvars(basering);
     216    string s1;
     217    def ring_top=basering;
     218//    string RestRing = nameof(basering);
    218219 
    219     if( @n > corank) {
    220       "I have to apply the splitting lemma. This will take some time....:-)";
    221       poly @g = Morse(@f, K, corank);
     220    if( n > corank) {
     221      debug_log(0,
     222       "I have to apply the splitting lemma. This will take some time....:-)");
     223      poly g = Morse(f, K, corank);
    222224 
    223       @g = ReOrder(@g);
     225      g = ReOrder(g);
    224226      if(defined(PhiG)==1) { kill PhiG; }
    225227      if(defined(Rrest) == 1) { kill Rrest; }
     
    229231      execute Setring(corank, "Rrest");
    230232      export Rrest;
    231       @RestRing = nameof(basering);
     233      //RestRing = nameof(basering);
     234      def ring_top=basering;
    232235 
    233       map @MapReduce=@Rtop,maxideal(1);
    234       poly @G = @MapReduce(@g);
     236      map MapReduce=@Rtop,maxideal(1);
     237      poly G = MapReduce(g);
    235238 
    236       @s1 = "map PhiG=@Rtop," + string(maxideal(1));// Konstruiere Id auf r
    237       execute @s1;
     239      s1 = "map PhiG=@Rtop," + string(maxideal(1));// Konstruiere Id auf r
     240      execute s1;
    238241      export PhiG;
    239242 
     
    241244      export RingB;
    242245    }
    243     else { poly @G = @f; }
     246    else { poly G = f; }
    244247 
    245248    setring RingB;
    246     @s1 = "map @showpoly=",@RestRing,","+A_Z("x", corank)+";";
    247     execute @s1;
     249    s1 = "map @showpoly=ring_top,"+A_Z("x", corank)+";";
     250    execute s1;
     251//    map @showpoly=RestRing,maxideal(1);
    248252    export @showpoly;
    249     @s1 = "setring ",@RestRing,";";
    250     execute @s1;
    251  
     253//    s1 = "setring ",RestRing,";";
     254//    execute s1;
     255    setring ring_top;
     256
    252257    if(defined(PhiG)==0) {
    253258      map PhiG=basering, maxideal(1);
    254259      export PhiG;
    255260    }
    256     if(corank == 2) { return(Funktion3(@G, corank)); }
    257     if(corank == 3) { return(Funktion50(@G, corank)); }
    258     return("","Fehler!");
    259   }
    260 
    261 ///////////////////////////////////////////////////////////////////////////////
    262 proc Funktion3 (poly @f, int corank);
    263 USAGE:    Funktion3();
     261    debug_log(0, "1bis ferting....");
     262    if(corank == 2) { return(Funktion3(G, corank, Mu, K)); }
     263    if(corank == 3) { return(Funktion50(G, corank, Mu, K)); }
     264    return(printresult(1, f, "Fehler!", Mu, -1, corank, K));
     265}
     266
     267///////////////////////////////////////////////////////////////////////////////
     268proc Funktion3 (poly f, int corank, int Mu, int K)
    264269{
    265   poly @f3 = jet(@f, 3);
    266   debug_log(1, "Schritt 3");
    267 
    268   if( @f3 == 0 ) { return(Funktion13(@f, corank)); }
    269 
    270   // f3 ~ x3 , x2y+y3 , x2y
    271   ideal @Jf = jacob(@f3);
    272   @Jf = std(@Jf);
    273   int @Dim = dim(@Jf);
    274   if(@Dim == 0) { return(Funktion4(@f, corank)); } // D[4]
    275 
    276   if(@Dim == 1) {
    277     if( mult(@Jf) == 1) { return(Funktion5(@f, corank)); } // D[k]
    278     if( mult(@Jf) == 2) { return(Funktion6(@f, corank)); } // E[k], J
    279     "dimension 1 und deg != 1, 2 => error, this should never occur";
    280     return("", "Fehler!");      // Should never occur
    281   }
    282   return("", "Fehler!");        // Should never occur
    283 }
    284 
    285 ///////////////////////////////////////////////////////////////////////////////
    286 proc Funktion6 (poly @f, int corank)
    287 USAGE:    Funktion6()
     270    poly f3 = jet(f, 3);
     271    debug_log(1, "Schritt 3");
     272
     273    if( f3 == 0 ) { return(Funktion13(f, corank, Mu, K)); }
     274
     275    // f3 ~ x3 , x2y+y3 , x2y
     276    ideal Jf = jacob(f3);
     277    Jf = std(Jf);
     278    int Dim = dim(Jf);
     279    if(Dim == 0) { return(Funktion4(f, corank, Mu, K)); } // D[4]
     280
     281    if(Dim == 1) {
     282      if( mult(Jf) == 1) { return(Funktion5(f, corank, Mu, K)); } // D[k]
     283      if( mult(Jf) == 2) { return(Funktion6(f, corank, Mu, K)); } // E[k], J
     284      "dimension 1 und deg != 1, 2 => error, this should never occur";
     285      return(printresult(3, f, "Fehler!", Mu, -1, corank, K));
     286      // Should never occur
     287    }
     288    // Should never reach this line
     289    return(printresult(3, f, "Fehler!", Mu, -1, corank, K));
     290}
     291
     292///////////////////////////////////////////////////////////////////////////////
     293proc Funktion6 (poly f, int corank, int Mu, int K)
    288294{
    289   int @n = nvars(basering);     // Zahl der Ringvariablen
    290   poly @f3 = jet(@f, 3);        // 3-Jet von f
    291   poly @fk;                     // k-Jet von f mit Gewichten
    292   ideal @JetId;                 // Ideal fuer Gewichteten Jet
    293   ideal @Jf;                    // jacob(@fk)
    294   int  @Dim;                    // dim(@Jf)
    295   int  @Mult;                   // mult(@Jf)
    296   int @k = 1;                   //
    297 
    298   debug_log(1, "   Schritt 6");
    299 
    300   GetRf(@f, @n);
    301   @f = Faktorisiere(@f, @f3, 3, 1);
    302 
    303 
    304   //-------------------------------------------------------
    305   // Bestimme nun Typ der E[k]
    306   while( (6*@k) <= Mu ) {
    307     @JetId = x(1)^3+x(2)^(3*@k);
    308     @fk = jet(@f, 3*@k, weight(@JetId));
    309     if( @fk == Coeff(@fk,x(1), x(1)^3)*x(1)^3 ) {
    310       //-------------------------------------------------------
    311       //                      Pruefe Jet x3,y3k+1  : E[6k]
    312       @JetId = x(1)^3+x(2)^(3*@k+1);
    313       @fk = jet(@f, 3*(3*@k+1), weight(@JetId));
    314       if( Coeff(@fk,x(2),x(2)^(3*@k+1)) != 0 ) { return(Funktion7(@f,@k)); }
    315 
    316       //-------------------------------------------------------
    317       //                      Pruefe Jet x3,xy2k+1 : E[6k+1]
    318       @JetId = x(1)^3+x(1)*x(2)^(2*@k+1);
    319       @fk = jet(@f, 3*(2*@k+1), weight(@JetId));
    320       if( Coeff(@fk, x(1)*x(2), x(1)*x(2)^(2*@k+1)) != 0 ) {
    321         return(Funktion8(@f,@k)); }
    322 
    323       //-------------------------------------------------------
    324       //                      Pruefe Jet x3,y3k+1  : E[6k+2]
    325       @JetId = x(1)^3+x(2)^(3*@k+2);
    326       @fk = jet(@f, 3*(3*@k+2), weight(@JetId));
    327       if( Coeff(@fk,x(2),x(2)^(3*@k+2)) != 0 ) { return(Funktion9(@f,@k)); }
    328 
    329       //-------------------------------------------------------
    330       //                      Arnold - Funktion 10 mit k+1
    331       // Gehe zu Funktion 10 mit k+1
    332       @k=@k+1;
    333       @JetId = x(1)^3+x(2)^(3*@k);
    334       @fk = jet(@f, 3*@k, weight(@JetId));
    335       @Jf = std(jacob(@fk));
    336       @Dim = dim(@Jf);
    337       //-------------------------------------------------
    338       //       Pruefe : fk ~ x3 + ax2yk + y3k mit 4a3+27 <> 0
    339       if( @Dim == 0 ) { return(Funktion11(@f,@k)); }
    340 
    341       //-------------------------------------------------
    342       //       Pruefe : fk ~ x3 + x2yk
    343       @Mult = mult(@Jf);
    344       if( @Dim ==1  && @Mult==1) { return(Funktion12(@f,@k)); }
    345       //-------------------------------------------------
    346       //       Pruefe : fk ~ x3
    347       if( @Dim == 1  && @Mult == 2) {
    348         if(Coeff(@fk, x(2), x(2)^(3*@k)) != 0) {
    349           @f = Faktorisiere(@f, @fk, 3, @k);
     295//---------------------------- initialisation ---------------------------------
     296    int n = nvars(basering);     // Zahl der Ringvariablen
     297    poly f3 = jet(f, 3);        // 3-Jet von f
     298    poly fk;                     // k-Jet von f mit Gewichten
     299    ideal JetId;                 // Ideal fuer Gewichteten Jet
     300    ideal Jf;                    // jacob(fk)
     301    int  Dim;                    // dim(Jf)
     302    int  Mult;                   // mult(Jf)
     303    int k = 1;                   //
     304
     305    debug_log(1, "   Schritt 6");
     306
     307    GetRf(f, n);
     308    f = Faktorisiere(f, f3, 3, 1);
     309
     310
     311    //-------------------------------------------------------
     312    // Bestimme nun Typ der E[k]
     313    while( (6*k) <= Mu ) {
     314      JetId = x(1)^3+x(2)^(3*k);
     315      fk = jet(f, 3*k, weight(JetId));
     316      if( fk == Coeff(fk,x(1), x(1)^3)*x(1)^3 ) {
     317        //-------------------------------------------------------
     318        //                      Pruefe Jet x3,y3k+1  : E[6k]
     319        JetId = x(1)^3+x(2)^(3*k+1);
     320        fk = jet(f, 3*(3*k+1), weight(JetId));
     321        if( Coeff(fk,x(2),x(2)^(3*k+1)) != 0 ) {
     322          return(Funktion7(f, corank, Mu, K, k)); }
     323
     324        //-------------------------------------------------------
     325        //                      Pruefe Jet x3,xy2k+1 : E[6k+1]
     326        JetId = x(1)^3+x(1)*x(2)^(2*k+1);
     327        fk = jet(f, 3*(2*k+1), weight(JetId));
     328        if( Coeff(fk, x(1)*x(2), x(1)*x(2)^(2*k+1)) != 0 ) {
     329          return(Funktion8(f, corank, Mu, K, k)); }
     330
     331        //-------------------------------------------------------
     332        //                      Pruefe Jet x3,y3k+1  : E[6k+2]
     333        JetId = x(1)^3+x(2)^(3*k+2);
     334        fk = jet(f, 3*(3*k+2), weight(JetId));
     335        if( Coeff(fk,x(2),x(2)^(3*k+2)) != 0 ) {
     336          return(Funktion9(f, corank, Mu, K, k)); }
     337
     338        //-------------------------------------------------------
     339        //                      Arnold - Funktion 10 mit k+1
     340        // Gehe zu Funktion 10 mit k+1
     341        k=k+1;
     342        JetId = x(1)^3+x(2)^(3*k);
     343        fk = jet(f, 3*k, weight(JetId));
     344        Jf = std(jacob(fk));
     345        Dim = dim(Jf);
     346        //-------------------------------------------------
     347        //       Pruefe : fk ~ x3 + ax2yk + y3k mit 4a3+27 <> 0
     348        if( Dim == 0 ) { return(Funktion11(f, corank, Mu, K, k)); }
     349
     350        //-------------------------------------------------
     351        //       Pruefe : fk ~ x3 + x2yk
     352        Mult = mult(Jf);
     353        if( Dim ==1  && Mult==1) { return(Funktion12(f, corank, Mu, K, k)); }
     354        //-------------------------------------------------
     355        //       Pruefe : fk ~ x3
     356        if( Dim == 1  && Mult == 2) {
     357          if(Coeff(fk, x(2), x(2)^(3*k)) != 0) {
     358            f = Faktorisiere(f, fk, 3, k);
     359          }
    350360        }
    351361      }
    352362    }
    353   }
    354   return("","Fehler!");
    355 }
    356 
    357 ///////////////////////////////////////////////////////////////////////////////
    358 proc Funktion13 (poly @f, int corank)
    359 USAGE:    Funktion13();
     363    // Should never reach this line
     364    return(printresult(6, f, "Fehler!", Mu, -1, corank, K));
     365}
     366
     367///////////////////////////////////////////////////////////////////////////////
     368proc Funktion13 (poly f, int corank, int Mu, int K)
    360369{
    361   poly @f4 = jet(@f, 4);
    362   debug_log(1, "   Schritt 13");
    363   if( @f4 == 0 ) { return(Funktion47(@f, corank)); }
    364 
    365   // f4 ~ x4+ax2y2+y4, x4+x2y2, x2y2, x3y, x4
    366   ideal @Jf = std(jacob(@f4));
    367   int @Dim = dim(@Jf);
    368   int @Mult = mult(@Jf);
    369 
    370   if( @Dim == 0) { return(Funktion14(@f, corank)); } // X[9]=X[1,0]=T[2,4,4]
    371   if( @Dim == 1) {
    372     if( @Mult == 1 ) { return(Funktion15(@f, corank)); }
    373     if( @Mult == 2 ) {
    374       @Jf = @Jf, jacob(@Jf);
    375       @Jf = std(@Jf);
    376       @Dim = dim(@Jf);
    377       if( @Dim == 0 ) { return(Funktion16(@f, corank)); }
    378       if( @Dim == 1 ) { return(Funktion17(@f, corank)); }
    379     }
    380     if( @Mult == 3 ) { return(Funktion25(@f, corank)); }
    381   }
    382   return("","Fehler!");
    383 }
    384 
    385 ///////////////////////////////////////////////////////////////////////////////
    386 proc Funktion17 (poly @f, int corank)
    387 USAGE:    Funktion17();
    388 { // Analog zu Fumktion 6
    389   // Komb. 17-24
    390   int   @p = 1;
    391   poly  @fk = jet(@f, 4);
    392   poly  @ft;
    393   ideal @JetId;
    394   ideal @Jf;
    395   int   @Dim;
    396   int   @Mult;
    397 
    398   debug_log(1, "      Schritt 17");
    399   while( 3*@p<= Mu) {
    400     debug_log(1, "Schritt 18(", @p, ")");
    401     @f = Isomorphie_s17(@f, @fk, @p, 1);
    402     if ( @p>1) {
    403       @JetId = x(1)^3*x(2) + x(2)^(3*@p);       // weight(@JetId);
    404       @fk = jet(@f, 3*@p, weight(@JetId));
    405     }
    406     // Z[6p+5]
    407     @JetId = x(1)^3*x(2) + x(2)^(3*@p+2);
    408     @fk = jet(@f, 3*(3*@p+2), weight(@JetId));
    409     if( Coeff(@fk, x(2), x(2)^(3*@p+2)) != 0) { return(Funktion19(@f, @p));}
    410 
    411     // Z[6p+6]
    412     @JetId = x(1)^3*x(2) + x(1)*x(2)^(2*@p+2);
    413     @fk = jet(@f, 2*(3*@p+2)+1, weight(@JetId));
    414     if( Coeff(@fk, x(1)*x(2), x(1)*x(2)^(2*@p+2)) != 0) {
    415       return(Funktion20(@f, @p));}
     370    poly f4 = jet(f, 4);
     371    debug_log(1, "   Schritt 13");
     372    if( f4 == 0 ) { return(Funktion47(f, corank, Mu, K)); }
     373
     374    // f4 ~ x4+ax2y2+y4, x4+x2y2, x2y2, x3y, x4
     375    ideal Jf = std(jacob(f4));
     376    int Dim = dim(Jf);
     377    int Mult = mult(Jf);
     378
     379    if( Dim == 0) { return(Funktion14(f, corank, Mu, K)); } // X[9]=X[1,0]=T[2,4,4]
     380    if( Dim == 1) {
     381      if( Mult == 1 ) { return(Funktion15(f, corank, Mu, K)); }
     382      if( Mult == 2 ) {
     383        Jf = Jf, jacob(Jf);
     384        Jf = std(Jf);
     385        Dim = dim(Jf);
     386        if( Dim == 0 ) { return(Funktion16(f, corank, Mu, K)); }
     387        if( Dim == 1 ) { return(Funktion17(f, corank, Mu, K)); }
     388      }
     389      if( Mult == 3 ) { return(Funktion25(f, corank, Mu, K)); }
     390    }
     391    // Should never reach this line
     392    return(printresult(13, f, "Fehler!", Mu, -1, corank, K));
     393}
     394
     395///////////////////////////////////////////////////////////////////////////////
     396proc Funktion17 (poly f, int corank, int Mu, int K)
     397{ // Analog zu Fumktion 6, Kombination 17-24
     398//---------------------------- initialisation ---------------------------------
     399    int   p = 1;
     400    poly  fk = jet(f, 4);
     401    poly  ft;
     402    ideal JetId;
     403    ideal Jf;
     404    int   Dim;
     405    int   Mult;
     406
     407    debug_log(1, "      Schritt 17");
     408    while( 3*p<= Mu) {
     409      debug_log(1, "Schritt 18(", p, ")");
     410      f = Isomorphie_s17(f, fk, p, 1);
     411      if ( p>1) {
     412        JetId = x(1)^3*x(2) + x(2)^(3*p);       // weight(JetId);
     413        fk = jet(f, 3*p, weight(JetId));
     414      }
     415      // Z[6p+5]
     416      JetId = x(1)^3*x(2) + x(2)^(3*p+2);
     417      fk = jet(f, 3*(3*p+2), weight(JetId));
     418      if( Coeff(fk, x(2), x(2)^(3*p+2)) != 0) {
     419        return(Funktion19(f, corank, Mu, K, p)); }
     420
     421      // Z[6p+6]
     422      JetId = x(1)^3*x(2) + x(1)*x(2)^(2*p+2);
     423      fk = jet(f, 2*(3*p+2)+1, weight(JetId));
     424      if( Coeff(fk, x(1)*x(2), x(1)*x(2)^(2*p+2)) != 0) {
     425        return(Funktion20(f, corank, Mu, K, p));}
    416426   
    417     // Z[6p+7]
    418     @JetId = x(1)^3*x(2) + x(2)^(3*@p+3);
    419     @fk = jet(@f, 3*(3*@p+3), weight(@JetId));
    420     if( Coeff(@fk, x(2), x(2)^(3*@p+3)) != 0) { return(Funktion21(@f, @p));}
    421 
    422     @p = @p+1;
    423     @JetId = x(1)^3*x(2) + x(2)^(3*@p+1); // weight(@JetId);
    424     @fk = jet(@f, 3*@p+1, weight(@JetId));
    425     @ft = Teile(@fk, x(2));
    426     @Jf = std(jacob(@ft));
    427     @Dim = dim(@Jf);
    428     @Mult = mult(@Jf);
    429 //    "fk=",Show(@fk)," ft=",Show(@ft)," p=",@p," Dim=", @Dim, "  Mult=",@Mult;
    430     if( @Dim == 0 ) { return(Funktion23(@f, @p)); }
    431     if( @Mult == 1 ) { return(Funktion24(@f, @p)); }
    432   }
    433   return("","Fehler!");
    434 }
    435 
    436 ///////////////////////////////////////////////////////////////////////////////
    437 proc Funktion25 (poly @f, int CoRang)
    438 USAGE:    Funktion25();
    439 {
    440 //  // Komb. 25-46
    441   // definition der Variablen
    442   int   @k = 1;
    443   poly  @fk = jet(@f, 4);
    444   poly  @ft;
    445   ideal @JetId;
    446   ideal @Jf;
    447   int   @Dim;
    448   int   @Mult;
    449   debug_log(1, "      Schritt 25");
    450 
    451   // Code
    452   while (@k<Mu) {
    453     @f =  Faktorisiere(@f, @fk, 4 , @k);
    454 
    455     // W[12k]
    456     @JetId = x(1)^4 + x(2)^(4*@k+1);
    457     @fk = jet(@f, 4*(4*@k+1), weight(@JetId));
    458     if( Coeff(@fk, x(2), x(2)^(4*@k+1)) != 0) { return(Funktion27(@f, @k));}
    459 
    460     // W[12k+1]
    461     @JetId = x(1)^4 + x(1)*x(2)^(3*@k+1);
    462     @fk = jet(@f, 4*(3*@k+1), weight(@JetId));
    463     if( Coeff(@fk, x(1)*x(2), x(1)*x(2)^(3*@k+1)) != 0) {
    464       return(Funktion28(@f, @k));}
    465 
     427      // Z[6p+7]
     428      JetId = x(1)^3*x(2) + x(2)^(3*p+3);
     429      fk = jet(f, 3*(3*p+3), weight(JetId));
     430      if( Coeff(fk, x(2), x(2)^(3*p+3)) != 0) {
     431        return(Funktion21(f, corank, Mu, K, p));}
     432
     433      p = p+1;
     434      JetId = x(1)^3*x(2) + x(2)^(3*p+1); // weight(JetId);
     435      fk = jet(f, 3*p+1, weight(JetId));
     436      ft = Teile(fk, x(2));
     437      Jf = std(jacob(ft));
     438      Dim = dim(Jf);
     439      Mult = mult(Jf);
     440//    "fk=",Show(fk)," ft=",Show(ft)," p=",p," Dim=", Dim, "  Mult=",Mult;
     441      if( Dim == 0 ) { return(Funktion23(f, corank, Mu, K, p)); }
     442      if( Mult == 1 ) { return(Funktion24(f, corank, Mu, K, p)); }
     443    }
     444    // Should never reach this line
     445    return(printresult(17, f, "Fehler!", Mu, -1, corank, K));
     446}
     447
     448///////////////////////////////////////////////////////////////////////////////
     449proc Funktion25 (poly f, int corank, int Mu, int K)
     450{ // Analog zu Fumktion 6, Kombination 25-46
     451//---------------------------- initialisation ---------------------------------
     452    int   k = 1;
     453    poly  fk = jet(f, 4);
     454    poly  ft;
     455    ideal JetId;
     456    ideal Jf;
     457    int   Dim, Mult;
     458    def ring_top=basering;
     459    debug_log(1, "      Schritt 25");
     460
     461    // Code
     462    while (k<Mu) {
     463      f =  Faktorisiere(f, fk, 4 , k);
     464
     465      // W[12k]
     466      JetId = x(1)^4 + x(2)^(4*k+1);
     467      fk = jet(f, 4*(4*k+1), weight(JetId));
     468      if( Coeff(fk, x(2), x(2)^(4*k+1)) != 0) {
     469        return(Funktion27(f, corank, Mu, K, k));}
     470
     471      // W[12k+1]
     472      JetId = x(1)^4 + x(1)*x(2)^(3*k+1);
     473      fk = jet(f, 4*(3*k+1), weight(JetId));
     474      if( Coeff(fk, x(1)*x(2), x(1)*x(2)^(3*k+1)) != 0) {
     475        return(Funktion28(f, corank, Mu, K, k));}
     476
     477      //
     478      JetId = x(1)^4 + x(2)^(4*k+2);
     479      fk = jet(f, 2*(4*k+2), weight(JetId));
     480      if( Coeff(fk, x(2), x(2)^(4*k+2)) != 0) {
     481        Jf = std(jacob(fk));
     482        Dim = dim(Jf);
     483        Mult = mult(Jf);
     484//        "fk="+string(fk)+" Dim="+string(Dim)+" mult="+string(Mult);
     485        if( Dim == 0 ) { return(Funktion30(f, corank, Mu, K, k)); }
     486        if( Dim == 1 ) { return(Funktion32(f, corank, Mu, K, k)); }
     487        return(printresult(25, f, "Fehler!", Mu, -1, corank, K));
     488      }
     489      else {
     490        // x^4 oder x^2(x^2+x(2)^2k+1)
     491        ft = Teile(fk, x(1)^2);
     492        Jf = std(jacob(ft));
     493        Dim = dim(Jf);
     494        Mult = mult(Jf);
     495//        "1-fk="+string(fk)+" Dim="+string(Dim)+" mult="+string(Mult);
     496        if( Dim == 0 ) { return(Funktion31(f, corank, Mu, K, k)); }
     497        if( Dim != 1 ) {
     498          return(printresult(25, f, "Fehler!", Mu, -1, corank, K)); }
     499
     500        JetId = x(1)^4 + x(1)*x(2)^(3*k+2);
     501        fk = jet(f, 4*(3*k+2), weight(JetId));
     502        if( Coeff(fk, x(1)*x(2), x(1)*x(2)^(3*k+2)) != 0) {
     503          return(Funktion34(f, corank, Mu, K, k)); }
     504
     505        JetId = x(1)^4 + x(2)^(4*k+3);
     506        fk = jet(f, 4*(4*k+3), weight(JetId));
     507        if( Coeff(fk, x(2), x(2)^(4*k+3)) != 0){
     508          return(Funktion35(f, corank, Mu, K, k)); }
     509
     510        k = k+1;
     511        JetId = x(1)^4 + x(2)^(4*k);
     512        fk = jet(f, (4*k), weight(JetId));
     513        Jf = std(jacob(fk));
     514        Dim = dim(Jf);
     515        Mult = mult(Jf);
     516//        "2-ft="+Show(fk)+" Dim="+string(Dim)+" mult="+string(Mult);
     517        if( Dim == 0 ) { return(Funktion37(f, corank, Mu, K, k)); }
     518        if( Dim == 1 ) {
     519          if( Mult == 1 ) { return(Funktion38(f, corank, Mu, K, k)); }
     520          if( Mult == 2 ) {
     521            ft = Teile(fk, x(1)^2);
     522            Jf = std(jacob(ft));
     523            Dim = dim(Jf);
     524            Mult = mult(Jf);
     525//          "3-ft="+Show(ft)+" Dim="+string(Dim)+" mult="+string(Mult);
     526            if( Dim == 0) { return(Funktion40(f, corank, Mu, K, k)); }
     527            if( Dim == 1) { return(Funktion39(f, corank, Mu, K, k)); }
     528          }
     529          if( Mult != 3 ) {
     530            return(printresult(25, f, "Fehler!", Mu, -1, corank, K)); }
     531        }
     532        else { return(printresult(25, f, "Fehler!", Mu, -1, corank, K)); }
     533      }
     534    }  // Ende der While-Schleife
     535    // Should never reach this line
     536    return(printresult(25, f, "Fehler!", Mu, -1, corank, K));
     537}
     538
     539///////////////////////////////////////////////////////////////////////////////
     540proc Funktion40 (poly f, int corank, int Mu, int K, int k)
     541{
     542//---------------------------- initialisation ---------------------------------
     543    int r, kr, rr, sr;
     544    string Typ, fkt, RestRing, s1;
     545    def ring_top=basering;
     546
     547    debug_log(1, "         Schritt 40" );
     548    string s = "Die Singularitaet `"+Show(jet(f, K-1));
     549    s  = s + "' ist vom Typ ";
     550    s = s + "Z["+string(k)+",i,p](F40), mu="+string(Mu);
     551    s = s + ", m="+string(k-1);
     552    s;
     553
     554  "------------------------ F 40 --------------";
     555    poly a;
     556    poly b;
     557    poly c;
     558    ideal JetId = x(1)^4 + x(2)^(4*k);
     559    poly fk = jet(f, (4*k), weight(JetId));
     560
     561    poly f2 = -fk / x(1)^3;
     562    ideal Jfsyz = f - fk, x(1)^3, f2;
     563    "f2=", f2;
     564    "fk=", fk;
     565    Jfsyz;
     566    matrix Mat = matrix(syz(Jfsyz));
     567    "Mat[1,1]="+Show(Mat[1,1]);
     568    "Mat[1,2]="+Show(Mat[1,2]);
     569    "Mat[2,1]="+Show(Mat[2,1]);
     570    "Mat[2,2]="+Show(Mat[2,2]);
     571    "Mat[3,1]="+Show(Mat[3,1]);
     572    "Mat[3,2]="+Show(Mat[3,2]);
     573    "---";
     574    a = Mat[2,1] / Mat[1,1] - Mat[2,2];
     575    b = - Mat[3,1] / Mat[1,1] + Mat[3,2];
     576    "f1 = "+Show(a);
     577    "f2 = "+Show(b);
     578    "---";
     579    "f1 * f2 = "+Show(jet(a*b,Mu));
     580    "---";
     581    "f1 * f2 - f = "+Show(jet(a*b - f,Mu));
     582    "---";
     583    JetId = x(1)^3 + x(2)^(3*k);
     584    "Jf2 = "+Show(jet(b, (3*k), weight(JetId)));
     585    "---";
     586    JetId = x(1) + x(2)^(k);
     587    "Jf1 = "+Show(jet(a, k, weight(JetId)));
     588    nameof(basering);
     589    basering;
     590    b;
     591    "test-0";
     592    milnor(b);
     593    "test-1";
     594    execute Setring(2, "tmp_ring");
     595    "test-2";
     596//    s1 = "map CnV="+ RestRing+ ",x(1), x(2);";
     597//    execute s1;
     598    map map_ringtop2tmpring=ring_top,maxideal(1);
     599    "test-3";
     600    map_ringtop2tmpring(b);
     601    "test-4";
     602    milnor(map_ringtop2tmpring(b));
     603    "test-5";
     604    if( defined(r) == 1) { "R ist definiert"; }
     605    "test-6";
     606    int oldDebug = @DeBug;
     607    init_debug(-1);
     608    list v=Klassifiziere(map_ringtop2tmpring(b));
     609    init_debug(oldDebug);
     610    fkt =v[1];
     611    Typ =v[2];
     612    "----------------Klassifiziere-done";
     613    Typ,kr,rr,sr=DecodeNormalFormString(Typ);
     614    Typ,"=",kr,rr,sr;
     615    r = kr-k;
     616    "------------------------";
     617    setring ring_top;
     618    if( Typ == "E[6k]" ) { return(Funktion42(f, corank, Mu, K, k, r)); }
     619    if( Typ == "E[6k+1]" ) { return(Funktion43(f, corank, Mu, K, k, r)); }
     620    if( Typ == "E[6k+2]" ) { return(Funktion44(f, corank, Mu, K, k, r)); }
     621    if( Typ == "J[k,0]" ) { return(Funktion45(f, corank, Mu, K, k, r, sr)); }
     622    if( Typ == "J[k,r]" ) { return(Funktion45(f, corank, Mu, K, k, r, sr)); }
     623    // Should never reach this line
     624    return(printresult(40, f, "Fehler!", Mu, -1, corank, K));
     625}
     626
     627///////////////////////////////////////////////////////////////////////////////
     628proc Funktion50 (poly f, int corank, int Mu, int K)
     629{
     630    poly f3 = jet(f, 3);
     631    debug_log(1, "Schritt 50");
     632    if( f3 == 0 ) { return(Funktion104(f, corank, Mu, K)); }
     633
     634    // f3 ~
     635    ideal Jf1 = jacob(f3);
     636    ideal Jf  = std(Jf1);
     637    ideal Jf2;
     638  //  "Jf1=",Show(Jf[1]);
     639  //  "Jf2=",Show(Jf[2]);
     640  //  "Jf3=",Show(Jf[3]);
     641    int Dim = dim(Jf);
     642    int Mult = mult(Jf);
     643    "Dim=",Dim,"  Mult=",Mult," Jet3=", Show(f3);
     644    debug_log(1, "Schritt 50");
     645
     646    if(Dim == 0) { return(Funktion51(f, corank, Mu, K)); } // x3 + y3 + z3 + axyz
     647    if(Dim == 1) {
     648      if(Mult == 2) {
     649        Jf2 = wedge(jacob(Jf1),3-Dim), Jf1;
     650        Jf2 = std(Jf2);
     651        Dim = dim(Jf2);
     652        Mult = mult(Jf2);
     653        "dim=", Dim, "Mult=",Mult," Jf2=", Jf2;
     654        if (Dim == 0) { return(Funktion54(f, corank, Mu, K)); }  // x3 + xyz
     655        if (Dim == 1) { return(Funktion58(f, corank, Mu, K)); }  // x3 + yz2
     656      }
     657      if(Mult == 3) {
     658        Jf2 = wedge(jacob(Jf1),3-Dim), Jf1;
     659        Jf2 = std(Jf2);
     660        Dim = dim(Jf2);
     661        if(Dim == 0) { return(Funktion56(f, corank, Mu, K)); }  // xyz
     662        if(Dim == 1) { return(Funktion66(f, corank, Mu, K)); }  // x2z + yz2
     663      }
     664      if(Mult == 4) { return(Funktion82(f, corank, Mu, K)); }   // x3 + xz2
     665    }
     666    if(Dim == 2) {
     667      if(Mult == 1) { return(Funktion97(f, corank, Mu, K)); }   // x2y
     668      if(Mult == 2) { return(Funktion103(f, corank, Mu, K)); }  // x3
     669    }
     670    if(Dim == 3) { return(Funktion52(f, corank, Mu, K)); }      // x3 + y3 + xyz
     671
     672    // Should never reach this line
     673    return(printresult(50, f, "Fehler!", Mu, -1, corank, K));
     674}
     675
     676///////////////////////////////////////////////////////////////////////////////
     677proc Funktion58 (poly fin, int corank, int Mu, int K)
     678{
     679//---------------------------- initialisation ---------------------------------
     680    def ring_top=basering;
     681    poly f = fin;
     682    poly f3 = jet(f, 3);
     683    string tp="Nix";
     684    int kx = 1; // Koordinate x
     685    int ky = 2; // Koordinate y
     686    int kz = 3; // Koordinate z
     687    poly a, b, phi;
     688    ideal B = maxideal(1);     // ideal fuer Abbildungen
     689    ideal Jf3 = jacob(f3);
     690    ideal S = sat(Jf3, maxideal(1))[1];
     691    ideal J1 = diff(S[1], x(kx)), diff(S[1], x(ky)), diff(S[1], x(kz)),
     692         diff(S[2], x(kx)), diff(S[2], x(ky)), diff(S[2], x(kz));
     693    matrix M[2][3] = J1;
     694    ideal J2 = minor(M, 2), S;
     695  //--------------------------------------------------------------
     696  //  Bestimme die Koordinate 'x'
     697  //
     698
     699    debug_log(1, "   Schritt 58");
     700
     701    S = sat(J2, maxideal(1))[1];
     702    J1 = Coeff(S[1], x(1), x(1)), Coeff(S[1], x(2), x(2)),
     703          Coeff(S[1], x(3), x(3)), Coeff(S[2], x(1), x(1)),
     704          Coeff(S[2], x(2), x(2)), Coeff(S[2], x(3), x(3));
     705    matrix C[2][3] = J1;
     706    matrix D = syz(C);
     707    kill C;
     708
     709    poly b1 = D[1,1];
     710    poly b2 = D[2,1];
     711    poly b3 = D[3,1];
     712
     713    if(@DeBug>5) { "f3,s1=", Show(f3); }
     714    if( b1 != 0) {
     715      map VERT=ring_top,-1*b1*x(1), -1*b2*x(1)+x(2), -1*b3*x(1) + x(3);
     716      kx=1; ky=2; kz=3;
     717    }
     718    else {
     719      if( b2 != 0) {
     720        map VERT=ring_top, x(1) + -1*b1*x(2), -1*b2*x(2), -1*b3*x(2) + x(3);
     721        kx=2; ky=1; kz=3;
     722      }
     723      else {
     724        if( b3 != 0) {
     725          map VERT=ring_top,x(1) + -1*b1*x(3), x(2) + -1*b2*x(3), -1*b3*x(3);
     726          kx=3; ky=1; kz=2;
     727        }
     728      }
     729    }
     730    f = VERT(f);
     731    if(@DeBug>5) { VERT; }
     732    f3 = jet(f,3);
     733    if(@DeBug>5) { "f3,s2=", Show(f3); }
     734
     735    //--------------------------------------------------------------
     736    // die Variable 'x' ist nun isoliert worden. d.h j3f = xf2+f3
     737    // d.h Die rolle von 'x' ist nun bestimmt.
     738    // fuehre Koordinaten-transformation fuer f_2 aus.
    466739    //
    467     @JetId = x(1)^4 + x(2)^(4*@k+2);
    468     @fk = jet(@f, 2*(4*@k+2), weight(@JetId));
    469     if( Coeff(@fk, x(2), x(2)^(4*@k+2)) != 0) {
    470       @Jf = std(jacob(@fk));
    471       @Dim = dim(@Jf);
    472       @Mult = mult(@Jf);
    473 //      "fk="+string(@fk)+" Dim="+string(@Dim)+" mult="+string(@Mult);
    474       if( @Dim == 0 ) { return(Funktion30(@f, @k)); }
    475       if( @Dim == 1 ) { return(Funktion32(@f, @k)); }
    476       return("","Fehler!");
     740    if(@DeBug>5) { "1) x=", kx, "  y=", ky, "  z=", kz; }
     741    matrix C = Coeffs(f3, x(kx));
     742    C;
     743    poly fb=C[2,1];     // Coeff von x^1
     744    poly fc=C[1,1];     // Coeff von x^0
     745    "f-2=", Show(fb);
     746    "f-3=", Show(fc);
     747    if(diff(fb, x(ky)) != 0) {
     748      kill VERT;
     749      ideal Jfsyz = fb, diff(fb, x(ky));
     750      matrix Mat = matrix(syz(Jfsyz));
     751      //    Mat;
     752      B = maxideal(1);     // setze Abbildungs-ideal
     753      if( nrows(Mat) == 2) {
     754        poly Relation = -2 * Mat[2,1] / Mat[1,1];
     755        b = Coeff(Relation, x(kz), x(kz));
     756        B[rvar(x(ky))] = x(ky)-b*x(kz);
     757      }
     758      else {
     759        Jfsyz = fb, diff(fb, x(kz));
     760        Mat = matrix(syz(Jfsyz));
     761        poly Relation = -2 * Mat[2,1];
     762        a = Coeff(Relation, x(ky), x(ky));
     763        B[rvar(x(kz))] = x(kz)-a*x(kz);
     764        ky, kz = swap(ky, kz);
     765      }
     766      map VERT=ring_top, B;
     767      VERT;
     768      f = VERT(f);
     769      f3 = jet(f,3);
     770      kill Mat;
     771    }
     772    else { ky,kz = swap(ky,kz); }
     773    "f3,s3=", Show(f3);
     774
     775    //--------------------------------------------------------------
     776    // fuehre nun tschirnhaus in der Variablen 'z' durch und erhalte
     777    // f = f_1(x,y,z)y^2 + z^3
     778    //
     779    "2) x=", kx, "  y=", ky, "  z=", kz;
     780    C = Coeffs(f3, x(kx));
     781    fb=C[2,1];  // Coeff von x^1
     782    fc=C[1,1];  // Coeff von x^0
     783    fc, VERT = tschirnhaus(fc, x(kz));
     784    VERT;
     785    f = VERT(f);
     786    "-------------------------------------";
     787    f3 = jet(f,3);
     788    "j3f,s5=",Show(f3);
     789    "f=", Show(f);
     790 
     791    //--------------------------------------------------------------
     792    // fuehre Koordinaten-transformation fuer f_1 durch und erhalte
     793    // f=xy2 + z3
     794    //
     795    "3) x=", kx, "  y=", ky, "  z=", kz;
     796    // ACHTUNG Bug, fuer Sing22
     797    Show(f3 - 1*(Coeffs(f3, x(kz))[4,1])*x(kz)^3);
     798    poly fa;
     799    fb = (f3 - 1*(Coeffs(f3, x(kz))[4,1])*x(kz)^3)/(x(ky)^2);
     800    "fb=", Show(fb);
     801    fc = (x(kx)-1*(Coeffs(fb, x(ky))[2,1])*x(ky)-1*(Coeffs(fb, x(kz))[2,1])*x(kz));
     802    fa = Coeffs(fb, x(kx))[2,1];
     803    if ( fa != 0 ) {
     804      B = maxideal(1);
     805      B[rvar(x(kx))] = fc / fa;
     806      map VERT=ring_top, B;
     807      VERT;
     808      f = VERT(f);
     809      f3 = jet(f,3);
     810      "j3f,s6=",Show(f3);
     811
     812    //    map VERT = ring_top, x(4-kx), x(4-ky), x(4-kz);
     813    //    f = VERT(f);
     814    //    map VERT = ring_top, x(1), x(3), x(2);
     815    //    f = VERT(f);
     816    //    phi = jet(f,3);
     817    //    f3 = jet(f,3);
     818    //    "j3f,s7=",Show(phi);
     819    }
     820
     821 
     822    //--------------------------------------------------------------
     823    if(Coeffs(f3, x(1))[4,1]!=0) {
     824      kx=1;
     825      if(Coeffs(f3, x(2))[3,1]==0) { ky=2; kz=3; }
     826      else { ky=3; kz=2; }
    477827    }
    478828    else {
    479       // x^4 oder x^2(x^2+x(2)^2k+1)
    480       @ft = Teile(@fk, x(1)^2);
    481       @Jf = std(jacob(@ft));
    482       @Dim = dim(@Jf);
    483       @Mult = mult(@Jf);
    484 //      "1-fk="+string(@fk)+" Dim="+string(@Dim)+" mult="+string(@Mult);
    485       if( @Dim == 0 ) { return(Funktion31(@f, @k)); }
    486       if( @Dim != 1 ) { return("Fehler!",""); }
    487 
    488       @JetId = x(1)^4 + x(1)*x(2)^(3*@k+2);
    489       @fk = jet(@f, 4*(3*@k+2), weight(@JetId));
    490       if( Coeff(@fk, x(1)*x(2), x(1)*x(2)^(3*@k+2)) != 0) {
    491         return(Funktion34(@f, @k)); }
    492 
    493       @JetId = x(1)^4 + x(2)^(4*@k+3);
    494       @fk = jet(@f, 4*(4*@k+3), weight(@JetId));
    495       if( Coeff(@fk, x(2), x(2)^(4*@k+3)) != 0) { return(Funktion35(@f, @k)); }
    496 
    497       @k = @k+1;
    498       @JetId = x(1)^4 + x(2)^(4*@k);
    499       @fk = jet(@f, (4*@k), weight(@JetId));
    500 
    501       @Jf = std(jacob(@fk));
    502       @Dim = dim(@Jf);
    503       @Mult = mult(@Jf);
    504 //      "2-ft="+Show(@fk)+" Dim="+string(@Dim)+" mult="+string(@Mult);
    505       if( @Dim == 0 ) { return(Funktion37(@f, @k)); }
    506       if( @Dim == 1 ) {
    507         if( @Mult == 1 ) { return(Funktion38(@f, @k)); }
    508         if( @Mult == 2 ) {
    509           @ft = Teile(@fk, x(1)^2);
    510           @Jf = std(jacob(@ft));
    511           @Dim = dim(@Jf);
    512           @Mult = mult(@Jf);
    513 //        "3-ft="+Show(@ft)+" Dim="+string(@Dim)+" mult="+string(@Mult);
    514           if( @Dim == 0) { return(Funktion40(@f, @k)); }
    515           if( @Dim == 1) { return(Funktion39(@f, @k)); }
     829      if(Coeffs(f3, x(2))[4,1]!=0) {
     830        kx=2;
     831        if(Coeffs(f3, x(3))[3,1]==0) { ky=3; kz=1; }
     832        else { ky=1; kz=3; }
     833      }
     834      else {
     835        kx=3;
     836        if(Coeffs(f3, x(1))[3,1]==0) { ky=1; kz=2; }
     837        else { ky=2; kz=1; }
     838      }
     839    }
     840    "4) x=", kx, "  y=", ky, "  z=", kz;
     841    map VERT = ring_top, x(kx), x(ky), x(kz);
     842    f = VERT(f);
     843    f3 = jet(f,3);
     844    "j3f,s8=",Show(f3);
     845
     846    return(Funktion59(f, corank, Mu, K));
     847}
     848
     849///////////////////////////////////////////////////////////////////////////////
     850proc Funktion59 (poly f, int corank, int Mu, int K)
     851{
     852    int p = 1;
     853    string tp="Nix";
     854    poly phi = jet(f,3);
     855    poly fr = f - phi;
     856    poly fk;
     857    poly alpha = coeffs(fr, x(1))[1,1];
     858    poly beta = (fr - alpha) / x(1);
     859    ideal JetId;
     860    intvec w;
     861
     862    "f    = ", Show(f);
     863    "fr   = ", Show(fr);
     864    "alpha= ", Show(alpha);
     865    "beta = ", Show(beta);
     866
     867    while(6*p<Mu) {
     868      "Schritt 59_", p;
     869      JetId = x(2)^(3*p+1); weight(JetId);
     870      JetId = phi + x(2)^(3*p+1);
     871      w = weight(JetId);
     872      fk = jet(fr, 3*w[1], w);
     873    "a)", p, 3*w[1], Show(fk), w;
     874      if( fk != 0 ) { return(Funktion60(f, corank, Mu, K, p)); }
     875
     876      JetId = phi + x(1)*x(2)^(2*p+1);
     877      w = weight(JetId);
     878      fk = jet(fr, 3*w[1], w);
     879    "b)", p, 3*w[1], Show(fk), w;
     880      if( fk != 0 ) { return(Funktion61(f, corank, Mu, K, p)); }
     881
     882      JetId = phi + x(2)^(3*p+2);
     883      w = weight(JetId);
     884      fk = jet(fr, 3*w[1], w);
     885    "c)", p, 3*w[1], Show(fk), w;
     886      if( fk != 0 ) { return(Funktion62(f, corank, Mu, K, p)); }
     887
     888      p = p+1;   // Weiter mit Funktion 63 fuer p eins groesser
     889      JetId = phi + x(2)^(3*p);
     890      w = weight(JetId);
     891      fk = jet(f, 3*w[1], w);
     892    "d)", p, 3*w[1], Show(fk), w;
     893    //    if( fk != 0 ) {
     894      JetId = jacob(fk);
     895      JetId = std(JetId);
     896      int Dim = dim(JetId);
     897      int Mult = mult(JetId);
     898      "Dim=",Dim,"  Mult=",Mult," Jetk=", Show(fk);
     899      if(Dim == 0) { return(Funktion64(f, corank, Mu, K, p)); }
     900      if(Dim == 1) {
     901        if(Mult == 1) { return(Funktion65(f, corank, Mu, K, p)); }
     902        if(Mult == 2) {
     903          "Faktorisiere";
     904          fk = jet(fr, 3*w[1], w);
     905          poly tt=Coeffs(phi, x(1))[4,1] *x(1)^3+fk;
     906          intvec RFlg=1,2,3;
     907          export RFlg;
     908          RFlg;
     909          "tt=",Show(tt);
     910          "f=",Show(f);
     911          f = Faktorisiere(f, tt, 3 , p);
     912          PhiG;
     913          "f=",Show(f);
     914          fr = f - phi;
     915        }
     916      }
     917    //    }
     918    }
     919    // Should never reach this line
     920    return(printresult(59, f, "Fehler!", Mu, -1, corank, K));
     921}
     922
     923///////////////////////////////////////////////////////////////////////////////
     924proc Funktion66 (poly f, int corank, int Mu, int K)
     925{
     926    int kx = 1; // Koordinate x
     927    int ky = 2; // Koordinate y
     928    int kz = 3; // Koordinate z
     929    poly f3 = jet(f, 3);
     930    ideal JetId;
     931
     932    debug_log(1, "Weiter-66");
     933    debug_log(2, "F3=", Show(f3));
     934    poly fx = diff(f3, x(kx));
     935    JetId = jacob(fx);
     936    JetId = std(JetId);
     937    "nach x:",Show(fx), "  Id=", JetId, "  Dim=", dim(JetId);
     938
     939    poly fy = diff(f3, x(ky));
     940    JetId = jacob(fx);
     941    JetId = std(JetId);
     942    "nach y:",Show(fy), "  Id=", JetId, "  Dim=", dim(JetId);
     943
     944    poly fz = diff(f3, x(kz));
     945    JetId = jacob(fx);
     946    JetId = std(JetId);
     947    "nach z:",Show(fz), "  Id=", JetId, "  Dim=", dim(JetId);
     948    return(printresult(1, 66, "Fehler!", Mu, -1, corank, K));
     949}
     950
     951///////////////////////////////////////////////////////////////////////////////
     952proc Funktion82 (poly f, int corank, int Mu, int K)
     953{
     954    poly f3 = jet(f,3);
     955    int kx = 1; // Koordinate x
     956    int ky = 2; // Koordinate y
     957    int kz = 3; // Koordinate z
     958    poly b1, b2, b3;
     959    intvec kv = 1,2,3;
     960    int    i;
     961    ideal Jfsyz = jacob(f3);
     962    matrix Mat;
     963    int Fall = 2;
     964
     965    debug_log(1, "Schritt 82");
     966    if (diff(f3, x(1)) == 0) { kx, ky = swap(kx, ky); }
     967    if (diff(f3, x(2)) == 0) {  }
     968    if (diff(f3, x(3)) == 0) { kz, ky = swap(kz, ky); }
     969    if ( (diff(f3, x(1)) != 0) && (diff(f3, x(2)) != 0) &&
     970          (diff(f3, x(3)) != 0) ) {
     971      Mat = matrix(syz(Jfsyz));
     972      b1 = Mat[1,1];
     973      b2 = Mat[2,1];
     974      b3 = Mat[3,1];
     975
     976      debug_log(2, Mat);
     977      if( b1 != 0) {
     978        map VERT=basering,b1*x(kx), b2*x(kx)+x(ky), b3*x(kx) + x(kz);
     979        f = VERT(f);
     980        kx, ky = swap(kx, ky);
     981      }
     982      else {
     983        if( b2 != 0) {
     984          map VERT=basering,x(kx)+b1*x(ky), b2*x(ky), b3*x(ky) + x(kz);
     985          f = VERT(f);
     986        }
     987        else {
     988          if( b3 != 0) {
     989            map VERT=basering,x(kx)+b1*x(kz),x(ky)+ b2*x(kz), b3*x(kz);
     990            f = VERT(f);
     991          }
     992        }
     993      }
     994    debug_log(2, VERT);
     995    }
     996    //  else {
     997      map VERT=basering,x(kx),x(ky),x(kz);
     998    debug_log(2, VERT);
     999      f = VERT(f);
     1000    //  }
     1001    f3 = jet(f,3);
     1002    if ( defined(VERT) == 1) { kill VERT; }
     1003    if( (f3-subst(f3, x(kx), 0)) == 0) { kx, ky = swap(kx, ky); }
     1004    if( (f3-subst(f3, x(kz), 0)) == 0) { kz, ky = swap(kz, ky); }
     1005  debug_log(2,   "1)f??=", Show(f3));
     1006  debug_log(2,   "1)f3=", Show(f));
     1007  //------------------------------------------------------
     1008  debug_log(2,   size(coeffs(f3, x(kx))));
     1009  //  if (size(coeffs(f3, x(kx))) == 3) {
     1010      matrix C = coeffs(f3, x(kx));
     1011  debug_log(2, C);
     1012      if(size(C) == 3) { C = coeffs(f3, x(kz)); }
     1013      if(C[1,1] == 0 && C[3,1] == 0) { Fall = 1; }
     1014      if(C[1,1] != 0 && C[3,1] != 0 ) { Fall = 3; }
     1015      if(C[1,1] == 0 && C[3,1] != 0 ) { Fall = 2; }
     1016      if(C[1,1] != 0 && C[3,1] == 0 ) { Fall = 2; kx,kz=swap(kx, kz); }
     1017
     1018  debug_log(2, C);
     1019  debug_log(2, "Fall: ", Fall, "  x=", kx, "  z=", kz);
     1020      map VERT;
     1021      if(Fall == 2) { b1, VERT = tschirnhaus(f3/x(kz), x(kx)); }
     1022      else {
     1023        b1, VERT = tschirnhaus(f3/x(kx), x(kx));
     1024        debug_log(2, "B1=", Show(jet(VERT(f),3)));
     1025        b2, VERT = tschirnhaus(f3/x(kz), x(kz));
     1026        debug_log(2, "B2=", Show(jet(VERT(f),3)));
     1027      }
     1028      f = VERT(f);
     1029    f3 = jet(f,3);
     1030        debug_log(2, "2)f3=", Show(f3));
     1031  //  f3, VERT = tschirnhaus(f3, x(1));
     1032      debug_log(2, "3)f3=", Show(jet(f,3)));
     1033  //  }
     1034
     1035    C = coeffs(f3, x(1));
     1036    if( C[1,1] == 0 && C[2,1] != 0 && C[3,1] == 0 && C[4,1] != 0 ) {
     1037      Funktion83(f, corank, Mu, K);
     1038    }
     1039    return(printresult(82, f, "Fehler!", Mu, -1, corank, K));
     1040}
     1041
     1042///////////////////////////////////////////////////////////////////////////////
     1043proc Isomorphie_s82_z (poly f, poly fk, int p)
     1044{
     1045    matrix Mat;
     1046    poly Relation, a, b;
     1047    ideal Jfsyz, B;
     1048
     1049    debug_log(1, "      Isomorphie 82/90 z");
     1050    debug_log(2, "tt=", Show(fk));
     1051    Jfsyz = fk, diff(fk, x(3));
     1052    Mat = matrix(syz(Jfsyz));
     1053    Relation = -2 * Mat[2,1] / Mat[1,1];
     1054    a = Coeff(Relation, x(3), x(3));
     1055    b = Coeff(Relation, x(2), x(2)^p);
     1056    B = maxideal(1);
     1057    B[rvar(x(3))] = x(3)-b*x(2)^p;
     1058    map VERT=basering,B;
     1059    f = VERT(f);
     1060    debug_log(2, VERT);
     1061    debug_log(2, "      z res=", Show(VERT(fk)));
     1062    return(f);
     1063}
     1064
     1065///////////////////////////////////////////////////////////////////////////////
     1066proc Isomorphie_s82_x (poly f, poly fk, int p)
     1067{
     1068    matrix Mat;
     1069    poly Relation, a, b;
     1070    ideal Jfsyz, B;
     1071
     1072    debug_log(1, "      Isomorphie 82/90 x");
     1073    debug_log(2, "tt=", Show(fk));
     1074    Jfsyz = fk, diff(fk, x(1));
     1075    Mat = matrix(syz(Jfsyz));
     1076    Relation = -3 * Mat[2,1] / Mat[1,1];
     1077    a = Coeff(Relation, x(1), x(1));
     1078    b = Coeff(Relation, x(2), x(2)^p);
     1079    B = maxideal(1);
     1080    B[rvar(x(1))] = x(1)-b*x(2)^p;
     1081    map VERT=basering,B;
     1082    f = VERT(f);
     1083    debug_log(2, VERT);
     1084    debug_log(2, "      x res=", Show(VERT(fk)));
     1085
     1086    return(f);
     1087}
     1088
     1089///////////////////////////////////////////////////////////////////////////////
     1090proc Funktion83 (poly f, int corank, int Mu, int K)
     1091{
     1092    int p = 1;
     1093    ideal JetId;
     1094    poly fk;
     1095    intvec w;
     1096    ideal Jf;
     1097    poly phi;
     1098    int Dim, Mult;
     1099    matrix Mat;
     1100    poly a, b;
     1101    ideal B;
     1102
     1103    debug_log(1, "   Schritt 83");
     1104    while(p<10) {
     1105      debug_log(1, "     Schritt 83_"+string(p));
     1106      phi = jet(f, 3);
     1107      JetId = x(1)^3 + x(3)^3 + x(2)^(3*p+1); weight(JetId);
     1108      w = weight(JetId);
     1109      fk = jet(f- phi, 3*w[1], w) ;
     1110    debug_log(2, "a)", p, 3*w[1], Show(fk), w, Show(phi));
     1111      if( fk != 0 ) { return(Funktion84(f, corank, Mu, K, p)); }
     1112
     1113      JetId = x(1)^3 + x(3)^3 + x(1)*x(2)^(2*p+1); weight(JetId);
     1114      w = weight(JetId);
     1115      fk = jet(f, 3*w[1], w) ;
     1116    debug_log(2, "b)", p, 3*w[1], Show(fk), w, Show(phi));
     1117      if ( fk != phi ) {
     1118        Jf=std(jacob(fk));
     1119        Dim = dim(Jf);
     1120        Mult = mult(Jf);
     1121  debug_log(2, "85-ft="+Show(fk)+" Dim="+string(Dim)+" mult="+string(Mult));
     1122        if ( Dim == 0 ) { return(Funktion86(f, corank, Mu, K, p)); }
     1123        if ( Dim == 1 ) { return(Funktion87(f, corank, Mu, K, p)); }
     1124      }
     1125
     1126      JetId = x(1)^3 + x(3)^3 + x(2)^(3*p+2); weight(JetId);
     1127      w = weight(JetId);
     1128      fk = jet(f- phi, 3*w[1], w) ;
     1129    debug_log(2, "c)", p, 3*w[1], Show(fk), w, Show(phi));
     1130      if( fk != 0 ) { return(Funktion89(f, corank, Mu, K, p)); }
     1131
     1132      p = p + 1;
     1133      JetId = x(1)^3 + x(3)^3 + x(2)^(3*p); weight(JetId);
     1134      w = weight(JetId);
     1135      fk = jet(f, 3*w[1], w) ;
     1136      Jf=std(jacob(fk));
     1137      Dim = dim(Jf);
     1138      Mult = mult(Jf);
     1139 debug_log(2,"90 - ft="+Show(fk)+" Dim="+string(Dim)+" mult="+string(Mult));
     1140      if ( Dim == 0 ) { }
     1141      if ( Dim == 1 ) {
     1142        if ( Mult == 4 ) {
     1143          if( fk - phi != 0) { // b!=0  und/oder b'!=0
     1144            if( Coeff(fk,x(1)*x(2), x(1)^2*x(2)^p) == 0 ) { // b=0 und b'!=0
     1145              a=(fk - Coeff(fk, x(1), x(1)^3)*x(1)^3) / x(1);
     1146              f = Isomorphie_s82_z(f, a, p);
     1147            }
     1148            else {
     1149              if( Coeff(fk,x(1)*x(2)*x(3), x(1)*x(2)^p*x(3)) == 0 ){
     1150                        // b!=0 und b'=0
     1151                debug_log(2, "Fall b'=2");
     1152                a=subst(fk, x(3), 0);
     1153                f = Isomorphie_s82_x(f, a, p);
     1154              }
     1155              else {
     1156                a = Coeff(fk,x(1)*x(2)*x(3), x(1)*x(2)^p*x(3));
     1157                b = Coeff(fk,x(2)*x(3), x(2)^(2*p)*x(3));
     1158                B = maxideal(1);
     1159                B[rvar(x(1))] = x(1)-b/a*x(2)^p;
     1160                map VERT=basering,B;
     1161                f = VERT(f);
     1162                fk = jet(f, 3*w[1], w) ;
     1163                debug_log(2, VERT);
     1164
     1165                a=(fk - Coeff(fk, x(1), x(1)^3)*x(1)^3) / x(1);
     1166                f = Isomorphie_s82_z(f, a, p);
     1167              } // ende else b!=0 und b'=0
     1168            } // ende else b=0 und b'!=0
     1169          } //ende fk-phi!=0
     1170        } // ende mult=4
     1171      } // ende dim=1
     1172    } // ENDE While
     1173    return(printresult(83, f, "Fehler!", Mu, -1, corank, K));
     1174}
     1175
     1176///////////////////////////////////////////////////////////////////////////////
     1177proc Funktion97 (poly f, int corank, int Mu, int K)
     1178{
     1179    int kx = 1; // Koordinate x
     1180    int ky = 2; // Koordinate y
     1181    int kz = 3; // Koordinate z
     1182    ideal B = maxideal(1);      // Abbildungs-ideal
     1183
     1184    int k = 2;
     1185    int i;
     1186    int pt = 2;
     1187    poly f3 = jet(f, 3);
     1188    ideal Jfsyz;
     1189
     1190    poly  l1;
     1191    poly  l2;
     1192    poly  a;
     1193    poly  b;
     1194    poly  c;
     1195    poly  prod;
     1196    matrix Mat;
     1197    int   k = 1;
     1198
     1199    "Weiter-97";
     1200    "Jet3 = ", Show(f3);
     1201    // vertausche 2 Koordinaten sodass d2f/dx2 <>0 ist.
     1202    for(i=1;i<4;i=i+1) {
     1203      if(diff(diff(f3, x(i)), x(i)) != 0) { kx = i; i=4; }
     1204    }
     1205    if(kx == 2) { ky = 1; kz = 3; }
     1206    if(kx == 3) { ky = 2; kz = 1; }
     1207
     1208    // bereche -l1l2 und anschliessend l1
     1209    f3 = jet(f, 3);
     1210    Jfsyz = f3, diff(f3, x(kx));
     1211    Mat = matrix(syz(Jfsyz));
     1212    Jfsyz = f3, Mat[2,1];
     1213    Mat = matrix(syz(Jfsyz));
     1214
     1215    // berechen Abb. sodass f=x2*l2
     1216    l1 = Mat[2,1];
     1217    a = Coeff(l1, x(kx), x(kx));
     1218    l1 =  l1 / number(a);
     1219    b = Coeff(l1, x(ky), x(ky));
     1220    c = Coeff(l1, x(kz), x(kz));
     1221    B[rvar(x(kx))] = x(kx) - b * x(ky) - c * x(kz);
     1222    map VERT=basering, B;
     1223    f = VERT(f);
     1224    kill VERT;
     1225    f3 = jet(f, 3);
     1226
     1227    "Jet3=", Show(f3);
     1228    l2 = f3 / x(kx)^2;
     1229    "l2=", l2;
     1230
     1231    // sorge dafuer, dass b<>0 ist.
     1232    b = Coeff(l2, x(ky), x(ky));
     1233    if( b== 0) {
     1234      ky, kz = swap(ky, kz);
     1235    }
     1236 
     1237    // Koordinaten-Transf. s.d. f=x2y
     1238    b = Coeff(l2, x(ky), x(ky));
     1239    l2 =  l2 / number(b);
     1240    a = Coeff(l2, x(kx), x(kx));
     1241    c = Coeff(l2, x(kz), x(kz));
     1242    B = maxideal(1);
     1243    B[rvar(x(ky))] = -a * x(kx) + x(ky) - c * x(kz);
     1244    map VERT=basering, B;
     1245    f = VERT(f);
     1246    kill VERT;
     1247
     1248    // bereche gewichteten jet von f
     1249    f3 = jet(f, 3);
     1250    "Jet3=", Show(f3);
     1251    Jfsyz = x(kx)^2*x(ky) + x(ky)^4 + x(kz)^4;
     1252    a = jet(f, 8, weight(Jfsyz));
     1253    // der Gewichtete Jet betsteht nun aus den Monomen:
     1254    // x2y, y4, y4z, y2z2, yz3, z4, x2z
     1255    "a=", Show(a);
     1256
     1257    ideal Jf=jacob(a);
     1258    ideal j1=std(Jf);
     1259    int Dim=dim(j1);
     1260    int Mult=mult(j1);
     1261    if( Dim == 0) { return(Funktion99(f, corank, Mu, K)); }
     1262    if( Dim == 1) {
     1263      if( Mult == 1 ) { return(Funktion100(f, corank, Mu, K)); }
     1264      if( Mult == 2 ) { return(Funktion101(f, corank, Mu, K)); }
     1265    }
     1266    " Dim=",Dim," Dim2=",dim(j2)," Mult=",Mult," Mult2=",mult(j2);
     1267    return(printresult(102, f, "V[k,r]", Mu, -1, corank, K));
     1268}
     1269
     1270///////////////////////////////////////////////////////////////////////////////
     1271proc Funktion103 (poly f, int corank, int Mu, int K)
     1272{
     1273    return(FunktionNoClass(f, corank, "3-jet = x3"));
     1274}
     1275
     1276///////////////////////////////////////////////////////////////////////////////
     1277proc Funktion104 (poly f, int corank, int Mu, int K)
     1278{
     1279    return(FunktionNoClass(f), corank);
     1280}
     1281
     1282///////////////////////////////////////////////////////////////////////////////
     1283proc Funktion105 (poly f, int corank, int Mu, int K)
     1284{
     1285    return(FunktionNoClass(f), corank);
     1286}
     1287
     1288///////////////////////////////////////////////////////////////////////////////
     1289proc FunktionNoClass (poly f, int corank, list #)
     1290{
     1291    if(size(#)==2) { string txt=#[2]; }
     1292
     1293    string s = "The singularity `"+Show(jet(f, K));
     1294    s = s +"' is not in Arnolds list."+newline;
     1295    if(size(#)==2) { s = s + txt; }
     1296    s = s + ", Milnor number = " + string(Mu);
     1297
     1298    return(printresult(1, f, s, Mu, -1, corank, K));
     1299    return(Show(f), s, corank);
     1300}
     1301
     1302///////////////////////////////////////////////////////////////////////////////
     1303proc tschirnhaus (poly f, poly x)
     1304USAGE:    tschirnhaus();
     1305{
     1306    def ring_top=basering;
     1307    int n = nvars(basering);
     1308    int j;
     1309
     1310    // "tschirnhaus fuer:", Show(f);
     1311    matrix cf = coeffs(f, x);
     1312    int hc = nrows(cf) - 1;     // hoechster exponent von x_i
     1313    poly b = cf[hc+1,1];        // koeffizient von x_i^hc
     1314    ideal B = maxideal(1);
     1315
     1316    string s="map EH=ring_top";
     1317    for( j=1; j<=n ; j=j+1) { s = s + ",0"; }
     1318    s = s + ";";
     1319    execute s;
     1320  "b=", b;
     1321  "EH(b)=", EH(b);
     1322
     1323    if ( EH(b) == 0)    // pruefe ob der Koeff von x_i^hc
     1324  { map Phi =ring_top, B;
     1325      return(f, Phi);
     1326    }
     1327    B[rvar(x)] = x -1*(cf[hc,1]/(hc*b));
     1328    map Phi = ring_top, B;
     1329    return(Phi(f), Phi);
     1330}
     1331
     1332///////////////////////////////////////////////////////////////////////////////
     1333proc Isomorphie_s17 (poly f, poly fk, int k, int ct)
     1334{
     1335    ideal Jfsyz, JetId;
     1336    poly  Relation;
     1337    poly  a, b, c, d;
     1338    matrix Matx, Maty;
     1339    def ring_top=basering;
     1340
     1341    // Ziel: bestimme a,b,c,d sodass  fk = (ax+by^k)^3(cx+dy) gilt.
     1342    debug_log(2, "Isomorphie_s17:");
     1343    debug_log(2, "Faktor: f=",Show(f)," Jet=",Show(fk)," k=",k);
     1344
     1345    if( defined(VERT) == 1) { kill VERT; }
     1346    //  "Fak-1:",Show(f)," jet=",Show(fk);
     1347
     1348    if( k == 1) {
     1349      Jfsyz = fk, diff(fk, x(1));
     1350      Matx = matrix(syz(Jfsyz));
     1351      Jfsyz = fk, diff(fk, x(2));
     1352      Maty = matrix(syz(Jfsyz));
     1353
     1354      a = Coeff(fk, x(1), x(1)^4);
     1355      b = Coeff(fk, x(2), x(2)^4);
     1356      c = Coeff(fk, x(1)*x(2), x(1)^3*x(2));
     1357      d = Coeff(fk, x(1)*x(2), x(1)*x(2)^3);
     1358
     1359      if( (a != 0) && (b != 0) ) {
     1360        int B,C, alpha, beta, gamma, g;
     1361        poly an, bn;
     1362
     1363        if(@DeBug>7) {
     1364          Coeff(Matx[1,1], x(2), x(2));
     1365          Coeff(Maty[1,1], x(1), x(1));
     1366          Coeff(Matx[2,1], x(1), x(1)^2);
     1367          Coeff(Matx[2,1], x(1)*x(2), x(1)*x(2));
     1368          Coeff(Matx[2,1], x(2), x(2)^2);
     1369        }
     1370        B = -int(Coeff(Matx[1,1], x(2), x(2)));
     1371        C = -int(Coeff(Maty[1,1], x(1), x(1)));
     1372        alpha = int(Coeff(Matx[2,1], x(1), x(1)^2));
     1373        beta  = int(Coeff(Matx[2,1], x(1)*x(2), x(1)*x(2)));
     1374        gamma = int(Coeff(Matx[2,1], x(2), x(2)^2));
     1375
     1376        if(@DeBug>7) {
     1377          "B=", B;
     1378          "C=", C;
     1379          "alpha=", alpha;
     1380          "beta =", beta;
     1381          "gamma=", gamma;
     1382     
     1383          "(B-beta)/2=", (B-beta)/2;
     1384          "(C-beta)/2=", (C-beta)/2;
     1385        }
     1386//      a = gcd((B-beta)/2, alpha);
     1387//      b = gcd((C-beta)/2, gamma);
     1388        map VERT=basering,(x(1) - 2*(gamma / (B - beta))*x(2)),x(2);
     1389        Relation = VERT(f);
     1390        fk = jet(Relation, 4);
     1391
     1392        an = Coeff(fk, x(1), x(1)^4);
     1393        bn = Coeff(fk, x(2), x(2)^4);
     1394        if( (an != 0) & (bn != 0) ) {
     1395          VERT=basering,x(1),(x(2) + a*x(1))/ b;
     1396        }
     1397
     1398        f = VERT(f);
     1399        fk = jet(f, 4);
     1400        PhiG = VERT(PhiG);
     1401
     1402        a = Coeff(fk, x(1), x(1)^4);
     1403        b = Coeff(fk, x(2), x(2)^4);
     1404        c = Coeff(fk, x(1)*x(2), x(1)^3*x(2));
     1405        d = Coeff(fk, x(1)*x(2), x(1)*x(2)^3);
     1406        Jfsyz = fk, diff(fk, x(1));
     1407        Matx = matrix(syz(Jfsyz));
     1408        Jfsyz = fk, diff(fk, x(2));
     1409        Maty = matrix(syz(Jfsyz));
     1410      }
     1411
     1412      if( (a == 0) || (b == 0) ) {
     1413        if( a == 0) {
     1414          if( c == 0) { // y3(ax+by)
     1415            Relation = - Matx[2,1] / Matx[1,1];
     1416            a = Coeff(Relation, x(1), x(1));
     1417            b = Coeff(Relation, x(2), x(2));
     1418            map VERT=basering,a*x(2)^k - b*x(1), x(1);
     1419          }
     1420          else { // (ax+by)^3y
     1421            Relation = - 3*Matx[2,1] / Matx[1,1];
     1422            a = Coeff(Relation, x(1), x(1));
     1423            b = Coeff(Relation, x(2), x(2));
     1424            map VERT=basering,a*x(1) - b*x(2), x(2);
     1425          }
     1426        }
     1427        else {
     1428          if( d == 0) { // x3(ax+by)
     1429            Relation = - Maty[2,1] / Maty[1,1];
     1430            a = Coeff(Relation, x(1), x(1));
     1431            b = Coeff(Relation, x(2), x(2));
     1432            map VERT=basering,x(1), b*x(2)^k - a*x(1);
     1433          }
     1434          else { // x(ax+by)^3
     1435            Relation = - 3*Maty[2,1] / Maty[1,1];
     1436            a = Coeff(Relation, x(1), x(1));
     1437            b = Coeff(Relation, x(2), x(2));
     1438            map VERT=basering,x(2), b*x(1) - a*x(2);
     1439          }
     1440        }
     1441        f = VERT(f);
     1442        PhiG = VERT(PhiG);
     1443      }
     1444      else {
     1445  //      "Weder b noch a sind 0";
     1446        if(ct > 5) { return(f); }
     1447        fk = jet(f, 4);
     1448        return(Isomorphie_s17(f, fk, k, ct+1));
     1449      }
     1450    }
     1451    else {  // k >1
     1452      a = fk/x(2);
     1453      Jfsyz = a, diff(a, x(1));
     1454      Matx = matrix(syz(Jfsyz));
     1455      Relation = -3 * Matx[2,1] / Matx[1,1];
     1456  //    Matx;
     1457      a = Coeff(Relation, x(1), x(1));
     1458      b = Coeff(Relation, x(2), x(2)^k);
     1459      map VERT=basering,x(1)-b*x(2)^k,x(2);
     1460      f = VERT(f);
     1461  //      VERT;
     1462      JetId = x(1)^3*x(2) + x(2)^(3*k+1);
     1463      fk = jet(f, 3*k+1, weight(JetId));
     1464  //      "fuer k>1: f=", Show(a);
     1465  //      "fuer k>1: jet=", Show(jet(fk, 4));
     1466    }
     1467
     1468  //  JetId = x(1)^3*x(2) + x(2)^(3*k+1);
     1469  //  fk = jet(f, 3*k+1, weight(JetId));
     1470  //  "Coeff von x3=",Coeff(fk, x(1), x(1)^3);
     1471  //  "Coeff von y3=",Coeff(fk, x(2), x(2)^3);
     1472  //  "f  =", Show(f);
     1473  //  "k=", k;
     1474  //  "jet=", Show(jet(fk, 4));
     1475    return(f);
     1476
     1477}
     1478
     1479///////////////////////////////////////////////////////////////////////////////
     1480proc printresult (int step, poly f, string typ, int Mu, int m, int corank, int K)
     1481{ list v;
     1482  debug_log(0,"   Arnold step number "+string(step));
     1483  if( typ != "Fehler!" && @DeBug>=0 ) {
     1484    "The singularity";
     1485    "   `"+Show(jet(f, K))+"'";
     1486    "is R-equivalent to "+typ+".";
     1487    if(Mu>=0) { "   Mu = "+string(Mu); }
     1488    if(m>=0)  { "   m  = "+string(m); }
     1489  }
     1490  v[1] = Show(f);
     1491  v[2] = typ;
     1492  v[3] = corank;
     1493  return(v);
     1494}
     1495
     1496///////////////////////////////////////////////////////////////////////////////
     1497proc Funktion2 (poly f, int corank, int Mu, int K)
     1498{
     1499    string tp = "A["+string(Mu)+"]";
     1500    return(printresult(2, f, tp, Mu, 0, corank, K));
     1501  //  ring RingB=char(basering),x,ds;
     1502  //  Morse(f, Kbestimmt(f));
     1503  //  return(string(x^(Mu+1)), tp, corank);
     1504}
     1505
     1506///////////////////////////////////////////////////////////////////////////////
     1507proc Funktion4 (poly f, int corank, int Mu, int K)
     1508{
     1509    string tp = "D[4]";
     1510    return(printresult(4, f, tp, Mu, 0, corank, K));
     1511}
     1512
     1513///////////////////////////////////////////////////////////////////////////////
     1514proc Funktion5 (poly f, int corank, int Mu, int K)
     1515{
     1516    string tp = "D["+string(Mu)+"]";
     1517    return(printresult(5, f, tp, Mu, 0, corank, K));
     1518}
     1519
     1520///////////////////////////////////////////////////////////////////////////////
     1521proc Funktion7 (poly f, int corank, int Mu, int K, int k)
     1522{
     1523    string tp = "E["+string(6*k)+"]";
     1524    return(printresult(7, f, tp, Mu, k-1, corank, K));
     1525//    if(6*k != Mu) { "Fehler!!!"; }
     1526}
     1527
     1528///////////////////////////////////////////////////////////////////////////////
     1529proc Funktion8 (poly f, int corank, int Mu, int K, int k)
     1530{
     1531    string tp = "E["+string(6*k+1)+"]";
     1532    return(printresult(8, f, tp, Mu, k-1, corank, K));
     1533//    if( (6*k+1) != Mu) { "Fehler!!!"; }
     1534}
     1535
     1536///////////////////////////////////////////////////////////////////////////////
     1537proc Funktion9 (poly f, int corank, int Mu, int K, int k)
     1538{
     1539    string tp = "E["+string(6*k+2)+"]";
     1540    return(printresult(9, f, tp, Mu, k-1, corank, K));
     1541//    if( (6*k+2) != Mu) { "Fehler!!!"; }
     1542}
     1543
     1544///////////////////////////////////////////////////////////////////////////////
     1545proc Funktion11 (poly f, int corank, int Mu, int K, int k)
     1546{
     1547    string tp = "J["+string(k)+",0]";
     1548    return(printresult(11, f, tp, Mu, k-1, corank, K));
     1549//    if( (6*k-2) != Mu) { "Fehler!!!"; }
     1550}
     1551
     1552///////////////////////////////////////////////////////////////////////////////
     1553proc Funktion12 (poly f, int corank, int Mu, int K, int k)
     1554{
     1555    string tp = "J["+string(k)+","+string(Mu - 6*k +2),"]";
     1556    return(printresult(12, f, tp, Mu, k-1, corank, K));
     1557//    if( (6*k-2+p) != Mu) { "Fehler!!!"; }
     1558}
     1559
     1560///////////////////////////////////////////////////////////////////////////////
     1561proc Funktion14 (poly f, int corank, int Mu, int K)
     1562{
     1563    string tp = "T[2,4,4]";
     1564    return(printresult(14, f, "X[9] = X[1,0] = "+tp, Mu, 1, corank, K));
     1565}
     1566
     1567///////////////////////////////////////////////////////////////////////////////
     1568proc Funktion15 (poly f, int corank, int Mu, int K)
     1569{
     1570    string tp = "T[2,4," + string(Mu-5) + "]";
     1571    return(printresult(15, f, "X[1,"+string(Mu-9)+"] = "+tp, Mu, 1, corank, K));
     1572}
     1573
     1574///////////////////////////////////////////////////////////////////////////////
     1575proc Funktion16 (poly f, int corank, int Mu, int K)
     1576{
     1577    string s;
     1578    int p;
     1579    int q;
     1580    string tp = "T[2,"+string(4+p)+","+string(4+q)+"]";
     1581//    return(printresult(16, f, tp, Mu, k-1, corank, K));
     1582
     1583    s = "The singularity `"+Show(jet(f, K));
     1584    s = s +"' is R-equivalent to Y[1,"+string(p)+","+string(q)+"]";
     1585    s =s+" = "+tp+".p=??,q=??, mu="+string(Mu);
     1586    s; // +"  ("+@SG_Typ+")";
     1587    return(Show(f), tp, corank);
     1588}
     1589
     1590///////////////////////////////////////////////////////////////////////////////
     1591proc Funktion19 (poly f, int corank, int Mu, int K, int k)
     1592{
     1593    string tp = "Z["+string(6*k+5)+"]";
     1594    return(printresult(19, f, tp, Mu, k-1, corank, K));
     1595}
     1596
     1597///////////////////////////////////////////////////////////////////////////////
     1598proc Funktion20 (poly f, int corank, int Mu, int K, int k)
     1599{
     1600    string tp = "Z["+string(6*k+6)+"]";
     1601    return(printresult(20, f, tp, Mu, k-1, corank, K));
     1602}
     1603
     1604///////////////////////////////////////////////////////////////////////////////
     1605proc Funktion21 (poly f, int corank, int Mu, int K, int k)
     1606{
     1607    string tp = "Z["+string(6*k+7)+"]";
     1608    return(printresult(21, f, tp, Mu, k-1, corank, K));
     1609}
     1610
     1611///////////////////////////////////////////////////////////////////////////////
     1612proc Funktion23 (poly f, int corank, int Mu, int K, int k)
     1613{
     1614    string tp = "Z["+string(k-1)+",0]";
     1615    return(printresult(23, f, tp, Mu, k-1, corank, K));
     1616}
     1617
     1618///////////////////////////////////////////////////////////////////////////////
     1619proc Funktion24 (poly f, int corank, int Mu, int K, int k)
     1620{
     1621    string tp = "Z["+string(k-1)+","+string(Mu-15)+"]";
     1622    return(printresult(24, f, tp, Mu, k-1, corank, K));
     1623}
     1624
     1625///////////////////////////////////////////////////////////////////////////////
     1626proc Funktion27 (poly f, int corank, int Mu, int K, int k)
     1627{
     1628    string tp = "W["+string(12*k)+"]";
     1629    return(printresult(27, f, tp, Mu, 3*k-2, corank, K));
     1630}
     1631
     1632///////////////////////////////////////////////////////////////////////////////
     1633proc Funktion28  (poly f, int corank, int Mu, int K, int k)
     1634{
     1635    string tp = "W["+string(12*k+1)+"]";
     1636    return(printresult(28, f, tp, Mu, 3*k-2, corank, K));
     1637}
     1638
     1639///////////////////////////////////////////////////////////////////////////////
     1640proc Funktion30  (poly f, int corank, int Mu, int K, int k)
     1641{
     1642    string tp = "W["+string(k)+",0]";
     1643    return(printresult(30, f, tp, Mu, 3*k-1, corank, K));
     1644}
     1645
     1646///////////////////////////////////////////////////////////////////////////////
     1647proc Funktion31  (poly f, int corank, int Mu, int K, int k)
     1648{
     1649    string tp = "W["+string(k)+","+string(Mu - 12*k - 3)+"]";
     1650    return(printresult(31, f, tp, Mu, 3*k-1, corank, K));
     1651}
     1652
     1653///////////////////////////////////////////////////////////////////////////////
     1654proc Funktion32  (poly f, int corank, int Mu, int K, int k)
     1655{
     1656    string tp = "W#["+string(k)+","+string(Mu - 12*k - 2)+"]";
     1657    return(printresult(32, f, tp, Mu, 3*k-1, corank, K));
     1658}
     1659
     1660///////////////////////////////////////////////////////////////////////////////
     1661proc Funktion34  (poly f, int corank, int Mu, int K, int k)
     1662{
     1663    string tp = "W["+string(12*k+5)+"]";
     1664    return(printresult(34, f, tp, Mu, 3*k-1, corank, K));
     1665}
     1666
     1667///////////////////////////////////////////////////////////////////////////////
     1668proc Funktion35  (poly f, int corank, int Mu, int K, int k)
     1669{
     1670    string tp = "W["+string(12*k+6)+"]";
     1671    return(printresult(35, f, tp, Mu, 3*k-1, corank, K));
     1672}
     1673
     1674///////////////////////////////////////////////////////////////////////////////
     1675proc Funktion37  (poly f, int corank, int Mu, int K, int k)
     1676{
     1677    string tp = "X["+string(k)+",0]";
     1678    return(printresult(37, f, tp, Mu, k-1, corank, K));
     1679}
     1680
     1681///////////////////////////////////////////////////////////////////////////////
     1682proc Funktion38  (poly f, int corank, int Mu, int K, int k)
     1683{
     1684    string tp = "X["+string(k)+","+string(Mu - 12*k + 3)+"]";
     1685    return(printresult(38, f, tp, Mu, k-1, corank, K));
     1686}
     1687
     1688///////////////////////////////////////////////////////////////////////////////
     1689proc Funktion39 (poly f, int corank, int Mu, int K, int k)
     1690{
     1691    string tp = "Y["+string(k)+",r,s]";
     1692    return(printresult(39, f, tp, Mu, k-1, corank, K));
     1693}
     1694
     1695///////////////////////////////////////////////////////////////////////////////
     1696proc Funktion42 (poly f, int corank, int Mu, int K, int k, int r)
     1697{
     1698    string tp = "Z["+string(k)+","+string(12*k+6*r-1)+"]";
     1699    return(printresult(42, f, tp, Mu, k-1, corank, K));
     1700}
     1701
     1702///////////////////////////////////////////////////////////////////////////////
     1703proc Funktion43 (poly f, int corank, int Mu, int K, int k, int r)
     1704{
     1705    string tp = "Z["+string(k)+","+string(12*k+6*r)+"]";
     1706    return(printresult(43, f, tp, Mu, k-1, corank, K));
     1707}
     1708
     1709///////////////////////////////////////////////////////////////////////////////
     1710proc Funktion44 (poly f, int corank, int Mu, int K, int k, int r)
     1711{
     1712    string tp = "Z["+string(k)+","+string(12*k+6*r+1)+"]";
     1713    return(printresult(44, f, tp, Mu, k-1, corank, K));
     1714}
     1715
     1716///////////////////////////////////////////////////////////////////////////////
     1717proc Funktion45 (poly f, int corank, int Mu, int K, int k, int r, int s)
     1718{
     1719    string tp = "Z["+string(k)+","+string(r)+","+string(s)+"]";
     1720    return(printresult(45, f, tp, Mu, k-1, corank, K));
     1721}
     1722
     1723///////////////////////////////////////////////////////////////////////////////
     1724proc Funktion47 (poly f, int corank, int Mu, int K)
     1725{
     1726    string s = "The Singularity '";+Show(jet(f, K), corank, K));
     1727    string tp="";
     1728//    return(printresult(47, f, tp, Mu, -1, corank, K));
     1729
     1730    s = s +"' has 4-jet equal to zero. (F47), mu="+string(Mu);
     1731 
     1732    s; // +"  ("+@SG_Typ+")";
     1733    return(Show(f), tp, corank);
     1734}
     1735
     1736///////////////////////////////////////////////////////////////////////////////
     1737proc Funktion51 (poly f, int corank, int Mu, int K)
     1738{
     1739    string tp = "T[3,3,3]";
     1740    return(printresult(51, f, "P[8] = "+tp, Mu, 1, corank, K));
     1741}
     1742
     1743///////////////////////////////////////////////////////////////////////////////
     1744proc Funktion52 (poly f, int corank, int Mu, int K)
     1745{
     1746    string tp = "P["+string(p+5)+"]=T[3,3,p]";
     1747    return(printresult(52, f, "P[p] = "+tp, Mu, 1, corank, K));
     1748}
     1749
     1750///////////////////////////////////////////////////////////////////////////////
     1751proc Funktion54 (poly f, int corank, int Mu, int K)
     1752{
     1753    string tp = "R[p,q]=T[3,p,q]";
     1754    return(printresult(54, f, "R[p,q] = "+tp, Mu, 1, corank, K));
     1755}
     1756
     1757///////////////////////////////////////////////////////////////////////////////
     1758proc Funktion56 (poly f, int corank, int Mu, int K)
     1759{
     1760    string tp = "T[p,q,r]";
     1761    return(printresult(56, f, tp, Mu, 1, corank, K));
     1762}
     1763
     1764///////////////////////////////////////////////////////////////////////////////
     1765proc Funktion60 (poly f, int corank, int Mu, int K, int k)
     1766{
     1767    string tp = "Q["+string(6*k+4)+"]";
     1768    return(printresult(60, f, tp, Mu, k-1, corank, K));
     1769}
     1770
     1771///////////////////////////////////////////////////////////////////////////////
     1772proc Funktion61 (poly f, int corank, int Mu, int K, int k)
     1773{
     1774    string tp = "Q["+string(6*k+5)+"]";
     1775    return(printresult(61, f, tp, Mu, k-1, corank, K));
     1776}
     1777
     1778///////////////////////////////////////////////////////////////////////////////
     1779proc Funktion62 (poly f, int corank, int Mu, int K, int k)
     1780{
     1781    string tp = "Q["+string(6*k+6)+"]";
     1782    return(printresult(62, f, tp, Mu, k-1, corank, K));
     1783}
     1784
     1785///////////////////////////////////////////////////////////////////////////////
     1786proc Funktion64 (poly f, int corank, int Mu, int K, int k)
     1787{
     1788    string tp = "Q["+string(k)+",0]";
     1789    return(printresult(64, f, tp, Mu, k-1, corank, K));
     1790}
     1791
     1792///////////////////////////////////////////////////////////////////////////////
     1793proc Funktion65 (poly f, int corank, int Mu, int K, int k)
     1794{
     1795    string tp = "Q["+string(k)+","+string(Mu - (6*k + 2))+"]";
     1796    return(printresult(65, f, tp, Mu, k-1, corank, K));
     1797}
     1798
     1799///////////////////////////////////////////////////////////////////////////////
     1800proc Funktion84 (poly f, int corank, int Mu, int K, int k)
     1801{
     1802    string tp  = "U[12k]";
     1803    return(printresult(84, f, tp, Mu, -1, corank, K));
     1804    return(FunktionNoClass(f, corank));
     1805
     1806
     1807///////////////////////////////////////////////////////////////////////////////
     1808proc Funktion86 (poly f, int corank, int Mu, int K, int k)
     1809{
     1810    string tp  = "U[k,0]";
     1811    return(printresult(86, f, tp, Mu, -1, corank, K));
     1812    return(FunktionNoClass(f, corank));
     1813}
     1814
     1815///////////////////////////////////////////////////////////////////////////////
     1816proc Funktion87 (poly f, int corank, int Mu, int K, int k)
     1817{
     1818    string tp  = "U[k,p]";
     1819    return(printresult(87, f, tp, Mu, -1, corank, K));
     1820    return(FunktionNoClass(f, corank));
     1821}
     1822
     1823///////////////////////////////////////////////////////////////////////////////
     1824proc Funktion89 (poly f, int corank, int Mu, int K, int k)
     1825{
     1826    string tp  = "U[12k+4]";
     1827    return(printresult(89, f, tp, Mu, -1, corank, K));
     1828    return(FunktionNoClass(f, corank));
     1829}
     1830
     1831///////////////////////////////////////////////////////////////////////////////
     1832proc Funktion91 (poly f, int corank, int Mu, int K, int k)
     1833{
     1834    string tp  = "U*[k,0]";
     1835    return(printresult(91, f, tp, Mu, -1, corank, K));
     1836    return(FunktionNoClass(f, corank));
     1837}
     1838
     1839///////////////////////////////////////////////////////////////////////////////
     1840proc Funktion92 (poly f, int corank, int Mu, int K, int k)
     1841{
     1842    string tp  = "UP[k]";
     1843    return(printresult(92, f, tp, Mu, -1, corank, K));
     1844    return(FunktionNoClass(f, corank));
     1845}
     1846
     1847///////////////////////////////////////////////////////////////////////////////
     1848proc Funktion93 (poly f, int corank, int Mu, int K, int k)
     1849{
     1850    string tp  = "UQ[k]";
     1851    return(printresult(93, f, tp, Mu, -1, corank, K));
     1852    return(FunktionNoClass(f, corank));
     1853}
     1854
     1855///////////////////////////////////////////////////////////////////////////////
     1856proc Funktion94 (poly f, int corank, int Mu, int K, int k)
     1857{
     1858    string tp  = "UR[k]";
     1859    return(printresult(94, f, tp, Mu, -1, corank, K));
     1860    return(FunktionNoClass(f, corank));
     1861}
     1862
     1863///////////////////////////////////////////////////////////////////////////////
     1864proc Funktion95 (poly f, int corank, int Mu, int K, int k)
     1865{
     1866    string tp  = "US[k]";
     1867    return(printresult(95, f, tp, Mu, -1, corank, K));
     1868    return(FunktionNoClass(f, corank));
     1869}
     1870
     1871///////////////////////////////////////////////////////////////////////////////
     1872proc Funktion96 (poly f, int corank, int Mu, int K, int k)
     1873{
     1874    string tp  = "UT[k]";
     1875    return(printresult(96, f, tp, Mu, -1, corank, K));
     1876    return(FunktionNoClass(f, corank));
     1877}
     1878
     1879///////////////////////////////////////////////////////////////////////////////
     1880proc Funktion100 (poly f, int corank, int Mu, int K)
     1881{
     1882    string tp = "V[1,"+string(Mu-15)+"]";
     1883    return(printresult(100, f, tp, Mu, -1, corank, K));
     1884}
     1885
     1886///////////////////////////////////////////////////////////////////////////////
     1887proc Funktion99 (poly f, int corank, int Mu, int K)
     1888{
     1889    string tp = "V[1,0]";
     1890    return(printresult(99, f, tp, Mu, -1, corank, K));
     1891}
     1892
     1893///////////////////////////////////////////////////////////////////////////////
     1894proc Funktion101 (poly f, int corank, int Mu, int K)
     1895{
     1896    string tp = "V#[1,"+string(Mu-15)+"]";
     1897    return(printresult(101, f, tp, Mu, -1, corank, K));
     1898}
     1899
     1900///////////////////////////////////////////////////////////////////////////////
     1901proc morsesplit(poly f)
     1902USAGE:    morsesplit(f,K);        f=poly
     1903RETURN:   Normal-Form of f in M^3";
     1904COMPUTE:  aplly the splittinglemma to f
     1905EXAMPLE:  example morsesplit; shows an example
     1906{
     1907  int n = nvars(basering);
     1908  int K,Mu,corank;
     1909  def ring_top=basering;
     1910  export ring_top;
     1911
     1912  // if trace/debug mode not set, do it!
     1913  init_debug();
     1914
     1915  K, Mu, corank = basicinvariants(f);
     1916  ring @Rtop=char(basering),(x(1..n)),(c,ds);
     1917
     1918  map Conv=ring_top,maxideal(1);
     1919  setring ring_top;
     1920
     1921  setring @Rtop;
     1922  if(defined(@ringdisplay) == 1) { kill @ringdisplay; }
     1923  string @ringdisplay = "setring ring_top";
     1924  export @ringdisplay;
     1925
     1926  poly f_out = Morse(jet(Conv(f),K), K, corank);
     1927  setring ring_top;
     1928  map ConvUp = @Rtop, maxideal(1);
     1929  return(ConvUp(f_out));
     1930}
     1931example
     1932{ "EXAMPLE"; echo=2;
     1933   ring r=0,(x,y,z),ds;
     1934   init_debug(1);
     1935   poly f=(x2+3y-2z)^2+xyz-(x-y3+x2*z3)^3;
     1936   poly g=morsesplit(f);
     1937   g;
     1938}
     1939
     1940///////////////////////////////////////////////////////////////////////////////
     1941proc Coeffs (list #)
     1942{
     1943  matrix m=matrix(coeffs(#[1],#[2]), deg(#[1])+1, 1);
     1944  return(m);
     1945}
     1946
     1947///////////////////////////////////////////////////////////////////////////////
     1948proc Morse(poly fi, int K, int corank)
     1949{
     1950    init_debug();
     1951    if( defined(ShowPhi) == 0) { int ShowPhi = 0; }
     1952    int n = nvars(basering);
     1953    int i = 1;          // Index fuer Variablen wird bearbeitet
     1954    int j = 0;          // Index fuer Variablen Schleife
     1955    int k = 0;          // Index fuer Variablen Schleife
     1956    int Rang = 0;       // Rang des Polynomes
     1957    string s1 = "0";
     1958    poly fc;            // current
     1959    poly f2;            // 2-jet von current
     1960    poly a;             // coef of x(i)^2
     1961    poly P;             // coef of x(i)
     1962    map Id;             // Identitaet auf r
     1963    if(defined(PhiG)==0) { map PhiG; }
     1964    if(defined(Phi)==0) { map Phi; }
     1965                        // Koordinaten-Transformation auf basering
     1966    map Psi;            // Koordinatenwechsel der SplatungsLemmas
     1967    ideal Jfx;
     1968    def ring_split=basering;
     1969 
     1970    debug_log(3, "Spalte folgendes Polynom mit Bestimmtheit: ", string(K));
     1971    debug_log(3, Show(fi));
     1972 
     1973    for( j=1; j<n ; j=j+1)
     1974    { s1 = s1 + ",0"; }
     1975    s1 = "intvec Abb = "+ s1+";";
     1976    execute s1;
     1977 
     1978    GetRf(fi, n);
     1979    debug_log(2, "Reihenfolge fuer Vertauschungen:", RFlg );
     1980    PhiG=ring_split,maxideal(1);
     1981 
     1982    if(corank == (n-1)) {
     1983      int Done = 0;
     1984      f2 = jet(fi, 2);
     1985      j=1;
     1986      Jfx = f2, diff(f2, x(j));
     1987      while(j<=n && (diff(f2, x(j))==0)) {
     1988        j = j+1;
     1989        Jfx = f2, diff(f2, x(j));
     1990      }
     1991      if(defined(VERT) == 1 ) { kill VERT; }
     1992      matrix Mat = matrix(syz(Jfx));
     1993      poly Beta = 2*Mat[2,1]/Mat[1,1];
     1994      if(defined(VERT) == 1 ) { kill VERT; }
     1995      s1 = "map VERT="+nameof(basering);        // Konstruiere Id auf basering
     1996      for( j=1; j<=n ; j=j+1) {
     1997        f2 = Coeff(Beta, x(RFlg[j]), x(RFlg[j]));
     1998        if(f2!=0) {
     1999          k = RFlg[j];
     2000          break;
     2001        }
     2002      }
     2003      for( j=1; j<=n ; j=j+1) {
     2004        f2 = Coeff(Beta, x(j), x(j));
     2005        if(j != k) { s1 = s1 + ", x(" + string(j) + ")"; }
     2006        if(j == k) {
     2007          f2= (2*f2*x(j)-Beta) / number(f2);
     2008          s1 = s1 + ","+string(f2);
     2009        }
     2010      }
     2011      s1 = s1 + ";";
     2012      execute s1;
     2013      fi = VERT(fi);   
     2014      PhiG = VERT(PhiG);
     2015    }
     2016    if( ShowPhi > 1) { PhiG; }
     2017 
     2018    fc = fi;
     2019    while( i <= n) {
     2020      Phi=ring_split,maxideal(1);
     2021      debug_log(6, "Prufe Variable x(" +string(RFlg[i]) + ")");
     2022      debug_log(6, "--------------------");
     2023      j = i + 1;        // setze j fuer evtle Verschiebung
     2024 
     2025      f2 = jet(fc,2);
     2026      debug_log(6, "Rechne 2-Jet =" , string(f2));
     2027      if( (f2 - subst(f2, x(RFlg[i]), 0)) == 0 ) { Abb[RFlg[i]] = 1; }
     2028      if( (f2 - subst(f2, x(RFlg[i]), 0)) != 0 ) {
     2029        while( (j<=n) || (i==n) ) {
     2030          if( @DeBug > 5 ) {
     2031            "Prufe 2-Jet mit Wert : " + string(jet(fc,2));
     2032          }
     2033          a=Coeff(jet(fc,2), x(RFlg[i]), x(RFlg[i])^2);
     2034          if( @DeBug > 5 ) {
     2035            "Koeffizient von x(" + string(RFlg[i]) + ")^2 ist: "+ string(a);
     2036          }
     2037          if( (a != 0) || (i==n) ) {
     2038            if( @DeBug > 5 ) {
     2039              "BREAK!!!!!!!!!!!!!!";
     2040            }
     2041          break;
     2042          }
     2043          if( @DeBug > 5 ) {
     2044            "Verschiebe evtl Variable x("+string(RFlg[j])+") um x("+string(RFlg[i])+ ")";
     2045          }
     2046          s1 = "Phi="+nameof(basering);
     2047          for( k=1; k<=n ; k=k+1) {
     2048            if(k!=RFlg[j]) { s1 = s1 + ",x(" + string(k) + ")"; }
     2049            if(k==RFlg[j]) {
     2050              s1=s1+",x("+string(k)+")+x("+string(RFlg[i])+")";
     2051            }
     2052          }
     2053          execute s1;
     2054  //        Phi;
     2055          fc = Phi(fi);
     2056          j = j + 1;
     2057        }               // Ende while( (j<=n) || (i==n) )
     2058 
     2059        if( @DeBug > 5 ) {
     2060          "Moegliche Verschiebung fertig!";
     2061        }
     2062        PhiG = Phi(PhiG);
     2063        if( ShowPhi > 1) { "NachVersch.:"; Phi; }
     2064 
     2065        if( (j<=n) || (i==n)) {
     2066  //        "fc hat nun die Gestalt: " + string(fc);
     2067          P = Coeff(fc, x(RFlg[i]), x(RFlg[i]));
     2068          if( @DeBug > 5 ) {
     2069            "Koeffizient von x(" + string(RFlg[i]) + ") ist: "+ string(P);
     2070          }
     2071          if(P != 0) {
     2072            if( @DeBug > 5 ) {
     2073              "1 Koeffizient von x(" + string(RFlg[i]) + ") ist: "+ string(P);
     2074              "a=" + string(a);
     2075            }
     2076            P = P / number (2 * a);
     2077            if( @DeBug > 5 ) {
     2078              "2 Koeffizient von x(" + string(RFlg[i]) + ") ist: "+ string(P);
     2079            }
     2080            s1 = "Phi="+nameof(basering);
     2081            for( k=1; k<=n ; k=k+1) {
     2082              if(k!=RFlg[i]) { s1 = s1 + ",x(" + string(k) + ")"; }
     2083              if(k==RFlg[i]) {
     2084                s1 = s1 + ",x(" + string(k) + ") + (-1)*(" + string(P) + ")";
     2085              }
     2086            }
     2087            execute s1;
     2088            if( @DeBug > 5 ) {
     2089              "Quadratische-Ergaenzung durch:";
     2090            Phi;
     2091            }
     2092            if( @DeBug > 10 ) { fc; }
     2093            fi = Phi(fc);
     2094          PhiG = Phi(PhiG);
     2095          if( ShowPhi > 1) { "Fakt:"; Phi; }
     2096            if( @DeBug > 10 ) { fi; }
     2097          fc = jet(fi,K);
     2098            if( @DeBug > 10 ) { fc; }
     2099            P = Coeff(fc, x(RFlg[i]), x(RFlg[i]));
     2100            if( @DeBug > 10 ) { P; }
     2101            if( P != 0) {
     2102              fi = fc;
     2103              continue;
     2104            }
     2105          }     // Ende if(P != 0)
     2106                // Fertig mit Quadratischer-Ergaenzung
     2107        }               // Ende if( (j<=n) || (i==n))
     2108      }                 // Ende if( (f2 - subst(f2, x(RFlg[i]), 0)) != 0 )
     2109 
     2110      if(@DeBug>3) { "f=",Show(fi); }
     2111      fi = fc;
     2112      if(@DeBug>3) { "f=",Show(fi); }
     2113      i = i + 1;
     2114      if( @DeBug > 5 ) {
     2115        "++++++++++++++++++++++++++++++++++++++++++++++++++++++++";
     2116      }
     2117    }
     2118    if( @DeBug > 5 ) {
     2119      "Ende  ---------------------------------------------------";
     2120    }
     2121 
     2122    if( ShowPhi > 0 ) {
     2123      "Abbildung innerhalb des Morse-Lemmas:";
     2124      PhiG;
     2125      "Vergleich:";
     2126      "PhiG(f)= " + Show(jet(PhiG(f), K));
     2127      "fi     = " + Show(fi);
     2128    }
     2129 
     2130    for( i=1; i<=n ; i=i+1) {
     2131      if(Abb[i] != 1)
     2132      { Rang = Rang + 1;
     2133        fi = subst(fi,x(i),0);
     2134      }
     2135    }
     2136    debug_log(2, "rank determined with Morse rg=", Rang);
     2137    debug_log(1, "Rest singularity f=",Show(fi));
     2138    return(fi);
     2139}
     2140
     2141///////////////////////////////////////////////////////////////////////////////
     2142proc Coeff
     2143{
     2144  if( size(#) != 3 ) {
     2145//=============================================================================
     2146    " USAGE:   Coeff(<Poly>, <Ring-Variable>, <>);";
     2147    " RETURN:  nil";
     2148    " NOTE:    intern!";
     2149    " EXAMPLE: a=Coeff(jet(fc,2), x(i), x(i)^2);";
     2150//=============================================================================
     2151    return();
     2152  }
     2153  if( typeof(#[1]) != "poly" ) {
     2154    "argv(1) must be poly";
     2155    "argv(2) must be ring-variables";
     2156    "argv(3) must be poly";
     2157    return();
     2158  }
     2159
     2160  int n = nvars(basering);
     2161  int i = 1;
     2162  poly a;
     2163  poly term  = #[3];
     2164  matrix K=coef(#[1], #[2]);
     2165
     2166  while( (i<=ncols(K)) && (K[1,i] != term) )
     2167  { i= i + 1;
     2168    if(i>ncols(K)) { break; }
     2169  }
     2170  if(i<=ncols(K)) { a = K[2,i]; }
     2171  if(i>ncols(K)) { a = 0; }
     2172
     2173  return(a);
     2174}
     2175
     2176///////////////////////////////////////////////////////////////////////////////
     2177proc ReOrder(poly f)
     2178{
     2179  int n = nvars(basering);
     2180  int i = 0;
     2181  poly   result;
     2182  int Ctv = 1;          // Zahl der Vorhandenen Variablen
     2183  int Ctn = n;  // Zahl der Nicht-Vorhandenen Variablen
     2184  ideal B = maxideal(1);
     2185  def @Rtop=basering;
     2186
     2187  for( i=1; i<=n; i=i+1)
     2188  { result = subst(f,x(i), 0) - f;
     2189    if( result != 0 )
     2190    { B[rvar(x(i))] = x(Ctv);
     2191      Ctv = Ctv + 1;
     2192    }
     2193    else
     2194    { B[rvar(x(i))] = x(Ctn);
     2195      Ctn = Ctn - 1;
     2196    }
     2197  }
     2198
     2199  map RO=@Rtop,B;
     2200  return(RO(f));
     2201}
     2202
     2203///////////////////////////////////////////////////////////////////////////////
     2204proc quickclass(poly f);
     2205USAGE:    quickclass(f);         f=poly
     2206RETURN:   Normal-Form of f
     2207REMARK:   try to determine the normal form of f by invariants, mainly by
     2208          computing the Hilbert funktion of the Milnor albegra, no coordinate
     2209          change is needed (see also proc 'milnorcode').
     2210EXAMPLE:  example quickclass; shows an example
     2211{
     2212  string Typ;
     2213  int    cnt;
     2214
     2215  def ring_top=basering;
     2216  // check basic condition on the basering.
     2217  if(checkring()) { return(f); }
     2218  if( f==0 ) {
     2219    "Normal form : 0";
     2220    return(f);
     2221  }
     2222  if( jet(f,0)!=0 ) {
     2223    "Normal form : 1";
     2224    return(f);
     2225  }
     2226  // Do the classification of f
     2227  // typ: list of typs matching the milnorcode
     2228  // cnt: number of matches found
     2229  Typ,cnt=HKclass(milnorcode(f));
     2230  "Singularity R-equivalent to :",Typ;
     2231  if(cnt==0) {
     2232    "Hilbert polynomial not recognised. Milnor code = ", milnorcode(f);
     2233    return();
     2234  }
     2235  if(cnt==1) {
     2236    debug_log(1,"Getting Normalform from database.");
     2237    "Normal form :",AL(Typ);
     2238    return(AL(Typ));
     2239  }
     2240  // Hier nun der Fall cnt>1
     2241  "Hilbert-Code of Jf^2";
     2242  "We have ", cnt, "case to test.";
     2243  Cubic(f);
     2244  return(Typ,cnt);
     2245}
     2246example
     2247{ "EXAMPLE:"; echo=2;
     2248   ring r=0,(x,y,z),ds;
     2249   poly f=(x2+3y-2z)^2+xyz-(x-y3+x2*z3)^3;
     2250   quickclass(f);
     2251}
     2252
     2253///////////////////////////////////////////////////////////////////////////////
     2254proc milnorcode (poly f, list #)
     2255USAGE:    milnorcode(f[,e]); f=poly, e=int
     2256RETURN:   intvec, coding the Hilbert function of the e-th Milnor algebra of f,
     2257          i.e. of basering/(jacob(f)^e) (default e=1), according to proc Hcode
     2258EXAMPLE:  example milnorcode; shows an example
     2259{
     2260  int  e=1;
     2261  if(size(#)==1) { e=#[1]; }
     2262  ideal jf=std(jacob(f)^e);
     2263  intvec v=hilb(jf,2);v;
     2264  "---"+string(v);
     2265 
     2266  return(Hcode(v));
     2267}
     2268example
     2269{ "EXAMPLE:"; echo=2;
     2270  ring r=0,(x,y,z),ds;
     2271  poly f=x2y+y3+z2;
     2272  milnorcode(f);
     2273  milnorcode(f,2);  // a big second argument may result in memory overflow
     2274}
     2275
     2276///////////////////////////////////////////////////////////////////////////////
     2277proc Hcode (intvec v)
     2278USAGE:    Hcode(v); v=intvec
     2279RETURN:   intvec, coding v according to the number of successive repetitions
     2280          of an entry
     2281EXAMPLE:  example Hcode; shows an example.
     2282{
     2283  int i, cur, cnt, maxcoef, nlen;
     2284  intvec hil1, hil2;
     2285  int col=1;
     2286  int len = size(v);
     2287  v[len+1]=0;
     2288
     2289  init_debug();
     2290  debug_log(1, "Hilbert:", v );
     2291
     2292  for(i=1; i<=len; i++) { if( v[i] > maxcoef) { maxcoef = v[i]; } }
     2293
     2294  nlen = 2*maxcoef - 1;
     2295  hil1[nlen]=0;
     2296  hil2[nlen]=0;
     2297
     2298  for(i=1; i<=nlen; i++)
     2299  { if( i > maxcoef) { hil2[i] = 2*maxcoef-i; }
     2300    else { hil2[i] = i; }
     2301  }
     2302
     2303  for(i=1; i<=nlen; i++)
     2304  { cnt=0;
     2305    while( (col<=len) && (v[col] == hil2[i]) )
     2306    { cnt++; col++; }
     2307    hil1[i] = cnt;
     2308  }
     2309  return(hil1);
     2310}
     2311example
     2312{ "EXAMPLE:"; echo=2;
     2313  intvec v1 = 1,3,5,5,2;
     2314  Hcode(v1);
     2315  intvec v2 = 1,2,3,4,4,4,4,4,4,4,3,2,1;
     2316  Hcode(v2);
     2317}
     2318
     2319///////////////////////////////////////////////////////////////////////////////
     2320proc Cubic (poly f)
     2321{
     2322  poly f3 = jet(f, 3);
     2323  if( jet(f,2) != 0) { return("2-jet non zero"); }
     2324  if( f3 == 0 ) { return("null form"); }
     2325
     2326  ideal Jf1 = jacob(f3);
     2327  ideal Jf  = std(Jf1);
     2328  ideal Jf2;
     2329  int Dim = dim(Jf);
     2330  int Mult = mult(Jf);
     2331//  "Dim=",Dim,"  Mult=",Mult;
     2332
     2333  if(Dim == 0) { return("P[8]:smooth cubic"); } // x3 + y3 + z3 + axyz
     2334  if(Dim == 1) {
     2335    if(Mult == 2) {
     2336      Jf2 = wedge(jacob(Jf1),3-Dim), Jf1;
     2337      Jf2 = std(Jf2);
     2338      Dim = dim(Jf2);
     2339      Mult = mult(Jf2);
     2340      "dim=", Dim, "Mult=",Mult," Jf2=", Jf2;
     2341      if (Dim == 0) { return("R:conic + line"); }       // x3 + xyz
     2342      if (Dim == 1) { return("Q:cuspidal cubic"); }  // x3 + yz2
     2343    }
     2344    if(Mult == 3) {
     2345      Jf2 = wedge(jacob(Jf1),3-Dim), Jf1;
     2346      Jf2 = std(Jf2);
     2347      Dim = dim(Jf2);
     2348      if(Dim == 0) { return("T:three lines"); } // xyz
     2349      if(Dim == 1) { return("S:conic + tangent"); }     // x2z + yz2
     2350    }
     2351    if(Mult == 4) { return("U:three concurrent lines"); }       // x3 + xz2
     2352  }
     2353  if(Dim == 2) {
     2354    if(Mult == 1) { return("V:doubleline + line"); }    // x2y
     2355    if(Mult == 2) { return("V': tripple line"); }       // x3
     2356  }
     2357  if(Dim == 3) { return("P[9]:nodal cubic"); }  // x3 + y3 + xyz
     2358
     2359  return("");
     2360}
     2361
     2362///////////////////////////////////////////////////////////////////////////////
     2363proc parity  (int e)
     2364USAGE:    parity()
     2365{
     2366  int r = e/2;
     2367  if( 2*r == e ) { return(0); }
     2368  return(1);
     2369}
     2370
     2371///////////////////////////////////////////////////////////////////////////////
     2372proc HKclass (intvec sg)
     2373{
     2374  int cnt = 0;
     2375  if(defined(@SG_Typ) == 0) { string @SG_Typ=""; export @SG_Typ; }
     2376  @SG_Typ="";
     2377 
     2378  // if trace/debug mode not set, do it!
     2379  init_debug();
     2380  debug_log(1, "Milnor code : ", sg );
     2381  if(size(sg) == 1) { @SG_Typ="A["+string(sg[1])+"]"; return(@SG_Typ,1); }
     2382  if(size(sg) == 3) { return(HKclass3(sg,cnt)); }
     2383  if(size(sg) == 5) { return(HKclass5(sg,cnt)); }
     2384  if(size(sg) == 7) { return(HKclass7(sg,cnt)); }
     2385  debug_log(1, "No solution found." );
     2386  return("",0);
     2387}
     2388
     2389///////////////////////////////////////////////////////////////////////////////
     2390proc HKclass3 (intvec sg, int cnt)
     2391{
     2392  int k;
     2393  int r;
     2394  int s;
     2395
     2396  if(sg[1] == 1) {
     2397    @SG_Typ,cnt = HKclass3_teil_1(sg,cnt);
     2398  }
     2399  if(@DeBug>5) { "HKclass3: ", @SG_Typ, " cnt=", cnt; }
     2400  return(@SG_Typ,cnt);
     2401}
     2402
     2403///////////////////////////////////////////////////////////////////////////////
     2404proc HKclass3_teil_1 (intvec sg, int cnt)
     2405{
     2406  int k;
     2407  int r;
     2408  int s;
     2409
     2410  if(@DeBug>1) { "entering HKclass3_teil_1", sg; }
     2411  if( sg[2] == 1) {                                     // D[k]
     2412    @SG_Typ = @SG_Typ + " D[k]=D["+string(sg[3]+3)+"]";cnt=cnt+1;
     2413  }
     2414  if(sg[2]>=1) {
     2415    if( parity(sg[2])) { // sg[2] ist ungerade
     2416      if(sg[2]<=sg[3]) {
     2417        k = (sg[2]+1)/2;
     2418        if(k>1) {                                       // J[k,r]
     2419          cnt=cnt+1;
     2420          @SG_Typ=@SG_Typ+" J[k,r]=J["+string(k)+","+string(sg[3]+1-2*k)+"]";
     2421        }
     2422      }
     2423      if(sg[2]==sg[3]+2) {                              // E[6k+2]
     2424        k = (sg[2]-1)/2;
     2425        if(k>0) {
     2426          cnt=cnt+1;
     2427          @SG_Typ = @SG_Typ + " E[6k+2]=E[" + string(6*k+2) + "]";
     2428        }
     2429      }
     2430    }
     2431    else {              // sg[2] ist gerade
     2432      if( sg[2] == sg[3]+1) {                           // E[6k]
     2433        k = sg[2]/2; cnt=cnt+1;
     2434        @SG_Typ = @SG_Typ + " E[6k]=E[" + string(6*k) + "]";
     2435      }
     2436      if( sg[2] == sg[3]) {                             // E[6k+1]
     2437        k = sg[2]/2; cnt=cnt+1;
     2438        @SG_Typ = @SG_Typ + " E[6k+1]=E[" + string(6*k+1) + "]";
     2439      }
     2440    }
     2441  }
     2442
     2443  if(@DeBug>1) { "finishing HKclass3_teil_1"; }
     2444  if(@DeBug>5) { "HKclass3: ", @SG_Typ, " cnt=", cnt; }
     2445  return(@SG_Typ,cnt);
     2446}
     2447
     2448///////////////////////////////////////////////////////////////////////////////
     2449proc HKclass5 (intvec sg, int cnt)
     2450{
     2451  int k;
     2452  int r;
     2453  int s;
     2454
     2455  @SG_Typ="";
     2456
     2457  if(sg[1] == 1 && sg[2] == 1) {
     2458    @SG_Typ,cnt = HKclass5_teil_1(sg,cnt);
     2459  }
     2460  if(sg[1] == 1 && sg[2] == 0) {
     2461    @SG_Typ,cnt = HKclass5_teil_2(sg,cnt);
     2462  }
     2463  if(@DeBug>5) { "HKclass3: ", @SG_Typ, " cnt=", cnt; }
     2464  return(@SG_Typ,cnt);
     2465}
     2466
     2467///////////////////////////////////////////////////////////////////////////////
     2468proc HKclass5_teil_1 (intvec sg, int cnt)
     2469{
     2470  int k;
     2471  int r;
     2472  int s;
     2473
     2474  if(@DeBug>1) { "entering HKclass5_teil_1", sg; }
     2475  if(parity(sg[3])) {  // Dritte Stelle soll ungerade sein
     2476    k = (sg[3]+1)/2;
     2477    if(sg[3] > sg[4]) {
     2478      k = k -1;
     2479      if( (sg[4]==sg[5]) && (sg[3] == sg[4]+1) && k>0 ) { // W[12k+6]
     2480        @SG_Typ = @SG_Typ + " W[12k+6]=W["+string(12*k+6)+"]"; cnt=cnt+1;
     2481      }
     2482      if( (sg[3]==sg[5]) && (sg[3] == sg[4]+2) && k>0 ) { // W[12k+5]
     2483        @SG_Typ = @SG_Typ + " W[12k+5]=W["+string(12*k+5)+"]"; cnt=cnt+1;
     2484      }
     2485    }
     2486    else {  // sg[3] <= sg[4]
     2487      if( (sg[3]==sg[4]) && (sg[5] >= sg[3]) ) {
     2488        r = sg[5] - sg[4];
     2489        @SG_Typ=@SG_Typ +" X[k,r]=X["+string(k)+","+string(r)+"]"; cnt=cnt+1;
     2490      }
     2491      if( (sg[3]==1) && (sg[4]==3) && (sg[5]>=sg[4])){    // Z[1,r]
     2492        r = sg[5] - sg[4];
     2493        @SG_Typ = @SG_Typ + " Z[1,r]=Z[1,"+string(r)+"]"; cnt=cnt+1;
     2494      }
     2495
     2496      if( sg[4] == sg[5]) {
     2497        if(parity(sg[4])) {                                  // Z[k,r,0]
     2498          r = (sg[4] - sg[3])/2;
     2499          if( r>0 ) { cnt=cnt+1;
     2500            @SG_Typ = @SG_Typ + " Z[k,r,0]=Z["+string(k)+","+string(r)+",0]";
     2501          }
     2502        }
     2503        else {                                                // Z[k,12k+6r]
     2504          r = (sg[4] - 2*k)/2;
     2505          @SG_Typ = @SG_Typ+" Z[k,12k+6r]=Z["+string(k)+",";
     2506          @SG_Typ = @SG_Typ+string(12*k+6*r)+"]"; cnt=cnt+1;
     2507        }
     2508      }
     2509
     2510      if( parity(sg[4]) ) {  // 4. Stelle ist ungerade
     2511        if(sg[4] == sg[5]+2) {                              // Z[k,12k+6r+1]
     2512          r = (sg[4]-2*k-1)/2;
     2513          @SG_Typ=@SG_Typ+" Z[k,12k+6r+1]=Z["+string(k)+",";
     2514          @SG_Typ=@SG_Typ+string(12*k+6*r+1)+"]"; cnt=cnt+1;
     2515       }
     2516       if( (sg[5]>sg[4]) && (sg[4]>sg[3]) ) {           // Z[k,r,s]
     2517          r = (sg[4] - sg[3])/2;
     2518          s = sg[5] - sg[4];
     2519          @SG_Typ = @SG_Typ + " Z[k,r,s]=";
     2520          @SG_Typ = @SG_Typ + "Z[" + string(k) + ","+ string(r);
     2521          @SG_Typ = @SG_Typ +  ","+ string(s) + "]"; cnt=cnt+1;
     2522        }
     2523      }
     2524      else {  // 4. Stelle ist gerade
     2525        if( sg[4] == sg[5]+1) {                             // Z[k,12k+6r-1]
     2526          r = (sg[4] - 2*k)/2;
     2527          @SG_Typ=@SG_Typ+" Z[k,12k+6r-1]=Z["+string(k)+",";
     2528          @SG_Typ=@SG_Typ+string(12*k+6*r-1)+"]"; cnt=cnt+1;
     2529        }
     2530      }
     2531
     2532      if(sg[4]>sg[3]) {                                     // Y[k,r,s]
     2533        r = sg[4] - sg[3];
     2534        s = sg[5] - sg[3] + r;
     2535        if( s<0 ) { s = -s; }
     2536        @SG_Typ = @SG_Typ + " Y[k,r,s]="; cnt=cnt+1;
     2537        @SG_Typ = @SG_Typ + "Y["+string(k)+","+string(r)+","+string(s)+"]";
     2538      }
     2539    }
     2540  }
     2541  else {  // Dritte Stelle soll gerade sein
     2542    k = sg[3]/2;
     2543    // sortiere verschiedene W's
     2544    if(k>0) {
     2545      if( (sg[4]==2*k-1) && (sg[4]==sg[5]) ) {  // W[12k]
     2546        @SG_Typ = @SG_Typ + " W[12k]=W["+string(12*k)+"]"; cnt=cnt+1;
     2547      }
     2548      if( (sg[4]==2*k-1) && (sg[3]==sg[5]) ) {  // W[12k+1]
     2549        @SG_Typ = @SG_Typ + " W[12k+1]=W["+string(12*k+1)+"]"; cnt=cnt+1;
     2550      }
     2551      if( (sg[4]==2*k) && (sg[5]>=sg[4]) ) {    // W[k,r]
     2552        r = sg[5] - sg[4];
     2553        @SG_Typ=@SG_Typ+" W[k,r]=W["+string(k)+","+string(r)+"]"; cnt=cnt+1;
     2554      }
     2555      if( (sg[5]==2*k-1) && (sg[4]>sg[3]) ) {  // W#[k,2r-1]
     2556        r = sg[4] - sg[3]; cnt=cnt+1;
     2557        @SG_Typ = @SG_Typ + " W#[k,2r-1]=W["+string(k)+","+string(2*r-1)+"]";
     2558      }
     2559      if( (sg[5]==2*k) && (sg[4]>sg[3]) ) {  // W#[k,2r]
     2560        r = sg[4] - sg[3]; cnt=cnt+1;
     2561        @SG_Typ = @SG_Typ + " W#[k,2r]=W["+string(k)+","+string(2*r)+"]";
     2562      }
     2563    }   // ENDIF k>0
     2564  }
     2565  if(@DeBug>1) { "finishing HKclass5_teil_1"; }
     2566  if(@DeBug>5) { "HKclass3: ", @SG_Typ, " cnt=", cnt; }
     2567  return(@SG_Typ,cnt);
     2568}
     2569
     2570///////////////////////////////////////////////////////////////////////////////
     2571proc HKclass5_teil_2 (intvec sg, int cnt)
     2572{
     2573  int k;
     2574  int r;
     2575  int s;
     2576
     2577  if(@DeBug>1) { "entering HKclass5_teil_2", sg; }
     2578  // finde T[p,q,r]
     2579  k = sg[3] + 1;
     2580  r = sg[4] + k;
     2581  s = sg[5] + r - 1;
     2582  if(k>2 && r>2 && s>2) {                               // T[k,r,s]
     2583    cnt=cnt+1;
     2584    @SG_Typ = @SG_Typ + " T[k,r,s]=T["+string(k)+","+string(r);
     2585    @SG_Typ = @SG_Typ + ","+string(s)+"]";
     2586  }
     2587
     2588  // finde weitere Moeglicjkeiten.
     2589  if(sg[3]==2) {  // Q[...]
     2590    if(parity(sg[4])) { // 4. Stelle ist ungerade.
     2591      if(sg[4]==sg[5]) {                                // Q[6k+4]
     2592        k = (sg[4]+1)/2; cnt=cnt+1;
     2593        @SG_Typ = @SG_Typ + " Q[6k+4]=Q["+string(6*k+4)+"]";
     2594      }
     2595      if(sg[4]+1==sg[5]) {                      // Q[6k+5]
     2596        k = sg[5]/2; cnt=cnt+1;
     2597        @SG_Typ = @SG_Typ + " Q[6k+5]=Q["+string(6*k+5)+"]";
     2598      }
     2599    }
     2600    else { // 4. Stelle ist gerade.
     2601      if(sg[4]==sg[5]+1) {                      // Q[6k+6]
     2602        k = sg[4]/2; cnt=cnt+1;
     2603        @SG_Typ = @SG_Typ + " Q[6k+6]=Q["+string(6*k+6)+"]";
     2604      }
     2605      if(sg[4]<sg[5]) {                 // Q[k,r]
     2606        k = (sg[4]+2)/2;
     2607        if(k>=2) {
     2608          r = sg[5]+1-2*k; cnt=cnt+1;
     2609          @SG_Typ = @SG_Typ + " Q[k,r]=Q["+string(k)+","+string(r)+"]";
     2610        }
     2611      }
     2612    }
     2613  }
     2614  else {           // S[...]
     2615    if(parity(sg[3])) {  // 3. Stelle ist ungerade.
     2616      k = (sg[3]-1)/2;
     2617      if(sg[3]==sg[4]+3 && sg[3]==sg[5]+2) {    // S[12k-1]
     2618        cnt=cnt+1;
     2619        @SG_Typ = @SG_Typ + " S[12k-1]=S["+string(12*k-1)+"]";
     2620      }
     2621      if(sg[3]==sg[4]+3 && sg[3]==sg[5]+1) {    // s[12k]
     2622        cnt=cnt+1;
     2623        @SG_Typ = @SG_Typ + " S[12k]=S["+string(12*k)+"]";
     2624      }
     2625      if(sg[3]==sg[4]+2 && sg[5]>=sg[4]+1) {    // S[k,r]
     2626        r = sg[5] - 2*k; cnt=cnt+1;
     2627        @SG_Typ = @SG_Typ + " S[k,r]=S["+string(k)+","+string(r)+"]";
     2628      }
     2629      if(sg[3]==sg[5]+2 && sg[4]>=sg[5]) {              // S#[k,2r-1]
     2630        r = sg[4] - 2*k + 1; cnt=cnt+1;
     2631        @SG_Typ = @SG_Typ + " S#[k,2r-1]=S#["+string(k)+","+string(2*r-1)+"]";
     2632      }
     2633      if(sg[3]==sg[5]+1 && sg[4]>=sg[5]) {              // S#[k,2r]
     2634        r = sg[4] - 2*k + 1; cnt=cnt+1;
     2635        @SG_Typ = @SG_Typ + " S#[k,2r]=S#["+string(k)+","+string(2*r)+"]";
     2636      }
     2637    }
     2638    else { // 3. Stelle ist gerade.
     2639      if(sg[3]==sg[5]+1 && sg[5]==sg[4]+3) {    // S[12k+4]
     2640        k = (sg[3]-2)/2; cnt=cnt+1;
     2641        @SG_Typ = @SG_Typ + " S[12k+4]=S["+string(12*k+4)+"]";
     2642      }
     2643      if(sg[3]==sg[5]+2 && sg[5]==sg[4]+1) {    // S[12k+5]
     2644        k = (sg[3]-2)/2; cnt=cnt+1;
     2645        @SG_Typ = @SG_Typ + " S[12k+5]=S["+string(12*k+5)+"]";
     2646      }
     2647    }
     2648  }
     2649  if(@DeBug>1) { "finishing HKclass5_teil_2"; }
     2650  if(@DeBug>5) { "HKclass3: ", @SG_Typ, " cnt=", cnt; }
     2651  return(@SG_Typ,cnt);
     2652}
     2653
     2654///////////////////////////////////////////////////////////////////////////////
     2655proc HKclass7 (intvec sg, int cnt)
     2656{
     2657  int k;
     2658  int r;
     2659  int s;
     2660
     2661  @SG_Typ="";
     2662
     2663  if(sg[1] == 1 && sg[2] == 0 && sg[3] == 1) {
     2664    @SG_Typ,cnt = HKclass7_teil_1(sg,cnt);
     2665  }
     2666  if(@DeBug>5) { "HKclass3: ", @SG_Typ, " cnt=", cnt; }
     2667  return(@SG_Typ,cnt);
     2668}
     2669
     2670///////////////////////////////////////////////////////////////////////////////
     2671proc HKclass7_teil_1 (intvec sg, int cnt)
     2672{
     2673  int k;
     2674  int r;
     2675  int s;
     2676
     2677  if(@DeBug>1) { "entering HKclass7_teil_1", sg; }
     2678  if(sg[4] == 2) {                                      // V[...]
     2679    if(sg[5] == 0 && sg[6] == 1 && sg[7]>0) {   // V[1,r]
     2680      r = sg[7] - 1; cnt = cnt + 1;
     2681      @SG_Typ = @SG_Typ + " V[1,r]=V[1,"+string(r)+"]";
     2682    }
     2683    if(sg[5] == 1 && sg[7] == 1) {                      // V#[1,2r-1]
     2684      r = sg[6] + 1; cnt = cnt + 1;
     2685      @SG_Typ = @SG_Typ + " V#[1,2r-1]=V#[1,"+string(2*r-1)+"]";
     2686    }
     2687    if(sg[5] == 1 && sg[7] == 2) {                      // V#[1,2r]
     2688      r = sg[6] + 1; cnt = cnt + 1;
     2689      @SG_Typ = @SG_Typ + " V#[1,2r]=V#[1,"+string(2*r)+"]";
     2690    }
     2691  }
     2692  //            Moegliche U[...]'s
     2693  k = sg[4];
     2694  if(sg[5]==2*k-1 && sg[6]==0 && sg[7]==sg[5]) {        // U[12k]
     2695    cnt = cnt + 1;@SG_Typ = @SG_Typ + " U[12k]=U["+string(12*k)+"]";
     2696  }
     2697  if(sg[5]==2*k && sg[6]==0 && sg[7]==sg[5]) {  // U[12k+4]
     2698    cnt = cnt + 1;@SG_Typ = @SG_Typ + " U[12k+4]=U["+string(12*k+4)+"]";
     2699  }
     2700  if(sg[5]==2*k-1 && sg[6]>0 && sg[7]==sg[5]) { // U[k,2r-1]
     2701    r = sg[6] - 1; cnt = cnt + 1;
     2702    @SG_Typ = @SG_Typ + " U[k,2r-1]=U["+string(k)+","+string(2*r-1)+"]";
     2703  }
     2704  if(sg[5]==2*k-1 && sg[6]>0 && sg[7]==2*k) {   // U[k,2r]
     2705    r = sg[6]; cnt = cnt + 1;
     2706    @SG_Typ = @SG_Typ + " U[k,2r]=U["+string(k)+","+string(2*r)+"]";
     2707  }
     2708  if(@DeBug>1) { "finishing HKclass7_teil_1"; }
     2709  if(@DeBug>5) { "HKclass3: ", @SG_Typ, " cnt=", cnt; }
     2710  return(@SG_Typ,cnt);
     2711}
     2712
     2713///////////////////////////////////////////////////////////////////////////////
     2714proc singularity(string typ, list #)
     2715USAGE:    singularity(typ, list)
     2716COMPUTE:  get the Singularity named by typ from the database.
     2717          list # is as follows:
     2718          #= k [,r [,s [,a [,b [,c [,d]]]]]] k,r,s=int   a,b,c,d=poly
     2719          The name of the dbm-databasefile ist: NFlist.[dir,pag]
     2720          The file is found in the current directory. If it does not
     2721          exists, please run the script MakeDBM first.
     2722RETURN:   Normal-form and corank of the singularity named by typ
     2723EXAMPLE:  example info; shows an example
     2724{
     2725  poly a1, a2, a3, a4, f;
     2726  int k, r, s;
     2727  int len = size(#);
     2728  list v;
     2729
     2730  k = #[1];
     2731  if(len>=2) { r = #[2]; }
     2732  else { r = 0; }
     2733  if(len>=3) { s = #[3]; }
     2734  else { s = 0; }
     2735  if( k<0 || r<0 || s<0) {
     2736    "Initial condition failed: k>=0; r>=0; s>=0";
     2737    "k="+string(k)+" r="+string(r)+"   s="+string(s);
     2738    return(0);
     2739  }
     2740  int crk;
     2741
     2742  init_debug();
     2743  def ring_top=basering;
     2744
     2745  if(len>=4) { a1 = #[4]; }
     2746  else { a1=1; }
     2747  if(len>=5) { a2 = #[5]; }
     2748  else { a2=1; }
     2749  if(len>=6) { a3 = #[6]; }
     2750  else { a3=1; }
     2751  if(len>=7) { a4 = #[7]; }
     2752  else { a4=1; }
     2753
     2754  debug_log(4, "Values: len=", string(len), " k=", string(k), " r=",
     2755        string(r));
     2756  if(defined(RingNF) == 1) { kill RingNF; }
     2757  ring RingNF=char(basering),(x,y,z),(c,ds);
     2758  poly f;
     2759  map Conv=ring_top,maxideal(1);
     2760  v = Singularitaet(typ, k, r, s, Conv(a1), Conv(a2), Conv(a4),
     2761            Conv(a4));
     2762  f = v[1]; crk = v[2];
     2763  debug_log(2, "Info=", f );
     2764  setring ring_top;
     2765  if(defined(Phi) == 1) { kill Phi; }
     2766  map Phi=RingNF,maxideal(1);
     2767
     2768  return(Phi(f), crk);
     2769}
     2770example
     2771{ "EXAMPLE"; echo=2;
     2772  ring r=0,(x,y,z),(c,ds);
     2773  init_debug(0);
     2774  singularity("E[6k]",6);
     2775  singularity("T[k,r,s]", 3, 7, 5);
     2776  poly f=y;
     2777  singularity("J[k,r]", 4, 0, 0, f);
     2778}
     2779
     2780///////////////////////////////////////////////////////////////////////////////
     2781proc Singularitaet (string typ,int k,int r,int s,poly a,poly b,poly c,poly d)
     2782{
     2783  list v; 
     2784  string DBMPATH=system("getenv","DBMPATH");
     2785  string DatabasePath, Database, S;
     2786  poly f, f1;
     2787  string Text = "";
     2788  string Tp = "";
     2789  int crk, Mu, ret;
     2790  intvec MlnCd;
     2791
     2792  if( DBMPATH != "" ) { DatabasePath = DBMPATH+"/NFlist"; }
     2793  else { DatabasePath = "NFlist"; }
     2794  Database="DBM: ",DatabasePath;
     2795
     2796  link dbmLink=Database;
     2797  if(@DeBug>1) { "Opening Singalarity-database: ", Database; }
     2798  Tp = read(dbmLink, typ);
     2799  debug_log(2,"DBMread(", typ, ")=", Tp, ".");
     2800  if( Tp != "(null)" && Tp !="" ) {
     2801    debug_log(2,"Test 1");
     2802    string Key = "I_", typ;
     2803    S = "f = ", Tp, ";";
     2804    debug_log(2,"S=", S, " Tp=", Tp, "Key=", Key);
     2805    execute S;
     2806    execute read(dbmLink, Key)+";";
     2807    debug_log(1, "Polynom f=", f,  "  crk=", crk, "  Mu=", Mu,
     2808                " MlnCd=", MlnCd);
     2809    v[1] = f; v[2] = crk; v[3] = Mu; v[4] = MlnCd;
     2810  }
     2811  else {
     2812    v[1] = 0; v[2] = 0; v[3] = 0; v[4] = 0;
     2813  }
     2814  close(dbmLink);
     2815  return(v);
     2816}
     2817
     2818///////////////////////////////////////////////////////////////////////////////
     2819proc RandomPolyK
     2820USAGE:   
     2821{
     2822  if( size(#) != 1 && size(#) != 2) {
     2823//=============================================================================
     2824    " USAGE:   RandomPolyK(<int>[,int])";
     2825    " RETURN:  none";
     2826    " NOTE:    ";
     2827    " EXAMPLE: ";
     2828//=============================================================================
     2829    return();
     2830  }
     2831  if( typeof(#[1]) != "int") {
     2832    "RandomPoly: argv(1) must be int";
     2833    return();
     2834  }
     2835
     2836  int n=4;
     2837  string rg = "setring " + nameof(basering) + ";";
     2838  if(defined(RgAnf) == 0) {
     2839    ring RgAnf=char(basering),(x,y,z,t),(c,ds);
     2840    export RgAnf;
     2841  }
     2842  if(defined(RgAnf) == 1) { setring RgAnf; }
     2843  int M = #[1];
     2844  if(M<5) { M = 5; }
     2845
     2846  int b;
     2847  int i;
     2848  int k = random(1, M);
     2849  int R = random(-5, 2*M);
     2850  int S = random(-5, 2*M);
     2851  int crk;
     2852  if(R<0) { R = 0; }
     2853  if(S<0) { S = 0; }
     2854
     2855  int Typ= random(1, 25);
     2856  if(size(#)==2) {
     2857    if( typeof(#[2]) == "int") { Typ = #[2]; }
     2858    if( typeof(#[2]) == "string") { kill Typ; string Typ = #[2]; }
     2859  }
     2860  string s;
     2861  string Tp;
     2862  export Tp;
     2863  poly f;
     2864
     2865  f, crk = singularity(Typ, k, R, S);
     2866//  f = f +t2;
     2867  if(crk==1) { f = f + y2 + z2; }
     2868  if(crk==2) { f = f + z2; }
     2869  s="RandomPoly-Series: gewaehlt fall `"+Tp+"'("+string(Typ)+") mit";
     2870  s=s+" f="+string(f);
     2871  s;
     2872  execute rg; // setring r;
     2873  if(defined(Phi) == 1) { kill Phi; }
     2874  s = "map Phi=RgAnf";
     2875  for(i=n; i>0; i=i-1) {
     2876//  for(i=1; i<=n; i=i+1)
     2877    s = s+",";
     2878    s=s+"x("+string(i)+")";
     2879    if(i>2 && random(1,10)<3) { s=s+"+x("+string(i-1)+")"; }
     2880//    if(i==1 && random(1,10)<4) { s=s+"-x("+string(n)+")"; }
     2881    if(i>2) {
     2882      for(b=3; b<5; b=b+1) {
     2883        //       s = s+ "+1*(" +string(random(0,9))+ ")*x("+string(i)+")";
     2884        //       s = s+ "^"+string(b+2);
     2885        if(random(1,20)<3) {
     2886          s = s+ "+1*(" +string(random(-2,2))+ ")*x("+string(b)+")^2";
    5162887        }
    517         if( @Mult != 3 ) { return("","Fehler!"); }
    518       }
    519       else { return("","Fehler!"); }
    520     }
    521   }  // Ende der While-Schleife
    522   return("","Fehler!"):
    523 }
    524 
    525 ///////////////////////////////////////////////////////////////////////////////
    526 proc Funktion40  (poly @f, int @k)
    527 USAGE:    Funktion40();
    528 {
    529   int @r;
    530   string @Typ;
    531   string @fkt;
    532   string @RestRing;
    533   string @s1;
    534   int @kr;
    535   int @rr;
    536   int @sr;
    537   debug_log(1, "         Schritt 40" );
    538   string @s = "Die Singularitaet `"+Show(jet(@f, K-1));
    539   @s  = @s + "' ist vom Typ ";
    540   @s = @s + "Z["+string(@k)+",i,p](F40), mu="+string(Mu);
    541   @s = @s + ", m="+string(@k-1);
    542   @s;
    543 
    544 "------------------------ F 40 --------------";
    545   poly @a;
    546   poly @b;
    547   poly @c;
    548   ideal @JetId = x(1)^4 + x(2)^(4*@k);
    549   poly @fk = jet(@f, (4*@k), weight(@JetId));
    550 
    551   poly @f2 = -@fk / x(1)^3;
    552   ideal @Jfsyz = @f - @fk, x(1)^3, @f2;
    553   "f2=", @f2;
    554   "fk=", @fk;
    555   @Jfsyz;
    556   matrix @Mat = matrix(syz(@Jfsyz));
    557   "Mat[1,1]="+Show(@Mat[1,1]);
    558   "Mat[1,2]="+Show(@Mat[1,2]);
    559   "Mat[2,1]="+Show(@Mat[2,1]);
    560   "Mat[2,2]="+Show(@Mat[2,2]);
    561   "Mat[3,1]="+Show(@Mat[3,1]);
    562   "Mat[3,2]="+Show(@Mat[3,2]);
    563   "---";
    564   @a = @Mat[2,1] / @Mat[1,1] - @Mat[2,2];
    565   @b = - @Mat[3,1] / @Mat[1,1] + @Mat[3,2];
    566   "f1 = "+Show(@a);
    567   "f2 = "+Show(@b);
    568   "---";
    569   "f1 * f2 = "+Show(jet(@a*@b,Mu));
    570   "---";
    571   "f1 * f2 - f = "+Show(jet(@a*@b - @f,Mu));
    572   "---";
    573   @JetId = x(1)^3 + x(2)^(3*@k);
    574   "Jf2 = "+Show(jet(@b, (3*@k), weight(@JetId)));
    575   "---";
    576   @JetId = x(1) + x(2)^(@k);
    577   "Jf1 = "+Show(jet(@a, @k, weight(@JetId)));
    578   nameof(basering);
    579   basering;
    580   @b;
    581 "test-0";
    582   milnor(@b);
    583 "test-1";
    584   execute Setring(2);
    585 "test-2";
    586   @s1 = "map CnV="+ @RestRing+ ",x(1), x(2);";
    587   execute @s1;
    588 "test-3";
    589   CnV(@b);
    590 "test-4";
    591   milnor(CnV(@b));
    592 "test-5";
    593   if( defined(r) == 1) { "R ist definiert"; }
    594 "test-6";
    595  @fkt,@Typ=Klassifiziere(CnV(@b));
    596 "Klassifiziere-done";
    597  @Typ,@kr,@rr,@sr=DecodeNormalFormString(@Typ);
    598  @Typ,"=",@kr,@rr,@sr;
    599  @r = @kr-@k;
    600  if( @Typ == "E[6k]" ) { return(Funktion42(@f, @k, @r)); }
    601  if( @Typ == "E[6k+1]" ) { return(Funktion43(@f, @k, @r)); }
    602  if( @Typ == "E[6k+2]" ) { return(Funktion44(@f, @k, @r)); }
    603  if( @Typ == "J[k,0]" ) { return(Funktion45(@f, @k, @r, @sr)); }
    604  if( @Typ == "J[k,r]" ) { return(Funktion45(@f, @k, @r, @sr)); }
    605  return("","Fehler!");
    606 }
    607 
    608 ///////////////////////////////////////////////////////////////////////////////
    609 proc Funktion50 (poly @f, int corank)
    610 USAGE:    Funktion50();
     2888      }
     2889    }
     2890  }
     2891  s=s+";";
     2892  execute s;
     2893//  Phi;
     2894  Phi(f);
     2895  poly fr=Phi(f);
     2896  fr = fr+x(1)^2;
     2897//  return(Phi(f));
     2898  return(fr);
     2899}
     2900//=============================================================================
     2901// $Id: classify.lib,v 1.15 1997-10-08 08:57:15 krueger Exp $
     2902//=============================================================================
     2903//
     2904// Please send bugs and comments to kruegermathematik.uni-kl.de
     2905//
     2906//=============================================================================
     2907//LIBRARY:  tools.lib     some usefull tools needed by the Arnold-Classifier.
     2908//
     2909// debug_log (int level, list #)     printout trace and debugging information
     2910//                                 depending on level>DeBug. 
     2911// init_debug([int level])           set the value of DeBug to level.
     2912// basicinvariants(poly f);          Computes mu, determinacies and corank of f.
     2913// corank(poly f);                 Computes corank of f.
     2914// Faktorisiere(poly f, poly g, int pt, int k);
     2915//                                 fk = (ax+by^k)^pt    (for internal use only)
     2916// Teile(poly f, poly g);                  Teilt f durch g.     (for internal use only)
     2917// init();                         Initialisierung.     (for internal use only)
     2918// GetRf(poly f, int n);                   (for internal use only)
     2919// Show(poly f);                           (for internal use only)
     2920// checkring();                    (for internal use only)
     2921// DecodeNormalFormString(string s); (for internal use only)
     2922// AL(string s/ poly f);             x
     2923// normalform(string s);             x
     2924// swap (a,b);                     returns b,a
     2925
     2926///////////////////////////////////////////////////////////////////////////////
     2927proc debug_log (int level, list #)
     2928USAGE:    debug_log(level,"comma separated message list");
     2929COMPUTE:  print "messages" if level>=DeBug.
     2930          usefull for userdefined trace-messages.
     2931SEE ALSO: init_debug();
    6112932{
    612   poly @f3 = jet(@f, 3);
    613   debug_log(1, "Schritt 50");
    614   if( @f3 == 0 ) { return(Funktion104(@f, corank)); }
    615 
    616   // f3 ~
    617   ideal @Jf1 = jacob(@f3);
    618   ideal @Jf  = std(@Jf1);
    619   ideal @Jf2;
    620 //  "Jf1=",Show(@Jf[1]);
    621 //  "Jf2=",Show(@Jf[2]);
    622 //  "Jf3=",Show(@Jf[3]);
    623   int @Dim = dim(@Jf);
    624   int @Mult = mult(@Jf);
    625   "Dim=",@Dim,"  Mult=",@Mult," Jet3=", Show(@f3);
    626 
    627   if(@Dim == 0) { return(Funktion51(@f, corank)); } // x3 + y3 + z3 + axyz
    628   if(@Dim == 1) {
    629     if(@Mult == 2) {
    630       @Jf2 = wedge(jacob(@Jf1),3-@Dim), @Jf1;
    631       @Jf2 = std(@Jf2);
    632       @Dim = dim(@Jf2);
    633       @Mult = mult(@Jf2);
    634       "dim=", @Dim, "Mult=",@Mult," Jf2=", @Jf2;
    635       if (@Dim == 0) { return(Funktion54(@f, corank)); }  // x3 + xyz
    636       if (@Dim == 1) { return(Funktion58(@f, corank)); }  // x3 + yz2
    637     }
    638     if(@Mult == 3) {
    639       @Jf2 = wedge(jacob(@Jf1),3-@Dim), @Jf1;
    640       @Jf2 = std(@Jf2);
    641       @Dim = dim(@Jf2);
    642       if(@Dim == 0) { return(Funktion56(@f, corank)); } // xyz
    643       if(@Dim == 1) { return(Funktion66(@f, corank)); } // x2z + yz2
    644     }
    645     if(@Mult == 4) { return(Funktion82(@f, corank)); }  // x3 + xz2
    646   }
    647   if(@Dim == 2) {
    648     if(@Mult == 1) { return(Funktion97(@f, corank)); }  // x2y
    649     if(@Mult == 2) { return(Funktion103(@f, corank)); } // x3
    650   }
    651   if(@Dim == 3) { return(Funktion52(@f, corank)); }     // x3 + y3 + xyz
    652 
    653   return("","Fehler!");
    654 }
    655 
    656 ///////////////////////////////////////////////////////////////////////////////
    657 proc Funktion51 (poly @f, int @k)
    658 USAGE:    Funktion51();
    659 {
    660   string @s = "Die Singularitaet `"+Show(jet(@f, K));
    661   string @tp = "P[8]=T[3,3,3]";
    662 
    663   @s  = @s +"' ist vom Typ "+@tp+"(F51), mu="+string(Mu)+", m="+string(@k-1);
    664   @s+"  ("+SG_Typ+")";
    665   return(Show(@f), @tp);
    666 }
    667 
    668 ///////////////////////////////////////////////////////////////////////////////
    669 proc Funktion52 (poly @f, int @k)
    670 USAGE:    Funktion52();
    671 {
    672   int @p = 4;
    673   string @s = "Die Singularitaet `"+Show(jet(@f, K));
    674   string @tp = "P["+string(@p+5)+"]=T[3,3,"+string(@p+5)+"]";
    675 
    676   @s  = @s +"' ist vom Typ "+@tp+"(F52), mu="+string(Mu)+", m="+string(@k-1);
    677   @s+"  ("+SG_Typ+")";
    678   return(Show(@f), @tp);
    679 }
    680 
    681 ///////////////////////////////////////////////////////////////////////////////
    682 proc Funktion54 (poly @f, int @k)
    683 USAGE:    Funktion54();
    684 {
    685   int @p = 4;
    686   string @s = "Die Singularitaet `"+Show(jet(@f, K));
    687   string @tp = "R[p,q]=T[3,p,q]";
    688 
    689   @s  = @s +"' ist vom Typ "+@tp+"(F54), mu="+string(Mu)+", m="+string(@k-1);
    690   @s+"  ("+SG_Typ+")";
    691   return(Show(@f), @tp);
    692 }
    693 
    694 ///////////////////////////////////////////////////////////////////////////////
    695 proc Funktion56 (poly @f, int @k)
    696 USAGE:    Funktion56();
    697 {
    698   int @p = 4;
    699   string @s = "Die Singularitaet `"+Show(jet(@f, K));
    700   string @tp = "T[p,q,r]";
    701 
    702   @s  = @s +"' ist vom Typ "+@tp+"(F56), mu="+string(Mu)+", m="+string(@k-1);
    703   @s+"  ("+SG_Typ+")";
    704   return(Show(@f), @tp);
    705 }
    706 
    707 ///////////////////////////////////////////////////////////////////////////////
    708 proc Funktion58 (poly @fin, int @k)
    709 USAGE:    Funktion58();
    710 {
    711   poly @f = @fin;
    712 
    713   "Schritt 58";
    714   poly @f3 = jet(@f, 3);
    715   string @tp="Nix";
    716   int @kx = 1;  // Koordinate x
    717   int @ky = 2;  // Koordinate y
    718   int @kz = 3;  // Koordinate z
    719   poly @a;
    720   poly @b;
    721   poly @phi;    // Rest im Grad 3
    722   ideal @B = maxideal(1);     // ideal fuer Abbildungen
    723   ideal @Jf3 = jacob(@f3);
    724   ideal @S = sat(@Jf3, maxideal(1));
    725   ideal @J1 = diff(@S[1], x(@kx)), diff(@S[1], x(@ky)), diff(@S[1], x(@kz)),
    726          diff(@S[2], x(@kx)), diff(@S[2], x(@ky)), diff(@S[2], x(@kz));
    727   matrix @M[2][3] = @J1;
    728   ideal @J2 = minor(@M, 2), @S;
    729 //--------------------------------------------------------------
    730 //  Bestimme die Koordinate 'x'
    731 //
    732   @S = sat(@J2, maxideal(1));
    733   @J1 = Coeff(@S[1], x(1), x(1)), Coeff(@S[1], x(2), x(2)),
    734          Coeff(@S[1], x(3), x(3)), Coeff(@S[2], x(1), x(1)),
    735          Coeff(@S[2], x(2), x(2)), Coeff(@S[2], x(3), x(3));
    736   matrix @C[2][3] = @J1;
    737   matrix @D = syz(@C);
    738   kill @C;
    739 
    740   poly @b1 = @D[1,1];
    741   poly @b2 = @D[2,1];
    742   poly @b3 = @D[3,1];
    743 
    744   if(DeBug>5) { "f3,s1=", Show(@f3); }
    745   if( @b1 != 0) {
    746     map VERT=basering,-1*@b1*x(1), -1*@b2*x(1)+x(2), -1*@b3*x(1) + x(3);
    747     @kx=1; @ky=2; @kz=3;
     2933   int len = size(#);
     2934   if( defined(@DeBug) == 0 ) { init_debug(); }
     2935   if(@DeBug>=level) {
     2936      if(level>1) { "Debug:("+ string(level)+ "): ", #[1..len]; }
     2937      else { #[1..len]; }
     2938   }
     2939}
     2940example
     2941{ "EXAMPLE:"; echo=2;
     2942  example init_debug;
     2943}
     2944
     2945///////////////////////////////////////////////////////////////////////////////
     2946proc init_debug(list #)
     2947USAGE:    init_debug([level]);  level=int
     2948COMPUTE:  Set the global variable DeBug to level. The variable DeBug is
     2949          used by the function debug_log(level, list of strings) to know
     2950          when to print the list of strings. init_debug() reports only
     2951          changes of DeBug.
     2952EXAMPLE:  example init_debug; shows an example
     2953NOTE:     The procedure init_debug(n); is usefull as trace-mode.
     2954          n may range from 0 to 10, higher values of n give more information.
     2955{
     2956  int newDebug=0;
     2957  if( defined(@DeBug) == 1) { newDebug = @DeBug; }
     2958
     2959  if( size(#) > 0 ) {
     2960    newDebug=#[1];
    7482961  }
    7492962  else {
    750     if( @b2 != 0) {
    751       map VERT=basering, x(1) + -1*@b1*x(2), -1*@b2*x(2), -1*@b3*x(2) + x(3);
    752       @kx=2; @ky=1; @kz=3;
     2963    string s=system("getenv", "SG_DEBUG");
     2964    if( s != "" ) {
     2965      s="newDebug="+s;
     2966      execute s;
     2967    }
     2968  }
     2969  if( defined(@DeBug) == 0) {
     2970    int @DeBug = newDebug;
     2971    export @DeBug;
     2972    if(@DeBug>0) { "Debugging level is set to ", @DeBug; }
     2973  }
     2974  else {
     2975    if( (size(#) == 0) && (newDebug < @DeBug) ) { return(); }
     2976    if( @DeBug != newDebug) {
     2977      int oldDebug = @DeBug;
     2978      @DeBug = newDebug;
     2979      if(@DeBug>0) { "Debugging level change from ", oldDebug, " to ", @DeBug;
     2980      }
     2981      else {
     2982        if( @DeBug==0 && oldDebug>0 ) { "Debugging switched off."; }
     2983      }
     2984    }
     2985  }
     2986}
     2987example
     2988{ "EXAMPLE:"; echo=2;
     2989  init_debug();
     2990  debug_log(1,"no trace information printed");
     2991  init_debug(1);
     2992  debug_log(1,"some trace information");
     2993  init_debug(2);
     2994  debug_log(2,"nice for debugging scripts");
     2995  init_debug(0);
     2996}
     2997
     2998///////////////////////////////////////////////////////////////////////////////
     2999proc basicinvariants(poly f)
     3000USAGE:    basicinvariants(f);   f = poly
     3001COMPUTE:  Compute basic invariants of f: an upper bound d for the determinacy,
     3002          the milnor number mu and the corank c of f
     3003RETURN:   intvec: d, mu, c
     3004EXAMPLE:  example basicinvariants; shows an example
     3005{
     3006  intvec v;
     3007  ideal Jfs = std(jacob(f));
     3008  v[1] = system("HC")+1;
     3009  v[2] = vdim(Jfs);
     3010  v[3] = corank(f);
     3011  if( v[2]<v[1] ) { v[1] = v[2]; }
     3012  return(v);
     3013}
     3014example
     3015{ "EXAMPLE:"; echo=2;
     3016   ring r=0,(x,y,z),ds;
     3017   basicinvariants((x2+3y-2z)^2+xyz-(x-y3+x2*z3)^3);
     3018}
     3019
     3020///////////////////////////////////////////////////////////////////////////////
     3021proc corank(poly f)
     3022USAGE:    corank(f);   f=poly
     3023RETURN:   the corank of the Hessian matrix of f, of type int
     3024REMARK:   corank(f) is the number of variables accuring in the residual
     3025          singulartity after applying 'morsesplit' to f
     3026EXAMPLE:  example corank; shows an example
     3027{
     3028  matrix M = jacob(jacob(jet(f,2)));
     3029  int cr = nvars(basering) - size(module(transpose(bareiss(M))));
     3030  return(cr);
     3031}
     3032example
     3033{ "EXAMPLE:"; echo=2;
     3034  ring r=0,(x,y,z),ds;
     3035  poly f=(x2+3y-2z)^2+xyz-(x-y3+x2*z3)^3;
     3036  corank(f);
     3037}
     3038///////////////////////////////////////////////////////////////////////////////
     3039proc Faktorisiere(poly f, poly fk, int pt, int k)
     3040{
     3041  ideal Jfsyz;
     3042  poly  Relation;
     3043  poly  a;
     3044  poly  b;
     3045  matrix Mat;
     3046  ideal B = maxideal(1);
     3047  def ring_top=basering;
     3048
     3049  // Ziel: bestimme a,b sodass  fk = (ax+by^k)^pt gilt.
     3050  if( @DeBug>1 ) {
     3051    "Faktor: f=",Show(f)," Jet=",Show(fk)," k=",k," exp=",pt;
     3052  }
     3053  if( defined(VERT) == 1) { kill VERT; }
     3054  if( @DeBug>1 ) { "Fak-1:",Show(f)," jet=",Show(fk); }
     3055  Jfsyz = fk, diff(fk, x(1));
     3056  Mat = matrix(syz(Jfsyz));
     3057  Mat;
     3058  if( (fk-subst(fk,x(1),0)) != 0  &&  (fk-subst(fk,x(2),0)) != 0 ) {
     3059    // "Fak-2:",Show(f)," jet=",Show(fk);
     3060    // Wenn k>0 ist die Wahl fuer x & y bereits getroffen
     3061    // sonst
     3062    Jfsyz = fk, diff(fk, x(1));
     3063    if( @DeBug>1 ) { "Fak-3: Jf=",Jfsyz; }
     3064    Mat = matrix(syz(Jfsyz));
     3065    Relation = -pt * Mat[2,1] / Mat[1,1];
     3066    if( @DeBug>1 ) {
     3067      Mat;
     3068      "Fak-4: rel=", Relation;
     3069    }
     3070    a = Coeff(Relation, x(1), x(1));
     3071    b = Coeff(Relation, x(2), x(2)^k);
     3072    B = maxideal(1);
     3073    if( (RFlg[1]==1 && k==1) || k>1) {
     3074      B[rvar(x(1))] = x(1)-b*x(2)^k;
    7533075    }
    7543076    else {
    755       if( @b3 != 0) {
    756         map VERT=basering, x(1) + -1*@b1*x(3), x(2) + -1*@b2*x(3), -1*@b3*x(3);
    757         @kx=3; @ky=1; @kz=2;
    758       }
    759     }
    760   }
    761   @f = VERT(@f);
    762   if(DeBug>5) { VERT; }
    763   @f3 = jet(@f,3);
    764   if(DeBug>5) { "f3,s2=", Show(@f3); }
    765 
    766 //--------------------------------------------------------------
    767 // die Variable 'x' ist nun isoliert worden. d.h j3f = xf2+f3
    768 // d.h Die rolle von 'x' ist nun bestimmt.
    769 // fuehre Koordinaten-transformation fuer f_2 aus.
    770 //
    771   if(DeBug>5) { "1) x=", @kx, "  y=", @ky, "  z=", @kz; }
    772   matrix @C = Coeffs(@f3, x(@kx));
    773   @C;
    774   poly @fb=@C[2,1];     // Coeff von x^1
    775   poly @fc=@C[1,1];     // Coeff von x^0
    776   "f-2=", Show(@fb);
    777   "f-3=", Show(@fc);
    778   if(diff(@fb, x(@ky)) != 0) {
    779     kill VERT;
    780     ideal @Jfsyz = @fb, diff(@fb, x(@ky));
    781     matrix @Mat = matrix(syz(@Jfsyz));
    782 //    @Mat;
    783     @B = maxideal(1);     // setze Abbildungs-ideal
    784     if( nrows(@Mat) == 2) {
    785       poly @Relation = -2 * @Mat[2,1] / @Mat[1,1];
    786       @b = Coeff(@Relation, x(@kz), x(@kz));
    787       @B[rvar(x(@ky))] = x(@ky)-@b*x(@kz);
    788     }
    789     else {
    790       @Jfsyz = @fb, diff(@fb, x(@kz));
    791       @Mat = matrix(syz(@Jfsyz));
    792       poly @Relation = -2 * @Mat[2,1];
    793       @a = Coeff(@Relation, x(@ky), x(@ky));
    794       @B[rvar(x(@kz))] = x(@kz)-@a*x(@kz);
    795       @ky, @kz = swap(@ky, @kz);
    796     }
    797     map VERT=basering, @B;
    798     VERT;
    799     @f = VERT(@f);
    800     @f3 = jet(@f,3);
    801     kill @Mat;
    802   }
    803   else { @ky,@kz = swap(@ky,@kz); }
    804   "f3,s3=", Show(@f3);
    805 
    806 //--------------------------------------------------------------
    807 // fuehre nun tschirnhaus in der Variablen 'z' durch und erhalte
    808 // f = f_1(x,y,z)y^2 + z^3
    809 //
    810   "2) x=", @kx, "  y=", @ky, "  z=", @kz;
    811   @C = Coeffs(@f3, x(@kx));
    812   @fb=@C[2,1];  // Coeff von x^1
    813   @fc=@C[1,1];  // Coeff von x^0
    814   @fc, VERT = tschirnhaus(@fc, x(@kz));
    815   VERT;
    816   @f = VERT(@f);
    817   "-------------------------------------";
    818   @f3 = jet(@f,3);
    819   "j3f,s5=",Show(@f3);
    820   "f=", Show(@f);
     3077      B[rvar(x(2))] = x(2)-b*x(1)^k;
     3078    }
     3079    map VERT=basering,B;
     3080    if( @DeBug>1 ) { "Fak-5",VERT; }
     3081    f = VERT(f);
     3082    PhiG = VERT(PhiG);
     3083  }
     3084
     3085//  "Fak-6:",Show(f)," jet=",Show(fk);
     3086  if( k==1 ) {
     3087    if( @DeBug>1 ) { "Fak-7:",Show(f)," jet=",Show(fk); }
     3088    if(Coeff(jet(f, pt), x(1), x(1)^pt) == 0) {
     3089      if(defined(VERT) == 1) { kill VERT; }
     3090      map VERT=basering,x(2),x(1);
     3091      f = VERT(f);
     3092      PhiG = VERT(PhiG);
     3093    }
     3094  }
     3095  if( @DeBug>1 ) { "Fak-8:",Show(f)," jet=",Show(fk); }
     3096  if(@DeBug>5) {
     3097        "Faktorisiere liefert: f=", Show(f);
     3098  }
     3099  return(f);
     3100}
     3101
     3102///////////////////////////////////////////////////////////////////////////////
     3103proc Teile(poly f, poly fk)
     3104{
     3105  ideal Jfsyz = f, fk;
     3106  poly  Relation;
     3107  matrix Mat = matrix(syz(Jfsyz));
     3108  Relation = -1 * Mat[2,1]/Mat[1,1];
     3109  return(Relation);
     3110}
     3111
     3112///////////////////////////////////////////////////////////////////////////////
     3113proc init
     3114USAGE:    init();
     3115{
     3116  int n = nvars(basering);
     3117  int i = 1;
     3118  string s1="map EH="+nameof(basering);
     3119  def ring_save=basering;
     3120
     3121  if(size(#)==0) {
     3122//    "init_top";
     3123    if( defined(Rrest) == 1) { kill Rrest; }
     3124    if( defined(RingB) == 1) { kill RingB; }
     3125  }
     3126//  else { "not int"; }
     3127  if( defined(@ringdisplay) == 1) { kill @ringdisplay; }
     3128  if( defined(Jf) == 1) { kill Jf; }
     3129
     3130  for( i=1; i<=n ; i=i+1) { s1 = s1 + ",0"; }
     3131  s1 = s1 + ";";
     3132  if( defined(EH) == 0 ) {
     3133    execute s1;
     3134    export EH;
     3135  }
     3136
     3137  if(defined(RingNF) == 1) { kill RingNF; }
     3138  ring RingNF=char(basering),(x,y,z),(c,ds);
     3139
     3140  setring ring_save;
     3141  return();
     3142}
     3143
     3144///////////////////////////////////////////////////////////////////////////////
     3145proc GetRf
     3146USAGE:    GetRf();
     3147{
     3148  poly fi = #[1];
     3149  int n = #[2];
     3150  int j = 0;            // Index fuer Variablen Schleife
     3151  int k = 0;            // Index fuer Variablen Schleife
     3152  int l1=0;
     3153  int l1w=0;
     3154  matrix Koef;
     3155  string s = "0";
     3156  string s_exec;
     3157
     3158  if(defined(RFlg) == 1) { kill RFlg; }
     3159  for( j=1; j<n ; j=j+1)
     3160  { s = s + ",0"; }
     3161  s_exec = "intvec RFlg = "+ s+";";
     3162  execute s_exec;
     3163  export RFlg;
     3164  intvec Haeufigkeit = RFlg;
     3165
     3166  for( j=1; j<=n ; j=j+1) {
     3167    Koef=coef(fi, x(j));
     3168    Haeufigkeit[j] = ncols(Koef);
     3169    if(Coeff(fi, x(j),0) == 0) { Haeufigkeit[j] = Haeufigkeit[j] + 1;}
     3170  }
     3171  for( j=n; j>0 ; j=j-1) {
     3172    l1=0;
     3173    l1w = 0;
     3174    for( k=1; k<=n ; k=k+1) {
     3175      if(Haeufigkeit[k]>l1w) { l1=k; l1w=Haeufigkeit[k]; }
     3176    }
     3177    RFlg[j] = l1;
     3178    Haeufigkeit[l1] = 0;
     3179  }
     3180  if(@DeBug>1) { "Reihenfolge fuer Vertauschungen:", RFlg; }
     3181
     3182}
     3183
     3184///////////////////////////////////////////////////////////////////////////////
     3185proc Show(poly g)
     3186{
     3187  string s;
     3188  def ring_save=basering;
     3189
     3190  execute @ringdisplay;
     3191  map showpoly=ring_save,maxideal(1);
     3192  s = string(showpoly(g));
     3193  setring ring_save;
     3194  return (s);
     3195}
     3196
     3197///////////////////////////////////////////////////////////////////////////////
     3198proc checkring
     3199{
     3200  int CH = char(basering);
     3201  if(CH >= 2 && CH<=13) {
     3202    "Ring has characteristic ",CH;
     3203    "Characteristic other than 0 or 0<char<13 is not yet implemented";
     3204    return(1);
     3205  }
     3206  return(0);  // characteristic of ring is OK, return (0)
     3207}
     3208
     3209///////////////////////////////////////////////////////////////////////////////
     3210proc DecodeNormalFormString (string S_in)
     3211USAGE:    DecodeNormalFormString
     3212{
     3213  string s2;
     3214  string s3;
     3215  string s4;
     3216  int C_eq = find(S_in, "=")+1;
     3217  debug_log(2, "Decode:", C_eq );
     3218  string s_in = S_in[C_eq,30];
     3219//  else { string s_in = S_in; }
     3220  debug_log(2, "S_in=", S_in,"  s_in=",s_in );
     3221  int a = find(s_in, "[")+1;
     3222  int b = find(s_in, "]")-1;
     3223  int i;
     3224  int t = 1;
     3225//  int k, r, s = 0,0,0;
     3226  int k = 0;
     3227  int r = 0;
     3228  int s = 0;
     3229
     3230  if(a<0 || b<0) { return("Error",0,0,0); }
     3231  string Typ = s_in[1..a-1];
     3232  string s1 = s_in[a..b];
     3233  if(@DeBug>5) { "Suche Type:", Typ; }
     3234  if( find(s1, ",") == 0) {
     3235    if(@DeBug>7) { "  Number of columns: 0"; }
     3236    s2 = "k = "+s1+";";
     3237    execute s2;
     3238    if( (Typ=="A[") || (Typ=="D[") ) { s3 = "k"; }
     3239    if( Typ == "E[") { t = 6; }
     3240    if( Typ == "W[") { t = 12; }
     3241    if( Typ == "Q[") { t = 6; }
     3242    if( Typ == "Z[") { t = 6; }
     3243    if( Typ == "U[") { t = 12; }
     3244    if( t > 1 ) {
     3245      i = k;
     3246      k = k/t;
     3247      b = i - t*k;
     3248      if( (s1 == "Q[") && (b==0) ) { k=k-1; b=6; }
     3249      if(Typ == "Z[") {
     3250        if(b==0) { k=k-1; b=6; }
     3251        if(b==1) { k=k-1; b=7; }
     3252      }
     3253      if( b == 0 ) {
     3254        s3 = string(t)+"k";
     3255      }
     3256      else { s3 = string(t)+"k+"+string(b); }
     3257    }
     3258    if( Typ == "S[") {
     3259      i = k+1;
     3260      k = i/12;
     3261      b = i - 12*k;
     3262      if( b == 1 ) {
     3263        s3 = "k";
     3264      }
     3265      else {
     3266        if(b==0) {
     3267          s3 = "12k"+string(b-1);
     3268        }
     3269        else { s3 = "12k+"+string(b-1); }
     3270      }
     3271    }
     3272    s2 = Typ + s3 +"]";
     3273  }  // es kommt mindestens ein komma vor...
     3274  else {
     3275//    s_in;
     3276    b = find(s1, ",");
     3277    s2 = "k = ",s1[1..b-1],";";
     3278    execute s2;
     3279    s1 = s1[b+1..size(s1)];
     3280    if(find(s1, ",") == 0) {
     3281      if(@DeBug>7) { "  Number of columns 1"; }
     3282      s2 = "r = "+s1+";";
     3283      execute s2;
     3284      s4 = "r";
     3285      s3 = "k";
     3286      if(r==0) { s4 = string(0); }
     3287      if(k==0 && Typ=="Z[") { s3 = string(1); }
     3288      if(Typ[2] == "#") {
     3289        i = r+1;
     3290        r = i/2;
     3291        b = i - 2*r;
     3292        if( b == 1 ) {
     3293          s4 = "2r";
     3294        }
     3295        else { s4 = "2r-1"; }
     3296      }
     3297      s2 = Typ + s3 + "," + s4 +"]";
     3298    }  // es kommt mindestens zwei komma vor...
     3299    else {
     3300      if(@DeBug>7) { "  Number of columns >=2"; }
     3301      if( @DeBug > 1 ) { "Y[k,r,s] / Z[k,r,s] / T[k,r,s]"; }
     3302      b = find(s1, ",");
     3303      s2 = "r = ",s1[1..b-1],";";
     3304      execute s2;
     3305      s2 = "s = ",s1[b+1..size(s1)],";";
     3306      execute s2;
     3307      if(Typ=="Y[") { s2 = "Y[k,r,s]"; }
     3308      if(Typ=="Z[") { s2 = "Z[k,r,s]"; }
     3309      if(Typ=="T[") { s2 = "T[k,r,s]"; }
     3310    }
     3311  }
     3312  debug_log(2, "Looking for Normalform of ",s2,"with (k,r,s) = (",
     3313        k,",",r,",", s, ")" );
     3314  return(s2,k,r, s);
     3315}
     3316
     3317///////////////////////////////////////////////////////////////////////////////
     3318proc AL
     3319USAGE:    AL(f);         f=poly
     3320          AL("name");    typ=string
     3321COMPUTE:  Arnold's List.
     3322          For AL(f): Computes via the Milnorcode the class of f and
     3323          returns the Normalform of f found in the database.
     3324          For AL("name"): Get the Normalform from the database for the
     3325          singularity given by its name.
     3326EXAMPLE:  example AL; shows an example
     3327{
     3328  // if trace/debug mode not set, do it!
     3329  init_debug();
     3330
     3331  if( typeof(#[1]) == "string" ) {
     3332    if(checkring()) { return(#[1]); }
     3333    return(normalform(#[1]));
     3334  }
     3335  if( typeof(#[1]) == "poly" ) {
     3336    if(checkring()) { return(#[1]); }
     3337    return(classifyh(#[1]));
     3338  }
    8213339 
    822 //--------------------------------------------------------------
    823 // fuehre Koordinaten-transformation fuer f_1 durch und erhalte
    824 // f=xy2 + z3
    825 //
    826   "3) x=", @kx, "  y=", @ky, "  z=", @kz;
    827 // ACHTUNG Bug, fuer Sing22
    828   Show(@f3 - 1*(Coeffs(@f3, x(@kz))[4,1])*x(@kz)^3);
    829   poly @fa;
    830   @fb = (@f3 - 1*(Coeffs(@f3, x(@kz))[4,1])*x(@kz)^3)/(x(@ky)^2);
    831   "fb=", Show(@fb);
    832   @fc = (x(@kx)-1*(Coeffs(@fb, x(@ky))[2,1])*x(@ky)-1*(Coeffs(@fb, x(@kz))[2,1])*x(@kz));
    833   @fa = Coeffs(@fb, x(@kx))[2,1];
    834   if ( @fa != 0 ) {
    835     @B = maxideal(1);
    836     @B[rvar(x(@kx))] = @fc / @fa;
    837     map VERT=basering, @B;
    838     VERT;
    839     @f = VERT(@f);
    840     @f3 = jet(@f,3);
    841     "j3f,s6=",Show(@f3);
    842 
    843 //    map VERT = basering, x(4-@kx), x(4-@ky), x(4-@kz);
    844 //    @f = VERT(@f);
    845 //    map VERT = basering, x(1), x(3), x(2);
    846 //    @f = VERT(@f);
    847 //    @phi = jet(@f,3);
    848 //    @f3 = jet(@f,3);
    849 //    "j3f,s7=",Show(@phi);
    850   }
    851 
    852  
    853 //--------------------------------------------------------------
    854   if(Coeffs(@f3, x(1))[4,1]!=0) {
    855     @kx=1;
    856     if(Coeffs(@f3, x(2))[3,1]==0) { @ky=2; @kz=3; }
    857     else { @ky=3; @kz=2; }
     3340}
     3341example
     3342{ "EXAMPLE:"; echo=2;
     3343  init_debug(0);
     3344  ring r=0,(a,b,c),ds; 
     3345  poly f=AL("E[13]");
     3346  f;
     3347  AL(f);
     3348}
     3349
     3350///////////////////////////////////////////////////////////////////////////////
     3351proc normalform(string s_in)
     3352USAGE:    normalform(s);  s=string
     3353COMPUTE:
     3354EXAMPLE:  example normalform; shows an example.
     3355{
     3356  string Typ;
     3357  int k, r, s, crk;
     3358  poly f;
     3359
     3360  if(checkring()) { return(s_in); }
     3361  if(nvars(basering)<=1) {
     3362    "We need at least 2 variables in basering, You have",nvars(basering),".";
     3363    return();
     3364  }
     3365  // if trace/debug mode not set, do it!
     3366  init_debug();
     3367
     3368  Typ,k,r,s=DecodeNormalFormString(s_in);
     3369  if(Typ=="Error") { return(0); }
     3370  f, crk = singularity(Typ, k, r, s);
     3371  return(f);
     3372}
     3373
     3374///////////////////////////////////////////////////////////////////////////////
     3375proc swap
     3376USAGE:    swap(a,b);
     3377RETURN:   return b,a.
     3378{
     3379  return(#[2],#[1]);
     3380}
     3381example
     3382{ "EXAMPLE:"; echo=2;
     3383  swap("variable1","variable2");
     3384}
     3385
     3386///////////////////////////////////////////////////////////////////////////////
     3387proc Setring
     3388USAGE:   
     3389{
     3390  if( size(#) != 1 && size(#) !=2)
     3391//=============================================================================
     3392  { " USAGE:   SetRing(<int #Var>, <string name>);";
     3393    " RETURN:  Ring named r";
     3394    " NOTE:    Creates a ring of characteristics 32003 with n variables";
     3395    " EXAMPLE: execute Setring(4);";
     3396//=============================================================================
     3397    return("");
     3398  }
     3399  if( typeof(#[1]) != "int") {
     3400    "Setring: argv(1) must be int";
     3401    return("");
     3402  }
     3403
     3404  if( size(#) == 2) {
     3405    if( typeof(#[2]) != "string") {
     3406      "Setring: argv(2) must be string";
     3407      return("");
     3408    }
     3409    string s="ring "+ (#[2]);
    8583410  }
    8593411  else {
    860     if(Coeffs(@f3, x(2))[4,1]!=0) {
    861       @kx=2;
    862       if(Coeffs(@f3, x(3))[3,1]==0) { @ky=3; @kz=1; }
    863       else { @ky=1; @kz=3; }
    864     }
    865     else {
    866       @kx=3;
    867       if(Coeffs(@f3, x(1))[3,1]==0) { @ky=1; @kz=2; }
    868       else { @ky=2; @kz=1; }
    869     }
    870   }
    871   "4) x=", @kx, "  y=", @ky, "  z=", @kz;
    872   map VERT = basering, x(@kx), x(@ky), x(@kz);
    873   @f = VERT(@f);
    874   @f3 = jet(@f,3);
    875   "j3f,s8=",Show(@f3);
    876 
    877   return(Funktion59(@f, @k));
    878 }
    879 
    880 ///////////////////////////////////////////////////////////////////////////////
    881 proc Funktion59 (poly @f, int @k)
    882 USAGE:    Funktion59();
    883 {
    884   int @p = 1;
    885   string @tp="Nix";
    886   poly @phi = jet(@f,3);
    887   poly @fr = @f - @phi;
    888   poly @fk;
    889   poly @alpha = coeffs(@fr, x(1))[1,1];
    890   poly @beta = (@fr - @alpha) / x(1);
    891   ideal @JetId;
    892   intvec @w;
    893 
    894   "f    = ", Show(@f);
    895   "fr   = ", Show(@fr);
    896   "alpha= ", Show(@alpha);
    897   "beta = ", Show(@beta);
    898 
    899   while(@p<9) {
    900     "Schritt 59_", @p;
    901     @JetId = x(2)^(3*@p+1); weight(@JetId);
    902     @JetId = @phi + x(2)^(3*@p+1);
    903     @w = weight(@JetId);
    904     @fk = jet(@fr, 3*@w[1], @w);
    905 "a)", @p, 3*@w[1], Show(@fk), @w;
    906     if( @fk != 0 ) { return(Funktion60(@f,@p)); }
    907 
    908     @JetId = @phi + x(1)*x(2)^(2*@p+1);
    909     @w = weight(@JetId);
    910     @fk = jet(@fr, 3*@w[1], @w);
    911 "b)", @p, 3*@w[1], Show(@fk), @w;
    912     if( @fk != 0 ) { return(Funktion61(@f,@p)); }
    913 
    914     @JetId = @phi + x(2)^(3*@p+2);
    915     @w = weight(@JetId);
    916     @fk = jet(@fr, 3*@w[1], @w);
    917 "c)", @p, 3*@w[1], Show(@fk), @w;
    918     if( @fk != 0 ) { return(Funktion62(@f,@p)); }
    919 
    920     @p = @p+1;   // Weiter mit Funktion 63 fuer p eins groesser
    921     @JetId = @phi + x(2)^(3*@p);
    922     @w = weight(@JetId);
    923     @fk = jet(@f, 3*@w[1], @w);
    924 "d)", @p, 3*@w[1], Show(@fk), @w;
    925 //    if( @fk != 0 ) {
    926     @JetId = jacob(@fk);
    927     @JetId = std(@JetId);
    928     int @Dim = dim(@JetId);
    929     int @Mult = mult(@JetId);
    930     "Dim=",@Dim,"  Mult=",@Mult," Jetk=", Show(@fk);
    931     if(@Dim == 0) { return(Funktion64(@f,@p)); }
    932     if(@Dim == 1) {
    933       if(@Mult == 1) { return(Funktion65(@f,@p)); }
    934       if(@Mult == 2) {
    935         "Faktorisiere";
    936         @fk = jet(@fr, 3*@w[1], @w);
    937         poly @tt=Coeffs(@phi, x(1))[4,1] *x(1)^3+@fk;
    938         intvec RFlg=1,2,3;
    939         export RFlg;
    940         RFlg;
    941         "tt=",Show(@tt);
    942         "f=",Show(@f);
    943         @f = Faktorisiere(@f, @tt, 3 , @p);
    944         PhiG;
    945         "f=",Show(@f);
    946         @fr = @f - @phi;
    947       }
    948     }
    949 //    }
    950   }
    951   return(Show(@f), @tp);
    952 }
    953 
    954 ///////////////////////////////////////////////////////////////////////////////
    955 proc Funktion66 (poly @f, int @k)
    956 USAGE:    Funktion66();
    957 {
    958   int @kx = 1;  // Koordinate x
    959   int @ky = 2;  // Koordinate y
    960   int @kz = 3;  // Koordinate z
    961   poly @f3 = jet(@f, 3);
    962   ideal @JetId;
    963 
    964   debug_log(1, "Weiter-66");
    965   debug_log(2, "F3=", Show(@f3));
    966   poly @fx = diff(@f3, x(@kx));
    967   @JetId = jacob(@fx);
    968   @JetId = std(@JetId);
    969   "nach x:",Show(@fx), "  Id=", @JetId, "  Dim=", dim(@JetId);
    970 
    971   poly @fy = diff(@f3, x(@ky));
    972   @JetId = jacob(@fx);
    973   @JetId = std(@JetId);
    974   "nach y:",Show(@fy), "  Id=", @JetId, "  Dim=", dim(@JetId);
    975 
    976   poly @fz = diff(@f3, x(@kz));
    977   @JetId = jacob(@fx);
    978   @JetId = std(@JetId);
    979   "nach z:",Show(@fz), "  Id=", @JetId, "  Dim=", dim(@JetId);
    980 }
    981 
    982 ///////////////////////////////////////////////////////////////////////////////
    983 proc Funktion82 (poly @f, int @k)
    984 USAGE:    Funktion82();
    985 {
    986   poly @f3 = jet(@f,3);
    987   int @kx = 1;  // Koordinate x
    988   int @ky = 2;  // Koordinate y
    989   int @kz = 3;  // Koordinate z
    990   poly @b1, @b2, @b3;
    991   intvec @kv = 1,2,3;
    992   int    @i;
    993   ideal @Jfsyz = jacob(@f3);
    994   matrix @Mat;
    995   int @Fall = 2;
    996 
    997   debug_log(1, "Schritt 82");
    998   if (diff(@f3, x(1)) == 0) { @kx, @ky = swap(@kx, @ky); }
    999   if (diff(@f3, x(2)) == 0) {  }
    1000   if (diff(@f3, x(3)) == 0) { @kz, @ky = swap(@kz, @ky); }
    1001   if ( (diff(@f3, x(1)) != 0) && (diff(@f3, x(2)) != 0) &&
    1002         (diff(@f3, x(3)) != 0) ) {
    1003     @Mat = matrix(syz(@Jfsyz));
    1004     @b1 = @Mat[1,1];
    1005     @b2 = @Mat[2,1];
    1006     @b3 = @Mat[3,1];
    1007 
    1008     debug_log(2, @Mat);
    1009     if( @b1 != 0) {
    1010       map VERT=basering,@b1*x(@kx), @b2*x(@kx)+x(@ky), @b3*x(@kx) + x(@kz);
    1011       @f = VERT(@f);
    1012       @kx, @ky = swap(@kx, @ky);
    1013     }
    1014     else {
    1015       if( @b2 != 0) {
    1016         map VERT=basering,x(@kx) + @b1*x(@ky), @b2*x(@ky), @b3*x(@ky) + x(@kz);
    1017         @f = VERT(@f);
    1018       }
    1019       else {
    1020         if( @b3 != 0) {
    1021           map VERT=basering,x(@kx)+ @b1*x(@kz), x(@ky)+ @b2*x(@kz), @b3*x(@kz);
    1022           @f = VERT(@f);
    1023         }
    1024       }
    1025     }
    1026 debug_log(2, VERT);
    1027   }
    1028 //  else {
    1029     map VERT=basering,x(@kx),x(@ky),x(@kz);
    1030 debug_log(2, VERT);
    1031     @f = VERT(@f);
    1032 //  }
    1033   @f3 = jet(@f,3);
    1034   if ( defined(VERT) == 1) { kill VERT; }
    1035   if( (@f3-subst(@f3, x(@kx), 0)) == 0) { @kx, @ky = swap(@kx, @ky); }
    1036   if( (@f3-subst(@f3, x(@kz), 0)) == 0) { @kz, @ky = swap(@kz, @ky); }
    1037 debug_log(2,   "1)f??=", Show(@f3));
    1038 debug_log(2,   "1)f3=", Show(@f));
    1039 //------------------------------------------------------
    1040 debug_log(2,   size(coeffs(@f3, x(@kx))));
    1041 //  if (size(coeffs(@f3, x(@kx))) == 3) {
    1042     matrix @C = coeffs(@f3, x(@kx));
    1043 debug_log(2, @C);
    1044     if(size(@C) == 3) { @C = coeffs(@f3, x(@kz)); }
    1045     if(@C[1,1] == 0 && @C[3,1] == 0) { @Fall = 1; }
    1046     if(@C[1,1] != 0 && @C[3,1] != 0 ) { @Fall = 3; }
    1047     if(@C[1,1] == 0 && @C[3,1] != 0 ) { @Fall = 2; }
    1048     if(@C[1,1] != 0 && @C[3,1] == 0 ) { @Fall = 2; @kx, @kz = swap(@kx, @kz); }
    1049 
    1050 debug_log(2, @C);
    1051 debug_log(2, "Fall: ", @Fall, "  x=", @kx, "  z=", @kz);
    1052     map VERT;
    1053     if(@Fall == 2) { @b1, VERT = tschirnhaus(@f3/x(@kz), x(@kx)); }
    1054     else {
    1055       @b1, VERT = tschirnhaus(@f3/x(@kx), x(@kx));
    1056       debug_log(2, "B1=", Show(jet(VERT(@f),3)));
    1057       @b2, VERT = tschirnhaus(@f3/x(@kz), x(@kz));
    1058       debug_log(2, "B2=", Show(jet(VERT(@f),3)));
    1059     }
    1060     @f = VERT(@f);
    1061     @f3 = jet(@f,3);
    1062     debug_log(2, "2)f3=", Show(@f3));
    1063 //  @f3, VERT = tschirnhaus(@f3, x(1));
    1064     debug_log(2, "3)f3=", Show(jet(@f,3)));
    1065 //  }
    1066 
    1067   @C = coeffs(@f3, x(1));
    1068   if( @C[1,1] == 0 && @C[2,1] != 0 && @C[3,1] == 0 && @C[4,1] != 0 ) {
    1069     Funktion83(@f, @k);
    1070   }
    1071   return("", "Fehler");
    1072 }
    1073 
    1074 ///////////////////////////////////////////////////////////////////////////////
    1075 proc Isomorphie_s82_z (poly @f, poly @fk, int @p)
    1076 USAGE:    Isomorphie_s82_z();
    1077 {
    1078   matrix @Mat;
    1079   poly @Relation, @a, @b;
    1080   ideal @Jfsyz, @B;
    1081 
    1082   debug_log(1, "      Isomorphie 82/90 z");
    1083   debug_log(2, "tt=", Show(@fk));
    1084   @Jfsyz = @fk, diff(@fk, x(3));
    1085   @Mat = matrix(syz(@Jfsyz));
    1086   @Relation = -2 * @Mat[2,1] / @Mat[1,1];
    1087   @a = Coeff(@Relation, x(3), x(3));
    1088   @b = Coeff(@Relation, x(2), x(2)^@p);
    1089   @B = maxideal(1);
    1090   @B[rvar(x(3))] = x(3)-@b*x(2)^@p;
    1091   map VERT=basering,@B;
    1092   @f = VERT(@f);
    1093   debug_log(2, VERT);
    1094   debug_log(2, "      z res=", Show(VERT(@fk)));
    1095   return(@f);
    1096 }
    1097 
    1098 ///////////////////////////////////////////////////////////////////////////////
    1099 proc Isomorphie_s82_x (poly @f, poly @fk, int @p)
    1100 USAGE:    Isomorphie_s82_x();
    1101 {
    1102   matrix @Mat;
    1103   poly @Relation, @a, @b;
    1104   ideal @Jfsyz, @B;
    1105 
    1106   debug_log(1, "      Isomorphie 82/90 x");
    1107   debug_log(2, "tt=", Show(@fk));
    1108   @Jfsyz = @fk, diff(@fk, x(1));
    1109   @Mat = matrix(syz(@Jfsyz));
    1110   @Relation = -3 * @Mat[2,1] / @Mat[1,1];
    1111   @a = Coeff(@Relation, x(1), x(1));
    1112   @b = Coeff(@Relation, x(2), x(2)^@p);
    1113   @B = maxideal(1);
    1114   @B[rvar(x(1))] = x(1)-@b*x(2)^@p;
    1115   map VERT=basering,@B;
    1116   @f = VERT(@f);
    1117   debug_log(2, VERT);
    1118   debug_log(2, "      x res=", Show(VERT(@fk)));
    1119 
    1120   return(@f);
    1121 }
    1122 
    1123 ///////////////////////////////////////////////////////////////////////////////
    1124 proc Funktion83 (poly @f, int @k)
    1125 USAGE:    Funktion83();
    1126 {
    1127   int @p = 1;
    1128   ideal @JetId;
    1129   poly @fk;
    1130   intvec @w;
    1131   ideal @Jf;
    1132   poly @phi;
    1133   int @Dim, @Mult;
    1134   matrix @Mat;
    1135   poly @a, @b;
    1136   ideal @B;
    1137 
    1138   debug_log(1, "   Schritt 83");
    1139   while(@p<10) {
    1140     debug_log(1, "     Schritt 83_"+string(@p));
    1141     @phi = jet(@f, 3);
    1142     @JetId = x(1)^3 + x(3)^3 + x(2)^(3*@p+1); weight(@JetId);
    1143     @w = weight(@JetId);
    1144     @fk = jet(@f- @phi, 3*@w[1], @w) ;
    1145 debug_log(2, "a)", @p, 3*@w[1], Show(@fk), @w, Show(@phi));
    1146     if( @fk != 0 ) { return(Funktion84(@f,@p)); }
    1147 
    1148     @JetId = x(1)^3 + x(3)^3 + x(1)*x(2)^(2*@p+1); weight(@JetId);
    1149     @w = weight(@JetId);
    1150     @fk = jet(@f, 3*@w[1], @w) ;
    1151 debug_log(2, "b)", @p, 3*@w[1], Show(@fk), @w, Show(@phi));
    1152     if ( @fk != @phi ) {
    1153       @Jf=std(jacob(@fk));
    1154       @Dim = dim(@Jf);
    1155       @Mult = mult(@Jf);
    1156 debug_log(2, "85-ft="+Show(@fk)+" Dim="+string(@Dim)+" mult="+string(@Mult));
    1157       if ( @Dim == 0 ) { return(Funktion86(@f,@p)); }
    1158       if ( @Dim == 1 ) { return(Funktion87(@f,@p)); }
    1159     }
    1160 
    1161     @JetId = x(1)^3 + x(3)^3 + x(2)^(3*@p+2); weight(@JetId);
    1162     @w = weight(@JetId);
    1163     @fk = jet(@f- @phi, 3*@w[1], @w) ;
    1164 debug_log(2, "c)", @p, 3*@w[1], Show(@fk), @w, Show(@phi));
    1165     if( @fk != 0 ) { return(Funktion89(@f,@p)); }
    1166 
    1167     @p = @p + 1;
    1168     @JetId = x(1)^3 + x(3)^3 + x(2)^(3*@p); weight(@JetId);
    1169     @w = weight(@JetId);
    1170     @fk = jet(@f, 3*@w[1], @w) ;
    1171     @Jf=std(jacob(@fk));
    1172     @Dim = dim(@Jf);
    1173     @Mult = mult(@Jf);
    1174 debug_log(2, "90 - ft="+Show(@fk)+" Dim="+string(@Dim)+" mult="+string(@Mult));
    1175     if ( @Dim == 0 ) { }
    1176     if ( @Dim == 1 ) {
    1177       if ( @Mult == 4 ) {
    1178         if( @fk - @phi != 0) { // b!=0  und/oder b'!=0
    1179           if( Coeff(@fk,x(1)*x(2), x(1)^2*x(2)^@p) == 0 ) { // b=0 und b'!=0
    1180             @a=(@fk - Coeff(@fk, x(1), x(1)^3)*x(1)^3) / x(1);
    1181             @f = Isomorphie_s82_z(@f, @a, @p);
    1182           }
    1183           else {
    1184             if( Coeff(@fk,x(1)*x(2)*x(3), x(1)*x(2)^@p*x(3)) == 0 ){
    1185                         // b!=0 und b'=0
    1186               debug_log(2, "Fall b'=2");
    1187               @a=subst(@fk, x(3), 0);
    1188               @f = Isomorphie_s82_x(@f, @a, @p);
    1189             }
    1190             else {
    1191               @a = Coeff(@fk,x(1)*x(2)*x(3), x(1)*x(2)^@p*x(3));
    1192               @b = Coeff(@fk,x(2)*x(3), x(2)^(2*@p)*x(3));
    1193               @B = maxideal(1);
    1194               @B[rvar(x(1))] = x(1)-@b/@a*x(2)^@p;
    1195               map VERT=basering,@B;
    1196               @f = VERT(@f);
    1197               @fk = jet(@f, 3*@w[1], @w) ;
    1198               debug_log(2, VERT);
    1199 
    1200               @a=(@fk - Coeff(@fk, x(1), x(1)^3)*x(1)^3) / x(1);
    1201               @f = Isomorphie_s82_z(@f, @a, @p);
    1202             } // ende else b!=0 und b'=0
    1203           } // ende else b=0 und b'!=0
    1204         } //ende @fk-@phi!=0
    1205       } // ende mult=4
    1206     } // ende dim=1
    1207   } // ENDE While
    1208   return("", "Fehler");
    1209 }
    1210 
    1211 ///////////////////////////////////////////////////////////////////////////////
    1212 proc Funktion97 (poly @f, int @K)
    1213 USAGE:    Funktion97();
    1214 {
    1215   int @kx = 1;  // Koordinate x
    1216   int @ky = 2;  // Koordinate y
    1217   int @kz = 3;  // Koordinate z
    1218   ideal @B = maxideal(1);       // Abbildungs-ideal
    1219 
    1220   int @k = 2;
    1221   int @i;
    1222   int @pt = 2;
    1223   poly @f3 = jet(@f, 3);
    1224   ideal @Jfsyz;
    1225 
    1226   poly  @l1;
    1227   poly  @l2;
    1228   poly  @a;
    1229   poly  @b;
    1230   poly  @c;
    1231   poly  @prod;
    1232   matrix @Mat;
    1233   int   @k = 1;
    1234 
    1235   "Weiter-97";
    1236   "Jet3 = ", Show(@f3);
    1237   // vertausche 2 Koordinaten sodass d2f/dx2 <>0 ist.
    1238   for(@i=1;@i<4;@i=@i+1) {
    1239     if(diff(diff(@f3, x(@i)), x(@i)) != 0) { @kx = @i; @i=4; }
    1240   }
    1241   if(@kx == 2) { @ky = 1; @kz = 3; }
    1242   if(@kx == 3) { @ky = 2; @kz = 1; }
    1243 
    1244   // bereche -l1l2 und anschliessend l1
    1245   @f3 = jet(@f, 3);
    1246   @Jfsyz = @f3, diff(@f3, x(@kx));
    1247   @Mat = matrix(syz(@Jfsyz));
    1248   @Jfsyz = @f3, @Mat[2,1];
    1249   @Mat = matrix(syz(@Jfsyz));
    1250 
    1251   // berechen Abb. sodass f=x2*l2
    1252   @l1 = @Mat[2,1];
    1253   @a = Coeff(@l1, x(@kx), x(@kx));
    1254   @l1 =  @l1 / number(@a);
    1255   @b = Coeff(@l1, x(@ky), x(@ky));
    1256   @c = Coeff(@l1, x(@kz), x(@kz));
    1257   @B[rvar(x(@kx))] = x(@kx) - @b * x(@ky) - @c * x(@kz);
    1258   map VERT=basering, @B;
    1259   @f = VERT(@f);
    1260   kill VERT;
    1261   @f3 = jet(@f, 3);
    1262 
    1263   "Jet3=", Show(@f3);
    1264   @l2 = @f3 / x(@kx)^2;
    1265   "l2=", @l2;
    1266 
    1267   // sorge dafuer, dass b<>0 ist.
    1268   @b = Coeff(@l2, x(@ky), x(@ky));
    1269   if( @b== 0) {
    1270     @ky, @kz = swap(@ky, @kz);
    1271   }
    1272 
    1273   // Koordinaten-Transf. s.d. f=x2y
    1274   @b = Coeff(@l2, x(@ky), x(@ky));
    1275   @l2 =  @l2 / number(@b);
    1276   @a = Coeff(@l2, x(@kx), x(@kx));
    1277   @c = Coeff(@l2, x(@kz), x(@kz));
    1278   @B = maxideal(1);
    1279   @B[rvar(x(@ky))] = -@a * x(@kx) + x(@ky) - @c * x(@kz);
    1280   map VERT=basering, @B;
    1281   @f = VERT(@f);
    1282   kill VERT;
    1283 
    1284   // bereche gewichteten jet von f
    1285   @f3 = jet(@f, 3);
    1286   "Jet3=", Show(@f3);
    1287   @Jfsyz = x(@kx)^2*x(@ky) + x(@ky)^4 + x(@kz)^4;
    1288   @a = jet(@f, 8, weight(@Jfsyz));
    1289   // der Gewichtete Jet betsteht nun aus den Monomen:
    1290   // x2y, y4, y4z, y2z2, yz3, z4, x2z
    1291   "a=", Show(@a);
    1292 
    1293   ideal @Jf=jacob(@a);
    1294   ideal @j1=std(@Jf);
    1295   int @Dim=dim(@j1);
    1296   int @Mult=mult(@j1);
    1297   if( @Dim == 0) { return(Show(@f), "V[1,0]"); }
    1298   if( @Dim == 1) {
    1299     if( @Mult == 1 ) { return(Funktion100(@f, @K)); }
    1300     if( @Mult == 2 ) { return(Funktion101(@f, @K)); }
    1301   }
    1302   " Dim=",@Dim," Dim2=",dim(@j2)," Mult=",@Mult," Mult2=",mult(@j2);
    1303   return(Show(@f), "V[k,r]");
    1304 }
    1305 
    1306 ///////////////////////////////////////////////////////////////////////////////
    1307 proc Funktion103 (poly @f)
    1308 USAGE:    Funktion103();
    1309 {
    1310   return(FunktionNoClass(@f,"3-jet = x3"));
    1311 }
    1312 
    1313 ///////////////////////////////////////////////////////////////////////////////
    1314 proc Funktion104 (poly @f)
    1315 USAGE:    Funktion104();
    1316 {
    1317   return(FunktionNoClass(@f));
    1318 }
    1319 
    1320 ///////////////////////////////////////////////////////////////////////////////
    1321 proc Funktion105 (poly @f);
    1322 USAGE:    Funktion105();
    1323 {
    1324   return(FunktionNoClass(@f));
    1325 }
    1326 
    1327 ///////////////////////////////////////////////////////////////////////////////
    1328 proc FunktionNoClass (poly @f, list #)
    1329 USAGE:    FunktionNoClass();
    1330 {
    1331   if(size(#)==2) { string @txt=#[2]; }
    1332 
    1333   string @s = "The singularity `"+Show(jet(@f, K));
    1334   @s = @s +"' is not in Arnolds list."+newline;
    1335   if(size(#)==2) { @s = @s + @txt; }
    1336   @s = @s + ", Milnor number = " + string(Mu);
    1337 
    1338   return(Show(@f), @s);
    1339 }
    1340 
    1341 ///////////////////////////////////////////////////////////////////////////////
    1342 proc tschirnhaus (poly @f, poly @x)
    1343 USAGE:    tschirnhaus();
    1344 {
    1345   int @n = nvars(basering);
    1346   int @j;
    1347 
    1348 // "tschirnhaus fuer:", Show(@f);
    1349   matrix @cf = coeffs(@f, @x);
    1350   int @hc = nrows(@cf) - 1;     // hoechster exponent von x_i
    1351   poly @b = @cf[@hc+1,1];       // koeffizient von x_i^hc
    1352   ideal @B = maxideal(1);
    1353 
    1354   string @s="map @EH="+nameof(basering);
    1355   for( @j=1; @j<=@n ; @j=@j+1) { @s = @s + ",0"; }
    1356   @s = @s + ";";
    1357   execute @s;
    1358 "b=", @b;
    1359 "EH(b)=", @EH(@b);
    1360 
    1361   if ( @EH(@b) == 0)    // pruefe ob der Koeff von x_i^hc
    1362   { map @Phi =basering, @B;
    1363     return(@f, @Phi);
    1364   }
    1365   @B[rvar(@x)] = @x -1*(@cf[@hc,1]/(@hc*@b));
    1366   map @Phi =basering, @B;
    1367   return(@Phi(@f), @Phi);
    1368 }
    1369 
    1370 ///////////////////////////////////////////////////////////////////////////////
    1371 proc Isomorphie_s17 (poly @f, poly @fk, int @k, int @ct)
    1372 USAGE:    Isomorphie_s17();
    1373 {
    1374   ideal @Jfsyz;
    1375   poly  @Relation;
    1376   poly  @a, @b, @c, @d;
    1377   ideal @JetId;
    1378   matrix @Matx, @Maty;
    1379 
    1380   // Ziel: bestimme a,b,c,d sodass  @fk = (ax+by^k)^3(cx+dy) gilt.
    1381   debug_log(2, "Isomorphie_s17:");
    1382   debug_log(2, "Faktor: f=",Show(@f)," Jet=",Show(@fk)," k=",@k);
    1383 
    1384   if( defined(VERT) == 1) { kill VERT; }
    1385 //  "Fak-1:",Show(@f)," jet=",Show(@fk);
    1386 
    1387   if( @k == 1) {
    1388     @Jfsyz = @fk, diff(@fk, x(1));
    1389     @Matx = matrix(syz(@Jfsyz));
    1390     @Jfsyz = @fk, diff(@fk, x(2));
    1391     @Maty = matrix(syz(@Jfsyz));
    1392 
    1393     @a = Coeff(@fk, x(1), x(1)^4);
    1394     @b = Coeff(@fk, x(2), x(2)^4);
    1395     @c = Coeff(@fk, x(1)*x(2), x(1)^3*x(2));
    1396     @d = Coeff(@fk, x(1)*x(2), x(1)*x(2)^3);
    1397 
    1398     if( (@a != 0) && (@b != 0) ) {
    1399       int @B,@C, @alpha, @beta, @gamma, @g;
    1400       poly @an, @bn;
    1401 
    1402       if(DeBug>7) {
    1403         Coeff(@Matx[1,1], x(2), x(2));
    1404         Coeff(@Maty[1,1], x(1), x(1));
    1405         Coeff(@Matx[2,1], x(1), x(1)^2);
    1406         Coeff(@Matx[2,1], x(1)*x(2), x(1)*x(2));
    1407         Coeff(@Matx[2,1], x(2), x(2)^2);
    1408       }
    1409       @B = -int(Coeff(@Matx[1,1], x(2), x(2)));
    1410       @C = -int(Coeff(@Maty[1,1], x(1), x(1)));
    1411       @alpha = int(Coeff(@Matx[2,1], x(1), x(1)^2));
    1412       @beta  = int(Coeff(@Matx[2,1], x(1)*x(2), x(1)*x(2)));
    1413       @gamma = int(Coeff(@Matx[2,1], x(2), x(2)^2));
    1414 
    1415       if(DeBug>7) {
    1416         "B=", @B;
    1417         "C=", @C;
    1418         "alpha=", @alpha;
    1419         "beta =", @beta;
    1420         "gamma=", @gamma;
    1421      
    1422         "(@B-@beta)/2=", (@B-@beta)/2;
    1423         "(@C-@beta)/2=", (@C-@beta)/2;
    1424       }
    1425 //      @a = gcd((@B-@beta)/2, @alpha);
    1426 //      @b = gcd((@C-@beta)/2, @gamma);
    1427       map VERT=basering,(x(1) - 2*(@gamma / (@B - @beta))*x(2)),x(2);
    1428       @Relation = VERT(@f);
    1429       @fk = jet(@Relation, 4);
    1430 
    1431       @an = Coeff(@fk, x(1), x(1)^4);
    1432       @bn = Coeff(@fk, x(2), x(2)^4);
    1433       if( (@an != 0) & (@bn != 0) ) {
    1434         VERT=basering,x(1),(x(2) + @a*x(1))/ @b;
    1435       }
    1436 
    1437       @f = VERT(@f);
    1438       @fk = jet(@f, 4);
    1439       PhiG = VERT(PhiG);
    1440 
    1441       @a = Coeff(@fk, x(1), x(1)^4);
    1442       @b = Coeff(@fk, x(2), x(2)^4);
    1443       @c = Coeff(@fk, x(1)*x(2), x(1)^3*x(2));
    1444       @d = Coeff(@fk, x(1)*x(2), x(1)*x(2)^3);
    1445       @Jfsyz = @fk, diff(@fk, x(1));
    1446       @Matx = matrix(syz(@Jfsyz));
    1447       @Jfsyz = @fk, diff(@fk, x(2));
    1448       @Maty = matrix(syz(@Jfsyz));
    1449     }
    1450 
    1451     if( (@a == 0) || (@b == 0) ) {
    1452       if( @a == 0) {
    1453         if( @c == 0) { // y3(ax+by)
    1454           @Relation = - @Matx[2,1] / @Matx[1,1];
    1455           @a = Coeff(@Relation, x(1), x(1));
    1456           @b = Coeff(@Relation, x(2), x(2));
    1457           map VERT=basering,@a*x(2)^@k - @b*x(1), x(1);
    1458         }
    1459         else { // (ax+by)^3y
    1460           @Relation = - 3*@Matx[2,1] / @Matx[1,1];
    1461           @a = Coeff(@Relation, x(1), x(1));
    1462           @b = Coeff(@Relation, x(2), x(2));
    1463           map VERT=basering,@a*x(1) - @b*x(2), x(2);
    1464         }
    1465       }
    1466       else {
    1467         if( @d == 0) { // x3(ax+by)
    1468           @Relation = - @Maty[2,1] / @Maty[1,1];
    1469           @a = Coeff(@Relation, x(1), x(1));
    1470           @b = Coeff(@Relation, x(2), x(2));
    1471           map VERT=basering,x(1), @b*x(2)^@k - @a*x(1);
    1472         }
    1473         else { // x(ax+by)^3
    1474           @Relation = - 3*@Maty[2,1] / @Maty[1,1];
    1475           @a = Coeff(@Relation, x(1), x(1));
    1476           @b = Coeff(@Relation, x(2), x(2));
    1477           map VERT=basering,x(2), @b*x(1) - @a*x(2);
    1478         }
    1479       }
    1480       @f = VERT(@f);
    1481       PhiG = VERT(PhiG);
    1482     }
    1483     else {
    1484 //      "Weder b noch a sind 0";
    1485       if(@ct > 5) { return(@f); }
    1486       @fk = jet(@f, 4);
    1487       return(Isomorphie_s17(@f, @fk, @k, @ct+1));
    1488     }
    1489   }
    1490   else {  // @k >1
    1491     @a = @fk/x(2);
    1492     @Jfsyz = @a, diff(@a, x(1));
    1493     @Matx = matrix(syz(@Jfsyz));
    1494     @Relation = -3 * @Matx[2,1] / @Matx[1,1];
    1495 //    @Matx;
    1496     @a = Coeff(@Relation, x(1), x(1));
    1497     @b = Coeff(@Relation, x(2), x(2)^@k);
    1498     map VERT=basering,x(1)-@b*x(2)^@k,x(2);
    1499     @f = VERT(@f);
    1500 //    VERT;
    1501     @JetId = x(1)^3*x(2) + x(2)^(3*@k+1);
    1502     @fk = jet(@f, 3*@k+1, weight(@JetId));
    1503 //    "fuer k>1: f=", Show(@a);
    1504 //    "fuer k>1: jet=", Show(jet(@fk, 4));
    1505   }
    1506 
    1507 //  @JetId = x(1)^3*x(2) + x(2)^(3*@k+1);
    1508 //  @fk = jet(@f, 3*@k+1, weight(@JetId));
    1509 //  "Coeff von x3=",Coeff(@fk, x(1), x(1)^3);
    1510 //  "Coeff von y3=",Coeff(@fk, x(2), x(2)^3);
    1511 //  "f  =", Show(@f);
    1512 //  "k=", @k;
    1513 //  "jet=", Show(jet(@fk, 4));
    1514   return(@f);
    1515 
    1516 }
    1517 
    1518 ///////////////////////////////////////////////////////////////////////////////
    1519 proc Funktion2 (poly f, int corank)
    1520 USAGE:   
    1521 {
    1522   string s = "The singularity `"+string(Show(f));
    1523   string tp = "A["+string(Mu)+"]";
    1524 
    1525   s = s +"' is R-equivalent to "+tp+".";
    1526   s; // +"  ("+SG_Typ+")";
    1527   ring RingB=char(basering),x,ds;
    1528 //  Morse(f, Kbestimmt(f));
    1529   return(string(x^(Mu+1)), tp);
    1530 }
    1531 
    1532 ///////////////////////////////////////////////////////////////////////////////
    1533 proc Funktion4 (poly f, int corank)
    1534 USAGE:   
    1535 {
    1536   string s = "The singularity `"+Show(jet(f, K));
    1537   string tp = "D[4]";
    1538 
    1539   s = s +"' is R-equivalent to "+tp+".";
    1540   s; // +"  ("+SG_Typ+")";
    1541   setring @Rtop;
    1542   return(Show(f), tp);
    1543 //  return(f, tp);
    1544 }
    1545 
    1546 ///////////////////////////////////////////////////////////////////////////////
    1547 proc Funktion5 (poly f, int corank)
    1548 USAGE:   
    1549 {
    1550   string s = "The singularity `"+Show(jet(f, K));
    1551   string tp = "D["+string(Mu)+"]";
    1552 
    1553   s = s +"' is R-equivalent to "+tp+".";
    1554   s; // +"  ("+SG_Typ+")";
    1555   return(Show(f), tp);
    1556 }
    1557 
    1558 ///////////////////////////////////////////////////////////////////////////////
    1559 proc Funktion7
    1560 USAGE:   
    1561 {
    1562   poly @f = #[1];
    1563   int @k = #[2];
    1564   string @s = "The singularity `"+Show(jet(@f, K));
    1565   string @tp = "E["+string(6*@k)+"]";
    1566 
    1567   @s  = @s + "' is R-equivalent to "+@tp + ", mu="+string(Mu)+", m="+string(@k-1);
    1568   if(6*@k != Mu) { "Fehler!!!"; }
    1569   @s; // +"  ("+SG_Typ+")";
    1570   return(Show(@f), @tp);
    1571 }
    1572 
    1573 ///////////////////////////////////////////////////////////////////////////////
    1574 proc Funktion8
    1575 USAGE:   
    1576 {
    1577   poly @f = #[1];
    1578   int @k = #[2];
    1579   string @s = "The singularity `"+Show(jet(@f, K));
    1580   string @tp = "E["+string(6*@k+1)+"]";
    1581 
    1582   @s  = @s + "' is R-equivalent to "+@tp + ", mu="+string(Mu)+", m="+string(@k-1);
    1583   if( (6*@k+1) != Mu) { "Fehler!!!"; }
    1584   @s; // +"  ("+SG_Typ+")";
    1585   return(Show(@f), @tp);
    1586 }
    1587 
    1588 ///////////////////////////////////////////////////////////////////////////////
    1589 proc Funktion9
    1590 USAGE:   
    1591 {
    1592   poly @f = #[1];
    1593   int @k = #[2];
    1594   string @s = "The singularity `"+Show(jet(@f, K));
    1595   string @tp = "E["+string(6*@k+2)+"]";
    1596 
    1597   @s  = @s + "' is R-equivalent to "+@tp + ", mu="+string(Mu)+", m="+string(@k-1);
    1598   if( (6*@k+2) != Mu) { "Fehler!!!"; }
    1599   @s; // +"  ("+SG_Typ+")";
    1600   return(Show(@f), @tp);
    1601 }
    1602 
    1603 ///////////////////////////////////////////////////////////////////////////////
    1604 proc Funktion11
    1605 USAGE:   
    1606 {
    1607   poly @f = #[1];
    1608   int @k = #[2];
    1609   string @s = "The singularity `"+Show(jet(@f, K));
    1610   string @tp = "J["+string(@k)+",0]";
    1611 
    1612   @s  = @s + "' is R-equivalent to "+@tp + ", mu="+string(Mu)+", m="+string(@k-1);
    1613   if( (6*@k-2) != Mu) { "Fehler!!!"; }
    1614   @s; // +"  ("+SG_Typ+")";
    1615   return(Show(@f), @tp);
    1616 }
    1617 
    1618 ///////////////////////////////////////////////////////////////////////////////
    1619 proc Funktion12
    1620 USAGE:   
    1621 {
    1622   poly @f = #[1];
    1623   int @k = #[2];
    1624   int @p = Mu - 6*@k +2;
    1625   string @s = "The singularity `"+Show(jet(@f, K));
    1626   string @tp = "J["+string(@k)+","+string(@p),"]";
    1627 
    1628   @s  = @s + "' is R-equivalent to "+@tp + ", mu="+string(Mu) + ", m="+string(@k-1);
    1629   if( (6*@k-2+@p) != Mu) { "Fehler!!!"; }
    1630   @s; // +"  ("+SG_Typ+")";
    1631   return(Show(@f), @tp);
    1632 }
    1633 
    1634 ///////////////////////////////////////////////////////////////////////////////
    1635 proc Funktion14
    1636 USAGE:   
    1637 {
    1638   poly @f = #[1];
    1639   string @s;
    1640   @s = "The singularity `"+Show(jet(@f, K));
    1641   string @tp = "T[2,4,4]";
    1642 
    1643   @s = @s +"' is R-equivalent to X[9] = X[1,0] = "+@tp + "., mu="+string(Mu);
    1644   @s; // +"  ("+SG_Typ+")";
    1645   return(Show(@f), @tp);
    1646 }
    1647 
    1648 ///////////////////////////////////////////////////////////////////////////////
    1649 proc Funktion15
    1650 USAGE:   
    1651 {
    1652   poly @f = #[1];
    1653   string @s;
    1654   int @p = Mu - 9;
    1655   @s = "The singularity `"+Show(jet(@f, K));
    1656   string @tp = "T[2,4," + string(4+@p) + "]";
    1657 
    1658   @s = @s+"' is R-equivalent to X[1,"+string(@p)+"] = "+@tp+"., mu="+string(Mu);
    1659   @s; // +"  ("+SG_Typ+")";
    1660   return(Show(@f), @tp);
    1661 }
    1662 
    1663 ///////////////////////////////////////////////////////////////////////////////
    1664 proc Funktion16
    1665 USAGE:   
    1666 {
    1667   poly @f = #[1];
    1668   string @s;
    1669   int @p;
    1670   int @q;
    1671   string @tp = "T[2,"+string(4+@p)+","+string(4+@q)+"]";
    1672 
    1673   @s = "The singularity `"+Show(jet(@f, K));
    1674   @s = @s +"' is R-equivalent to Y[1,"+string(@p)+","+string(@q)+"]";
    1675   @s =@s+" = "+@tp+".p=??,q=??, mu="+string(Mu);
    1676   @s; // +"  ("+SG_Typ+")";
    1677   return(Show(@f), @tp);
    1678 }
    1679 
    1680 ///////////////////////////////////////////////////////////////////////////////
    1681 proc Funktion19
    1682 USAGE:   
    1683 {
    1684   poly @f = #[1];
    1685   int @p = #[2];
    1686   string @s = "The singularity `"+Show(jet(@f, K));
    1687   string @tp = "Z["+string(6*@p+5)+"]";
    1688 
    1689   @s  = @s + "' is R-equivalent to " + @tp+", mu="+string(Mu) + ", m="+string(@p-1);
    1690   @s; // +"  ("+SG_Typ+")";
    1691   return(Show(@f), @tp);
    1692 }
    1693 
    1694 ///////////////////////////////////////////////////////////////////////////////
    1695 proc Funktion20
    1696 USAGE:   
    1697 {
    1698   poly @f = #[1];
    1699   int @p = #[2];
    1700   string @s = "The singularity `"+Show(jet(@f, K));
    1701   string @tp = "Z["+string(6*@p+6)+"]";
    1702 
    1703   @s  = @s + "' is R-equivalent to " + @tp+", mu="+string(Mu) + ", m="+string(@p-1);
    1704   @s; // +"  ("+SG_Typ+")";
    1705   return(Show(@f), @tp);
    1706 }
    1707 
    1708 ///////////////////////////////////////////////////////////////////////////////
    1709 proc Funktion21
    1710 USAGE:   
    1711 {
    1712   poly @f = #[1];
    1713   int @p = #[2];
    1714   string @s = "The singularity `"+Show(jet(@f,K));
    1715   string @tp = "Z["+string(6*@p+7)+"]";
    1716 
    1717   @s  = @s + "' is R-equivalent to " + @tp+", mu="+string(Mu) + ", m="+string(@p-1);
    1718   @s; // +"  ("+SG_Typ+")";
    1719   return(Show(@f), @tp);
    1720 }
    1721 
    1722 ///////////////////////////////////////////////////////////////////////////////
    1723 proc Funktion23
    1724 USAGE:   
    1725 {
    1726   poly @f = #[1];
    1727   int @p = #[2];
    1728   string @s = "The singularity `"+Show(jet(@f, K));
    1729   string @tp = "Z["+string(@p-1)+",0]";
    1730 
    1731   @s  = @s + "' is R-equivalent to " + @tp+", mu="+string(Mu) + ", m="+string(@p-1);
    1732   @s; // +"  ("+SG_Typ+")";
    1733   return(Show(@f), @tp);
    1734 }
    1735 
    1736 ///////////////////////////////////////////////////////////////////////////////
    1737 proc Funktion24
    1738 USAGE:   
    1739 {
    1740   poly @f = #[1];
    1741   int @p = #[2];
    1742   int @r = Mu - 15;
    1743   string @s = "The singularity `"+Show(jet(@f, K));
    1744   string @tp = "Z["+string(@p-1)+","+string(@r)+"]";
    1745 
    1746   @s  = @s + "' is R-equivalent to " + @tp+", mu="+string(Mu) + ", m="+string(@p-1);
    1747   @s; // +"  ("+SG_Typ+")";
    1748   return(Show(@f), @tp);
    1749 }
    1750 
    1751 ///////////////////////////////////////////////////////////////////////////////
    1752 proc Funktion27
    1753 USAGE:   
    1754 {
    1755   poly @f = #[1];
    1756   int @k = #[2];
    1757   string @s = "The singularity `"+Show(jet(@f, K));
    1758   string @tp = "W["+string(12*@k)+"]";
    1759 
    1760   @s  = @s + "' is R-equivalent to " + @tp+", mu="+string(Mu) + ", m="+string(3*@k-2);
    1761   @s; // +"  ("+SG_Typ+")";
    1762   return(Show(@f), @tp);
    1763 }
    1764 
    1765 ///////////////////////////////////////////////////////////////////////////////
    1766 proc Funktion28
    1767 USAGE:   
    1768 {
    1769   poly @f = #[1];
    1770   int @k = #[2];
    1771   string @s = "The singularity `"+Show(jet(@f, K));
    1772   string @tp = "W["+string(12*@k+1)+"]";
    1773 
    1774   @s  = @s + "' is R-equivalent to " + @tp+", mu="+string(Mu) + ", m="+string(3*@k-2);
    1775   @s; // +"  ("+SG_Typ+")";
    1776   return(Show(@f), @tp);
    1777 }
    1778 
    1779 ///////////////////////////////////////////////////////////////////////////////
    1780 proc Funktion30
    1781 USAGE:   
    1782 {
    1783   poly @f = #[1];
    1784   int @k = #[2];
    1785   string @s = "The singularity `"+Show(jet(@f, K));
    1786   string @tp = "W["+string(@k)+",0]";
    1787 
    1788   @s  = @s + "' is R-equivalent to " + @tp+", mu="+string(Mu) + ", m="+string(3*@k-1);
    1789   @s; // +"  ("+SG_Typ+")";
    1790   return(Show(@f), @tp);
    1791 }
    1792 
    1793 ///////////////////////////////////////////////////////////////////////////////
    1794 proc Funktion31
    1795 USAGE:   
    1796 {
    1797   poly @f = #[1];
    1798   int @k = #[2];
    1799   int @i = Mu - 12*@k - 3;
    1800   string @s = "The singularity `"+Show(jet(@f, K));
    1801   string @tp = "W["+string(@k)+","+string(@i)+"]";
    1802 
    1803   @s  = @s +"' is R-equivalent to "+@tp+"(F31), mu="+string(Mu)+", m="+string(3*@k-1);
    1804   @s; // +"  ("+SG_Typ+")";
    1805   return(Show(@f), @tp);
    1806 }
    1807 
    1808 ///////////////////////////////////////////////////////////////////////////////
    1809 proc Funktion32
    1810 USAGE:   
    1811 {
    1812   poly @f = #[1];
    1813   int @k = #[2];
    1814   int @i = Mu - 12*@k - 2;
    1815   string @s = "The singularity `"+Show(jet(@f, K));
    1816   string @tp = "W#["+string(@k)+","+string(@i)+"]";
    1817 
    1818   @s  = @s +"' is R-equivalent to "+@tp+"(F32), mu="+string(Mu)+", m="+string(3*@k-1);
    1819   @s; // +"  ("+SG_Typ+")";
    1820   return(Show(@f), @tp);
    1821 }
    1822 
    1823 ///////////////////////////////////////////////////////////////////////////////
    1824 proc Funktion34
    1825 USAGE:   
    1826 {
    1827   poly @f = #[1];
    1828   int @k = #[2];
    1829   string @s = "The singularity `"+Show(jet(@f, K));
    1830   string @tp = "W["+string(12*@k+5)+"]";
    1831 
    1832   @s  = @s +"' is R-equivalent to "+@tp+"(F34), mu="+string(Mu)+", m="+string(3*@k-1);
    1833   @s; // +"  ("+SG_Typ+")";
    1834   return(Show(@f), @tp);
    1835 }
    1836 
    1837 ///////////////////////////////////////////////////////////////////////////////
    1838 proc Funktion35
    1839 USAGE:   
    1840 {
    1841   poly @f = #[1];
    1842   int @k = #[2];
    1843   string @s = "The singularity `"+Show(jet(@f, K));
    1844   string @tp = "W["+string(12*@k+6)+"]";
    1845 
    1846   @s  = @s + "'is R-equivalent to "+@tp+"(F35), mu="+string(Mu)+", m="+string(3*@k-1);
    1847   @s; // +"  ("+SG_Typ+")";
    1848   return(Show(@f), @tp);
    1849 }
    1850 
    1851 ///////////////////////////////////////////////////////////////////////////////
    1852 proc Funktion37
    1853 USAGE:   
    1854 {
    1855   poly @f = #[1];
    1856   int @k = #[2];
    1857   string @s = "The singularity `"+Show(jet(@f, K));
    1858   string @tp = "X["+string(@k)+",0]";
    1859 
    1860   @s  = @s +"' is R-equivalent to "+@tp+"(F37), mu="+string(Mu)+", m="+string(@k-1);
    1861   @s; // +"  ("+SG_Typ+")";
    1862   return(Show(@f), @tp);
    1863 }
    1864 
    1865 ///////////////////////////////////////////////////////////////////////////////
    1866 proc Funktion38
    1867 USAGE:   
    1868 {
    1869   poly @f = #[1];
    1870   int @k = #[2];
    1871   int @p = Mu - 12*@k + 3;
    1872   string @s = "The singularity `"+Show(jet(@f, K-1));
    1873   string @tp = "X["+string(@k)+","+string(@p)+"]";
    1874 
    1875   @s  = @s +"' is R-equivalent to "+@tp+"(F38), mu="+string(Mu)+", m="+string(@k-1);
    1876   @s; // +"  ("+SG_Typ+")";
    1877   return(Show(@f), @tp);
    1878 }
    1879 
    1880 ///////////////////////////////////////////////////////////////////////////////
    1881 proc Funktion39
    1882 USAGE:   
    1883 {
    1884   poly @f = #[1];
    1885   int @k = #[2];
    1886   string @s = "The singularity `"+Show(jet(@f, K));
    1887   string @tp = "Y["+string(@k)+",r,s]";
    1888 
    1889   @s  = @s +"' is R-equivalent to "+@tp+"(F39), mu="+string(Mu)+", m="+string(@k-1);
    1890   @s; // +"  ("+SG_Typ+")";
    1891   return(Show(@f), @tp);
    1892 }
    1893 
    1894 ///////////////////////////////////////////////////////////////////////////////
    1895 proc Funktion42
    1896 USAGE:   
    1897 {
    1898   poly @f = #[1];
    1899   int @k = #[2];
    1900   int @r = #[3];
    1901   string @s = "The singularity `"+Show(jet(@f, K));
    1902   string @tp = "Z["+string(@k)+","+string(12*@k+6*@r-1)+"]";
    1903 
    1904   @s  = @s +"' is R-equivalent to "+@tp+"(F42), mu="+string(Mu)+", m="+string(@k-1);
    1905   @s; // +"  ("+SG_Typ+")";
    1906   return(Show(@f), @tp);
    1907 }
    1908 
    1909 ///////////////////////////////////////////////////////////////////////////////
    1910 proc Funktion43
    1911 USAGE:   
    1912 {
    1913   poly @f = #[1];
    1914   int @k = #[2];
    1915   int @r = #[3];
    1916   string @s = "The singularity `"+Show(jet(@f, K));
    1917   string @tp = "Z["+string(@k)+","+string(12*@k+6*@r)+"]";
    1918 
    1919   @s  = @s +"' is R-equivalent to "+@tp+"(F43), mu="+string(Mu)+", m="+string(@k-1);
    1920   @s; // +"  ("+SG_Typ+")";
    1921   return(Show(@f), @tp);
    1922 }
    1923 
    1924 ///////////////////////////////////////////////////////////////////////////////
    1925 proc Funktion44
    1926 USAGE:   
    1927 {
    1928   poly @f = #[1];
    1929   int @k = #[2];
    1930   int @r = #[3];
    1931   string @s = "The singularity `"+Show(jet(@f, K));
    1932   string @tp = "Z["+string(@k)+","+string(12*@k+6*@r+1)+"]";
    1933 
    1934   @s = @s +"' is R-equivalent to "+@tp+"(F44), mu="+string(Mu)+", m="+string(@k-1);
    1935   @s; // +"  ("+SG_Typ+")";
    1936   return(Show(@f), @tp);
    1937 }
    1938 
    1939 ///////////////////////////////////////////////////////////////////////////////
    1940 proc Funktion45
    1941 USAGE:   
    1942 {
    1943   poly @f = #[1];
    1944   int @k = #[2];
    1945   int @r = #[3];
    1946   int @S = #[4];
    1947   string @s = "The singularity `"+Show(jet(@f, K));
    1948   string @tp = "Z["+string(@k)+","+string(@r)+","+string(@S)+"]";
    1949 
    1950   @s = @s +"' is R-equivalent to "+@tp+"(F45/46), mu="+string(Mu)+", m="+string(@k-1);
    1951   @s; // +"  ("+SG_Typ+")";
    1952   return(Show(@f), @tp);
    1953 }
    1954 
    1955 ///////////////////////////////////////////////////////////////////////////////
    1956 proc Funktion47
    1957 USAGE:   
    1958 {
    1959   poly @f = #[1];
    1960   int @k = #[2];
    1961   int @r = #[3];
    1962   int @S = #[4];
    1963   string @s = "The Singularity '";+Show(jet(@f, K));
    1964   string @tp="";
    1965 
    1966   @s = @s +"' has 4-jet equal to zero. (F47), mu="+string(Mu);
    1967 
    1968   @s; // +"  ("+SG_Typ+")";
    1969   return(Show(@f), @tp);
    1970 }
    1971 
    1972 ///////////////////////////////////////////////////////////////////////////////
    1973 proc Funktion60
    1974 USAGE:   
    1975 {
    1976   poly @f = #[1];
    1977   int @k = #[2];
    1978   string @s = "The singularity `"+Show(jet(@f, K));
    1979   string @tp = "Q["+string(6*@k+4)+"]";
    1980 
    1981   @s = @s +"' is R-equivalent to "+@tp+"(F60), mu="+string(Mu)+", m="+string(@k-1);
    1982   @s; // +"  ("+SG_Typ+")";
    1983   return(Show(@f), @tp);
    1984 }
    1985 
    1986 ///////////////////////////////////////////////////////////////////////////////
    1987 proc Funktion61
    1988 USAGE:   
    1989 {
    1990   poly @f = #[1];
    1991   int @k = #[2];
    1992   string @s = "The singularity `"+Show(jet(@f, K));
    1993   string @tp = "Q["+string(6*@k+5)+"]";
    1994 
    1995   @s = @s +"' is R-equivalent to "+@tp+"(F61), mu="+string(Mu)+", m="+string(@k-1);
    1996   @s; // +"  ("+SG_Typ+")";
    1997   return(Show(@f), @tp);
    1998 }
    1999 
    2000 ///////////////////////////////////////////////////////////////////////////////
    2001 proc Funktion62
    2002 USAGE:   
    2003 {
    2004   poly @f = #[1];
    2005   int @k = #[2];
    2006   string @s = "The singularity `"+Show(jet(@f, K));
    2007   string @tp = "Q["+string(6*@k+6)+"]";
    2008 
    2009   @s = @s +"' is R-equivalent to "+@tp+"(F62), mu="+string(Mu)+", m="+string(@k-1);
    2010   @s; // +"  ("+SG_Typ+")";
    2011   return(Show(@f), @tp);
    2012 }
    2013 
    2014 ///////////////////////////////////////////////////////////////////////////////
    2015 proc Funktion64
    2016 USAGE:   
    2017 {
    2018   poly @f = #[1];
    2019   int @k = #[2];
    2020   string @s = "The singularity `"+Show(jet(@f, K));
    2021   string @tp = "Q["+string(@k)+",0]";
    2022 
    2023   @s = @s +"' is R-equivalent to "+@tp+"(F64), mu="+string(Mu)+", m="+string(@k-1);
    2024   @s; // +"  ("+SG_Typ+")";
    2025   return(Show(@f), @tp);
    2026 }
    2027 
    2028 ///////////////////////////////////////////////////////////////////////////////
    2029 proc Funktion65
    2030 USAGE:   
    2031 {
    2032   poly @f = #[1];
    2033   int @k = #[2];
    2034   int @i = Mu - (6*@k + 2);
    2035   string @s = "The singularity `"+Show(jet(@f, K));
    2036   string @tp = "Q["+string(@k)+","+string(@i)+"]";
    2037 
    2038   @s = @s +"' is R-equivalent to "+@tp+"(F65), mu="+string(Mu)+", m="+string(@k-1);
    2039   @s; // +"  ("+SG_Typ+")";
    2040   return(Show(@f), @tp);
    2041 }
    2042 
    2043 ///////////////////////////////////////////////////////////////////////////////
    2044 proc Funktion84
    2045 USAGE:   
    2046 {
    2047   poly @f = #[1];
    2048   int @k = #[2];
    2049   "      Schritt 84";
    2050 
    2051   return(FunktionNoClass(#[1]));
    2052 }
    2053 
    2054 ///////////////////////////////////////////////////////////////////////////////
    2055 proc Funktion86
    2056 USAGE:   
    2057 {
    2058   poly @f = #[1];
    2059   int @k = #[2];
    2060   "      Schritt 86";
    2061 
    2062   return(FunktionNoClass(#[1]));
    2063 }
    2064 
    2065 ///////////////////////////////////////////////////////////////////////////////
    2066 proc Funktion87
    2067 USAGE:   
    2068 {
    2069   poly @f = #[1];
    2070   int @k = #[2];
    2071   "      Schritt 87";
    2072 
    2073   return(FunktionNoClass(#[1]));
    2074 }
    2075 
    2076 ///////////////////////////////////////////////////////////////////////////////
    2077 proc Funktion89
    2078 USAGE:   
    2079 {
    2080   poly @f = #[1];
    2081   int @k = #[2];
    2082   "      Schritt 89";
    2083 
    2084   return(FunktionNoClass(#[1]));
    2085 }
    2086 
    2087 ///////////////////////////////////////////////////////////////////////////////
    2088 proc Funktion100
    2089 USAGE:   
    2090 {
    2091   poly @f = #[1];
    2092   int @k = #[2];
    2093   string @s = "The Singularity '"+Show(jet(@f, K));
    2094   string @tp = "V[1,"+string(Mu-15)+"]";
    2095 
    2096   @s = @s +"' is R-equivalent to "+@tp+"(F100), mu="+string(Mu)+", m="+string(@k-1);
    2097 
    2098   @s; // +"  ("+SG_Typ+")";
    2099   return(Show(@f), @tp);
    2100 }
    2101 
    2102 ///////////////////////////////////////////////////////////////////////////////
    2103 proc Funktion101
    2104 USAGE:   
    2105 {
    2106   poly @f = #[1];
    2107   int @k = #[2];
    2108   string @s = "The Singularity '"+Show(jet(@f, @k));
    2109   string @tp = "V#[1,"+string(Mu-15)+"]";
    2110 
    2111   @s = @s +"' is R-equivalent to "+@tp+"(F101), mu="+string(Mu)+", m="+string(@k-1);
    2112 
    2113   @s; // +"  ("+SG_Typ+")";
    2114   return(Show(@f), @tp);
    2115 }
    2116 
    2117 ///////////////////////////////////////////////////////////////////////////////
     3412    string s="ring r";
     3413  }
     3414  s=s+"=0,(x(1.."+ string(#[1]) +")),(c,ds);";
     3415  return(s);
     3416}
    21183417
    21193418///////////////////////////////////////////////////////////////////////////////
     
    21243423{ "   Internal functions for the classification unsing Arnold's method:
    21253424  Klassifiziere(poly f);             determine the typ of the singularity f
    2126   Funktion1bis (poly @f, int corank)
    2127   Funktion2 (poly f,int k)
    2128   Funktion3 (poly @f, int corank);
    2129   Funktion4 (poly f,int k)
    2130   Funktion5 (poly f,int k)
    2131   Funktion6 (poly @f, int corank)
    2132   Funktion7 (poly f,int k)
    2133   Funktion8 (poly f,int k)
    2134   Funktion9 (poly f,int k)
    2135   Funktion11 (poly f,int k)
    2136   Funktion12 (poly f,int k)
    2137   Funktion13 (poly @f, int corank)
    2138   Funktion14 (poly f,int k)
    2139   Funktion15 (poly f,int k)
    2140   Funktion16 (poly f,int k)
    2141   Funktion17 (poly @f, int corank)
    2142   Funktion19 (poly f,int k)
    2143   Funktion20 (poly f,int k)
    2144   Funktion21 (poly f,int k)
    2145   Funktion23 (poly f,int k)
    2146   Funktion24 (poly f,int k)
    2147   Funktion25 (poly @f, int CoRang)
    2148   Funktion27 (poly f,int k)
    2149   Funktion28 (poly f,int k)
    2150   Funktion30 (poly f,int k)
    2151   Funktion31 (poly f,int k)
    2152   Funktion32 (poly f,int k)
    2153   Funktion34 (poly f,int k)
    2154   Funktion35 (poly f,int k)
    2155   Funktion37 (poly f,int k)
    2156   Funktion38 (poly f,int k)
    2157   Funktion39 (poly f,int k)
    2158   Funktion40 (poly @f, int @k)
    2159   Funktion42 (poly f,int k)
    2160   Funktion43 (poly f,int k)
    2161   Funktion44 (poly f,int k)
    2162   Funktion45 (poly f,int k)
    2163   Funktion47 (poly f,int k)
    2164   Funktion50 (poly @f, int corank)
    2165   Funktion51 (poly @f, int @k)
    2166   Funktion52 (poly @f, int @k)
    2167   Funktion54 (poly @f, int @k)
    2168   Funktion56 (poly @f, int @k)
    2169   Funktion58 (poly @fin, int @k)
    2170   Funktion59 (poly @f, int @k)
    2171   Funktion60 (poly f,int k)
    2172   Funktion61 (poly f,int k)
    2173   Funktion62 (poly f,int k)
    2174   Funktion64 (poly f,int k)
    2175   Funktion65 (poly f,int k)
    2176   Funktion66 (poly @f, int @k)
    2177   Funktion82 (poly @f, int @k)
    2178   Funktion83 (poly @f, int @k)
    2179   Funktion84 (poly f,int k)
    2180   Funktion86 (poly f,int k)
    2181   Funktion87 (poly f,int k)
    2182   Funktion89 (poly f,int k)
    2183   Funktion97 (poly @f, int @K)
    2184   Funktion100 (poly f,int k)
    2185   Funktion101 (poly f,int k)
    2186 
    2187   Funktion103(poly f, int corank);
    2188   Funktion104(poly f, int corank);
    2189   Funktion105(poly f, int corank);
    2190   FunktionNoClass(poly f, int corank);
    2191   Isomorphie_s82_x(poly f, poly fk, int k);
    2192   Isomorphie_s82_z(poly f, poly fk, int k);
    2193   tschirnhaus(poly f, int corank);
    2194   Isomorphie_s17 (poly f, poly fk, int k, int ct);
     3425  Funktion1bis (poly f, int corank, int Mu, int K)
     3426  Funktion2 (poly f, int corank, int Mu, int K)
     3427  Funktion3 (poly f, int corank, int Mu, int K)
     3428  Funktion4 (poly f, int corank, int Mu, int K)
     3429  Funktion5 (poly f, int corank, int Mu, int K)
     3430  Funktion6 (poly f, int corank, int Mu, int K)
     3431  Funktion7 (poly f, int corank, int Mu, int K, int k)
     3432  Funktion8 (poly f, int corank, int Mu, int K, int k)
     3433  Funktion9 (poly f, int corank, int Mu, int K, int k)
     3434  Funktion11 (poly f, int corank, int Mu, int K, int k)
     3435  Funktion12 (poly f, int corank, int Mu, int K, int k)
     3436  Funktion13 (poly f, int corank, int Mu, int K)
     3437  Funktion14 (poly f, int corank, int Mu, int K)
     3438  Funktion15 (poly f, int corank, int Mu, int K)
     3439  Funktion16 (poly f, int corank, int Mu, int K)
     3440  Funktion17 (poly f, int corank, int Mu, int K)
     3441  Funktion19 (poly f, int corank, int Mu, int K, int k)
     3442  Funktion20 (poly f, int corank, int Mu, int K, int k)
     3443  Funktion21 (poly f, int corank, int Mu, int K, int k)
     3444  Funktion23 (poly f, int corank, int Mu, int K, int k)
     3445  Funktion24 (poly f, int corank, int Mu, int K, int k)
     3446  Funktion25 (poly f, int corank, int Mu, int K)
     3447  Funktion27 (poly f, int corank, int Mu, int K, int k)
     3448  Funktion28 (poly f, int corank, int Mu, int K, int k)
     3449  Funktion30 (poly f, int corank, int Mu, int K, int k)
     3450  Funktion31 (poly f, int corank, int Mu, int K, int k)
     3451  Funktion32 (poly f, int corank, int Mu, int K, int k)
     3452  Funktion34 (poly f, int corank, int Mu, int K, int k)
     3453  Funktion35 (poly f, int corank, int Mu, int K, int k)
     3454  Funktion37 (poly f, int corank, int Mu, int K, int k)
     3455  Funktion38 (poly f, int corank, int Mu, int K, int k)
     3456  Funktion39 (poly f, int corank, int Mu, int K, int k)
     3457  Funktion40 (poly f, int corank, int Mu, int K, int k)
     3458  Funktion42 (poly f, int corank, int Mu, int K, int k, int r)
     3459  Funktion43 (poly f, int corank, int Mu, int K, int k, int r)
     3460  Funktion44 (poly f, int corank, int Mu, int K, int k, int r)
     3461  Funktion45 (poly f, int corank, int Mu, int K, int k, int r, int s)
     3462  Funktion47 (poly f, int corank, int Mu, int K)
     3463  Funktion50 (poly f, int corank, int Mu, int K)
     3464  Funktion51 (poly f, int corank, int Mu, int K)
     3465  Funktion52 (poly f, int corank, int Mu, int K)
     3466  Funktion54 (poly f, int corank, int Mu, int K)
     3467  Funktion56 (poly f, int corank, int Mu, int K)
     3468  Funktion58 (poly fin, int corank, int Mu, int K)
     3469  Funktion59 (poly f, int corank, int Mu, int K)
     3470  Funktion60 (poly f, int corank, int Mu, int K, int k)
     3471  Funktion61 (poly f, int corank, int Mu, int K, int k)
     3472  Funktion62 (poly f, int corank, int Mu, int K, int k)
     3473  Funktion64 (poly f, int corank, int Mu, int K, int k)
     3474  Funktion65 (poly f, int corank, int Mu, int K, int k)
     3475  Funktion66 (poly f, int corank, int Mu, int K)
     3476  Funktion82 (poly f, int corank, int Mu, int K)
     3477  Funktion83 (poly f, int corank, int Mu, int K)
     3478  Funktion84 (poly f, int corank, int Mu, int K, int k)
     3479  Funktion86 (poly f, int corank, int Mu, int K, int k)
     3480  Funktion87 (poly f, int corank, int Mu, int K, int k)
     3481  Funktion89 (poly f, int corank, int Mu, int K, int k)
     3482  Funktion97 (poly f, int corank, int Mu, int K)
     3483  Funktion100 (poly f, int corank, int Mu, int K)
     3484  Funktion101 (poly f, int corank, int Mu, int K)
     3485  Funktion103 (poly f, int corank, int Mu, int K)
     3486  Funktion104 (poly f, int corank, int Mu, int K)
     3487  Funktion105 (poly f, int corank, int Mu, int K)
     3488  FunktionNoClass (poly f, int corank, list #)
     3489  Isomorphie_s82_x (poly f, poly fk, int k)
     3490  Isomorphie_s82_z (poly f, poly fk, int k)
     3491  Isomorphie_s17 (poly f, poly fk, int k, int ct)
     3492  printresult (string f, string typ, int Mu, int m)
    21953493  ";
    21963494  "   Internal functions for the classifcation by invariants:
     3495  Cubic (poly f)          (for internal use only)
     3496  parity (int e)               return the parity of e
     3497  HKclass (intvec i)          (for internal use only)
     3498  HKclass3( intvec i)         (for internal use only)
     3499  HKclass3_teil_1 (intvec i)  (for internal use only)
     3500  HKclass5 (intvec i)         (for internal use only)
     3501  HKclass5_teil_1 (intvec i)  (for internal use only)
     3502  HKclass5_teil_2 (intvec i)  (for internal use only)
     3503  HKclass7 (intvec i)         (for internal use only)
     3504  HKclass7_teil_1 (intvec i)  (for internal use only)
    21973505  ";
    21983506  "   Internal functions for the Morse-splitting lemma:
     3507  Morse(poly fi, int K, int corank)          Splittinglemma itself
     3508  Coeffs (list #)
     3509  Coeff
     3510  ReOrder(poly f)
     3511  Singularitaet (string typ,int k,int r,int s,poly a,poly b,poly c,poly d)
     3512  RandomPolyK
     3513  debug_log (int level, list #)
     3514  Faktorisiere(poly f, poly fk, int pt, int k)
     3515  Teile(poly f, poly fk)
     3516  init
     3517  GetRf
     3518  Show(poly g)
     3519  checkring
     3520  DecodeNormalFormString
     3521  AL
     3522  normalform(string s_in)
     3523  swap
     3524  Setring
     3525
    21993526  ";
    22003527  "   Internal functions providing tools:
     
    22043531// E n d   O f   F i l e
    22053532//proc Ausgaben_lib
    2206 //proc Funktion103 (poly @f)
    2207 //proc Funktion104 (poly @f)
    2208 //proc Funktion105 (poly @f);
    2209 
    2210 //proc FunktionNoClass (poly @f, list #)
    2211 //proc Isomorphie_s17 (poly @f, poly @fk, int @k, int @ct)
    2212 //proc Isomorphie_s82_x (poly @f, poly @fk, int @p)
    2213 //proc Isomorphie_s82_z (poly @f, poly @fk, int @p)
    2214 //proc Klassifiziere (poly @f)
     3533
     3534//proc Isomorphie_s17 (poly f, poly fk, int k, int ct)
     3535//proc Isomorphie_s82_x (poly f, poly fk, int p)
     3536//proc Isomorphie_s82_z (poly f, poly fk, int p)
     3537//proc Klassifiziere (poly f)
    22153538//proc classify (poly f_in)
    22163539//proc internalfunctions
    2217 //proc tschirnhaus (poly @f, poly @x)
     3540//proc tschirnhaus (poly f, poly x)
    22183541///////////////////////////////////////////////////////////////////////////////
    22193542//---------------------------- initialisation ---------------------------------
  • Singular/LIB/makedbm.lib

    ra3872e rcc9598  
    1 // $Id: makedbm.lib,v 1.2 1997-08-15 08:00:37 krueger Exp $
     1// $Id: makedbm.lib,v 1.3 1997-10-08 08:57:21 krueger Exp $
    22//=========================================================================
    33//
     
    4141  write(l, "E[6k+1]", "x3+x*(y^(2*k+1))+a*(y^(3*k+2))");
    4242  write(l, "E[6k+2]", "x3+y^(3*k+2)+a*x*(y^(2*k+2))");
    43   write(l, "J[k,0]", "x3+b*x2*y^k+y^(3*k)c*x*y^(2*k+1)");
     43  write(l, "J[k,0]", "x3+b*x^2*y^k+y^(3*k)+c*x*y^(2*k+1)");
    4444  write(l, "J[k,r]", "x3+x2*y^k+a*y^(3*k+r)");
    4545  write(l, "X[1,0]", "x4+a*x2y2+y4");
    4646  write(l, "X[1,r]", "x4+x2y2+a*y^(4+r)");
    47   write(l, "X[k,0]", "x4+b*x3y^k+a*x2y^(2k) + xy^(3k)");
    48   write(l, "X[k,r]", "x4+a*x3y^k+x2y^(2*k) + b*(y^(4*k+r))");
     47  write(l, "X[k,0]", "x4+b*x3y^k+a*x2y^(2*k) + xy^(3*k)");
     48  write(l, "X[k,r]", "x4+a*x3*y^k+x2y^(2*k)+b*(y^(4*k+r))");
    4949  write(l, "W[12k]", "x4+y^(4*k+1)+a*x*(y^(3*k+1))+c*x2*(y^(2*k+1))");
    5050  write(l, "W[12k+1]", "x4+x*(y^(3*k+1))+a*x2*(y^(2*k+1))+c*y^(4*k+2)");
Note: See TracChangeset for help on using the changeset viewer.