Changeset 92f225 in git
 Timestamp:
 Mar 2, 2010, 9:00:24 PM (13 years ago)
 Branches:
 (u'jengelhdatetime', 'ceac47cbc86fe4a15902392bdbb9bd2ae0ea02c6')(u'spielwiese', '0604212ebb110535022efecad887940825b97c3f')
 Children:
 e64e417c78d3204d113ad1bc94fb0c850761401f
 Parents:
 920a1e8c8bf9b487a06f6ab6aabb70aeb007a7bb
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Singular/LIB/freegb.lib
r920a1e r92f225 16 16 17 17 lpMult(f,g); letterplace multiplication of letterplace polynomials 18 shiftPoly(p,i); compute the ith shift of letterplace polynomial p 19 lpPower(f,n); natural power of a letterplace polynomial 18 20 lp2lstr(K, s); convert letterplace ideal to a list of modules 19 21 lst2str(L[, n]); convert a list (of modules) into polynomials in free algebra … … 21 23 vct2str(M[, n]); convert a vector into a word in free algebra 22 24 lieBracket(a,b[, N]); compute Lie bracket abba of two letterplace polynomials 23 serreRelations(A,z); compute the ideal of Serre's relations associated to a generalized Cartan matrix A 25 serreRelations(A,z); compute the homogeneous part of Serre's relations associated to a generalized Cartan matrix A 26 fullSerreRelations(A,N,C,P,d); compute the ideal of all Serre's relations associated to a generalized Cartan matrix A 24 27 isVar(p); check whether p is a power of a single variable 25 28 ademRelations(i,j); compute the ideal of Adem relations for i<2j in char 0 … … 36 39 37 40 LIB "qhmoduli.lib"; // for Max 41 42 proc tstfreegb() 43 { 44 /* tests all procs for consistency */ 45 /* adding the new proc, add it here */ 46 example makeLetterplaceRing; 47 example freeGBasis; 48 example setLetterplaceAttributes; 49 /* secondary */ 50 example lpMult; 51 example shiftPoly; 52 example lpPower; 53 example lp2lstr; 54 example lst2str; 55 example mod2str; 56 example vct2str; 57 example lieBracket; 58 example serreRelations; 59 example fullSerreRelations; 60 example isVar; 61 example ademRelations; 62 } 38 63 39 64 proc setLetterplaceAttributes(def R, int uptodeg, int lV) … … 456 481 "USAGE: freeGBasis(L, d); L a list of modules, d an integer 457 482 RETURN: ring 458 PURPOSE: compute the twosided Groebner basis of an ideal, encoded by L in 459 the free associative algebra, up to degree d 460 NOTE: Apply @code{lst2str} to the output in order to obtain a humanreadable 461 representation 483 ASSUME: L has a special form. Namely, it is a list of modules, where 484 @* each generator of every module stands for a monomial times coefficient in free algebra. 485 @* In such a vector generator, the 1st entry is a nonzero coefficient from the ground field 486 @* and each next entry hosts a variable from the basering. 487 PURPOSE: compute the twosided Groebner basis of an ideal, encoded by L 488 @* in the free associative algebra, up to degree d 489 NOTE: Apply @code{lst2str} to the output in order to obtain a better readable presentation 462 490 EXAMPLE: example freeGBasis; shows examples 463 491 " … … 701 729 "EXAMPLE:"; echo = 2; 702 730 ring r = 0,(x,y,z),(dp(1),dp(2)); 703 module M = [1,x,y],[7,y,y],[3,x,x]; 704 module N = [1,x,y,x],[1,y,x,y]; 705 list L; L[1] = M; L[2] = N; 706 lst2str(L); 707 def U = freeGBasis(L,5); 731 module M = [1,x,y],[7,y,y],[3,x,x]; // stands for free poly xy  7yy  3xx 732 module N = [1,x,y,x],[1,y,x,y]; // stands for free poly xyx  yxy 733 list L; L[1] = M; L[2] = N; // list of modules stands for an ideal in free algebra 734 lst2str(L); // list to string conversion of input polynomials 735 def U = freeGBasis(L,5); // 5 is the degree bound 708 736 lst2str(U); 709 737 } … … 874 902 } 875 903 904 // new: uniting both mLR1 (homog) and mLR2 (nonhomog) 905 proc makeLetterplaceRing(int d, list #) 906 "USAGE: makeLetterplaceRing(d [,h]); d an integer, h an optional integer 907 RETURN: ring 908 PURPOSE: creates a ring with the ordering, used in letterplace computations 909 NOTE: if h is given an nonzero, the pure homogeneous letterplace block ordering will be used. 910 EXAMPLE: example makeLetterplaceRing; shows examples 911 " 912 { 913 int use_old_mlr = 0; 914 if ( size(#)>0 ) 915 { 916 if (( typeof(#[1]) == "int" )  ( typeof(#[1]) == "poly" ) ) 917 { 918 poly x = poly(#[1]); 919 if (x!=0) 920 { 921 use_old_mlr = 1; 922 } 923 } 924 } 925 if (use_old_mlr) 926 { 927 def @A = makeLetterplaceRing1(d); 928 } 929 else 930 { 931 def @A = makeLetterplaceRing2(d); 932 } 933 return(@A); 934 } 935 example 936 { 937 "EXAMPLE:"; echo = 2; 938 ring r = 0,(x,y,z),(dp(1),dp(2)); 939 def A = makeLetterplaceRing(2); 940 setring A; A; 941 attrib(A,"isLetterplaceRing"); 942 attrib(A,"uptodeg"); // degree bound 943 attrib(A,"lV"); // number of variables in the main block 944 setring r; def B = makeLetterplaceRing(2,1); // to compare: 945 setring B; B; 946 } 947 876 948 //proc freegbRing(int d) 877 proc makeLetterplaceRing (int d)878 "USAGE: makeLetterplaceRing (d); d an integer949 proc makeLetterplaceRing1(int d) 950 "USAGE: makeLetterplaceRing1(d); d an integer 879 951 RETURN: ring 880 PURPOSE: creates a ring with d blocks of shifted original variables 881 EXAMPLE: example makeLetterplaceRing; shows examples 952 PURPOSE: creates a ring with a special ordering, suitable for 953 @* the use of homogeneous letterplace (d blocks of shifted original variables) 954 EXAMPLE: example makeLetterplaceRing1; shows examples 882 955 " 883 956 { … … 952 1025 "EXAMPLE:"; echo = 2; 953 1026 ring r = 0,(x,y,z),(dp(1),dp(2)); 954 def A = makeLetterplaceRing(2); 1027 def A = makeLetterplaceRing1(2); 1028 setring A; 1029 A; 1030 attrib(A,"isLetterplaceRing"); 1031 attrib(A,"uptodeg"); // degree bound 1032 attrib(A,"lV"); // number of variables in the main block 1033 } 1034 1035 proc makeLetterplaceRing2(int d) 1036 "USAGE: makeLetterplaceRing2(d); d an integer 1037 RETURN: ring 1038 PURPOSE: creates a ring with a special ordering, suitable for 1039 @* the use of nonhomogeneous letterplace 1040 NOTE: the matrix for the ordering looks as follows: first row is 1,1,...,1 1041 @* then there come 'd' blocks of shifted original variables 1042 EXAMPLE: example makeLetterplaceRing2; shows examples 1043 " 1044 { 1045 // d = up to degree, will be shifted to d+1 1046 if (d<1) {"bad d"; return(0);} 1047 1048 int uptodeg = d; int lV = nvars(basering); 1049 1050 int ppl = printlevelvoice+2; 1051 string err = ""; 1052 1053 int i,j,s; 1054 def save = basering; 1055 int D = d1; 1056 list LR = ringlist(save); 1057 list L, tmp, tmp2, tmp3; 1058 L[1] = LR[1]; // ground field 1059 L[4] = LR[4]; // quotient ideal 1060 tmp = LR[2]; // varnames 1061 s = size(LR[2]); 1062 for (i=1; i<=D; i++) 1063 { 1064 for (j=1; j<=s; j++) 1065 { 1066 tmp[i*s+j] = string(tmp[j])+"("+string(i+1)+")"; 1067 } 1068 } 1069 for (i=1; i<=s; i++) 1070 { 1071 tmp[i] = string(tmp[i])+"("+string(1)+")"; 1072 } 1073 L[2] = tmp; 1074 list OrigNames = LR[2]; 1075 // ordering: one 1..1 a above 1076 // ordering: d blocks of the ord on r 1077 // try to get whether the ord on r is blockord itself 1078 // TODO: make L(2) ordering! exponent is maximally 2 1079 s = size(LR[3]); 1080 if (s==2) 1081 { 1082 // not a blockord, 1 block + module ord 1083 tmp = LR[3][s]; // module ord 1084 for (i=1; i<=d; i++) 1085 { 1086 LR[3][s1+i] = LR[3][1]; 1087 } 1088 // LR[3][s+D] = tmp; 1089 LR[3][s+1+D] = tmp; 1090 LR[3][1] = list("a",intvec(1: int(d*lV))); // degord 1091 } 1092 if (s>2) 1093 { 1094 // there are s1 blocks 1095 int nb = s1; 1096 tmp = LR[3][s]; // module ord to place at the very end 1097 tmp2 = LR[3]; tmp2 = tmp2[1..nb]; 1098 tmp3[1] = list("a",intvec(1: int(d*lV))); // degord, insert as the 1st 1099 for (i=1; i<=d; i++) 1100 { 1101 tmp3 = tmp3 + tmp2; 1102 } 1103 tmp3 = tmp3 + list(tmp); 1104 LR[3] = tmp3; 1105 // for (i=1; i<=d; i++) 1106 // { 1107 // for (j=1; j<=nb; j++) 1108 // { 1109 // // LR[3][i*nb+j+1]= LR[3][j]; 1110 // LR[3][i*nb+j+1]= tmp2[j]; 1111 // } 1112 // } 1113 // // size(LR[3]); 1114 // LR[3][(s1)*d+2] = tmp; 1115 // LR[3] = list("a",intvec(1: int(d*lV))) + LR[3]; // degord, insert as the 1st 1116 // remove everything behind nb*(D+1)+1 ? 1117 // tmp = LR[3]; 1118 // LR[3] = tmp[1..size(tmp)1]; 1119 } 1120 L[3] = LR[3]; 1121 def @R = ring(L); 1122 // setring @R; 1123 // int uptodeg = d; int lV = nvars(basering); // were defined before 1124 def @@R = setLetterplaceAttributes(@R,uptodeg,lV); 1125 return (@@R); 1126 } 1127 example 1128 { 1129 "EXAMPLE:"; echo = 2; 1130 ring r = 0,(x,y,z),(dp(1),dp(2)); 1131 def A = makeLetterplaceRing2(2); 955 1132 setring A; 956 1133 A; … … 2205 2382 */ 2206 2383 2384 proc fullSerreRelations(intmat A, ideal rNegative, ideal rCartan, ideal rPositive, int uptodeg) 2385 "USAGE: fullSerreRelations(A,N,C,P,d); A an intmat, N,C,P ideals, d an int 2386 RETURN: ring (and ideal) 2387 PURPOSE: compute the inhomogeneous Serre's relations associated to A in given variable names 2388 ASSUME: three ideals in the input are of the same sizes and contain merely variables 2389 @* which are interpreted as follows: N resp. P stand for negative resp. positive roots, 2390 @* C stand for Cartan elements. d is the degree bound for letterplace ring, which will be returned. 2391 @* The matrix A is a generalized Cartan matrix with integer entries 2392 @* The result is the ideal called 'fsRel' in the returned ring. 2393 EXAMPLE: example fullSerreRelations; shows examples 2394 " 2395 { 2396 /* SerreRels on rNeg and rPos plus Cartans etc. */ 2397 int ppl = printlevel voice+2; 2398 /* ideals must be written in variables: assume each term is of degree 1 */ 2399 int i,j,k; 2400 int N = nvars(basering); 2401 def save = basering; 2402 int comFlag = 0; 2403 /* assume: (size(rNegative) == size(rPositive)) */ 2404 /* assume: (size(rNegative) == size(rCartan)) i.e. nonsimple Cartans */ 2405 if ( (size(rNegative) != size(rPositive))  (size(rNegative) != size(rCartan)) ) 2406 { 2407 ERROR("All input ideals must be of the same size"); 2408 } 2409 2410 // if (size(rNegative) != size(rPositive)) 2411 // { 2412 // ERROR("The 1st and the 3rd input ideals must be of the same size"); 2413 // } 2414 2415 /* assume: 2*size(rNegative) + size(rCartan) >= nvars(basering) */ 2416 i = 2*size(rNegative) + size(rCartan); 2417 if (i>N) 2418 { 2419 ERROR("The total number of elements in input ideals must not exceed the dimension of the ground ring"); 2420 } 2421 if (i < N) 2422 { 2423 comFlag = Ni; // so many elements will commute 2424 "Warning: some elements will be treated as mutually commuting"; 2425 } 2426 /* extract varnames from input ideals */ 2427 intvec iNeg = varIdeal2intvec(rNegative); 2428 intvec iCartan = varIdeal2intvec(rCartan); 2429 intvec iPos = varIdeal2intvec(rPositive); 2430 /* for each vector in rNeg and rPositive, go into the corr. ring and create SerreRels */ 2431 /* rNegative: */ 2432 list L = ringlist(save); 2433 def LPsave = makeLetterplaceRing2(uptodeg); setring save; 2434 list LNEG = L; list tmp; 2435 /* L[1] field as is; L[2] vars: a subset; L[3] ordering: dp, L[4] as is */ 2436 for (i=1; i<=size(iNeg); i++) 2437 { 2438 tmp[i] = string(var(iNeg[i])); 2439 } 2440 LNEG[2] = tmp; LNEG[3] = list(list("dp",intvec(1:size(iNeg))), list("C",0)); 2441 def RNEG = ring(LNEG); setring RNEG; 2442 def RRNEG = makeLetterplaceRing2(uptodeg); 2443 setring RRNEG; 2444 ideal I = serreRelations(A,1); I = simplify(I,1+2+8); 2445 setring LPsave; 2446 ideal srNeg = imap(RRNEG,I); 2447 dbprint(ppl,"01 ideal of negative relations is ready"); 2448 dbprint(ppl1,srNeg); 2449 setring save; kill L,tmp,RRNEG,RNEG, LNEG; 2450 /* rPositive: */ 2451 list L = ringlist(save); 2452 list LPOS = L; list tmp; 2453 /* L[1] field as is; L[2] vars: a subset; L[3] ordering: dp, L[4] as is */ 2454 for (i=1; i<=size(iPos); i++) 2455 { 2456 tmp[i] = string(var(iPos[i])); 2457 } 2458 LPOS[2] = tmp; LPOS[3] = list(list("dp",intvec(1:size(iPos))), list("C",0)); 2459 def RPOS = ring(LPOS); setring RPOS; 2460 def RRPOS = makeLetterplaceRing2(uptodeg); 2461 setring RRPOS; 2462 ideal I = serreRelations(A,1); I = simplify(I,1+2+8); 2463 setring LPsave; 2464 ideal srPos = imap(RRPOS,I); 2465 dbprint(ppl,"02 ideal of positive relations is ready"); 2466 dbprint(ppl1,srPos); 2467 setring save; kill L,tmp,RRPOS,RPOS, LPOS; 2468 string sMap = "ideal Mmap ="; 2469 for (i=1; i<=nvars(save); i++) 2470 { 2471 sMap = sMap + string(var(i)) +"(1),"; 2472 } 2473 sMap[size(sMap)] = ";"; 2474 /* cartans: h_j h_i = h_i h_j */ 2475 setring LPsave; 2476 ideal ComCartan; 2477 for (i=1; i<size(iCartan); i++) 2478 { 2479 for (j=i+1; j<=size(iCartan); j++) 2480 { 2481 ComCartan = ComCartan + lieBracket(var(iCartan[j]),var(iCartan[i])); 2482 } 2483 } 2484 ComCartan = simplify(ComCartan,1+2+8); 2485 execute(sMap); // defines an ideal Mmap 2486 map F = save, Mmap; 2487 dbprint(ppl,"1. commuting Cartans: "); 2488 dbprint(ppl1,ComCartan); 2489 /* [e_i, f_j] =0 if i<>j */ 2490 ideal ComPosNeg; // assume: #Neg=#Pos 2491 for (i=1; i<size(iPos); i++) 2492 { 2493 for (j=1; j<=size(iPos); j++) 2494 { 2495 if (j !=i) 2496 { 2497 ComPosNeg = ComPosNeg + lieBracket(var(iPos[i]),var(iNeg[j])); 2498 ComPosNeg = ComPosNeg + lieBracket(var(iPos[j]),var(iNeg[i])); 2499 } 2500 } 2501 } 2502 ComPosNeg = simplify(ComPosNeg,1+2+8); 2503 dbprint(ppl,"2. commuting Positive and Negative:"); 2504 dbprint(ppl1,ComPosNeg); 2505 /* [e_i, f_i] = h_i */ 2506 poly tempo; 2507 for (i=1; i<=size(iCartan); i++) 2508 { 2509 tempo = lieBracket(var(iPos[i]),var(iNeg[i]))  var(iCartan[i]); 2510 ComPosNeg = ComPosNeg + tempo; 2511 } 2512 // ComPosNeg = simplify(ComPosNeg,1+2+8); 2513 dbprint(ppl,"3. added sl2 triples [e_i,f_i]=h_i"); 2514 dbprint(ppl1,ComPosNeg); 2515 2516 /* [h_i, e_j] = A_ij e_j */ 2517 /* [h_i, f_j] = A_ij f_j */ 2518 ideal ActCartan; // assume: #Neg=#Pos 2519 for (i=1; i<=size(iCartan); i++) 2520 { 2521 for (j=1; j<=size(iCartan); j++) 2522 { 2523 tempo = lieBracket(var(iCartan[i]),var(iPos[j]))  A[i,j]*var(iPos[j]); 2524 ActCartan = ActCartan + tempo; 2525 tempo = lieBracket(var(iCartan[i]),var(iNeg[j])) + A[i,j]*var(iNeg[j]); 2526 ActCartan = ActCartan + tempo; 2527 } 2528 } 2529 ActCartan = simplify(ActCartan,1+2+8); 2530 dbprint(ppl,"4. actions of Cartan:"); 2531 dbprint(ppl1, ActCartan); 2532 2533 /* final part: prepare the output */ 2534 setring LPsave; 2535 ideal fsRel = srNeg, srPos, ComPosNeg, ComCartan, ActCartan; 2536 export fsRel; 2537 setring save; 2538 return(LPsave); 2539 } 2540 example 2541 { 2542 "EXAMPLE:"; echo = 2; 2543 intmat A[2][2] = 2544 2, 1, 2545 1, 2; // A_2 = sl_3 Cartan matrix 2546 ring r = 0,(f1,f2,h1,h2,e1,e2),dp; 2547 ideal negroots = f1,f2; ideal cartans = h1,h2; ideal posroots = e1,e2; 2548 int uptodeg = 5; 2549 def RS = fullSerreRelations(A,negroots,cartans,posroots,uptodeg); 2550 setring RS; fsRel; 2551 } 2552 2553 proc varIdeal2intvec(ideal I) 2554 { 2555 /* assume1: input ideal is a list of variables of the ground ring */ 2556 int i,j; intvec V; 2557 for (i=1; i<= size(I); i++) 2558 { 2559 j = univariate(I[i]); 2560 if (j<=0) 2561 { 2562 ERROR("input ideal must contain only variables"); 2563 } 2564 V[i] = j; 2565 } 2566 dbprint(printlevelvoice+2,V); 2567 /* now we make a smaller list of nonrepeating entries */ 2568 ideal iW = simplify(ideal(V),2+4); // no zeros, no repetitions 2569 if (size(iW) < size(V)) 2570 { 2571 /* extract intvec from iW */ 2572 intvec inW; 2573 for(j=1; j<=size(iW); j++) 2574 { 2575 inW[j] = int(leadcoef(iW[j])); 2576 } 2577 return(inW); 2578 } 2579 return(V); 2580 } 2581 example 2582 { 2583 "EXAMPLE:"; echo = 2; 2584 ring r = 0,(x,y,z),dp; 2585 ideal I = x,z; 2586 varIdeal2intvec(I); 2587 varIdeal2intvec(ideal(x2,y^3,x+1)); 2588 varIdeal2intvec(ideal(x*y,y,x+1)); 2589 } 2590 2207 2591 proc lp2lstr(ideal K, def save) 2208 2592 "USAGE: lp2lstr(K,s); K an ideal, s a ring name … … 2462 2846 2463 2847 // TODO: 2464 // multiply two letterplace polynomials, lpMult 2848 // multiply two letterplace polynomials, lpMult: done 2465 2849 // reduction/ Normalform? needs kernel stuff 2466 2850 … … 2500 2884 } 2501 2885 2886 proc lpPower(poly f, int n) 2887 "USAGE: lpPower(f,n); f letterplace polynomial, int n 2888 RETURN: poly 2889 ASSUME: basering has a letterplace ring structure 2890 PURPOSE: compute the letterplace form of f^n 2891 EXAMPLE: example lpPower; shows examples 2892 " 2893 { 2894 if (n<0) { ERROR("the power must be a natural number!"); } 2895 if (n==0) { return(poly(1)); } 2896 if (n==1) { return(f); } 2897 int i; 2898 poly p = 1; 2899 for(i=1; i<= n; i++) 2900 { 2901 p = lpMult(p,f); 2902 } 2903 return(p); 2904 } 2905 example 2906 { 2907 "EXAMPLE:"; echo = 2; 2908 // define a ring in letterplace form as follows: 2909 ring r = 0,(x(1),y(1),x(2),y(2),x(3),y(3),x(4),y(4)),dp; 2910 def R = setLetterplaceAttributes(r,4,2); // supply R with letterplace structure 2911 setring R; 2912 poly a = x(1)*y(2); poly b = y(1); 2913 lpPower(a,2); 2914 lpPower(b,4); 2915 } 2916 2917 // under development for Roberto 2918 proc extractLinearPart(module M) 2919 { 2920 /* returns vectors from a module whose max leadexp is 1 */ 2921 /* does not take place nonlinearity into account yet */ 2922 /* use rather kernel function isinV to get really nonlinear things */ 2923 int i; int s = ncols(M); 2924 int answer = 1; 2925 vector v; module Ret; 2926 for(i=1; i<=s; i++) 2927 { 2928 if ( isLinearVector(M[i]) ) 2929 { 2930 Ret = Ret, M[i]; 2931 } 2932 } 2933 Ret = simplify(Ret,2); 2934 return(Ret); 2935 } 2936 2937 // under development for Roberto 2938 proc isLinearVector(vector v) 2939 { 2940 /* returns true iff max leadexp is 1 */ 2941 int i,j,k; 2942 intvec w; 2943 int s = size(v); 2944 poly p; 2945 int answer = 1; 2946 for(i=1; i<=s; i++) 2947 { 2948 p = v[i]; 2949 while (p != 0) 2950 { 2951 w = leadexp(p); 2952 j = Max(w); 2953 if (j >=2) 2954 { 2955 answer = 0; 2956 return(answer); 2957 } 2958 p = plead(p); 2959 } 2960 } 2961 return(answer); 2962 } 2963 2964 2965 // // the following is to determine a shift of a mono/poly from the 2966 // // interface 2967 2968 // proc whichshift(poly p, int numvars) 2969 // { 2970 // // numvars = number of vars of the orig free algebra 2971 // // assume: we are in the letterplace ring 2972 // // takes monomial on the input 2973 // poly q = lead(p); 2974 // intvec v = leadexp(v); 2975 // if (v==0) { return(int(0)); } 2976 // int sv = size(v); 2977 // int i=1; 2978 // while ( (v[i]==0) && (i<sv) ) { i++; } 2979 // i = sv div i; 2980 // return(i); 2981 // } 2982 2983 2984 2985 // LIB "qhmoduli.lib"; 2986 // proc polyshift(poly p, int numvars) 2987 // { 2988 // poly q = p; int i = 0; 2989 // while (q!=0) 2990 // { 2991 // i = Max(i, whichshift(q,numvars)); 2992 // q = q  lead(q); 2993 // } 2994 // return(q); 2995 // } 2996 2502 2997 static proc lpAssumeViolation() 2503 2998 {
Note: See TracChangeset
for help on using the changeset viewer.