> 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: # > DegreeSteering:=proc(v,gg) > local an1,an2,aa; > global J; > aa:=lhs(v[-1]); > J:=InvolutiveBasisGINV(J,[op(v[1..-2]),aa=gg]): > an1:=nops(map(r->if not has(r,aa) then r end if,J)); > an2:=nops(map(r->if not > has(LeadingMonomial(r,[op(v[1..-2]),aa=gg]),aa) then r end if,J)); > return(an1,an2,gg,nops(J)); > end proc: # # > L := REL(a,2,b,3,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 -2 a[2] b[3] b[1] + a[2] b[1] a[1] b[3] + a[2] b[2] 2 3 2 - c[4], -a[2] b[3] a[1] b[2] + c[5], a[2] b[3] - c[6]] # > sL := solve({op(L)},map(i->c[i],{$1..6})); 3 2 sL := {c[6] = a[2] b[3] , c[1] = a[1] b[1], 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[4] = 2 2 2 2 -2 a[2] b[3] b[1] + a[2] b[1] a[1] b[3] + a[2] b[2] , 2 c[5] = a[2] b[3] a[1] b[2]} # # # 1.) # > L1 := subs([c[6]=1,b[3]=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[1] a[1] b[2] - a[1] + c[3], 2 2 -2 b[1] + b[1] a[1] + b[2] - c[4], -a[1] b[2] + c[5]] # > J := copy(L1): # > v := [c[5] = 10, c[4] = 8, c[3] = 6, c[2] = 4, c[1] = 2, b[2]=2, > b[1]=1, a[1]=1]: # > InvolutiveOptions("rational",false); false > DegreeSteering(v,2); 1, 4, 2, 10 1, 4, 2, 10 > DegreeSteering(v,6); 35, 37, 6, 95 35, 37, 6, 95 > DegreeSteering(v,9); 48, 48, 9, 105 48, 48, 9, 105 # # > J := select(r->not has(r,a[1]),J): > nops(J); 48 # > v := [c[5] = 10, c[4] = 8, c[3] = 6, c[2] = 4, c[1] = 2, b[2] = 2, > b[1] = 1]: # > DegreeSteering(v,10); 3, 26, 10, 82 2, 21, 10, 55 > DegreeSteering(v,18); 28, 35, 18, 110 18, 24, 18, 80 > DegreeSteering(v,21); 43, 43, 21, 112 28, 28, 21, 83 # > J := select(r->not has(r,b[1]),J): > nops(J); 43 28 > indets(J); {b[2], c[1], c[2], c[3], c[4], c[5]} # # > v := [c[5] = 10, c[4] = 8, c[3] = 6, c[2] = 4, c[1] = 2, b[2] = 2]: # > DegreeSteering(v,5); 0, 10, 5, 80 > DegreeSteering(v,11); 0, 16, 11, 97 > DegreeSteering(v,21); Warning, resulting involutive basis is big; reading it may take a while... 6, 20, 21, 187 6, 19, 21, 148 > DegreeSteering(v,29); Warning, resulting involutive basis is big; reading it may take a while... 21, 21, 29, 224 21, 21, 29, 164 # > J := select(r->not has(r,b[2]),J): > nops(J); 21 21 > indets(J); {c[1], c[2], c[3], c[4], c[5]} # # > v := map(i->c[6-i]=6-i,[$1..5]): # > J := InvolutiveBasisGINV(J, v): # > AssertInvBasis(J, v): > hs := PolHilbertSeries(t); 2 3 4 5 6 7 hs := 1 + 5 t + 15 t + 35 t + 68 t + 115 t + 173 t + 244 t 8 9 10 / 420 93 11 \ + 327 t + 422 t + t |----- + -------- + --------| |1 - t 2 3| \ (1 - t) (1 - t) / # > DEG:=proc(p) > degree(subs(map(i->c[i]=t^i,[$1..8]),LeadingMonomial(p,v))); > end proc: # > map(DEG,J); [19, 20, 21, 21, 22, 22, 23, 23, 23, 24, 24, 25, 25, 25, 26, 26, 27, 27, 28, 30, 31] [19, 20, 21, 21, 22, 22, 23, 23, 23, 24, 24, 25, 25, 25, 26, 26, 27, 27, 28, 30, 31] # > nops(J); 21 21 # > nops(select(irreduc,J)); 21 21 # # # # 2.) # > Homo:=proc(p) > evala(algsubs(t^6=c[6],evala(subs(map(i->c[i]=c[i]/t^i,[$1..5]),p)*t^D > EG(p)))); > end proc: # > JH:=map(Homo,J): > indets(JH); {c[6], c[1], c[2], c[3], c[4], c[5]} # > nops(JH); 21 # # > v:=[c[6] = 6, c[5] = 5, c[4] = 4, c[3] = 3, c[2] = 2, c[1] = 1]: # > Jfin := InvolutiveBasisGINV(JH, v): Warning, resulting involutive basis is big; reading it may take a while... # > nops(Jfin); 58 42 > map(DEG,Jfin); [19, 20, 21, 21, 22, 22, 23, 23, 23, 24, 24, 25, 25, 25, 25, 26, 26, 27, 27, 27, 27, 28, 28, 29, 29, 29, 30, 30, 31, 31, 31, 31, 32, 32, 32, 33, 33, 33, 33, 34, 34, 34, 35, 35, 35, 36, 36, 37, 37, 37, 37, 38, 38, 39, 39, 39, 40, 41] [19, 20, 21, 21, 22, 22, 23, 23, 23, 24, 24, 25, 25, 25, 26, 26, 27, 27, 27, 28, 28, 29, 29, 30, 30, 31, 31, 32, 32, 33, 33, 34, 34, 35, 35, 36, 36, 37, 37, 38, 39, 41] # > AssertInvBasis(Jfin, v): > > # minimal generating set as subset of JH > > nops(JH); 21 > map(DEG,JH); [19, 20, 21, 21, 22, 22, 23, 23, 23, 24, 24, 25, 25, 25, 26, 26, 27, 27, 28, 30, 31] > Aus:=[$1..20]; Aus := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20] > v; [c[6] = 6, c[5] = 5, c[4] = 4, c[3] = 3, c[2] = 2, c[1] = 1] > JA1:=InvolutiveBasisGINV(map(i->JH[i],Aus),v): Warning, resulting involutive basis is big; reading it may take a while... > {$1..21} minus {op(Aus)}; {21} > PolInvReduceGINV(JH[21],JA1,v); 0 > Aus := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, > 20]; Aus := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 19, 20] > JA1:=InvolutiveBasisGINV(map(i->JH[i],Aus),v): Warning, resulting involutive basis is big; reading it may take a while... > PolInvReduceGINV(JH[18],JA1,v); 0 > Aus := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 17, 19, > 20]; Aus := [ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 17, 19, 20 ] > JA1:=InvolutiveBasisGINV(map(i->JH[i],Aus),v): Warning, resulting involutive basis is big; reading it may take a while... > PolInvReduceGINV(JH[16],JA1,v); 0 > DEG(JH[14]); 25 > Aus := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 15, 17, 19, 20]; Aus := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 15, 17, 19, 20] > JA1:=InvolutiveBasisGINV(map(i->JH[i],Aus),v): Warning, resulting involutive basis is big; reading it may take a while... > PolInvReduceGINV(JH[14],JA1,v); 0 > Aus := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 15, 17, 19, 20]; Aus := [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 15, 17, 19, 20] > JA1:=InvolutiveBasisGINV(map(i->JH[i],Aus),v): Warning, resulting involutive basis is big; reading it may take a while... > PolInvReduceGINV(JH[13],JA1,v); 0 > map(i->DEG(JH[i]),Aus); [19, 20, 21, 21, 22, 22, 23, 23, 23, 24, 24, 25, 26, 27, 28, 30] > MinErzGanz:=map(i->JH[i],Aus): > map(DEG,MinErzGanz); [19, 20, 21, 21, 22, 22, 23, 23, 23, 24, 24, 25, 26, 27, 28, 30] > save v,MinErzGanz, > "/Users/plesken/CharlesMatrix.d/paper.d/paperneu.d/documentation.d/Doc > 6_min_gen_ganz.res": > # > # #