|\^/| Maple 2021 (X86 64 LINUX) ._|\| |/|_. Copyright (c) Maplesoft, a division of Waterloo Maple Inc. 2021 \ MAPLE / All rights reserved. Maple is a trademark of <____ ____> Waterloo Maple Inc. | Type ? for help. #Corollary22_b.maple # # This is the maple computation reported in the proof of Corollary 22 # # It is for the Schubert problem (3,1)*(4)*(2,1,1)*(2,1,1)*(2,1,1) = 6 # # Frank Sottile # 7 December 2018 ################################################################################# #interface(quiet=true): > kernelopts(printbytes=false): > die:=rand(-1..2): > with(LinearAlgebra): # These are local coordinates for (3,1) * (4) # The second row with last three entries x, w+x, w-x is a bit sneaky # The block structure of its columns will be important. # Rows 1 and 4 give a 2-plane in cols (12789) that meets a 2-plane # and a complementary 3-plane > Coords := Matrix([ > [ 0, 0, 0, 0, 0, 0, 1, a, b], > [ 0, 0, 0, 1, z, y, x, w+x, w-x], > [ 0, 1, v, u, t, s, r, 0, 0], > [ 1, c, 0, 0, 0, 0, 0, 0, 0]]): # These are 3-planes in the C^2 given by columns 1,2,7,8,9 that are in # a particular special position. They are the intersections of the # three seven planes defining (211), (211), (211) > LI := Matrix([ > [1, 1, 0, 0, 0, 0, 1, 1, 1], > [1, 2, 0, 0, 0, 0, 2, 2, 0], > [1, 3, 0, 0, 0, 0, 3, 0, 3]]): > LII := Matrix([ > [1, 1, 0, 0, 0, 0, 2, 2, 2], > [1, 2, 0, 0, 0, 0, 3, 3, 0], > [1, 3, 0, 0, 0, 0, 1, 0, 1]]): > LIII := Matrix([ > [1, 1, 0, 0, 0, 0, 3, 3, 3], > [1, 2, 0, 0, 0, 0, 2, 2, 0], > [1, 3, 0, 0, 0, 0, 1, 0, 1]]): #ij:=2: #LR := [seq(die()+ij,i=1..9)]: #LR := [seq(r,i=1..8),1+2*ij]: # The first two are an attempt to find the 'right' general row for the last row of LaI. > LP := [1,2,3,seq(p,i=1..5),1]: > LaI := Matrix(3,9,die): > LaIlp := Matrix(1,9,LP); LaIlp := [1 2 3 p p p p p 1] > LaII := Matrix(4,9,die): > LaIII := Matrix(4,9,die): > CLLI := Matrix([[Coords], [LI], [LaI], [LaIlp]]) ; [0 0 0 0 0 0 1 a b ] [ ] [0 0 0 1 z y x w + x w - x ] [ ] [0 1 v u t s r 0 0 ] [ ] [1 c 0 0 0 0 0 0 0 ] [ ] [1 1 0 0 0 0 1 1 1 ] [ ] CLLI := [1 2 0 0 0 0 2 2 0 ] [ ] [1 3 0 0 0 0 3 0 3 ] [ ] [-1 1 1 0 -1 2 0 0 1 ] [ ] [2 2 0 -1 1 2 -1 2 -1 ] [ ] [0 1 0 0 2 2 1 1 -1 ] [ ] [: : : : : : : : "11 x 9 Matrix"] > CLLII := Matrix([[Coords], [LII], [LaII]]) : > CLLIII := Matrix([[Coords], [LIII], [LaIII]]) : > COLS :=[seq(ii,ii=1..9)]: # # These are the equations for the auxillary problem in G(2,5) # given by rows 1 and 4 of the coordinates and columns 1,2,7,8,9 # > SEqs:=[ > Determinant(SubMatrix(CLLI, [1,4,5,6,7], [1,2,7,8,9])), > Determinant(SubMatrix(CLLII, [1,4,5,6,7], [1,2,7,8,9])), > Determinant(SubMatrix(CLLIII, [1,4,5,6,7], [1,2,7,8,9]))]; SEqs := [4 a c + 3 b c - c - 6, -3 a c + b c + 15 a + b + 5 c - 19, -4 a c - b c + 16 a + 4 b + 7 c - 22] > GB:=Groebner[Basis](SEqs,plex(a,b,c)); 3 2 2 2 GB := [c - 6 c + 11 c - 6, -c + b + 4 c - 4, c + 2 a - 3 c] > factor(GB[1]); (c - 1) (c - 2) (c - 3) # # As this factors, it shows that the three solutions correspond to c=1,2,3 # which are defined over Q (and are constant) > Eqs:=[]: > for ROWS in combinat[choose]([seq(ii,ii=5..11)],5) do > Eqs:=[Eqs[],Determinant(SubMatrix(CLLI, [1,2,3,4,ROWS[]], COLS)) > ,Determinant(SubMatrix(CLLII, [1,2,3,4,ROWS[]], COLS)) > ,Determinant(SubMatrix(CLLIII, [1,2,3,4,ROWS[]], COLS))]: > end do: > for CLS in combinat[choose](COLS,8) do > Eqs:=[Eqs[],Determinant(SubMatrix(CLLI, [1,2,3,4,8,9,10,11], CLS)) > ,Determinant(SubMatrix(CLLII, [1,2,3,4,8,9,10,11], CLS)) > ,Determinant(SubMatrix(CLLIII, [1,2,3,4,8,9,10,11], CLS))]: > end do: > GG:=Groebner[Basis](subs(p=5,Eqs),lexdeg([z,y,x,w,v,u,t,s,r],[a,b,c])): > GG:=Groebner[Basis](GG,plex(z,y,x,w,v,u,t,s,r,a,b,c)): > with(PolynomialIdeals): > J:=; 2 3 2 2 J := > NumberOfSolutions(J); 6 # # There are six solutions when p=5, which is what is expected. # # # We check that for each value of c=1,2,3 there are two solutions to the Schubert problem, as shown by the degree is 2 in s. # > GG:=Groebner[Basis](subs(c=1,Eqs),plex(a,b,z,y,x,w,v,u,t,r,s)): > S1:=GG[1]; 5 4 S1 := (66471401012739583455 p - 1372754939195024561190 p 3 2 + 3830032279392119712090 p + 17332872003192765525480 p 2 + 8453078045758355885955 p - 5595527535039154649790) s + ( 5 4 -20919094711892746104 p + 750127956397427736586 p 3 2 - 6885409714641143968512 p + 5456502797039516112408 p + 80655356136186451709316 p + 77655485660700687472206) s 5 4 + 1590240204663623161 p - 70840768953387971372 p 3 2 + 486578075684943926367 p + 4518421567936465856148 p - 27688970774069999730198 p - 41630759294996808589446 > GG:=Groebner[Basis](subs(c=2,Eqs),plex(a,b,z,y,x,w,v,u,t,r,s)): > S2:=GG[1]; 5 4 S2 := (476369426185322496 p - 18508801155312738304 p 3 2 + 174381647647238531584 p - 40783895437953044608 p 2 - 3018609893660792107680 p - 3262193556255620379288) s + ( 5 4 -1786709490928963584 p + 40248947612494660864 p 3 2 - 227955356962251775552 p - 379929087726663707888 p + 3649552923016360373268 p + 5486853521683822278186) s 5 4 3 + 86557099194268416 p - 1688720073636974208 p + 4423450520578372288 p 2 + 69690139758002305184 p - 260313655897190863869 p - 554311234462399204896 > GG:=Groebner[Basis](subs(c=3,Eqs),plex(a,b,z,y,x,w,v,u,t,r,s)): > S3:=GG[1]; 5 4 S3 := (13564975374683222277 p + 684916332175769425704 p 3 2 - 6501803221282617728706 p - 39214319324274564840738 p 2 + 111741784533230934259053 p + 495923767958246359038210) s + ( 5 4 31275873725740844710 p - 294129635144499436932 p 3 2 - 262277918725599988459 p + 13705960775906174391759 p - 86136292932661603683486 p - 423033051650017925001222) s 5 4 + 5339100175263745825 p - 84874422307048380980 p 3 2 + 442281495366727819703 p + 1108343077322680037231 p - 15609960102257526508833 p - 19256324419724057254764 # # Let us compute their discriminants as functions of 4 # > D1:= primpart(expand(coeff(S1,s^2)^2 - 4* coeff(S1,s)*subs(s=0,S1))); 10 D1 := 4551512694420509071176877151320937396001 p 9 - 193197121671321181895412930027713891035036 p 8 + 2690702823948416685232059772329753289344368 p 7 - 11278788477100139271453536396309361030650688 p 6 - 33234854826723167697057624894945769597555314 p 5 + 324602060011363943728211334988038817099460880 p 4 - 490738830653303070638994460448000642146024476 p 3 - 1900950844623817502392411958648421487344487152 p 2 + 8315649131678181352441407871580126340472355817 p + 21937177898330949444027079056183006958396023996 p + 12962737254302207480706713718292844762306795604 > D2:= primpart(expand(coeff(S2,s^2)^2 - 4* coeff(S2,s)*subs(s=0,S2))); 10 D2 := 105692174094356240046704347433140224 p 9 - 5454798913458167496118920709615878144 p 8 + 111391377006705415394684057702627188736 p 7 - 1014551071377243987587458685096369031168 p 6 + 2020742260146233329468980407974924658176 p 5 + 28172190991701309411422717852365780594816 p 4 - 125009800177359371167336919017718039055008 p 3 - 363372815980227118023166566819203687876760 p 2 + 1350786908185973235404140666119371571851586 p + 4187467978784899103952719429059164608123841 p + 2850950624268922425864760018352106485022696 > D3:= primpart(expand(coeff(S3,s^2)^2 - 4* coeff(S3,s)*subs(s=0,S3))); 10 D3 := -483931534646756681855387462421154278271 p 9 + 35481383564048155050664329131379992114816 p 8 + 143130800966606379367470481255960171765232 p 7 - 9970322932373655385036258110802265946330136 p 6 + 1801491341718777849564725675394569381767370 p 5 + 617199730542650822600567899096861194705732644 p 4 + 673020796388342109640445141553151494248874984 p 3 - 13246684557802420533088105071134282296560383136 p 2 - 28855567242054692132525819312387390885019323871 p + 77782023811329784875212514871337035462369145340 p + 213356136894550063850599720073214889985578717668 # # Check that these are relatively prime # > Groebner[Basis]([D1,D2], plex(s)); [1] > Groebner[Basis]([D1,D3], plex(s)); [1] > Groebner[Basis]([D3,D2], plex(s)); [1] # # As these are relatively prime, their branch points in the p-line are distinct. # # # Numerically find the roots of the discriminants # > fsolve(D1=0,complex); -3.98768343758277, -1.85708886363582, -1.27997309941116, -1.27554568844130, 2.33163738266011 - 3.57698181374714 I, 2.33163738266011 + 3.57698181374714 I, 7.105975650 - 0.08197399985 I, 7.105975650 + 0.08197399985 I, 15.98592951 - 0.5378457660 I, 15.98592951 + 0.5378457660 I > fsolve(D2=0,complex); -3.51000621517294, -2.78117519780063, -1.41874863538203 - 0.181563019808743 I, -1.41874863538203 + 0.181563019808743 I, 8.812098305 - 0.08035456910 I, 8.812098305 + 0.08035456910 I, 9.493942371 - 0.009313282674 I, 9.493942371 + 0.009313282674 I, 12.0634207580938 - 6.88687319125149 I, 12.0634207580938 + 6.88687319125149 I > fsolve(D3=0,complex); -15.2927861600518, -4.17808995899323, -3.52605539215152, -3.52331187736125 - 1.38456102442403 I, -3.52331187736125 + 1.38456102442403 I, 3.08649135682007, 5.22713952550894, 10.3621257240635, 11.0999458145567, 73.5868680853130 > quit; memory used=2558.4MB, alloc=183.6MB, time=9.96