Changeset 5c8c19 in git
- Timestamp:
- Dec 4, 2000, 2:48:16 PM (23 years ago)
- Branches:
- (u'spielwiese', '828514cf6e480e4bafc26df99217bf2a1ed1ef45')
- Children:
- 61dadae46cd95345d4d43af6de7e728300732ab7
- Parents:
- 6f033b6b6340279e600b54c5c6afc99b846b49cf
- File:
-
- 1 edited
-
Singular/LIB/classify.lib (modified) (41 diffs)
Legend:
- Unmodified
- Added
- Removed
-
Singular/LIB/classify.lib
r6f033b r5c8c19 1 e// $Id: classify.lib,v 1.4 2 2000-05-12 12:25:41Singular Exp $1 e// $Id: classify.lib,v 1.43 2000-12-04 13:48:16 Singular Exp $ 2 2 // KK, last modified: 04.04.1998 3 3 /////////////////////////////////////////////////////////////////////////////// 4 4 5 version = "$Id: classify.lib,v 1.4 2 2000-05-12 12:25:41Singular Exp $";5 version = "$Id: classify.lib,v 1.43 2000-12-04 13:48:16 Singular Exp $"; 6 6 info=" 7 7 LIBRARY: classify.lib Procedures for the Arnold-Classifier of Singularities … … 132 132 133 133 /////////////////////////////////////////////////////////////////////////////// 134 static 135 proc Klassifiziere (poly f) 134 static proc Klassifiziere (poly f) 136 135 { 137 136 //--------------------------- initialisation ---------------------------------- 138 string s1; 139 int n, cnt, corank_f, K, Mu; 140 list v, cstn; 141 map PhiG; 142 def ring_top = basering; 143 144 n = nvars(basering); // Zahl der Variablen des aktuellen Rings. 145 PhiG = ring_top, maxideal(1); 146 cstn[4] = PhiG; 147 if( defined(@ringdisplay) == 0) { 148 string @ringdisplay; // Define always 'ringdisplay' to be 149 export @ringdisplay; // able to run 'Show(f)' 150 } 151 @ringdisplay = "setring RingB;"; 152 if(defined(RingB)!=0) { kill RingB; } 153 execute ("ring RingB="+charstr(basering)+",("+A_Z("x", n)+"),(c,ds);"); 154 export RingB; 155 setring ring_top; 137 string s1; 138 int n, cnt, corank_f, K, Mu; 139 list v, cstn; 140 map PhiG; 141 def ring_top = basering; 142 143 n = nvars(basering); // Zahl der Variablen des aktuellen Rings. 144 PhiG = ring_top, maxideal(1); 145 cstn[4] = PhiG; 146 if( defined(@ringdisplay) == 0) 147 { 148 string @ringdisplay; // Define always 'ringdisplay' to be 149 export @ringdisplay; // able to run 'Show(f)' 150 } 151 @ringdisplay = "setring RingB;"; 152 if(defined(RingB)!=0) { kill RingB; } 153 execute ("ring RingB="+charstr(basering)+",("+A_Z("x", n)+"),(c,ds);"); 154 export RingB; 155 setring ring_top; 156 156 157 157 //---------------------- compute basciinvariants ------------------------------ 158 if(jet(f,0) != 0 ) { 159 cstn[1] = corank(f); cstn[2]=-1; cstn[3]=1; 160 return(printresult(1, f, "a unit", cstn, -1)); 161 } 162 163 debug_log(1, "Computing Basicinvariants of f ..."); 164 K, Mu, corank_f = basicinvariants(f); 165 debug_log(0, "About the singularity :"); 166 debug_log(0, " Milnor number(f) = "+string(Mu)); 167 debug_log(0, " Corank(f) = "+string(corank_f)); 168 debug_log(0, " Determinacy <= "+string(K)); 169 cstn[1] = corank_f; 170 cstn[2] = Mu; 171 cstn[3] = K; 172 173 if( Mu == 0) { 174 cstn[1]=1; cstn[3]=1; 175 return(printresult(1, f, "A[0]", cstn, 0)); } 176 177 if(Mu<0) { 178 debug_log(0, "The Milnor number of the function is infinite."); 179 debug_log(0, "The singularity is not in Arnolds list."); 180 return(printresult(1, 1, "error!", cstn, -1)); 181 } 182 183 f = jet(f, K); 184 v = HKclass(milnorcode(f)); 185 if(v[2]>0) { debug_log(0, "Guessing type via Milnorcode: ", v[1]);} 186 else { 187 debug_log(0, "Hilbert polynomial not recognised. Milnor code = ", 188 milnorcode(f)); 189 } 190 debug_log(0, ""); 191 debug_log(0, "Computing normal form ..."); 158 if(jet(f,0) != 0 ) 159 { 160 cstn[1] = corank(f); cstn[2]=-1; cstn[3]=1; 161 return(printresult(1, f, "a unit", cstn, -1)); 162 } 163 164 debug_log(1, "Computing Basicinvariants of f ..."); 165 K, Mu, corank_f = basicinvariants(f); 166 debug_log(0, "About the singularity :"); 167 debug_log(0, " Milnor number(f) = "+string(Mu)); 168 debug_log(0, " Corank(f) = "+string(corank_f)); 169 debug_log(0, " Determinacy <= "+string(K)); 170 cstn[1] = corank_f; 171 cstn[2] = Mu; 172 cstn[3] = K; 173 174 if( Mu == 0) 175 { 176 cstn[1]=1; cstn[3]=1; 177 return(printresult(1, f, "A[0]", cstn, 0)); 178 } 179 180 if(Mu<0) 181 { 182 debug_log(0, "The Milnor number of the function is infinite."); 183 debug_log(0, "The singularity is not in Arnolds list."); 184 return(printresult(1, 1, "error!", cstn, -1)); 185 } 186 187 f = jet(f, K); 188 v = HKclass(milnorcode(f)); 189 if(v[2]>0) { debug_log(0, "Guessing type via Milnorcode: ", v[1]);} 190 else 191 { 192 debug_log(0, "Hilbert polynomial not recognised. Milnor code = ", 193 milnorcode(f)); 194 } 195 debug_log(0, ""); 196 debug_log(0, "Computing normal form ..."); 192 197 193 198 //------------ step 1, classification according to corank(f) ------------------ 194 if(corank_f == 0) { 195 return(printresult(2, f, "A["+string(Mu)+"]", cstn, 0)); } 196 if(corank_f == 1) { 197 return(printresult(2, f, "A["+string(Mu)+"]", cstn, 0)); } 198 cstn[4] = 0; 199 if(corank_f == 2) { return(Funktion1bis(f, cstn)); } 200 if(corank_f == 3) { return(Funktion1bis(f, cstn)); } 201 return(printresult(105, f, "NoClass", cstn, -1)); 202 } 203 204 /////////////////////////////////////////////////////////////////////////////// 205 static 206 proc Funktion1bis (poly f, list cstn) 199 if(corank_f == 0) 200 { 201 return(printresult(2, f, "A["+string(Mu)+"]", cstn, 0)); 202 } 203 if(corank_f == 1) 204 { 205 return(printresult(2, f, "A["+string(Mu)+"]", cstn, 0)); 206 } 207 cstn[4] = 0; 208 if(corank_f == 2) { return(Funktion1bis(f, cstn)); } 209 if(corank_f == 3) { return(Funktion1bis(f, cstn)); } 210 return(printresult(105, f, "NoClass", cstn, -1)); 211 } 212 213 /////////////////////////////////////////////////////////////////////////////// 214 static proc Funktion1bis (poly f, list cstn) 207 215 { 208 216 //---------------------------- initialisation --------------------------------- … … 270 278 271 279 /////////////////////////////////////////////////////////////////////////////// 272 static 273 proc Funktion3 (poly f, list cstn) 280 static proc Funktion3 (poly f, list cstn) 274 281 { 275 282 //---------------------------- initialisation --------------------------------- … … 301 308 302 309 /////////////////////////////////////////////////////////////////////////////// 303 static 304 proc Funktion6 (poly f, list cstn) 310 static proc Funktion6 (poly f, list cstn) 305 311 { // Arnold's steps 6-12 306 312 //---------------------------- initialisation --------------------------------- … … 380 386 381 387 /////////////////////////////////////////////////////////////////////////////// 382 static 383 proc Funktion13 (poly f, list cstn) 388 static proc Funktion13 (poly f, list cstn) 384 389 { 385 390 //---------------------------- initialisation --------------------------------- … … 418 423 419 424 /////////////////////////////////////////////////////////////////////////////// 420 static 421 proc Funktion17 (poly f, list cstn) 425 static proc Funktion17 (poly f, list cstn) 422 426 { // Analog zu Fumktion 6, Kombination 17-24 423 427 //---------------------------- initialisation --------------------------------- … … 485 489 486 490 /////////////////////////////////////////////////////////////////////////////// 487 static 488 proc Funktion25 (poly f, list cstn) 491 static proc Funktion25 (poly f, list cstn) 489 492 { // Analog zu Fumktion 6, Kombination 25-46 490 493 //---------------------------- initialisation --------------------------------- … … 594 597 595 598 /////////////////////////////////////////////////////////////////////////////// 596 static 597 proc Funktion40 (poly f, list cstn, int k) 599 static proc Funktion40 (poly f, list cstn, int k) 598 600 { 599 601 //---------------------------- initialisation --------------------------------- … … 652 654 653 655 /////////////////////////////////////////////////////////////////////////////// 654 static 655 proc Funktion50 (poly f, list cstn) 656 static proc Funktion50 (poly f, list cstn) 656 657 { 657 658 //---------------------------- initialisation --------------------------------- … … 705 706 706 707 /////////////////////////////////////////////////////////////////////////////// 707 static 708 proc Funktion58 (poly fin, list cstn) 708 static proc Funktion58 (poly fin, list cstn) 709 709 { 710 710 //---------------------------- initialisation --------------------------------- … … 855 855 856 856 /////////////////////////////////////////////////////////////////////////////// 857 static 858 proc Funktion59 (poly f, list cstn) 857 static proc Funktion59 (poly f, list cstn) 859 858 { 860 859 //---------------------------- initialisation --------------------------------- … … 933 932 934 933 /////////////////////////////////////////////////////////////////////////////// 935 static 936 proc Funktion66 (poly f, list cstn) 934 static proc Funktion66 (poly f, list cstn) 937 935 { 938 936 //---------------------------- initialisation --------------------------------- … … 963 961 964 962 /////////////////////////////////////////////////////////////////////////////// 965 static 966 proc Funktion82 (poly f, list cstn) 963 static proc Funktion82 (poly f, list cstn) 967 964 { 968 965 //---------------------------- initialisation --------------------------------- … … 1058 1055 1059 1056 /////////////////////////////////////////////////////////////////////////////// 1060 static 1061 proc Isomorphie_s82_z (poly f, poly fk, int p) 1057 static proc Isomorphie_s82_z (poly f, poly fk, int p) 1062 1058 { 1063 1059 //---------------------------- initialisation --------------------------------- … … 1086 1082 1087 1083 /////////////////////////////////////////////////////////////////////////////// 1088 static 1089 proc Isomorphie_s82_x (poly f, poly fk, int p) 1084 static proc Isomorphie_s82_x (poly f, poly fk, int p) 1090 1085 { 1091 1086 //---------------------------- initialisation --------------------------------- … … 1115 1110 1116 1111 /////////////////////////////////////////////////////////////////////////////// 1117 static 1118 proc Funktion83 (poly f, list cstn) 1112 static proc Funktion83 (poly f, list cstn) 1119 1113 { 1120 1114 //---------------------------- initialisation --------------------------------- … … 1202 1196 1203 1197 /////////////////////////////////////////////////////////////////////////////// 1204 static 1205 proc Funktion97 (poly f, list cstn) 1198 static proc Funktion97 (poly f, list cstn) 1206 1199 { 1207 1200 //---------------------------- initialisation --------------------------------- … … 1319 1312 1320 1313 /////////////////////////////////////////////////////////////////////////////// 1321 static 1322 proc Isomorphie_s17 (poly f, poly fk, int k, int ct, list #) 1314 static proc Isomorphie_s17 (poly f, poly fk, int k, int ct, list #) 1323 1315 { 1324 1316 //---------------------------- initialisation --------------------------------- … … 1439 1431 1440 1432 /////////////////////////////////////////////////////////////////////////////// 1441 static 1442 proc printresult (int step, poly f, string typ, list cstn, int m) 1433 static proc printresult (int step, poly f, string typ, list cstn, int m) 1443 1434 { 1444 1435 //---------------------------- initialisation --------------------------------- … … 1448 1439 corank, Mu, K = cstn[1..3]; 1449 1440 debug_log(0," Arnold step number "+string(step)); 1450 if( @DeBug >= 0 ) { 1441 if( @DeBug >= 0 ) 1442 { 1451 1443 "The singularity"; 1452 1444 " "+Show(jet(f, K))+""; 1453 if( typ != "error!" && typ != "NoClass" ) { 1445 if( typ != "error!" && typ != "NoClass" ) 1446 { 1454 1447 "is R-equivalent to "+typ+"."; 1455 1448 } 1456 if ( typ == "NoClass" ) { 1449 if ( typ == "NoClass" ) 1450 { 1457 1451 "is not in Arnolds list."; 1458 1452 } … … 1466 1460 1467 1461 /////////////////////////////////////////////////////////////////////////////// 1468 static 1469 proc Funktion47 (poly f, list cstn) 1470 { 1471 int corank = cstn[1]; 1472 int Mu = cstn[2]; 1473 int K = cstn[3]; 1474 string s = "The Singularity ";+Show(jet(f, K), corank, K); 1475 string tp=""; 1476 // return(printresult(47, f, tp, cstn, -1)); 1477 1478 s = s +" has 4-jet equal to zero. (F47), mu="+string(Mu); 1479 1480 s; // +" ("+SG_Typ+")"; 1481 return(Show(f), tp, corank); 1482 } 1483 1484 /////////////////////////////////////////////////////////////////////////////// 1485 static 1486 proc Funktion91 (poly f, list cstn, int k) 1487 { 1488 string tp = "U*[k,0]"; 1489 return(printresult(91, f, tp, cstn, -1)); 1490 } 1491 1492 /////////////////////////////////////////////////////////////////////////////// 1493 static 1494 proc Funktion92 (poly f, list cstn, int k) 1495 { 1496 string tp = "UP[k]"; 1497 return(printresult(92, f, tp, cstn, -1)); 1498 } 1499 1500 /////////////////////////////////////////////////////////////////////////////// 1501 static 1502 proc Funktion93 (poly f, list cstn, int k) 1503 { 1504 string tp = "UQ[k]"; 1505 return(printresult(93, f, tp, cstn, -1)); 1506 } 1507 1508 /////////////////////////////////////////////////////////////////////////////// 1509 static 1510 proc Funktion94 (poly f, list cstn, int k) 1511 { 1512 string tp = "UR[k]"; 1513 return(printresult(94, f, tp, cstn, -1)); 1514 } 1515 1516 /////////////////////////////////////////////////////////////////////////////// 1517 static 1518 proc Funktion95 (poly f, list cstn, int k) 1519 { 1520 string tp = "US[k]"; 1521 return(printresult(95, f, tp, cstn, -1)); 1522 } 1523 1524 /////////////////////////////////////////////////////////////////////////////// 1525 static 1526 proc Funktion96 (poly f, list cstn, int k) 1527 { 1528 string tp = "UT[k]"; 1529 return(printresult(96, f, tp, cstn, -1)); 1462 static proc Funktion47 (poly f, list cstn) 1463 { 1464 int corank = cstn[1]; 1465 int Mu = cstn[2]; 1466 int K = cstn[3]; 1467 string s = "The Singularity ";+Show(jet(f, K), corank, K); 1468 string tp=""; 1469 // return(printresult(47, f, tp, cstn, -1)); 1470 1471 s = s +" has 4-jet equal to zero. (F47), mu="+string(Mu); 1472 1473 s; // +" ("+SG_Typ+")"; 1474 return(Show(f), tp, corank); 1475 } 1476 1477 /////////////////////////////////////////////////////////////////////////////// 1478 static proc Funktion91 (poly f, list cstn, int k) 1479 { 1480 string tp = "U*[k,0]"; 1481 return(printresult(91, f, tp, cstn, -1)); 1482 } 1483 1484 /////////////////////////////////////////////////////////////////////////////// 1485 static proc Funktion92 (poly f, list cstn, int k) 1486 { 1487 string tp = "UP[k]"; 1488 return(printresult(92, f, tp, cstn, -1)); 1489 } 1490 1491 /////////////////////////////////////////////////////////////////////////////// 1492 static proc Funktion93 (poly f, list cstn, int k) 1493 { 1494 string tp = "UQ[k]"; 1495 return(printresult(93, f, tp, cstn, -1)); 1496 } 1497 1498 /////////////////////////////////////////////////////////////////////////////// 1499 static proc Funktion94 (poly f, list cstn, int k) 1500 { 1501 string tp = "UR[k]"; 1502 return(printresult(94, f, tp, cstn, -1)); 1503 } 1504 1505 /////////////////////////////////////////////////////////////////////////////// 1506 static proc Funktion95 (poly f, list cstn, int k) 1507 { 1508 string tp = "US[k]"; 1509 return(printresult(95, f, tp, cstn, -1)); 1510 } 1511 1512 /////////////////////////////////////////////////////////////////////////////// 1513 static proc Funktion96 (poly f, list cstn, int k) 1514 { 1515 string tp = "UT[k]"; 1516 return(printresult(96, f, tp, cstn, -1)); 1530 1517 } 1531 1518 … … 1575 1562 1576 1563 /////////////////////////////////////////////////////////////////////////////// 1577 static 1578 proc Coeffs (list #) 1564 static proc Coeffs (list #) 1579 1565 { 1580 1566 matrix m=matrix(coeffs(#[1],#[2]), deg(#[1])+1, 1); … … 1583 1569 1584 1570 /////////////////////////////////////////////////////////////////////////////// 1585 static 1586 proc Morse(poly f, int K, int corank, int ShowPhi) 1587 { 1588 //---------------------------- initialisation --------------------------------- 1589 poly fc, f2, a, P, Beta, fi; 1590 ideal Jfx, B; 1591 int n, i, j, k, Rang, Done; 1592 matrix Mat; 1593 map Id, Psi, Phi, PhiG; 1594 intvec Abb, RFlg; 1595 list v; 1596 1597 fi = f; 1598 n = nvars(basering); 1599 init_debug(); 1600 1601 def ring_top=basering; 1602 1603 debug_log(3, "Spalte folgendes Polynom mit Bestimmtheit: ", string(K)); 1604 debug_log(3, Show(fi)); 1605 1606 for( j=1; j<=n ; j++) { Abb[j] = 0; } 1607 1608 RFlg = GetRf(fi, n); 1609 debug_log(2, "Reihenfolge fuer Vertauschungen:", RFlg ); 1610 PhiG=ring_top,maxideal(1); 1571 static proc Morse(poly f, int K, int corank, int ShowPhi) 1572 { 1573 //---------------------------- initialisation --------------------------------- 1574 poly fc, f2, a, P, Beta, fi; 1575 ideal Jfx, B; 1576 int n, i, j, k, Rang, Done; 1577 matrix Mat; 1578 map Id, Psi, Phi, PhiG; 1579 intvec Abb, RFlg; 1580 list v; 1581 1582 fi = f; 1583 n = nvars(basering); 1584 init_debug(); 1585 1586 def ring_top=basering; 1587 1588 debug_log(3, "Spalte folgendes Polynom mit Bestimmtheit: ", string(K)); 1589 debug_log(3, Show(fi)); 1590 1591 for( j=1; j<=n ; j++) { Abb[j] = 0; } 1592 1593 RFlg = GetRf(fi, n); 1594 debug_log(2, "Reihenfolge fuer Vertauschungen:", RFlg ); 1595 PhiG=ring_top,maxideal(1); 1611 1596 1612 1597 //----------------- find quadratic term, if there is only one ----------------- 1613 B = maxideal(1); 1614 if(corank == (n-1)) { 1615 Done = 0; 1616 f2 = jet(fi, 2); 1617 j = 1; 1618 Jfx = f2, diff(f2, x(j)); 1619 while(j<=n && (diff(f2, x(j))==0)) { 1620 j = j+1; 1621 Jfx = f2, diff(f2, x(j)); 1622 } 1623 Mat = matrix(syz(Jfx)); 1624 Beta = 2*Mat[2,1]/Mat[1,1]; 1625 for( j=1; j<=n ; j=j+1) { 1626 f2 = Coeff(Beta, x(RFlg[j]), x(RFlg[j])); 1627 if(f2!=0) { 1628 k = RFlg[j]; 1598 B = maxideal(1); 1599 if(corank == (n-1)) 1600 { 1601 Done = 0; 1602 f2 = jet(fi, 2); 1603 j = 1; 1604 Jfx = f2, diff(f2, x(j)); 1605 while(j<=n && (diff(f2, x(j))==0)) 1606 { 1607 j++; 1608 Jfx = f2, diff(f2, x(j)); 1609 } 1610 Mat = matrix(syz(Jfx)); 1611 Beta = 2*Mat[2,1]/Mat[1,1]; 1612 for( j=1; j<=n ; j++) 1613 { 1614 f2 = Coeff(Beta, x(RFlg[j]), x(RFlg[j])); 1615 if(f2!=0) 1616 { 1617 k = RFlg[j]; 1618 break; 1619 } 1620 } 1621 for( j=1; j<=n ; j=j+1) 1622 { 1623 f2 = Coeff(Beta, x(j), x(j)); 1624 if(j == k) { B[rvar(x(j))] = (2*f2*x(j)-Beta) / number(f2); } 1625 } 1626 Phi =ring_top,B; 1627 fi = Phi(fi); 1628 PhiG = Phi(PhiG); 1629 } 1630 if( ShowPhi > 1) { PhiG; } 1631 1632 //------------------------ compute spliting lemma ----------------------------- 1633 fc = fi; 1634 i = 1; // Index fuer Variablen wird bearbeitet 1635 while( i <= n) 1636 { 1637 Phi=ring_top,maxideal(1); 1638 debug_log(6, "Pruefe Variable x(" +string(RFlg[i]) + ")"); 1639 debug_log(6, "--------------------"); 1640 j = i + 1; // setze j fuer evtle Verschiebung 1641 f2 = jet(fc,2); 1642 debug_log(6, "Rechne 2-Jet =" , string(f2)); 1643 if( (f2 - subst(f2, x(RFlg[i]), 0)) == 0 ) { Abb[RFlg[i]] = 1; } 1644 if( (f2 - subst(f2, x(RFlg[i]), 0)) != 0 ) 1645 { 1646 while( (j<=n) || (i==n) ) 1647 { 1648 debug_log(6, "Pruefe 2-Jet mit Wert : " + string(jet(fc,2))); 1649 a = Coeff(jet(fc,2), x(RFlg[i]), x(RFlg[i])^2); 1650 debug_log(6,"Koeffizient von x(" + string(RFlg[i]) + ")^2 ist:", a); 1651 if( (a != 0) || (i==n) ) 1652 { 1653 debug_log(6, "BREAK!!!!!!!!!!!!!!"); 1629 1654 break; 1630 1655 } 1631 } 1632 for( j=1; j<=n ; j=j+1) { 1633 f2 = Coeff(Beta, x(j), x(j)); 1634 if(j == k) { B[rvar(x(j))] = (2*f2*x(j)-Beta) / number(f2); } 1635 } 1636 Phi =ring_top,B; 1637 fi = Phi(fi); 1656 debug_log(6,"Verschiebe evtl Variable x(",string(RFlg[j]),") um x(", 1657 string(RFlg[i]), ")"); 1658 B = maxideal(1); 1659 for( k=1; k<=n ; k=k+1) 1660 { 1661 if(k==RFlg[j]) { B[rvar(x(k))] = x(k) + x(RFlg[i]); } 1662 } 1663 Phi = ring_top,B; 1664 fc = Phi(fi); 1665 j++; 1666 } // Ende while( (j<=n) || (i==n) ) 1667 1668 debug_log(6, "Moegliche Verschiebung fertig!"); 1638 1669 PhiG = Phi(PhiG); 1639 } 1640 if( ShowPhi > 1) { PhiG; } 1641 1642 //------------------------ compute spliting lemma ----------------------------- 1643 fc = fi; 1644 i = 1; // Index fuer Variablen wird bearbeitet 1645 while( i <= n) { 1646 Phi=ring_top,maxideal(1); 1647 debug_log(6, "Pruefe Variable x(" +string(RFlg[i]) + ")"); 1648 debug_log(6, "--------------------"); 1649 j = i + 1; // setze j fuer evtle Verschiebung 1650 f2 = jet(fc,2); 1651 debug_log(6, "Rechne 2-Jet =" , string(f2)); 1652 if( (f2 - subst(f2, x(RFlg[i]), 0)) == 0 ) { Abb[RFlg[i]] = 1; } 1653 if( (f2 - subst(f2, x(RFlg[i]), 0)) != 0 ) { 1654 while( (j<=n) || (i==n) ) { 1655 debug_log(6, "Pruefe 2-Jet mit Wert : " + string(jet(fc,2))); 1656 a = Coeff(jet(fc,2), x(RFlg[i]), x(RFlg[i])^2); 1657 debug_log(6,"Koeffizient von x(" + string(RFlg[i]) + ")^2 ist:", a); 1658 if( (a != 0) || (i==n) ) { 1659 debug_log(6, "BREAK!!!!!!!!!!!!!!"); 1660 break; 1670 if( ShowPhi > 1) { "NachVersch.:"; Phi; } 1671 1672 if( (j<=n) || (i==n)) 1673 { 1674 P = Coeff(fc, x(RFlg[i]), x(RFlg[i])); 1675 debug_log(6, "Koeffizient von x("+string(RFlg[i])+") ist: ", 1676 string(P)); 1677 if(P != 0) 1678 { 1679 debug_log(6, "1 Koeffizient von x("+string(RFlg[i])+") ist: ", 1680 string(P)); 1681 debug_log(6, "a=" + string(a)); 1682 P = P / number (2 * a); 1683 debug_log(6, "2 Koeffizient von x("+string(RFlg[i])+") ist: ", 1684 string(P)); 1685 B = maxideal(1); 1686 for( k=1; k<=n ; k=k+1) {if(k==RFlg[i]) {B[rvar(x(k))]=x(k)-P;}} 1687 Phi =ring_top,B; 1688 debug_log(6, "Quadratische-Ergaenzung durch:", Phi); 1689 fi = Phi(fc); 1690 PhiG = Phi(PhiG); 1691 fc = jet(fi,K); 1692 P = Coeff(fc, x(RFlg[i]), x(RFlg[i])); 1693 if( P != 0) 1694 { 1695 fi = fc; 1696 continue; 1661 1697 } 1662 debug_log(6,"Verschiebe evtl Variable x(",string(RFlg[j]),") um x(", 1663 string(RFlg[i]), ")"); 1664 B = maxideal(1); 1665 for( k=1; k<=n ; k=k+1) { 1666 if(k==RFlg[j]) { B[rvar(x(k))] = x(k) + x(RFlg[i]); } 1667 } 1668 Phi = ring_top,B; 1669 fc = Phi(fi); 1670 j = j + 1; 1671 } // Ende while( (j<=n) || (i==n) ) 1672 1673 debug_log(6, "Moegliche Verschiebung fertig!"); 1674 PhiG = Phi(PhiG); 1675 if( ShowPhi > 1) { "NachVersch.:"; Phi; } 1676 1677 if( (j<=n) || (i==n)) { 1678 P = Coeff(fc, x(RFlg[i]), x(RFlg[i])); 1679 debug_log(6, "Koeffizient von x("+string(RFlg[i])+") ist: ", 1680 string(P)); 1681 if(P != 0) { 1682 debug_log(6, "1 Koeffizient von x("+string(RFlg[i])+") ist: ", 1683 string(P)); 1684 debug_log(6, "a=" + string(a)); 1685 P = P / number (2 * a); 1686 debug_log(6, "2 Koeffizient von x("+string(RFlg[i])+") ist: ", 1687 string(P)); 1688 B = maxideal(1); 1689 for( k=1; k<=n ; k=k+1) {if(k==RFlg[i]) {B[rvar(x(k))]=x(k)-P;}} 1690 Phi =ring_top,B; 1691 debug_log(6, "Quadratische-Ergaenzung durch:", Phi); 1692 fi = Phi(fc); 1693 PhiG = Phi(PhiG); 1694 fc = jet(fi,K); 1695 P = Coeff(fc, x(RFlg[i]), x(RFlg[i])); 1696 if( P != 0) { 1697 fi = fc; 1698 continue; 1699 } 1700 } // Ende if(P != 0) 1701 // Fertig mit Quadratischer-Ergaenzung 1702 } // Ende if( (j<=n) || (i==n)) 1703 } // Ende if( (f2 - subst(f2, x(RFlg[i]), 0)) != 0 ) 1704 1705 fi = fc; 1706 i = i + 1; 1707 debug_log(6, "++++++++++++++++++++++++++++++++++++++++++++++++++++++++"); 1708 } 1709 debug_log(6, "Ende ---------------------------------------------------"); 1698 } // Ende if(P != 0) 1699 // Fertig mit Quadratischer-Ergaenzung 1700 } // Ende if( (j<=n) || (i==n)) 1701 } // Ende if( (f2 - subst(f2, x(RFlg[i]), 0)) != 0 ) 1702 1703 fi = fc; 1704 i++; 1705 debug_log(6, "++++++++++++++++++++++++++++++++++++++++++++++++++++++++"); 1706 } 1707 debug_log(6, "Ende ---------------------------------------------------"); 1710 1708 1711 1709 //--------------------------- collect results --------------------------------- 1712 if( ShowPhi > 0 ) {1713 "Abbildung innerhalb des Morse-Lemmas:";1714 PhiG;1715 "Vergleich:";1716 "PhiG(f)= " + Show(jet(PhiG(f), K));1717 "fi = " + Show(fi);1718 }1719 1720 Rang = 0; 1721 B = maxideal(1);1722 for( i=1; i<=n ; i++) { if(Abb[i] != 1) { Rang ++; B[rvar(x(i))] = 0; } }1723 Phi = ring_top,B;1724 PhiG = Phi(PhiG);1725 fi = Phi(fi);1726 v = fi, PhiG;1727 debug_log(2, "rank determined with Morse rg=", Rang);1728 debug_log(1, "Rest singularity f=",Show(fi));1729 return(v);1730 } 1731 1732 /////////////////////////////////////////////////////////////////////////////// 1733 static 1734 proc Coeff(poly f, list #)1710 if( ShowPhi > 0 ) 1711 { 1712 "Abbildung innerhalb des Morse-Lemmas:"; 1713 PhiG; 1714 "Vergleich:"; 1715 "PhiG(f)= " + Show(jet(PhiG(f), K)); 1716 "fi = " + Show(fi); 1717 } 1718 1719 Rang = 0; 1720 B = maxideal(1); 1721 for( i=1; i<=n ; i++) { if(Abb[i] != 1) { Rang ++; B[rvar(x(i))] = 0; } } 1722 Phi = ring_top,B; 1723 PhiG = Phi(PhiG); 1724 fi = Phi(fi); 1725 v = fi, PhiG; 1726 debug_log(2, "rank determined with Morse rg=", Rang); 1727 debug_log(1, "Rest singularity f=",Show(fi)); 1728 return(v); 1729 } 1730 1731 /////////////////////////////////////////////////////////////////////////////// 1732 static proc Coeff(poly f, list #) 1735 1733 { 1736 1734 //---------------------------- initialisation --------------------------------- … … 1755 1753 1756 1754 /////////////////////////////////////////////////////////////////////////////// 1757 static 1758 proc ReOrder(poly f) 1755 static proc ReOrder(poly f) 1759 1756 { 1760 1757 //---------------------------- initialisation --------------------------------- … … 1906 1903 1907 1904 /////////////////////////////////////////////////////////////////////////////// 1908 static 1909 proc Cubic (poly f) 1905 static proc Cubic (poly f) 1910 1906 { 1911 1907 //---------------------------- initialisation --------------------------------- … … 1951 1947 1952 1948 /////////////////////////////////////////////////////////////////////////////// 1953 static 1954 proc parity (int e) 1949 static proc parity (int e) 1955 1950 "USAGE: parity()" 1956 1951 { … … 1961 1956 1962 1957 /////////////////////////////////////////////////////////////////////////////// 1963 static 1964 proc HKclass (intvec sg) 1958 static proc HKclass (intvec sg) 1965 1959 { 1966 1960 //---------------------------- initialisation --------------------------------- … … 1982 1976 1983 1977 /////////////////////////////////////////////////////////////////////////////// 1984 static 1985 proc HKclass3 (intvec sg, string SG_Typ, int cnt) 1978 static proc HKclass3 (intvec sg, string SG_Typ, int cnt) 1986 1979 { 1987 1980 list v; … … 1993 1986 1994 1987 /////////////////////////////////////////////////////////////////////////////// 1995 static 1996 proc HKclass3_teil_1 (intvec sg, string SG_Typ, int cnt) 1988 static proc HKclass3_teil_1 (intvec sg, string SG_Typ, int cnt) 1997 1989 { 1998 1990 int k, r, s; … … 2030 2022 2031 2023 /////////////////////////////////////////////////////////////////////////////// 2032 static 2033 proc HKclass5 (intvec sg, string SG_Typ, int cnt) 2024 static proc HKclass5 (intvec sg, string SG_Typ, int cnt) 2034 2025 { 2035 2026 list v; … … 2042 2033 2043 2034 /////////////////////////////////////////////////////////////////////////////// 2044 static 2045 proc HKclass5_teil_1 (intvec sg, string SG_Typ, int cnt) 2035 static proc HKclass5_teil_1 (intvec sg, string SG_Typ, int cnt) 2046 2036 { 2047 2037 int k, r, s; … … 2144 2134 2145 2135 /////////////////////////////////////////////////////////////////////////////// 2146 static 2147 proc HKclass5_teil_2 (intvec sg, string SG_Typ, int cnt) 2136 static proc HKclass5_teil_2 (intvec sg, string SG_Typ, int cnt) 2148 2137 { 2149 2138 int k, r, s; … … 2223 2212 2224 2213 /////////////////////////////////////////////////////////////////////////////// 2225 static 2226 proc HKclass7 (intvec sg, string SG_Typ, int cnt) 2214 static proc HKclass7 (intvec sg, string SG_Typ, int cnt) 2227 2215 { 2228 2216 list v; … … 2234 2222 2235 2223 /////////////////////////////////////////////////////////////////////////////// 2236 static 2237 proc HKclass7_teil_1 (intvec sg, string SG_Typ, int cnt) 2224 static proc HKclass7_teil_1 (intvec sg, string SG_Typ, int cnt) 2238 2225 { 2239 2226 int k, r, s; … … 2346 2333 2347 2334 /////////////////////////////////////////////////////////////////////////////// 2348 static 2349 proc Singularitaet (string typ,int k,int r,int s,poly a,poly b,poly c,poly d) 2335 static proc Singularitaet (string typ,int k,int r,int s,poly a,poly b,poly c,poly d) 2350 2336 { 2351 2337 list v; … … 2560 2546 } 2561 2547 /////////////////////////////////////////////////////////////////////////////// 2562 static 2563 proc Faktorisiere(poly f, poly fk, int pt, int k, intvec RFlg) 2548 static proc Faktorisiere(poly f, poly fk, int pt, int k, intvec RFlg) 2564 2549 { 2565 2550 //---------------------------- initialisation --------------------------------- … … 2612 2597 2613 2598 /////////////////////////////////////////////////////////////////////////////// 2614 static 2615 proc Teile(poly f, poly fk) 2599 static proc Teile(poly f, poly fk) 2616 2600 { 2617 2601 ideal Jfsyz = f, fk; … … 2623 2607 2624 2608 /////////////////////////////////////////////////////////////////////////////// 2625 static 2626 proc GetRf (poly fi, int n) 2609 static proc GetRf (poly fi, int n) 2627 2610 "USAGE: GetRf();" 2628 2611 { … … 2652 2635 2653 2636 /////////////////////////////////////////////////////////////////////////////// 2654 static 2655 proc Show(poly g) 2637 static proc Show(poly g) 2656 2638 { 2657 2639 string s; … … 2666 2648 2667 2649 /////////////////////////////////////////////////////////////////////////////// 2668 static 2669 proc checkring 2650 static proc checkring 2670 2651 { 2671 2652 int CH = char(basering); … … 2679 2660 2680 2661 /////////////////////////////////////////////////////////////////////////////// 2681 static 2682 proc DecodeNormalFormString (string S_in) 2662 static proc DecodeNormalFormString (string S_in) 2683 2663 "USAGE: DecodeNormalFormString" 2684 2664 {
Note: See TracChangeset
for help on using the changeset viewer.
