MAXIMAL_TERMS1 := 20000: MAXIMAL_TERMS2 := 1000: ##### GENERAL ROOT SYSTEM PROCEDURES ##### my_rank := proc (R) option remember; local i, j, res; res := 0; for i from 2 to length(R) do member(substring(R,i..i),[`0`,`1`,`2`,`3`,`4`,`5`,`6`,`7`,`8`,`9`],'j'); res := res * 10 + j - 1; od: res; end proc: my_cartan_matrix := proc (R) option remember; local Car, L, r, i, j; L := substring (R, 1..1); r := my_rank (R); Car := matrix (r, r); for i to r do for j to r do Car [i, j] := 0; od; od; for i to r do Car [i, i] := 2; od; for i from 2 to r do Car [i - 1, i] := -1; od; for i to r - 1 do Car [i + 1, i] := -1; od; if L = 'A' then elif L = 'B' then Car [2, 1] := -2; elif L = 'C' then Car [1, 2] := -2; elif L = 'D' then Car [1, 2] := 0; Car [1, 3] := -1; Car [2, 1] := 0; Car [3, 1] := -1; elif L = 'E' then Car [1, 2] := 0; Car [1, 3] := -1; Car [2, 1] := 0; Car [2, 3] := 0; Car [2, 4] := -1; Car [3, 1] := -1; Car [3, 2] := 0; Car [4, 2] := -1; elif R = F4 then Car [3, 2] := -2; elif R = G2 then Car [2, 1] := -3; else ERROR (cat(R,` is an unknown root system`)); fi; Car; end proc: my_cartan_inverse := proc (R) option remember; linalg:-inverse(my_cartan_matrix(R)); end proc: pos_roots_number := proc (R) option remember; local L, r; L:=substring(R,1..1); r:=my_rank(R); if L='A' then return r*(r+1)/2; fi; if (L='B') or (L='C') then return r^2; fi; if (L='D') then return r*(r-1); fi; if R=G2 then return 6; fi; if R=F4 then return 24; fi; if R=E6 then return 36; fi; if R=E7 then return 63; fi; if R=E8 then return 120; fi; ERROR (cat(R,` is an unknown root system`)); end proc: my_root_length := proc (R, k) option remember; local L; L:=substring(R,1..1); if (R=G2) and (k=2) then return 3; fi; if (L='B') and (k>1) or (L='C') and (k=1) or (R=F4) and (k>2) then return 2; fi; return 1; end proc: ##### NUMERICAL REPRESENTATION AND REDUCTION MODULO W_P ##### my_root_coords := proc (R, p) local C, i, k; C:=my_cartan_inverse(R); [seq(add(coeff(p,omega[i])*C[i,k],i=1..my_rank(R)),k=1..my_rank(R))]; end proc: reflect_weights := proc (R) option remember; local Car,i,j; Car:=my_cartan_matrix(R); [seq(omega[i]-add(Car[i,j]*omega[j],j=1..my_rank(R)),i=1..my_rank(R))]; end proc: numer_repr := proc (Car, r, w) local i, t; t:=add(omega[i],i=1..r); for i to nops(w) do t:=subs(omega[w[-i]]=Car[w[-i]],t) od; t; end proc: weyl_length := proc (Car, r, w) local res, i, j, t; t:=add(omega[i],i=1..r); res := 0; for i to nops(w) do if coeff(t,omega[w[i]])>0 then res:=res+1 else res:=res-1; fi; t := subs(omega[w[i]]=Car[w[i]],t); od; res; end proc: is_minimal_repr := proc (J, Car, r, w) local j, t; t:=numer_repr(Car,r,ListTools:-Reverse(w)); for j in J do if coeff(t,omega[j])<0 then return false; fi; od; return true; end proc: reduce_left := proc (J, Car, r, q) local i, flag, t, res; t:=q; res:=[]; flag:=true; while flag do flag:=false; for i in J do if coeff(t,omega[i])<0 then res:=[op(res),i]; t:=subs(omega[i]=Car[i],t); flag:=true; break; fi; od; od; [res,t]; end proc: my_right_coset := proc (J, Car, r, w) local t; t:=reduce_left(J,Car,r,numer_repr (Car, r, w)); [t[1],reduce_left([$1..r], Car, r, t[2])[1]]; end proc: right_coset := proc (J, R, w); my_right_coset(J,reflect_weights(R),my_rank(R),w); end proc: my_reduce := proc (Car, r, w); my_right_coset([],Car,r,w)[2]; end proc: my_left_coset := proc (J, Car, r, w) local t; t:=my_right_coset (J, Car, r, ListTools:-Reverse(w)); [my_reduce(Car,r,ListTools:-Reverse(t[2])),ListTools:-Reverse(t[1])]; end proc: left_coset := proc (J, R, w) my_left_coset(J,reflect_weights(R),my_rank(R),w); end proc: my_double_coset := proc (JL, JR, Car, r, w) local t; t:=my_left_coset (JR, Car, r, w);[op(my_right_coset(JL, Car, r, t[1])),t[2]]; end proc: double_coset := proc (JL, JR, R, w) my_double_coset(JL,JR,reflect_weights(R),my_rank(R),w); end proc: my_longest_elt := proc (R) option remember; local r,i; r := my_rank(R); reduce_left([$1..r],reflect_weights(R),r,-add(omega[i],i=1..r))[1]; end proc: my_longest_elt2 := proc (J, R) option remember; my_right_coset(J,reflect_weights(R),my_rank(R),my_longest_elt(R))[1]; end proc: common_part := proc (S, R) local Car, r, T, i, j, k, flag, res; Car:=reflect_weights(R); r:=my_rank(R); T:=[seq(numer_repr(Car,r,ListTools:-Reverse(S[i])),i=1..nops(S))]; res:=[]; do k:=0; for i to r do flag:=true; for j to nops(T) do if coeff(T[j],omega[i])>0 then flag:=false; break; fi; od; if flag then k:=i; break; fi; od; if k=0 then break; fi; res := [op(res),k]; for j to nops(T) do T[j]:=subs(omega[k]=Car[k],T[j]); od; od; res; end proc: my_pos_roots := proc (R) option remember; local Car, r, w, j, i, t, res1, res2, res3, res4; Car := reflect_weights (R); r := my_rank (R); w := my_longest_elt (R); res1 := []; res2 := []; res3 := []; res4 := []; for i to nops(w) do t := omega[w[i]]-Car[w[i]]; for j from i-1 to 1 by -1 do t := subs (omega[w[j]]=Car[w[j]], t); od: res1 := [op(res1), t]; res2 := [op(res2), numer_repr(Car, r, [op(w[1..i]),op(ListTools:-Reverse(w[1..i-1]))])]; res3 := [op(res3), my_root_coords (R, t)]; res4 := [op(res4), my_root_length (R, w[i])]; od: [res1, res2, res3, res4]; end proc: ##### CHOW GENERATORS ##### list_of_generators := proc (J, R, k) option remember; local Car, X, L, N, r, i, j, w, num; r:=my_rank(R); if k=0 then return [[[]],[add(omega[i],i=1..r)]]; fi; Car:=reflect_weights(R); X:=list_of_generators(J,R,k-1); N:=[]; L:=[]; for j to nops(X[1]) do for i to r do if coeff(X[2][j],omega[i])>0 then w:=[i,op(X[1][j])]; if is_minimal_repr(J,Car,r,w) then num:=numer_repr(Car,r,w); if not (num in {op(N)}) then L:=[op(L),w]; N:=[op(N),num]; fi; fi; fi; od; od; [L,N]; end proc: chow_generators := proc (J,R,k) option remember; local Car, r, X; X:=list_of_generators(J,R,k)[1]; Car:=reflect_weights(R); r:=my_rank(R); [seq(my_reduce(Car,r,x),x in X)]; end proc: chow_dual := proc (J, R, w) local w0; w0 := my_longest_elt(R); my_reduce(reflect_weights(R),my_rank(R),[op(w0),op(w),op(my_longest_elt2(J,R))]); end proc: chow_dim := proc (J, R) local t; pos_roots_number(R)-add(pos_roots_number(t[2]),t in levi_part2(J,R)); end proc: ##### PIERI FORMULA ##### my_indets := proc (p) local res, j, s; res:=[]; for s in indets(p) do if op(0,s)=Z then res:=[op(res),[seq(op(j,s),j=1..nops(s))]]; fi; od; res; end proc: piericoef := proc (R, k, w, u) option remember; local L, i; L:=my_pos_roots(R); i:=ListTools:-Search(numer_repr(reflect_weights(R),my_rank(R), [op(ListTools:-Reverse(u)),op(w)]),L[2]); if i=0 then return 0; fi; L[3][i][k]*my_root_length(R,k)/L[4][i]; end proc: pieri1 := proc (J, R, k, u) option remember; local w; add(piericoef (R, k, w, u) * Z[op(w)], w in chow_generators(J, R, nops(u)+1)); end proc: pieri2 := proc (J, R, k, p) local L,l; L:=my_indets(p); if nops(L)=0 then return Z[k]*p; fi; subs(seq(Z[op(l)]=pieri1(J, R, k, l), l in L), p) end proc: pieri := proc (J, R, k, p, n) local i,t; if nargs=4 then return pieri2 (J, R, k, p); fi; t:=p; for i to n do t:=pieri2(J, R, k, t); od; t; end proc: ##### DIFFERENTIAL OPERATORS ##### old_delta := proc (Car, k, p) local res, m, c, i; res:=0; for i to degree(p,omega[k]) do c:=coeff(p,omega[k],i); if c<>0 then res:=res+c*add(binomial(i,m)*(Car[k]-omega[k])^(m-1)*omega[k]^(i-m),m=1..i); fi; od; expand(res); end proc: critical_degree := proc (R) option remember; local r, d, n; r:=my_rank(R); n:=pos_roots_number(R); for d to n do if binomial(d+r-1,d)>MAXIMAL_TERMS1 then return d-1; fi; od; return n; end proc: my_degree := proc (r, p) local i; degree(p,{seq(omega[i],i=1..r)}); end proc: rucksack := proc (V, B, S) local A, newA, D, i, j, k, res; A:=array(0..S); newA:=array(0..S); for i from 0 to S do A[i]:=0; od; D:=array(0..nops(V),0..S); for i from 0 to S do D[0,i]:=0; od; for i to nops(V) do if V[i]=0 then for j from 0 to S do D[i,j]:=0; od; else for j from 0 to S do newA[j]:=-1; for k from 0 to min(floor(j/V[i]),B[i]) do if A[j-k*V[i]]+k*V[i]>newA[j] then newA[j]:=A[j-k*V[i]]+k*V[i]; D[i,j]:=k; fi; od; od; for j from 0 to S do A[j]:=newA[j]; od; fi; od; res:=[]; j:=S; for i from nops(V) by -1 to 1 do res:=[D[i,j],op(res)]; j:=j-V[i]*D[i,j]; od; res; end proc: my_split := proc (r, cd, p) local V, B, X, M, i, r1, r2; if op(0,p)=`^` then V:=[my_degree(r,op(1,p))]; B:=[op(2,p)]; X:=[op(1,p)]; elif op(0,p)=`*` then V:=[]; B:=[]; X:=[]; for i to nops(p) do if op(0,op(i,p))=`^` then V:=[op(V),my_degree(r,op(1,op(i,p)))]; B:=[op(B),op(2,op(i,p))]; X:=[op(X),op(1,op(i,p))]; else V:=[op(V),my_degree(r,op(i,p))]; B:=[op(B),1]; X:=[op(X),op(i,p)]; fi; od; else return [1,p]; fi; M:=rucksack(V,B,cd); r1:=1; for i to nops(V) do if M[i]>0 then r1:=r1*X[i]^M[i]; fi; od; r2:=1; for i to nops(V) do if M[i] MAXIMAL_TERMS2 then return old_delta(Car,k,expand(q)); fi; d:=my_degree(r,q); if d<=cd then return old_delta (Car,k,expand(q)); fi; if op(0,q)=`+` then return add(new_delta(Car,r,cd,k,op(i,q)),i=1..nops(q)); fi; L:=my_split(r,floor(d/2),q); L[1]:=my_expand(r,cd,L[1]); L[2]:=my_expand(r,cd,L[2]); return my_expand(r,cd,new_delta(Car,r,cd,k,L[1])*L[2])+ my_expand(r,cd,subs(omega[k]=Car[k],L[1])*new_delta(Car,r,cd,k,L[2])) end proc: c_func := proc (J, R, p) local Car, r, cd, i, j, L, l, w, w1, q, t, res; if p=0 then return 0; fi; Car:=reflect_weights(R); r:=my_rank(R); cd:=critical_degree(R); L:=chow_generators(J,R,my_degree(r,p)); w:=common_part(L,R); q:=p; for i to nops(w) do q:=new_delta(Car,r,cd,w[i],q); od; res:=0; for l in L do w1:=my_reduce(Car,r,[op(l),op(w)]); t:=q; for j to nops(w1) do t:=new_delta(Car,r,cd,w1[-j],t); od; res:=res+t*Z[op(my_reduce(Car,r,l))]; od; res; end proc: ##### LEVI PART COMPUTATION ##### root_sys_name := proc (type, rk); if rk=1 then return A1; fi; if substring(type,1..1)='F' then return cat(A,rk); fi; return cat(type,rk); end proc: levi_part := proc (J, Ord, R) local L, i, k, r; if Ord=[] then return []; fi; k:=0; for i to nops(Ord) do if not (Ord[i] in {op(J)}) then k:=i; break; fi; od; if k=0 then return [[Ord, R]]; fi; r:=my_rank(R); L:=substring(R,1..1); if (L='A') or (L='B') or (L='C') or (R=G2) or ((L='D') and (k>4)) or ((R=F4) and ((k=2) or (k=3))) or ((L='E') and (k>6)) then return [op(levi_part(J,Ord[1..k-1],root_sys_name(L,k-1))), op(levi_part(J,Ord[k+1..r],root_sys_name(A,r-k)))]; fi; if L='D' then if k=4 then return [op(levi_part(J,Ord[5..r],root_sys_name(A,r-4))), op(levi_part(J,[Ord[1],Ord[3],Ord[2]],A3))]; fi; if k=3 then return [op(levi_part(J,Ord[4..r],root_sys_name(A,r-3))), op(levi_part(J,[Ord[1]],A1)),op(levi_part(J,[Ord[2]],A1))]; fi; return levi_part(J,[Ord[3-k],op(Ord[3..r])],root_sys_name(A,r-1)); fi; if R=F4 then if k=1 then return levi_part(J,Ord[2..4],B3); fi; if k=4 then return levi_part(J,[Ord[3],Ord[2],Ord[1]],C3); fi; fi; if L<>'E' then ERROR (cat(R,` is an unknown root system`)); fi; if k=1 then return levi_part(J,Ord[2..r],root_sys_name(D,r-1)); fi; if k=2 then return levi_part(J,[Ord[1],op(Ord[3..r])],root_sys_name(A,r-1)); fi; if k=3 then return [op(levi_part(J,[Ord[1]],A1)), op(levi_part(J,[Ord[2],op(Ord[4..r])],root_sys_name(A,r-2)))]; fi; if k=4 then return [op(levi_part(J,[Ord[1],Ord[3]],A2)),op(levi_part(J,[Ord[2]],A1)), op(levi_part(J,Ord[5..r],root_sys_name(A,r-4)))]; fi; if k=5 then return [op(levi_part(J,[Ord[1],Ord[3],Ord[4],Ord[2]],A4)), op(levi_part(J,Ord[6..r],root_sys_name(A,r-5)))]; fi; if k=6 then return [op(levi_part(J,[Ord[2],Ord[5],Ord[4],Ord[3],Ord[1]],D5)), op(levi_part(J,Ord[7..r],root_sys_name(A,r-6)))]; fi; end proc: levi_part2 := proc (J, R) option remember; levi_part(J,[$1..my_rank(R)],R); end proc: ##### FUNDAMENTAL INVARIANTS ##### deg_fundam_invariant := proc (R, k) option remember; local L; L:=substring(R,1..1); if L='A' then return k+1; fi; if (L='B') or (L='C') then return 2*k; fi; if (L='D') then if k=2*n-1 then return c_func(J,R,subs(seq(T[i]=SUBS[i],i=1..nops(T)),p)); fi; M:=rucksack(L,B,floor(N/2)); p1:=1; d:=0; for i to nops(M) do if M[i]>0 then p1:=p1*T[i]^M[i]; fi; d:=d+L[i]*M[i]; od; p2:=1; for i to nops(M) do if M[i]=d then return c_func(J,R,subs(seq(T[i]=SUBS[i],i=1..nops(T)),p)); fi; x1:=relations(J,R,p1); G:=chow_generators(J,R,N-n); L:=generators(J,R,N-n); M:=linalg:-inverse(L[2]); V:=vector(nops(G)); for i to nops(G) do V[i]:=my_poincare_dual(J,R,x1,chow_expand_monomial(J,R,p2*L[1][i]),d); od; V:=linalg:-multiply(M,V); return add(V[i]*Z[op(chow_dual(J,R,G[i]))],i=1..nops(G)); end proc: generators := proc (J, R, n) option remember; local G, G1, L, L1, S, LP, B, M, x, i, j, k, l, rk, d, N; if n=0 then return [[1],[[1]]]; fi; G1:=chow_generators(J,R,n-1); G:=chow_generators(J,R,n); LP:=levi_part2(J,R); L:=generators(J,R,n-1); B:=[]; M:=matrix(nops(G),nops(G)); rk:=0; for i to nops(G) do for j to nops(G) do M[i,j]:=0; od; od; S:={$1..my_rank(R)} minus {op(J)}; for i to nops(S) do for j to nops(G1) do x:=pieri(J,R,S[i],add(L[2][j,k]*Z[op(G1[k])],k=1..nops(G1))); for k to nops(G) do M[rk+1,k]:=coeff(x,Z[op(G[k])]) od; if linalg:-rank(M)>rk then rk:=rk+1; B:=[op(B),L[1][j]*omega[S[i]]]; fi; if rk=nops(G) then break; fi; od; if rk=nops(G) then break; fi; od; if rkrk then rk:=rk+1; B:=[op(B),P[i,j]*L1[1][l]]; if rk=nops(G) then return [B,M]; fi; fi; fi; od; fi; od; od; fi; [B,M]; end proc: add_to_mult:=proc (J,R,p) local v, L, SUBS, M, j, k; SUBS:=[]; for v in my_indets(p) do L:=generators(J,R,nops(v)); M:=linalg:-inverse(L[2]); k:=ListTools:-Search(my_reduce(reflect_weights(R),my_rank(R),v), chow_generators(J,R,nops(v))); if k=0 then ERROR(`A wrong generator`); fi; SUBS:=[op(SUBS),Z[op(v)]=add(M[k,j]*L[1][j],j=1..nops(L[1]))]; od; subs(op(SUBS),p); end proc: c_func_inv:=proc (J,R,p) local V,LP,S,i,j; LP:=levi_part2(J,R); S:={}; for i to nops(LP) do for j to my_rank(LP[i][2]) do S:=S union {P[i,j]=fundam_invariant(LP[i][2],LP[i][1],R,j)}; od; od; subs(op(S),add_to_mult(J,R,p)); end proc: chow_expand_monomial:=proc (J,R,q) local LP, V, q1, q2, c, i, j, d; if q=0 then return 0; fi; LP:=levi_part2(J,R); V:=indets(q); c:=subs(seq(V[i]=1,i=1..nops(V)),q); for i to nops(LP) do for j to my_rank(LP[i][2]) do V:=V minus {P[i,j]}; od; od; q1:=subs(seq(V[i]=1,i=1..nops(V)),q)/c; q2:=simplify(q/q1); q2:=relations(J,R,q1)*q2; V:={$1..my_rank(R)} minus {op(J)}; for i to nops(V) do d:=degree(q2,omega[V[i]]); q2:=pieri(J,R,V[i],q2/omega[V[i]]^d,d); od; q2; end: chow_expand:=proc (J,R,p) local q, i; q:=expand(add_to_mult(J,R,p)); if op(0,q)=`+` then return expand (add (chow_expand_monomial(J,R,op(i,q)), i=1..nops(q))); fi; chow_expand_monomial(J,R,q); end proc: ##### CHERN CLASSES ##### unipotent_rad := proc (J, R) option remember; local j, S, i, res; res:={}; S:=my_pos_roots(R); for i to nops (S[1]) do for j in {$ 1..my_rank(R)} minus {op(J)} do if S[3][i][j]>0 then res:=res union {S[1][i]}; break; fi; od; od; res; end proc: relative_root := proc (J, Pat, R) option remember; local j, S, i, flag, res; res:={}; S:=my_pos_roots(R); for i to nops (S[1]) do flag := true; for j in {$ 1..my_rank(R)} minus {op(J)} do if S[3][i][j]<>Pat[j] then flag := false; break; fi; od; if flag then res:=res union {S[1][i]}; fi; od; res; end proc: sym_funct := proc (T, R, k, p) local x, y, j; x:=array(0..k); x[0]:=1; for j to k do x[j]:=0; od; for y in T do for j from k by -1 to 1 do x[j]:=x[j]+expand(x[j-1]*y); if nargs>3 then x[j]:=x[j] mod p; fi; od; od; x[k]; end proc: chern_class := proc (J, R, k, p) option remember; local res; res:=c_func(J,R,sym_funct(unipotent_rad(J,R),args[2..nargs])); if nargs>3 then res := res mod p; fi; res; end proc: weyl_orbit := proc (J, R, lambda) local Car, T, S, t, i, flag; Car := reflect_weights(R); T := {lambda}; flag := false; do S := T; for t in T do for i in J do S := S union {subs(omega[i]=Car[i], t)}; od; od; if S = T then break; fi; T := S; od; T; end proc: steinberg_weight := proc (R, w) option rememeber; local Car, t, x, i, j, k, flag, r, res; r := my_rank (R); Car := reflect_weights (R); res := 0; for i to r do t := omega[i]-Car[i]; for j to nops(w) do t := subs (omega[w[j]] = Car[w[j]], t); od; x := my_root_coords (R, t); flag := true; for k to r do if x[k] < 0 then flag := false; break; fi; od; if flag then t := omega[i]; for j to nops(w) do t := subs (omega[w[j]] = Car[w[j]], t); od; res := res + t; fi; od; res; end proc: ##### STEENROD OPERATIONS ##### gennext:=proc(p) local newp, i, m; m:=nops(p); newp:=p; i:=m; while p[i]=0 do i:=i-1; od; newp[i]:=0; newp[i-1]:=p[i-1]+1; newp[m]:=p[i]-1; newp; end proc: gennextcomb:=proc(p,n,k) local newp, i, j, m; m:=nops(p); newp:=p; i:=k; while p[i]=n-m+i do i:=i-1; od; for j from i to m do newp[j]:=p[i]+j-i+1; od; newp; end proc: triang:=proc(p) option remember; local m, k, ind, i, j, q, s, res, newp; k:=nops(p); if p[k]=0 then return 0; fi; if k=1 then return 1; fi; res:=0; ind:=[]; for i to k-1 do if triangA[i,k]<>0 then ind:=[op(ind),i]; fi; od; m:=nops(ind); if m=0 then if p[k]=1 then return triang(p[1..k-1]); fi; return 0; fi; q:=[seq(0,i=1..m)]; q[m]:=p[k]-1; do s:=combinat:-multinomial(p[k]-1,op(q)); for i to m do s:=s*triangA[ind[i],k]^(q[i]); od; newp:=p[1..k-1]; for i to m do newp[ind[i]]:=p[ind[i]]+q[i]; od; res:=res+s*triang(newp); if q[1]=p[k]-1 then break; fi; q:=gennext(q); od; res; end proc: generatelist:=proc(group_id,w,u) local p,n,m,i,j,S,k,D1,D2,v,t,Car; n:=nops(w); m:=nops(u); S:=[]; D2:={op(my_pos_roots(group_id)[1])}; D1:={}; Car:=reflect_weights(group_id); for t in D2 do v:=-t; for j to nops(u) do v:=subs(omega[u[-j]]=Car[u[-j]],v); od; if v in D2 then D1:=D1 union {v}; fi; od; p:=[seq(i,i=1..m)]; do k:=m+1; D2:={}; for i to m while k=m+1 do v:=omega[w[p[i]]]-Car[w[p[i]]]; for j to i-1 do v:=subs(omega[w[p[i-j]]]=Car[w[p[i-j]]],v); od; if (v in D2) or not (v in D1) then k:=i; fi; D2:=D2 union {v}; od; if k=m+1 then S:=[op(S),p]; k:=m; fi; if p[1]=n-m+1 then break; fi; p:=gennextcomb(p,n,k); od; S; end proc: inittriangA:=proc(group_id,w) global triangA; local c,i,j; c:=my_cartan_matrix(group_id); triangA:=matrix(nops(w),nops(w)); forget(triang); for i to nops(w) do for j to nops(w) do if inops(u) then return 0; fi; inittriangA(group_id,w); l:=generatelist(group_id,w,u); res:=0; for i to nops(l) do q:=[seq(i,i=1..k)]; do x:=[seq(0,i=1..nops(w))]; for j to nops(u) do x[l[i][j]]:=1; od; for j to k do x[l[i][q[j]]]:=p; od; res:=(res+triang(x)) mod p; if q[1]=nops(u)-k+1 then break; fi; q:=gennextcomb(q,nops(u),k); od; od; res; end proc: steenrod1 := proc (J, R, u, p, k) option remember; local w; add(steencoef (R, w, u, p, k) * Z[op(w)], w in chow_generators(J, R, nops(u)+(p-1)*k)); end proc: steenrod := proc (J, R, p, k, q) local L,l; L:=my_indets(q); if nops(L)=0 then if k=0 then return q else return 0; fi; fi; subs(seq(Z[op(l)]=steenrod1(J,R,l,p,k),l in L),q) end proc: ##### DOUBLE PARABOLIC FILTRATION ##### prodbase := proc (J,K,R,w) local flag, i, j, x, y, res, K1, Car; Car := reflect_weights (R); K1:={$1..my_rank(R)} minus {op(K)}; res:=[]; for i in J do y:=omega[i]-Car[i]; for j to nops(w) do y:=subs(omega[w[j]]=Car[w[j]],y); od; x:=my_root_coords(R,y); flag:=true; for j in K1 do if x[j]>0 then flag:=false; break; fi; od; if flag then res:=[op(res), i]; fi; od; res; end proc: my_dcoset_reps := proc (J,K,R) option remember; local i, w, S; S := {}; for i from 0 to chow_dim(K,R) do for w in chow_generators(K,R,i) do S := S union {right_coset(J,R,w)[2]}; od; od; S; end proc: prodbases := proc (J,K,R) option remember; local w, res; res := []; for w in my_dcoset_reps(J,K,R) do res := [op(res), [prodbase(J,K,R,w),w]]; od; res; end proc: prodimagecor := proc (J,K,R,w,u,v) local M,L,S,t,l; M := prodbase(J,K,R,w); S := []; t := chow_expand(M,R,Z[op(u)]*Z[op(v)]); for l in my_indets(t) do S := [op(S), Z[op(l)]=my_pushforward(M,K,R,l,w)]; od; subs(op(S),t); end proc: prodimage := proc(J,K,R,w,u) local v,i,t,res; res := []; for i from 0 to chow_dim(J,R) do for v in chow_generators(J,R,i) do t := prodimagecor (J,K,R,w,u,v); if t<>0 then res := [op(res), [Z[op(chow_dual(J,R,v))],t]]; fi; od; od; res; end proc: my_pushforward := proc(J,K,R,v,w) local x, y; x := chow_dual(J,R,v); y := left_coset(K,R,[op(x),op(w)])[1]; if nops(y)=nops(x)+nops(w) then Z[op(chow_dual(K,R,y))] else 0; fi; end proc: pushforward := proc(J,K,R,v); my_pushforward(J,K,R,v,[]); end proc: lprint(`Chow ring package v. 1.1 loaded`):