#2e5p2.maple
#
# Frank Sottile
# October 25 1999
# Berkeley CA
#
#   This file contains 3 MAPLE routines.   The first tests 10,000 cases of
# Shapiro's Conjecture for the 6 2-planes in C^7 which meet 5 4-planes
# osculating the rational normal curve.  This uses a universal eliminant
# computed by the third file.   The second file is a maple script that checks
# 421 anamolous cases.  It a different eliminant for those and checks that
# it has all 6 roots real for each of these 421 cases.
#
interface(quiet=true):
readlib(realroot):
with(combinat) :
#
# The 10,000 cases are 3 subsets of teh following set:
#
tests:=choose([-31,-29,-23,-17,-14,-13,-12,-11,-10,-9,-8,-7,-6,-5,-4,-3,-2,-1,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,17,19,23,29,31,37,41,43],3):
#
# This is the computed universal eliminant
#
Elim:=
-96*s^5*x25+128*u*s^5+6704*t^2*x25^2*u^2+6704*t^2*x25^2*s^2+3712*t^3*x25^2*s+
3712*t^3*x25^2*u-3680*x25*t^2*s^3-1248*x25*u*t^4-3680*x25*s^2*t^3-1248*x25*s*t^
4+4544*t^3*s*u^2+4544*u*s^2*t^3+1536*u*s*t^4+4544*t^2*u*s^3+4544*t^2*u^3*s+8448
*t^2*s^2*u^2+640*s^2*t^4-3680*t^2*x25*u^3-3680*t^3*x25*u^2-15776*x25*t^2*u*s^2-\
15776*t^2*x25*s*u^2+15664*t^2*x25^2*u*s-8672*x25*u*t^3*s+3712*t*x25^2*s^3-1248*
t*s^4*x25+3712*t*u^3*x25^2-1248*t*u^4*x25+1536*t*u^4*s+4544*t*s^2*u^3+1536*t*u*
s^4+4544*t*u^2*s^3-1248*u*s^4*x25+15664*t*u*x25^2*s^2-8672*t*u^3*x25*s+15664*t*
u^2*x25^2*s-15776*t*u^2*x25*s^2-8672*t*x25*u*s^3+128*u^5*s+1024*u^3*s^3+6704*u^
2*x25^2*s^2-1248*u^4*x25*s+3712*u^3*x25^2*s-3680*u^3*x25*s^2-3680*x25*u^2*s^3+
3712*u*x25^2*s^3+528*u^4*x25^2+640*s^2*u^4+640*u^2*s^4-4656*t*x25^3*s^2-4656*t^
2*x25^3*s-4656*t^2*u*x25^3-4656*t*u^2*x25^3-4656*u^2*x25^3*s-4656*u*x25^3*s^2-\
10848*t*u*x25^3*s-1104*x25^3*t^3+1080*t^2*x25^4-1104*x25^3*u^3+2520*x25^4*u*s+
1080*x25^4*u^2+528*x25^2*s^4-1104*x25^3*s^3+1080*x25^4*s^2+640*t^2*u^4+1024*t^3
*u^3+640*u^2*t^4+1024*t^3*s^3+640*t^2*s^4+2520*t*x25^4*u+2520*t*x25^4*s-96*u^5*
x25-96*t^5*x25+528*x25^2*t^4+128*u^5*t+128*s^5*t+128*s*t^5+128*u*t^5+81*x25^6-\
486*x25^5*s-486*x25^5*t-486*x25^5*u:

for i from 1 to 10000 do 
if (nops(realroot(subs(s=tests[i][1],t=tests[i][2],u=tests[i][3],Elim)))<6)
    then
  lprint(nops(realroot(subs(s=tests[i][1],t=tests[i][2],u=tests[i][3],Elim))),
    tests[i]);
fi;
od;
quit;

#############################################################
#
# This files checke the 421 anamolous cases
#
######################################


interface(quiet=true):
with(Ore_algebra):
with(linalg):
with(Groebner):
readlib(realroot):


