#42.instances
#
# This maple file is set up to run thousands of instances of 
# Shapiro's conjecture for Grass(2,6).
#
# We work in local coordinates for the set of 2-planes which meet
# the 4-planes K_4(0) and K_4(\infty).
#
# First a Groebner basis is computed in the term order
#     wdeg([1,15,15,15,15,15],[a,b,c,d,e,f])
# This produces an eliminant in the `a' variable, which is tested for 
# 14 real roots.   When this fails, we apply the FGLM algorithm to 
# compute the eliminant in  plex(a,b,c,d,e,f), which is a polynomial
# in f.  This is tested for 14 real roots.
#
# We are first testing all 5005 6-tuples in 
#   [-7,-6,-5,-4,-3,-2,-1,1,2,3,4,5,6,7,8].
#    1 to 2000  took 40293.660 seconds
# 2001 to 3500  took 27063.479    #[-6,-4,-3,-2,-1,2]  was ambiguious
#				  #  further testing was required
# 3501 to 5005  took  29732.470
#			# Ambiguous, but  [-5, -3, -2, -1, 1, 3]
#			# tested to have  [-4, -2, -1,  1, 2, 4]
#			# 14 real roots   [-3, -1,  1,  2, 3, 5]
#
#[-30,-28,-14,-13,-10,-5,-1,1,6,12,30,31,32,33]
#     1 to 1500  took 40875.809 seconds
#  1501 to 3003  took 41864.419 seconds
#
#[1,2,3,5,7,11,13,17,23,29,31,37,41,43]
#     1 to 1001  took  28449.889 seconds
#  1002 to 2002  took  30788.590 seconds
#  2003 to 3003  took  29709.900 seconds
#
#
#
interface(quiet=true):

with(combinat):
with(Ore_algebra):
with(linalg):
with(Groebner):
readlib(realroot):
die:=rand(-10..10):
Digits:=5:
#

read(MakeLex):
trials:=choose([1,2,3,5,7,11,13,17,23,29,31,37,41,43],6):
#nops(trials);  quit;

Eq := s -> simplify(det(matrix([
              [1,s,s^2, s^3 , s^4 ,   s^5],
              [0,1,2*s,3*s^2,4*s^3, 5*s^4],
              [0,0, 1 , 3*s ,6*s^2,10*s^3],
              [0,0, 0 ,  1  ,4*s  ,10*s^2],
              [1,a, b ,  d  ,  0  ,  0   ],
              [0,0, 1 ,  c  ,  e  ,  f   ]]))/s):

for j from 2003 to 3003 do  

 Vals:= trials[j]:
 eqs:=[]:
 for i from 1 to 6 do eqs:=[eqs[],Eq(Vals[i])]: od:
 G:=gbasis(eqs,wdeg([1,15,15,15,15,15],[a,b,c,d,e,f])):
 if (nops(realroot(G[1],1/1000))<14) then
   GG:=LEX(G,[a,b,c,d,e,f]):
   for i from 1 to nops(GG) do
    if nops(indets(GG))=1 then
    F:=GG[i]  fi:
   od:
  if (nops(realroot(F,1/1000))<14) then
   lprint(`BIG Trouble`,Vals,F); 
 fi:fi:
od:
time();
quit;