Changeset 4644812 in git
 Timestamp:
 Oct 2, 2008, 10:14:35 AM (15 years ago)
 Branches:
 (u'jengelhdatetime', 'ceac47cbc86fe4a15902392bdbb9bd2ae0ea02c6')(u'spielwiese', '0604212ebb110535022efecad887940825b97c3f')
 Children:
 227d1ec79ffb8506afb0ebaf6d26672e4dcdd560
 Parents:
 e40f77ae12c0d4b4f8155bd7ecbcfb7139652262
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Singular/LIB/freegb.lib
re40f77 r4644812 1 1 ////////////////////////////////////////////////////////////////////////////// 2 version="$Id: freegb.lib,v 1.1 0 20080807 18:08:37 levandovExp $";2 version="$Id: freegb.lib,v 1.11 20081002 08:14:35 Singular Exp $"; 3 3 category="Noncommutative"; 4 4 info=" … … 56 56 for (k=2; k<=sv; k++) 57 57 { 58 58 sp = sp + string(v[k])+"("+string(k1+s)+")*"; 59 59 } 60 60 sp = sp + string(v[1])+";"; // coef; … … 242 242 if (q==0) 243 243 { 244 245 246 247 248 249 250 244 q = find(vv,string(p)); 245 if (q==0) 246 { 247 err = "error in find for string "+vv; 248 dbprint(ppl,err); 249 return("_"); 250 } 251 251 } 252 252 // q>0 … … 357 357 { 358 358 q = leadmonom(p); 359 360 359 } 361 360 } … … 373 372 374 373 proc mono2word(poly p, int d) 375 { 374 { 376 375 } 377 376 … … 469 468 for (j=1; j<=nb; j++) 470 469 { 471 470 LR[3][i*nb+j] = LR[3][j]; 472 471 } 473 472 } … … 505 504 v = M[j]; 506 505 sv = size(v); 507 // 506 // "sv:";sv; 508 507 sp = "@@p = @@p + "; 509 508 for (k=2; k<=sv; k++) 510 509 { 511 510 sp = sp + string(v[k])+"("+string(k1)+")*"; 512 511 } 513 512 sp = sp + string(v[1])+";"; // coef; … … 527 526 dbprint(ppl,"computing GB"); 528 527 ideal J = system("freegb",I,d,nvars(save)); 529 // ideal J = slimgb(I); 528 // ideal J = slimgb(I); 530 529 dbprint(ppl,J); 531 530 // 4. skip shifted elts … … 564 563 for(k=1; k<=sx; k++) 565 564 { 566 567 568 569 570 //return(0);571 572 573 574 575 565 if ( x[k] >= 2 ) 566 { 567 err = "skip: the value x[k] is " + string(x[k]); 568 dbprint(ppl,err); 569 // return(0); 570 K[i] = 0; 571 p = 0; 572 q = 0; 573 break; 574 } 576 575 } 577 576 p = p  q; … … 599 598 for(k=1; k<=sx; k++) 600 599 { 601 602 603 604 605 //printf("a: %s, b: %s",a,b);606 607 608 609 610 611 612 613 614 // 615 // 616 // 617 // 618 // 600 if (x[k] ==1) 601 { 602 a = k / s; // block number=a+1, a!=0 603 b = k % s; // remainder 604 // printf("a: %s, b: %s",a,b); 605 if (b == 0) 606 { 607 // that is it's the last var in the block 608 b = s; 609 a = a1; 610 } 611 V = V + var(b)*gen(a+2); 612 } 613 // else 614 // { 615 // printf("error: the value x[k] is %s", x[k]); 616 // return(0); 617 // } 619 618 } 620 619 err = "V: " + string(V); … … 722 721 for (j=1; j<=nb; j++) 723 722 { 724 723 LR[3][i*nb+j] = LR[3][j]; 725 724 } 726 725 } … … 757 756 for (j=1; j<=sm; j++) 758 757 { 759 760 761 762 //"sv:";sv;763 764 765 766 767 768 769 770 771 758 //vectors, e.g. free monomials 759 v = M[j]; 760 sv = size(v); 761 // "sv:";sv; 762 sp = "@@p = @@p + "; 763 for (k=2; k<=sv; k++) 764 { 765 sp = sp + string(v[k])+"("+string(k2+i)+")*"; 766 } 767 sp = sp + string(v[1])+";"; // coef; 768 setring @R; 769 execute(sp); 770 setring save; 772 771 } 773 772 setring @R; … … 869 868 for (j=1; j<=nb; j++) 870 869 { 871 870 LR[3][i*nb+j] = LR[3][j]; 872 871 } 873 872 } … … 1125 1124 for (j=1; j<=nb; j++) 1126 1125 { 1127 1126 LR[3][i*nb+j] = LR[3][j]; 1128 1127 } 1129 1128 } … … 1160 1159 for (j=1; j<=sm; j++) 1161 1160 { 1162 1163 1164 1165 //"sv:";sv;1166 1167 1168 1169 1170 1171 1172 1173 1174 1161 //vectors, e.g. free monomials 1162 v = M[j]; 1163 sv = size(v); 1164 // "sv:";sv; 1165 sp = "@@p = @@p + "; 1166 for (k=2; k<=sv; k++) 1167 { 1168 sp = sp + string(v[k])+"("+string(k1+i)+")*"; 1169 } 1170 sp = sp + string(v[1])+";"; // coef; 1171 setring @R; 1172 execute(sp); 1173 setring save; 1175 1174 } 1176 1175 setring @R; … … 1223 1222 for(k=1; k<=sx; k++) 1224 1223 { 1225 1226 1227 1228 1229 //return(0);1230 1231 1232 1233 1234 1224 if ( x[k] >= 2 ) 1225 { 1226 err = "skip: the value x[k] is " + string(x[k]); 1227 dbprint(ppl,err); 1228 // return(0); 1229 K[i] = 0; 1230 p = 0; 1231 q = 0; 1232 break; 1233 } 1235 1234 } 1236 1235 p = p  q; … … 1258 1257 for(k=1; k<=sx; k++) 1259 1258 { 1260 1261 1262 1263 1264 //printf("a: %s, b: %s",a,b);1265 1266 1267 1268 1269 1270 1271 1272 1273 // 1274 // 1275 // 1276 // 1277 // 1259 if (x[k] ==1) 1260 { 1261 a = k / s; // block number=a+1, a!=0 1262 b = k % s; // remainder 1263 // printf("a: %s, b: %s",a,b); 1264 if (b == 0) 1265 { 1266 // that is it's the last var in the block 1267 b = s; 1268 a = a1; 1269 } 1270 V = V + var(b)*gen(a+2); 1271 } 1272 // else 1273 // { 1274 // printf("error: the value x[k] is %s", x[k]); 1275 // return(0); 1276 // } 1278 1277 } 1279 1278 err = "V: " + string(V); … … 1362 1361 def U = crs(L,4); 1363 1362 setring U; 1364 I = I, 1365 y(2)*h(3)+z(2)*x(3), y(3)*h(4)+z(3)*x(4), 1363 I = I, 1364 y(2)*h(3)+z(2)*x(3), y(3)*h(4)+z(3)*x(4), 1366 1365 y(2)*x(3)z(2)*h(3), y(3)*x(4)z(3)*h(4); 1367 1366 I = simplify(I,2); … … 1486 1485 */ 1487 1486 1488 /* s1,s2: 1487 /* s1,s2: 1489 1488 s1*s1 =0, s2*s2 = s1*s2*s1 1490 1489 */ … … 1492 1491 /* 1493 1492 try char 0: 1494 s1,s2: 1493 s1,s2: 1495 1494 s1*s1 =0, s2*s2 = s1*s2*s1, s(1)*s(3)== s(1)*s(1)*s(3) == 0 = 2*s(4) >def for s(4) 1496 1495 hence 2==0! only in char 2 … … 1499 1498 proc adem2mod(int n) 1500 1499 { 1501 // Adem rels modulo 2 1500 // Adem rels modulo 2 1502 1501 } 1503 1502 … … 1518 1517 return(LS); 1519 1518 } 1520 i = find(s,"",2); 1519 i = find(s,"",2); 1521 1520 // i==1 might happen if the 1st symbol coeff is negative 1522 1521 j = find(s,"+"); … … 1540 1539 j = find(s,"+"); 1541 1540 cnt++; 1542 if (j==0) 1541 if (j==0) 1543 1542 { 1544 1543 LS[cnt] = string(s); … … 1564 1563 i = find(s,"",2); 1565 1564 cnt++; 1566 if (i==0) 1565 if (i==0) 1567 1566 { 1568 1567 LS[cnt] = string(s); … … 1604 1603 { 1605 1604 // i==1> minus at leadcoef 1606 ie = find(s,"",i+1); 1605 ie = find(s,"",i+1); 1607 1606 je = find(s,"+",i+1); 1608 1607 if (je == ie) … … 1671 1670 { 1672 1671 "EXAMPLE:"; echo = 2; 1673 string a = "f1"; string b = "f2"; 1672 string a = "f1"; string b = "f2"; 1674 1673 list L = a,b,a; 1675 addplaces(L); 1674 addplaces(L); 1676 1675 } 1677 1676 … … 1692 1691 ring r = 0,(f2,f1),dp; 1693 1692 string s = "f2*f1*f1  2*f1*f2*f1+ f1*f1*f2"; 1694 sent2lplace(s); 1693 sent2lplace(s); 1695 1694 } 1696 1695 … … 1703 1702 t = s[2..size(s)]; 1704 1703 if (testnumber(t)) 1705 { 1704 { 1706 1705 //a negative number 1707 1706 } … … 1740 1739 ring r = (0,a),x,dp; 1741 1740 string s = "a^2+7*a2"; 1742 testnumber(s); 1741 testnumber(s); 1743 1742 s = "b+a"; 1744 testnumber(s); 1743 testnumber(s); 1745 1744 } 1746 1745 … … 1754 1753 string a,b,c,d,t; 1755 1754 // 1. get coeff 1756 i = find(s,"*"); 1757 if (i==0) { return(s); } 1755 i = find(s,"*"); 1756 if (i==0) { return(s); } 1758 1757 list VN; 1759 1758 c = s[1..i1]; // incl. the case like (a^2+1) … … 1767 1766 t = c[2..size(c)]; 1768 1767 if (testnumber(t)) 1769 { 1770 //a negative number 1768 { 1769 //a negative number 1771 1770 // nop here 1772 1771 } … … 1817 1816 "EXAMPLE:"; echo = 2; 1818 1817 ring r = (0,a),(f2,f1),dp; 1819 str2lplace("2*f2^2*f1^2*f2"); 1818 str2lplace("2*f2^2*f1^2*f2"); 1820 1819 str2lplace("f1*f2"); 1821 1820 str2lplace("(a^2+7a)*f1*f2"); … … 1825 1824 { 1826 1825 // makes x*x*x*x out of x^4 ., rep statys for repetitions 1827 // looks for "" problem 1826 // looks for "" problem 1828 1827 // exception: "" as coeff 1829 1828 string ex,t; … … 1877 1876 i = find(s,"^"); // first ^ 1878 1877 j = find(s,"*",i+1); // next * == end of ^ 1879 if (j==0) 1880 { 1881 ex = s[i+1..size(s)]; 1882 } 1883 else 1884 { 1885 ex = s[i+1..j1]; 1878 if (j==0) 1879 { 1880 ex = s[i+1..size(s)]; 1881 } 1882 else 1883 { 1884 ex = s[i+1..j1]; 1886 1885 } 1887 1886 execute("int @exp = " + ex + ";"); //@exp = exponent … … 1894 1893 // "varn:"; varn; 1895 1894 string pref; 1896 if (k>0) 1897 { 1898 pref = s[1..k]; // with * on the kth place 1895 if (k>0) 1896 { 1897 pref = s[1..k]; // with * on the kth place 1899 1898 } 1900 1899 // "pref:"; pref; 1901 string suf; 1900 string suf; 1902 1901 if ( (j>0) && (j+1 <= size(s)) ) 1903 1902 { … … 1927 1926 "EXAMPLE:"; echo = 2; 1928 1927 ring r = (0,a),(x,y,z,t),dp; 1929 strpower2rep("x^4"); 1930 strpower2rep("2*x^4*y^3*z*t^2"); 1931 strpower2rep("a^2*x^4"); 1928 strpower2rep("x^4"); 1929 strpower2rep("2*x^4*y^3*z*t^2"); 1930 strpower2rep("a^2*x^4"); 1932 1931 } 1933 1932 1934 1933 proc Liebr(poly a, poly b, list #) 1935 1934 { 1936 // alias ppLiebr; 1935 // alias ppLiebr; 1937 1936 //if int N is given compute [a,[...[a,b]]]] left normed bracket 1938 1937 poly q; … … 1997 1996 a = lead(a); 1998 1997 b = lead(b); 1999 int sa = deg(a); 2000 int sb = deg(b); 1998 int sa = deg(a); 1999 int sb = deg(b); 2001 2000 poly v = a*pshift(b,sa)  b*pshift(a,sb); 2002 2001 return(v); … … 2021 2020 // suppose that A is cartan matrix 2022 2021 // then Serre's relations are 2023 // (ad f_j)^{1A_{ij}} ( f_i) 2022 // (ad f_j)^{1A_{ij}} ( f_i) 2024 2023 int ppl = printlevelvoice+2; 2025 2024 int n = ncols(A); // hence n variables 2026 2025 int i,j,k,l; 2027 poly p,q; 2026 poly p,q; 2028 2027 ideal I; 2029 2028 for (i=1; i<=n; i++) … … 2039 2038 { 2040 2039 q = Liebr(var(j),var(i)); 2041 2040 // printf("first bracket: %s",q); 2042 2041 dbprint(ppl,"first bracket: ",q); 2043 2044 2042 // if (l >=2) 2043 // { 2045 2044 for (k=1; k<=l1; k++) 2046 2045 { 2047 2046 q = Liebr(var(j),q); 2048 2047 // printf("further bracket: %s",q); 2049 2048 dbprint(ppl,"further bracket:",q); 2050 2049 } 2051 2050 // } 2052 2051 } 2053 2052 if (q!=0) { I = I,q; q=0;} … … 2108 2107 for(k=1; k<=sx; k++) 2109 2108 { 2110 2111 2112 2113 2114 //return(0);2115 2116 2117 2118 2119 2109 if ( x[k] >= 2 ) 2110 { 2111 err = "skip: the value x[k] is " + string(x[k]); 2112 dbprint(ppl,err); 2113 // return(0); 2114 K[i] = 0; 2115 p = 0; 2116 q = 0; 2117 break; 2118 } 2120 2119 } 2121 2120 p = p  q; … … 2143 2142 for(k=1; k<=sx; k++) 2144 2143 { 2145 2146 2147 2148 2149 //printf("a: %s, b: %s",a,b);2150 2151 2152 2153 2154 2155 2156 2157 2144 if (x[k] ==1) 2145 { 2146 a = k / s; // block number=a+1, a!=0 2147 b = k % s; // remainder 2148 // printf("a: %s, b: %s",a,b); 2149 if (b == 0) 2150 { 2151 // that is it's the last var in the block 2152 b = s; 2153 a = a1; 2154 } 2155 V = V + var(b)*gen(a+2); 2156 } 2158 2157 } 2159 2158 err = "V: " + string(V); … … 2244 2243 i = find(s,","); 2245 2244 "i"; i; 2246 if (i==0) 2247 { 2245 if (i==0) 2246 { 2248 2247 i = find(s,";"); 2249 2248 if (i==0) … … 2279 2278 setring A; 2280 2279 string fn = "myfile"; 2281 string s1 = "z*y*y*y  3*y*z*x*y + 3*y*y*z*y  y*x*y*z,"; 2280 string s1 = "z*y*y*y  3*y*z*x*y + 3*y*y*z*y  y*x*y*z,"; 2282 2281 string s2 = "2*y*x*y*z + y*y*z*z  z*z*y*y + 2*z*y*z*y,"; 2283 2282 string s3 = "z*y*x*t  2*y*z*y*t + y*y*z*t  t*z*y*y + 2*t*y*z*y  t*x*y*z;"; … … 2321 2320 2322 2321 2323 // TODO: 2322 // TODO: 2324 2323 // multiply two letterplace polynomials, lpMult 2325 2324 // reduction/ Normalform? needs kernel stuff
Note: See TracChangeset
for help on using the changeset viewer.