##########################################
#
# The 421 bad cases
#
######################################
tests:=[[-31,-29,-2],[-31,-29,2],[-31,-23,-8],[-31,-23,8],[-31,-17,-14],[-31,-17,14],[-31,-14,17],[-31,-12,19],[-31,-8,23],[-31,-2,29],[-31,6,37],[-31,10,41],[-31,12,43],[-29,-23,-6],[-29,-23,6],[-29,-17,-12],[-29,-17,12],[-29,-14,15],[-29,-12,17],[-29,-10,19],[-29,-6,23],[-29,2,31],[-29,8,37],[-29,12,41],[-29,14,43],[-23,-17,-6],[-23,-17,6],[-23,-14,-9],[-23,-14,9],[-23,-13,-10],[-23,-13,10],[-23,-12,-11],[-23,-12,11],[-23,-11,12],[-23,-10,13],[-23,-9,14],[-23,-8,15],[-23,-6,17],[-23,-4,19],[-23,6,29],[-23,8,31],[-23,14,37],[-17,-14,-3],[-17,-14,3],[-17,-13,-4],[-17,-13,4],[-17,-12,-5],[-17,-12,5],[-17,-11,-6],[-17,-11,6],[-17,-10,-7],[-17,-10,7],[-17,-9,-8],[-17,-9,8],[-17,-8,9],[-17,-7,10],[-17,-6,11],[-17,-5,12],[-17,-4,13],[-17,-3,14],[-17,-2,15],[-17,2,19],[-17,6,23],[-17,12,29],[-17,14,31],[-14,-13,-1],[-14,-13,1],[-14,-12,-2],[-14,-12,2],[-14,-11,-3],[-14,-11,3],[-14,-10,-4],[-14,-10,4],[-14,-9,-5],[-14,-9,5],[-14,-8,-6],[-14,-8,6],[-14,-7,7],[-14,-6,8],[-14,-5,9],[-14,-4,10],[-14,-3,11],[-14,-2,12],[-14,-1,13],[-14,1,15],[-14,3,17],[-14,5,19],[-14,9,23],[-14,15,29],[-14,17,31],[-14,23,37],[-14,29,43],[-13,-12,-1],[-13,-12,1],[-13,-11,-2],[-13,-11,2],[-13,-10,-3],[-13,-10,3],[-13,-9,-4],[-13,-9,4],[-13,-8,-5],[-13,-8,5],[-13,-7,-6],[-13,-7,6],[-13,-6,7],[-13,-5,8],[-13,-4,9],[-13,-3,10],[-13,-2,11],[-13,-1,12],[-13,1,14],[-13,2,15],[-13,4,17],[-13,6,19],[-13,10,23],[-12,-11,-1],[-12,-11,1],[-12,-10,-2],[-12,-10,2],[-12,-9,-3],[-12,-9,3],[-12,-8,-4],[-12,-8,4],[-12,-7,-5],[-12,-7,5],[-12,-6,6],[-12,-5,7],[-12,-4,8],[-12,-3,9],[-12,-2,10],[-12,-1,11],[-12,1,13],[-12,2,14],[-12,3,15],[-12,5,17],[-12,7,19],[-12,11,23],[-12,17,29],[-12,19,31],[-12,29,41],[-12,31,43],[-11,-10,-1],[-11,-10,1],[-11,-9,-2],[-11,-9,2],[-11,-8,-3],[-11,-8,3],[-11,-7,-4],[-11,-7,4],[-11,-6,-5],[-11,-6,5],[-11,-5,6],[-11,-4,7],[-11,-3,8],[-11,-2,9],[-11,-1,10],[-11,1,12],[-11,2,13],[-11,3,14],[-11,4,15],[-11,6,17],[-11,8,19],[-11,12,23],[-10,-9,-1],[-10,-9,1],[-10,-8,-2],[-10,-8,2],[-10,-7,-3],[-10,-7,3],[-10,-6,-4],[-10,-6,4],[-10,-5,5],[-10,-4,6],[-10,-3,7],[-10,-2,8],[-10,-1,9],[-10,1,11],[-10,2,12],[-10,3,13],[-10,4,14],[-10,5,15],[-10,7,17],[-10,9,19],[-10,13,23],[-10,19,29],[-10,31,41],[-9,-8,-1],[-9,-8,1],[-9,-7,-2],[-9,-7,2],[-9,-6,-3],[-9,-6,3],[-9,-5,-4],[-9,-5,4],[-9,-4,5],[-9,-3,6],[-9,-2,7],[-9,-1,8],[-9,1,10],[-9,2,11],[-9,3,12],[-9,4,13],[-9,5,14],[-9,6,15],[-9,8,17],[-9,10,19],[-9,14,23],[-8,-7,-1],[-8,-7,1],[-8,-6,-2],[-8,-6,2],[-8,-5,-3],[-8,-5,3],[-8,-4,4],[-8,-3,5],[-8,-2,6],[-8,-1,7],[-8,1,9],[-8,2,10],[-8,3,11],[-8,4,12],[-8,5,13],[-8,6,14],[-8,7,15],[-8,9,17],[-8,11,19],[-8,15,23],[-8,23,31],[-8,29,37],[-7,-6,-1],[-7,-6,1],[-7,-5,-2],[-7,-5,2],[-7,-4,-3],[-7,-4,3],[-7,-3,4],[-7,-2,5],[-7,-1,6],[-7,1,8],[-7,2,9],[-7,3,10],[-7,4,11],[-7,5,12],[-7,6,13],[-7,7,14],[-7,8,15],[-7,10,17],[-7,12,19],[-6,-5,-1],[-6,-5,1],[-6,-4,-2],[-6,-4,2],[-6,-3,3],[-6,-2,4],[-6,-1,5],[-6,1,7],[-6,2,8],[-6,3,9],[-6,4,10],[-6,5,11],[-6,6,12],[-6,7,13],[-6,8,14],[-6,9,15],[-6,11,17],[-6,13,19],[-6,17,23],[-6,23,29],[-6,31,37],[-6,37,43],[-5,-4,-1],[-5,-4,1],[-5,-3,-2],[-5,-3,2],[-5,-2,3],[-5,-1,4],[-5,1,6],[-5,2,7],[-5,3,8],[-5,4,9],[-5,5,10],[-5,6,11],[-5,7,12],[-5,8,13],[-5,9,14],[-5,10,15],[-5,12,17],[-5,14,19],[-4,-3,-1],[-4,-3,1],[-4,-2,2],[-4,-1,3],[-4,1,5],[-4,2,6],[-4,3,7],[-4,4,8],[-4,5,9],[-4,6,10],[-4,7,11],[-4,8,12],[-4,9,13],[-4,10,14],[-4,11,15],[-4,13,17],[-4,15,19],[-4,19,23],[-4,37,41],[-3,-2,-1],[-3,-2,1],[-3,-1,2],[-3,1,4],[-3,2,5],[-3,3,6],[-3,4,7],[-3,5,8],[-3,6,9],[-3,7,10],[-3,8,11],[-3,9,12],[-3,10,13],[-3,11,14],[-3,12,15],[-3,14,17],[-2,-1,1],[-2,1,3],[-2,2,4],[-2,3,5],[-2,4,6],[-2,5,7],[-2,6,8],[-2,7,9],[-2,8,10],[-2,9,11],[-2,10,12],[-2,11,13],[-2,12,14],[-2,13,15],[-2,15,17],[-2,17,19],[-2,29,31],[-2,41,43],[-1,1,2],[-1,2,3],[-1,3,4],[-1,4,5],[-1,5,6],[-1,6,7],[-1,7,8],[-1,8,9],[-1,9,10],[-1,10,11],[-1,11,12],[-1,12,13],[-1,13,14],[-1,14,15],[1,2,3],[1,3,4],[1,4,5],[1,5,6],[1,6,7],[1,7,8],[1,8,9],[1,9,10],[1,10,11],[1,11,12],[1,12,13],[1,13,14],[1,14,15],[2,3,5],[2,4,6],[2,5,7],[2,6,8],[2,7,9],[2,8,10],[2,9,11],[2,10,12],[2,11,13],[2,12,14],[2,13,15],[2,15,17],[2,17,19],[2,29,31],[2,41,43],[3,4,7],[3,5,8],[3,6,9],[3,7,10],[3,8,11],[3,9,12],[3,10,13],[3,11,14],[3,12,15],[3,14,17],[4,5,9],[4,6,10],[4,7,11],[4,8,12],[4,9,13],[4,10,14],[4,11,15],[4,13,17],[4,15,19],[4,19,23],[4,37,41],[5,6,11],[5,7,12],[5,8,13],[5,9,14],[5,10,15],[5,12,17],[5,14,19],[6,7,13],[6,8,14],[6,9,15],[6,11,17],[6,13,19],[6,17,23],[6,23,29],[6,31,37],[6,37,43],[7,8,15]]:

