> restart; > with(LinearAlgebra): > with(Involutive): > > pol:=proc(a,n) > t^n+add((-1)^i*a[i]*t^(n-i),i=1..n); > end proc: > > REL:=proc(a,n,b,m,c) > local A,B,C; > A:=CompanionMatrix(pol(a,n),t); > B:=CompanionMatrix(pol(b,m),t); > C:=Matrix(convert(Matrix(n,n,(i,j)->A[i,j]*B),listlist)); > map(i->coeff(CharacteristicPolynomial(C,t)-pol(c,n*m),t,n*m-i),[$1..n* > m]); > end proc: > > # Relations > L:=REL(a,2,b,4,c); L := [-a[1] b[1] + c[1], 2 2 -2 a[2] b[2] + b[1] a[2] + a[1] b[2] - c[2], 3 3 a[1] a[2] b[3] - b[1] a[2] a[1] b[2] - a[1] b[3] + c[3], 2 2 2 2 a[2] b[4] - 2 b[3] a[2] b[1] - 4 a[1] a[2] b[4] 2 4 2 2 + a[2] b[1] a[1] b[3] + a[1] b[4] + a[2] b[2] - c[4], 2 2 -a[2] a[1] b[3] b[2] + 3 a[2] a[1] b[4] b[1] 3 3 2 - b[1] a[2] a[1] b[4] + c[5], a[2] b[3] 2 2 3 + a[2] a[1] b[4] b[2] - 2 a[2] b[2] b[4] - c[6], 3 4 2 -a[2] a[1] b[3] b[4] + c[7], a[2] b[4] - c[8]] > sL:=solve({op(L)},map(i->c[i],{$1..8})); 4 2 sL := {c[1] = a[1] b[1], c[8] = a[2] b[4] , 3 c[7] = a[2] a[1] b[3] b[4], 2 2 c[2] = -2 a[2] b[2] + b[1] a[2] + a[1] b[2], 3 c[3] = -3 a[1] a[2] b[3] + b[1] a[2] a[1] b[2] + a[1] b[3], c[6] = 3 2 2 2 3 a[2] b[3] + a[2] a[1] b[4] b[2] - 2 a[2] b[2] b[4], c[5] 2 2 = a[2] a[1] b[3] b[2] - 3 a[2] a[1] b[4] b[1] 3 2 + b[1] a[2] a[1] b[4], c[4] = 2 a[2] b[4] 2 2 - 2 b[3] a[2] b[1] - 4 a[1] a[2] b[4] 2 4 2 2 + a[2] b[1] a[1] b[3] + a[1] b[4] + a[2] b[2] } > L1:=subs([c[8]=1,b[4]=1,a[2]=1],L)[1..-2]; 2 2 L1 := [-a[1] b[1] + c[1], -2 b[2] + b[1] + a[1] b[2] - c[2], 3 3 a[1] b[3] - b[1] a[1] b[2] - a[1] b[3] + c[3], 2 2 2 4 2 - 2 b[3] b[1] - 4 a[1] + b[1] a[1] b[3] + a[1] + b[2] 3 - c[4], -a[1] b[3] b[2] + 3 a[1] b[1] - b[1] a[1] + c[5], 2 2 b[3] + a[1] b[2] - 2 b[2] - c[6], -a[1] b[3] + c[7]] > sL1:=solve({op(L1)},map(i->c[i],{$1..7})); 3 sL1 := {c[3] = -3 a[1] b[3] + b[1] a[1] b[2] + a[1] b[3], 3 c[5] = a[1] b[3] b[2] - 3 a[1] b[1] + b[1] a[1] , c[4] = 2 2 4 2 2 - 2 b[3] b[1] - 4 a[1] + b[1] a[1] b[3] + a[1] + b[2] , 2 2 c[7] = a[1] b[3], c[2] = -2 b[2] + b[1] + a[1] b[2], 2 2 c[6] = b[3] + a[1] b[2] - 2 b[2], c[1] = a[1] b[1]} > > > > # Degrees of field extensions (determinant 1) > indets(L1); {b[3], a[1], c[2], c[1], c[3], c[4], c[5], c[6], c[7], b[1], b[2]} > vv := [a[1], b[1], b[2], b[3]]; vv := [a[1], b[1], b[2], b[3]] > with(combinat): Warning, the protected name Chi has been redefined and unprotected > c4a7:=choose(7,4); c4a7 := [[1, 2, 3, 4], [1, 2, 3, 5], [1, 2, 3, 6], [1, 2, 3, 7], [1, 2, 4, 5], [1, 2, 4, 6], [1, 2, 4, 7], [1, 2, 5, 6], [1, 2, 5, 7], [1, 2, 6, 7], [1, 3, 4, 5], [1, 3, 4, 6], [1, 3, 4, 7], [1, 3, 5, 6], [1, 3, 5, 7], [1, 3, 6, 7], [1, 4, 5, 6], [1, 4, 5, 7], [1, 4, 6, 7], [1, 5, 6, 7], [2, 3, 4, 5], [2, 3, 4, 6], [2, 3, 4, 7], [2, 3, 5, 6], [2, 3, 5, 7], [2, 3, 6, 7], [2, 4, 5, 6], [2, 4, 5, 7], [2, 4, 6, 7], [2, 5, 6, 7], [3, 4, 5, 6], [3, 4, 5, 7], [3, 4, 6, 7], [3, 5, 6, 7], [4, 5, 6, 7]] > nops(c4a7); 35 > CC:=proc(L) > map(i->c[i],L); > end proc: > C4a7:=map(CC,c4a7): > Comp:=proc(L) > remove(has,map(i->c[i],[$1..7]),L); > end proc: > Comp(C4a7[1]); [c[5], c[6], c[7]] > Degs:=[]: > for s from 1 to nops(C4a7) do > J:=InvolutiveBasisFast(subs(zip((i,j)->i=j,C4a7[s],[-3,1,-7,-12]),map( > k->L1[k],c4a7[s])),vv): > AssertInvBasis(J,vv): > print(C4a7[s],subs(t=1,PolHilbertSeries(t))); > Degs:=[op(Degs),subs(t=1,PolHilbertSeries(t))]: > end do: [c[1], c[2], c[3], c[4]], 14 [c[1], c[2], c[3], c[5]], 12 [c[1], c[2], c[3], c[6]], 14 [c[1], c[2], c[3], c[7]], 6 [c[1], c[2], c[4], c[5]], 14 [c[1], c[2], c[4], c[6]], 24 [c[1], c[2], c[4], c[7]], 12 [c[1], c[2], c[5], c[6]], 12 [c[1], c[2], c[5], c[7]], 6 [c[1], c[2], c[6], c[7]], 2 [c[1], c[3], c[4], c[5]], 14 [c[1], c[3], c[4], c[6]], 22 [c[1], c[3], c[4], c[7]], 6 [c[1], c[3], c[5], c[6]], 16 [c[1], c[3], c[5], c[7]], 2 [c[1], c[3], c[6], c[7]], 6 [c[1], c[4], c[5], c[6]], 20 [c[1], c[4], c[5], c[7]], 6 [c[1], c[4], c[6], c[7]], 12 [c[1], c[5], c[6], c[7]], 6 [c[2], c[3], c[4], c[5]], 42 [c[2], c[3], c[4], c[6]], 48 [c[2], c[3], c[4], c[7]], 20 [c[2], c[3], c[5], c[6]], 14 [c[2], c[3], c[5], c[7]], 16 [c[2], c[3], c[6], c[7]], 12 [c[2], c[4], c[5], c[6]], 48 [c[2], c[4], c[5], c[7]], 22 [c[2], c[4], c[6], c[7]], 24 [c[2], c[5], c[6], c[7]], 14 [c[3], c[4], c[5], c[6]], 42 [c[3], c[4], c[5], c[7]], 14 [c[3], c[4], c[6], c[7]], 14 [c[3], c[5], c[6], c[7]], 12 [c[4], c[5], c[6], c[7]], 14 > Degs1 := Degs; Degs1 := [14, 12, 14, 6, 14, 24, 12, 12, 6, 2, 14, 22, 6, 16, 2, 6, 20, 6, 12, 6, 42, 48, 20, 14, 16, 12, 48, 22, 24, 14, 42, 14, 14, 12, 14] > sort(Degs); [2, 2, 6, 6, 6, 6, 6, 6, 12, 12, 12, 12, 12, 12, 14, 14, 14, 14, 14, 14, 14, 14, 14, 16, 16, 20, 20, 22, 22, 24, 24, 42, 42, 48, 48] > # a second run of the above loop with different evaluation points yields # the same degrees: > Degs-Degs1; [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] > remove(has, %, 0); [] > > Degs; [14, 12, 14, 6, 14, 24, 12, 12, 6, 2, 14, 22, 6, 16, 2, 6, 20, 6, 12, 6, 42, 48, 20, 14, 16, 12, 48, 22, 24, 14, 42, 14, 14, 12, 14] > zip((i,j)->[i,j], C4a7, Degs); [[[c[1], c[2], c[3], c[4]], 14], [[c[1], c[2], c[3], c[5]], 12], [[c[1], c[2], c[3], c[6]], 14], [[c[1], c[2], c[3], c[7]], 6], [[c[1], c[2], c[4], c[5]], 14], [[c[1], c[2], c[4], c[6]], 24], [[c[1], c[2], c[4], c[7]], 12], [[c[1], c[2], c[5], c[6]], 12], [[c[1], c[2], c[5], c[7]], 6], [[c[1], c[2], c[6], c[7]], 2], [[c[1], c[3], c[4], c[5]], 14], [[c[1], c[3], c[4], c[6]], 22], [[c[1], c[3], c[4], c[7]], 6], [[c[1], c[3], c[5], c[6]], 16], [[c[1], c[3], c[5], c[7]], 2], [[c[1], c[3], c[6], c[7]], 6], [[c[1], c[4], c[5], c[6]], 20], [[c[1], c[4], c[5], c[7]], 6], [[c[1], c[4], c[6], c[7]], 12], [[c[1], c[5], c[6], c[7]], 6], [[c[2], c[3], c[4], c[5]], 42], [[c[2], c[3], c[4], c[6]], 48], [[c[2], c[3], c[4], c[7]], 20], [[c[2], c[3], c[5], c[6]], 14], [[c[2], c[3], c[5], c[7]], 16], [[c[2], c[3], c[6], c[7]], 12], [[c[2], c[4], c[5], c[6]], 48], [[c[2], c[4], c[5], c[7]], 22], [[c[2], c[4], c[6], c[7]], 24], [[c[2], c[5], c[6], c[7]], 14], [[c[3], c[4], c[5], c[6]], 42], [[c[3], c[4], c[5], c[7]], 14], [[c[3], c[4], c[6], c[7]], 14], [[c[3], c[5], c[6], c[7]], 12], [[c[4], c[5], c[6], c[7]], 14]] > > > > > # Degrees of field extensions (general determinant) > L2 := subs(a[2]=1, L); 2 2 L2 := [-a[1] b[1] + c[1], -2 b[2] + b[1] + a[1] b[2] - c[2], 3 3 a[1] b[3] - b[1] a[1] b[2] - a[1] b[3] + c[3], 2 b[4] 2 2 4 - 2 b[3] b[1] - 4 a[1] b[4] + b[1] a[1] b[3] + a[1] b[4] 2 + b[2] - c[4], 3 -a[1] b[3] b[2] + 3 a[1] b[4] b[1] - b[1] a[1] b[4] + c[5], 2 2 b[3] + a[1] b[4] b[2] - 2 b[2] b[4] - c[6], 2 -a[1] b[3] b[4] + c[7], b[4] - c[8]] > indets(L2); {b[4], b[3], a[1], c[2], c[1], c[3], c[4], c[5], c[6], c[7], c[8], b[1], b[2]} > vv := [a[1], b[1], b[2], b[3], b[4]]; vv := [a[1], b[1], b[2], b[3], b[4]] > with(combinat): > c5a8:=choose(8,5); c5a8 := [[1, 2, 3, 4, 5], [1, 2, 3, 4, 6], [1, 2, 3, 4, 7], [1, 2, 3, 4, 8], [1, 2, 3, 5, 6], [1, 2, 3, 5, 7], [1, 2, 3, 5, 8], [1, 2, 3, 6, 7], [1, 2, 3, 6, 8], [1, 2, 3, 7, 8], [1, 2, 4, 5, 6], [1, 2, 4, 5, 7], [1, 2, 4, 5, 8], [1, 2, 4, 6, 7], [1, 2, 4, 6, 8], [1, 2, 4, 7, 8], [1, 2, 5, 6, 7], [1, 2, 5, 6, 8], [1, 2, 5, 7, 8], [1, 2, 6, 7, 8], [1, 3, 4, 5, 6], [1, 3, 4, 5, 7], [1, 3, 4, 5, 8], [1, 3, 4, 6, 7], [1, 3, 4, 6, 8], [1, 3, 4, 7, 8], [1, 3, 5, 6, 7], [1, 3, 5, 6, 8], [1, 3, 5, 7, 8], [1, 3, 6, 7, 8], [1, 4, 5, 6, 7], [1, 4, 5, 6, 8], [1, 4, 5, 7, 8], [1, 4, 6, 7, 8], [1, 5, 6, 7, 8], [2, 3, 4, 5, 6], [2, 3, 4, 5, 7], [2, 3, 4, 5, 8], [2, 3, 4, 6, 7], [2, 3, 4, 6, 8], [2, 3, 4, 7, 8], [2, 3, 5, 6, 7], [2, 3, 5, 6, 8], [2, 3, 5, 7, 8], [2, 3, 6, 7, 8], [2, 4, 5, 6, 7], [2, 4, 5, 6, 8], [2, 4, 5, 7, 8], [2, 4, 6, 7, 8], [2, 5, 6, 7, 8], [3, 4, 5, 6, 7], [3, 4, 5, 6, 8], [3, 4, 5, 7, 8], [3, 4, 6, 7, 8], [3, 5, 6, 7, 8], [4, 5, 6, 7, 8]] > > CC:=proc(L) > map(i->c[i],L); > end proc: > C5a8:=map(CC,c5a8): > Comp:=proc(L) > remove(has,map(i->c[i],[$1..8]),L); > end proc: > Comp(C5a8[1]); [c[6], c[7], c[8]] > Degs:=[]: > for s from 1 to nops(C5a8) do > J:=InvolutiveBasisFast(subs(zip((i,j)->i=j,C5a8[s],[-5,1,17,3,19]),map > (k->L2[k],c5a8[s])),vv): > AssertInvBasis(J,vv): > print(C5a8[s],subs(t=1,PolHilbertSeries(t))); > Degs:=[op(Degs),subs(t=1,PolHilbertSeries(t))]: > end do: [c[1], c[2], c[3], c[4], c[5]], 14 [c[1], c[2], c[3], c[4], c[6]], 18 [c[1], c[2], c[3], c[4], c[7]], 20 [c[1], c[2], c[3], c[4], c[8]], 28 [c[1], c[2], c[3], c[5], c[6]], 12 [c[1], c[2], c[3], c[5], c[7]], 18 [c[1], c[2], c[3], c[5], c[8]], 24 [c[1], c[2], c[3], c[6], c[7]], 20 [c[1], c[2], c[3], c[6], c[8]], 28 [c[1], c[2], c[3], c[7], c[8]], 12 [c[1], c[2], c[4], c[5], c[6]], 24 [c[1], c[2], c[4], c[5], c[7]], 24 [c[1], c[2], c[4], c[5], c[8]], 28 [c[1], c[2], c[4], c[6], c[7]], 36 [c[1], c[2], c[4], c[6], c[8]], 48 [c[1], c[2], c[4], c[7], c[8]], 24 [c[1], c[2], c[5], c[6], c[7]], 18 [c[1], c[2], c[5], c[6], c[8]], 24 [c[1], c[2], c[5], c[7], c[8]], 12 [c[1], c[2], c[6], c[7], c[8]], 4 [c[1], c[3], c[4], c[5], c[6]], 24 [c[1], c[3], c[4], c[5], c[7]], 22 [c[1], c[3], c[4], c[5], c[8]], 28 [c[1], c[3], c[4], c[6], c[7]], 32 [c[1], c[3], c[4], c[6], c[8]], 44 [c[1], c[3], c[4], c[7], c[8]], 12 [c[1], c[3], c[5], c[6], c[7]], 24 [c[1], c[3], c[5], c[6], c[8]], 32 [c[1], c[3], c[5], c[7], c[8]], 4 [c[1], c[3], c[6], c[7], c[8]], 12 [c[1], c[4], c[5], c[6], c[7]], 32 [c[1], c[4], c[5], c[6], c[8]], 40 [c[1], c[4], c[5], c[7], c[8]], 12 [c[1], c[4], c[6], c[7], c[8]], 24 [c[1], c[5], c[6], c[7], c[8]], 12 [c[2], c[3], c[4], c[5], c[6]], 50 [c[2], c[3], c[4], c[5], c[7]], 64 [c[2], c[3], c[4], c[5], c[8]], 84 [c[2], c[3], c[4], c[6], c[7]], 70 [c[2], c[3], c[4], c[6], c[8]], 96 [c[2], c[3], c[4], c[7], c[8]], 40 [c[2], c[3], c[5], c[6], c[7]], 32 [c[2], c[3], c[5], c[6], c[8]], 28 [c[2], c[3], c[5], c[7], c[8]], 32 [c[2], c[3], c[6], c[7], c[8]], 24 [c[2], c[4], c[5], c[6], c[7]], 70 [c[2], c[4], c[5], c[6], c[8]], 96 [c[2], c[4], c[5], c[7], c[8]], 44 [c[2], c[4], c[6], c[7], c[8]], 48 [c[2], c[5], c[6], c[7], c[8]], 28 [c[3], c[4], c[5], c[6], c[7]], 58 [c[3], c[4], c[5], c[6], c[8]], 84 [c[3], c[4], c[5], c[7], c[8]], 28 [c[3], c[4], c[6], c[7], c[8]], 28 [c[3], c[5], c[6], c[7], c[8]], 24 [c[4], c[5], c[6], c[7], c[8]], 28 > Degs1 := Degs; Degs1 := [14, 18, 20, 28, 12, 18, 24, 20, 28, 12, 24, 24, 28, 36, 48, 24, 18, 24, 12, 4, 24, 22, 28, 32, 44, 12, 24, 32, 4, 12, 32, 40, 12, 24, 12, 50, 64, 84, 70, 96, 40, 32, 28, 32, 24, 70, 96, 44, 48, 28, 58, 84, 28, 28, 24, 28] > sort(Degs); [4, 4, 12, 12, 12, 12, 12, 12, 12, 14, 18, 18, 18, 20, 20, 22, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 28, 28, 28, 28, 28, 28, 28, 28, 28, 32, 32, 32, 32, 32, 36, 40, 40, 44, 44, 48, 48, 50, 58, 64, 70, 70, 84, 84, 96, 96] > # a second run of the above loop with different evaluation points yields # the same degrees: > Degs-Degs1; [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] > remove(has, %, 0); [] > > Degs; [14, 18, 20, 28, 12, 18, 24, 20, 28, 12, 24, 24, 28, 36, 48, 24, 18, 24, 12, 4, 24, 22, 28, 32, 44, 12, 24, 32, 4, 12, 32, 40, 12, 24, 12, 50, 64, 84, 70, 96, 40, 32, 28, 32, 24, 70, 96, 44, 48, 28, 58, 84, 28, 28, 24, 28] > zip((i,j)->[i,j], C5a8, Degs); [[[c[1], c[2], c[3], c[4], c[5]], 14], [[c[1], c[2], c[3], c[4], c[6]], 18], [[c[1], c[2], c[3], c[4], c[7]], 20], [[c[1], c[2], c[3], c[4], c[8]], 28], [[c[1], c[2], c[3], c[5], c[6]], 12], [[c[1], c[2], c[3], c[5], c[7]], 18], [[c[1], c[2], c[3], c[5], c[8]], 24], [[c[1], c[2], c[3], c[6], c[7]], 20], [[c[1], c[2], c[3], c[6], c[8]], 28], [[c[1], c[2], c[3], c[7], c[8]], 12], [[c[1], c[2], c[4], c[5], c[6]], 24], [[c[1], c[2], c[4], c[5], c[7]], 24], [[c[1], c[2], c[4], c[5], c[8]], 28], [[c[1], c[2], c[4], c[6], c[7]], 36], [[c[1], c[2], c[4], c[6], c[8]], 48], [[c[1], c[2], c[4], c[7], c[8]], 24], [[c[1], c[2], c[5], c[6], c[7]], 18], [[c[1], c[2], c[5], c[6], c[8]], 24], [[c[1], c[2], c[5], c[7], c[8]], 12], [[c[1], c[2], c[6], c[7], c[8]], 4], [[c[1], c[3], c[4], c[5], c[6]], 24], [[c[1], c[3], c[4], c[5], c[7]], 22], [[c[1], c[3], c[4], c[5], c[8]], 28], [[c[1], c[3], c[4], c[6], c[7]], 32], [[c[1], c[3], c[4], c[6], c[8]], 44], [[c[1], c[3], c[4], c[7], c[8]], 12], [[c[1], c[3], c[5], c[6], c[7]], 24], [[c[1], c[3], c[5], c[6], c[8]], 32], [[c[1], c[3], c[5], c[7], c[8]], 4], [[c[1], c[3], c[6], c[7], c[8]], 12], [[c[1], c[4], c[5], c[6], c[7]], 32], [[c[1], c[4], c[5], c[6], c[8]], 40], [[c[1], c[4], c[5], c[7], c[8]], 12], [[c[1], c[4], c[6], c[7], c[8]], 24], [[c[1], c[5], c[6], c[7], c[8]], 12], [[c[2], c[3], c[4], c[5], c[6]], 50], [[c[2], c[3], c[4], c[5], c[7]], 64], [[c[2], c[3], c[4], c[5], c[8]], 84], [[c[2], c[3], c[4], c[6], c[7]], 70], [[c[2], c[3], c[4], c[6], c[8]], 96], [[c[2], c[3], c[4], c[7], c[8]], 40], [[c[2], c[3], c[5], c[6], c[7]], 32], [[c[2], c[3], c[5], c[6], c[8]], 28], [[c[2], c[3], c[5], c[7], c[8]], 32], [[c[2], c[3], c[6], c[7], c[8]], 24], [[c[2], c[4], c[5], c[6], c[7]], 70], [[c[2], c[4], c[5], c[6], c[8]], 96], [[c[2], c[4], c[5], c[7], c[8]], 44], [[c[2], c[4], c[6], c[7], c[8]], 48], [[c[2], c[5], c[6], c[7], c[8]], 28], [[c[3], c[4], c[5], c[6], c[7]], 58], [[c[3], c[4], c[5], c[6], c[8]], 84], [[c[3], c[4], c[5], c[7], c[8]], 28], [[c[3], c[4], c[6], c[7], c[8]], 28], [[c[3], c[5], c[6], c[7], c[8]], 24], [[c[4], c[5], c[6], c[7], c[8]], 28]] > > > > >