SmMat := s -> matrix([
		[ 1 , s ,s^2, s^3 , s^4 ,  s^5 ,   s^6],
		[ 0 , 1 ,2*s,3*s^2,4*s^3, 5*s^4, 6*s^5],
		[ 0 , 0 , 1 , 3*s ,6*s^2,10*s^3,15*s^4],
		[ 0 , 0 , 0 ,  1  , 4*s ,10*s^2,20*s^3],
		[ 1 ,x12,x13, x14 ,  0  ,  0   ,   0  ],
		[ 0 , 0 , 0 ,  1  , x25 , x26  ,  x27 ]]):


AA:=op(2,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,2,3,4,5,6])))):
BB:=op(2,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,2,3,4,5,7])))):
CC:=op(2,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,2,3,4,6,7])))):
DD:=op(3,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,2,3,5,6,7])))):
EE:=op(3,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,2,4,5,6,7])))):
FF:=op(3,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,3,4,5,6,7])))):
GG:=op(3,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[2,3,4,5,6,7])))):
G:=gbasis([AA,BB,CC,DD,EE,FF,GG],
	wdeg([1,2,3,1,2,3],[x12,x13,x14,x25,x26,x27])):


for Vals in tests do
equations:=[]:
for P in G do
 equations:=[equations[],
 subs(s=Vals[1],P),subs(s=Vals[2],P),subs(s=Vals[3],P)]:
od:

GB:=gbasis(equations,wdeg([1,6,6,6,6,6],[x13,x12,x14,x25,x26,x27])):
if (nops(realroot(GB[nops(GB)]))<6)
  then 
  lprint(Vals);
 fi:

od:
quit;



######################################################
#
#	This computes the universal eliminant for Shapiro's
#	Conjecture for the case of 2-planes in C^7 satisfying
#	(13)^5 = 6.
#
######################################################
#interface(quiet=true):
with(Ore_algebra):
with(linalg):
with(Groebner):

SmMat := s -> matrix([
		[ 1 , s ,s^2, s^3 , s^4 ,  s^5 ,   s^6],
		[ 0 , 1 ,2*s,3*s^2,4*s^3, 5*s^4, 6*s^5],
		[ 0 , 0 , 1 , 3*s ,6*s^2,10*s^3,15*s^4],
		[ 0 , 0 , 0 ,  1  , 4*s ,10*s^2,20*s^3],
		[ 1 ,x12,x13, x14 ,  0  ,  0   ,   0  ],
		[ 0 , 0 , 0 ,  1  , x25 , x26  ,  x27 ]]):


AA:=op(2,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,2,3,4,5,6])))):
BB:=op(2,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,2,3,4,5,7])))):
CC:=op(2,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,2,3,4,6,7])))):
DD:=op(3,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,2,3,5,6,7])))):
EE:=op(3,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,2,4,5,6,7])))):
FF:=op(3,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[1,3,4,5,6,7])))):
GG:=op(3,factor(det(submatrix(SmMat(s),[1,2,3,4,5,6],[2,3,4,5,6,7])))):
G:=gbasis([AA,BB,CC,DD,EE,FF,GG],
	wdeg([1,2,3,1,2,3],[x12,x13,x14,x25,x26,x27])):

#for i from 1 to nops(G) do indets(G[i]);  od;

equations:=[]:
for P in G do
 equations:=[equations[],P,subs(s=t,P),subs(s=u,P)]:
od:
kernelopts(gcfreq=10000000):
GB:=gbasis(equations,wdeg([1,2,3,1,2,3],[x12,x13,x14,x25,x26,x27])):

#  First 3 equations are linear in some variables:
#sort(GB[1],[x12]);
#sort(GB[2],[x13]);
#sort(GB[3],[x27]);

X27:=solve(GB[3]=0,x27):

GB2:=[]:
for i from 4 to nops(GB) do
GB2:=[GB2[],simplify(subs(x27=X27,GB[i]))]: od:

#for i from 1 to 9 do indets(GB2[i]); od:

with(Groebner):

G:=gbasis(GB2,wdeg([1,2,3],[x25,x26,x14])):

GG:=gbasis(G,wdeg([1,2,7],[x25,x26,x14])):
for i from 1 to 5 do indets(GG[i]); od:

G:=gbasis([GG[1],GG[2],GG[3],GG[4]],wdeg([1,7],[x25,x26])):

Elim:=G[1]:
lprint(Elim):
time();
quit;