// Luis David Garcia, last modified: 04.29.07 (jr)
///////////////////////////////////////////////////////////////////////////////
version="$Id: schubert.lib,v 1.0.0.0 2007/04/23 13:04:15 levandov Exp $";
category="Real Algebraic Geometry";
info="
LIBRARY:  Schubert.lib     Grassmanians Computations

PROCEDURES:
 myring(int,list)          creates a ring
 descents(intvec,intvec)   check if the descents of a given intvec are compatible with the
                                 given Schubert problem 
 rooksNE(intvec, int)
 nIndets(intvec, int)
 flagRing(intvec, int)
 localCoords(intvec, int)

 numPoints(intvec w)     computes the largest dimension of a flag which participates in an
                          essential condition in w --- this is the number of points needed
                          to construct the secant flag
";                     

LIB "matrix.lib";
LIB "linalg.lib";
LIB "general.lib";
///////////////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////////////////
/* myring returns a ring with n variables
   without brackets. It has as input an integer and
   three optional string parameters. */

proc myring (int n, list#)
"USAGE:   myring(n,[f,v,o]); n int, f string, v string, o string

 RETURN:   ring: ring with coefficient field f, ring variables v_1,...,v_n, and term ordering o

 @*The default values for f, v, and o are \"0\", \"x\" and \"dp\" respectively

 EXAMPLE:  example myring; shows an example"
{
  if (size(#)==0 or size(#)>3) { #[1] = "0"; #[2] = "x"; #[3] = "dp";}
  if (size(#)==1) { #[2] = "x"; #[3] = "dp";}
  if (size(#)==2) { #[3] = "dp";}
  int i = 1;
  string ringconstructor = "ring nameofmyprettyring = " + #[1] + ",(" + #[2] + string(i);
  for (i=2; i<=n; i++)
    {
      ringconstructor = ringconstructor + ",";
      ringconstructor = ringconstructor + #[2] + string(i);
    }
  ringconstructor = ringconstructor + ")," + #[3] + ";";
  execute(ringconstructor);
  return(basering);
}
example
{
  "EXAMPLE:"; echo = 2;
  int n = 5;
  def R = myring(n);
  setring R;
  R;
}

//////////////////////////////////////////////////////////////////////////////////
/* 'descents' has as input two integer vectors w and a. It
   checks if the descents of w are compatible with a and produces
   an intvec of descents.
   We define a function 'member' to test if an integer is an
   element of a given list.*/

proc member (int a, intvec v)
"USAGE: member(a,v); a int, v intvec

 RETURN: int: TRUE(1) or FALSE(0)"
{
  int n = size(v);
  int i;
  for (i=1; i<=n; i++)
    {
      if (a == v[i])
	{
	  return(1);
	}
    }
  return(0);
}

//////////////////////////////////////////////////////////////////////////////////
/* May not be needed anymore -jr 25.04.07 */
proc descents (intvec w, intvec a)
"USAGE: descents(w,a); w intvec, a intvec

 RETURN: intvec: list of all the descents in w or 0 if w is not compatible with a

 Example: example descents; shows an example"
{
  int i,j,n = 1, 1, size(w);
  intvec d;
  for (i = 1; i< n; i++)
    {
      if (w[i] > w[i+1])
	{
	  if (member(i,a))
	    {
	      d[j] = i;
	      j++;
	    }
	  else
	    {
	      return(0);
	    }
	}
    }
  return(d);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec w = 1,2,4,3,5,6;
  intvec a = 3,6;
  intvec b = 4,6;
  descents(w,a);
  descents(w,b);
}

//////////////////////////////////////////////////////////////////////////////////
/* I am not sure about this function */
/* Modified on 23.04.07 by jr */

proc rooksNE (intvec w, int i, int j)
"USAGE: rooksNE(w,i); w intvec, i int, j int

 RETURN: int:

 Example: example rooksNE; shows an example"
{
  int k;
  int n, count = size(w), 0;
  for (k=1; k<=i; k++)
    {
      if (w[k] + j > n)
	{
	  count++;
	}
    }
  return(count);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec w = 1,3,2,4;
  rooksNE(w,2,2);
  rooksNE(w,2,3);
}


//////////////////////////////////////////////////////////////////////////////////
/* 'nIndets' computes the number of indeterminates
    for a given a flag variety*/

proc nIndets (intvec a, int n)
"USAGE: nIndets(a, n); a intvec, n int

 RETURN: int: number of indeterminates for a given flag variety

 Example: example nIndets; shows an example"
{
  int i;
  int s = size(a);
  int d = a[1]*(n - a[1]);
  for (i=2; i<=s; i++)
    {
      d = d + (a[i] - a[i-1])*(n - a[i]);
    }
  return(d);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec a = 2,3;
  int n = 5;
  nIndets(a,n);
}

/* 'flagRing' computes a ring with the number of
   indeterminates specified by a given flag variety */

proc flagRing (intvec a, int n, list#)
"USAGE: flagRing(a,n); a intvec, n int

 RETURN: ring: ring specified by a flag variety

 Example: example flagRing; shows an example"
{
  int d = nIndets(a,n);
  return(myring(d,#));
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec a = 2,3;
  int n = 5;
  def R = flagRing(a,n);
  R;
}

/* 'localCoords' computes the matrix of local coordinates
   of a given flag variety */

proc block (intvec v, int c, int n)
"USAGE: block(v,c,n); v intvec, c int, n int

 RETURN: matrix, int: the v-block of the matrix of local coordinates
                      and the index of the highest variable used.

 Example: example block; shows an example"
{
  int a,b,m, i,j;
  int k = c;
  matrix B;

  if (size(v)==1)
    {
      m = v[1];
      b = m;
    }
  else
    {
      a,b = v;
      m = b-a;
      matrix zero[m][a];
    }

  matrix Id[m][m] = diag(1,m);
  matrix Vars[m][n-b];
  for (i=1; i<=m; i++)
    {
      for (j=1; j<=n-b; j++)
	{
	  Vars[i,j] = var(k);
	  k++;
	}
    }
  B = concat(Id,Vars);
  if (size(v)==2)
    {
      B = concat(zero, B);
    }

  return(B,k);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec a = 2,3;
  int n = 5;
  def R = flagRing(a,n);
  setring R;
  int k;
  matrix B;
  B,k = block(2,1,n);
  print(B);
  print(block(a,k,n));
}

proc localCoordMatrix (intvec a, int n)
"USAGE: localCoordMatrix(a); a intvec

 RETURN: matrix: matrix of local coordinates

 Example: example localCoordMatrix; shows an example"
{
  int i,k;
  int s = size(a);
  int m = a[s];
  intvec v;
  matrix E,B;
  E,k = block(a[1],1,n);
  for (i=1; i<s; i++)
    {
      v = a[i],a[i+1];
      B,k = block(v,k,n);
      E = transpose(concat(transpose(E),transpose(B)));
    }
  return(E);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec a = 3,7,9;
  int n = 10;
  def R = flagRing(a,n);
  setring R;
  matrix E = localCoords(a,n);
  print(E);
}

//////////////////////////////////////////////////////////////////////////
proc secantMatrix (list l, int n)
{
  int m = size(l);
  matrix P[m][n];
  int i,j;
  for (i=1; i<=m; i++)
    {
      for (j=1; j<=n; j++)
	{
	  P[i,j] = l[i]^(j-1);
	}
    }
  return(P);
}

////////////////////////////////////////////////////////////////////////////
proc osculatingMatrix (number p, int n)
{
  matrix P[n-1][n];
  int i,j;
  for (i=0; i<n-1; i++)
    {
      for (j=0; j<n; j++)
	{
	  P[i+1,j+1] = binomial(j,i,0)*p^(j-i);
	}
    }
  return(P);
}

/////////////////////////////////////////////////////////////////////////
//
// l  : list of points
// w  : permutation (schubert condition)
// a  : type of flag 
// n  : dimension of vector space (Fl(a,n))
//
/* conditionIdeal modified by fs  on 09.04.08. */
proc conditionIdeal (list l, intvec w, intvec a,  int n, list#)
{
  int i,j,k;
  matrix F = secantMatrix(l,n);
  matrix E = localCoordMatrix(a,n);
  matrix M,e,f;
  list tmp;
  ideal I=0;
  for (i=1; i<=size(a); i++) {
    e = submat(E,1..a[i],1..n);
    tmp = w[1..a[i]];
    tmp = sort(tmp)[1];
    for (j=1; j<=a[i]; j++) {
      if (j==1 and j<tmp[1]) {
        k = size(w)+1-tmp[j];
        f = submat(F,1..k,1..n);
        M = transpose(concat(transpose(f),transpose(e)));
        I = I + minor(M,n+1+j-tmp[j]);
      }
      if (j>1) {
        if (tmp[j-1]+1<tmp[j]) {
          k = size(w)+1-tmp[j];
          f = submat(F,1..k,1..n);
          M = transpose(concat(transpose(f),transpose(e)));
          I = I + minor(M,n+1+j-tmp[j]);
        }
      }
 
    }
  }
  return(I);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec w = 1,2,4,3;
  intvec a = 2,3;
  int n = 4;
  def R = flagRing(a,n);
  setring R;
  list l = 1,2,3,4;
  ideal I = conditionIdeal(l,w,a,n,"help");
  I;
}
//////////////////////////////////////////////////////////////////////////////////

/* May not be needed anymore -jr 25.04.07 */
proc  maxOverDescents (intvec d, intvec w)  
{
  int i;
  int wmax = w[d[1]];
  for (i=2; i<=size(d); i++)
    {
      if (w[d[i]] > wmax)
	{
	  wmax = w[d[i]];
	}
    }
  return(wmax);
}

/* Modified on 09.04.08 by fs */
proc flagIdeal (list points, list conditions, intvec multiplicities, intvec a, int n)
{
  int i,j,m,s;
  int k=1;
  intvec w;
  ideal I;
  list l;
  for (i=1; i<= size(conditions); i++)
    {
      w = conditions[i]; 
      m = multiplicities[i];
/////////////////////////////
      s = numPoints(w);
/////////////////////////////
      for (j=1; j<=m; j++)
	{
          l = points[k..k+s-1];
	  I = I + conditionIdeal(l,w,a,n);
          k = k+s;
	}
    }
  return(I);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec w1 = 1,3,2,4;
  intvec w2 = 1,2,4,3;
  list conditions = w1,w2;
  intvec multiplicities = 3,2;
  intvec a = 2,3;
  int n = 4;
  def R = flagRing(a,n);
  setring R;
  list points = -10/3,-3,-2,-1/3,1/5,3/5,4/5,1;
  ideal I = flagIdeal(points,conditions,multiplicities,a,n);
  I;
}

/* Modified to agree with the new version
   of conditionIdeal 29.04.07 by jr */
proc oscConditionIdeal (number p, intvec w, intvec a,  int n, list#)
{
  int i,j,k,s;
  matrix F = osculatingMatrix(p,n);
  matrix E = localCoordMatrix(a, n);
  matrix M,e,f;
  ideal I=0;
  for (i=1; i<=size(a); i++)
    {
      e = submat(E,1..a[i],1..n);
      for (j=1;j<=n-1;j++)
	{
	  f = submat(F,1..j,1..n);
	  M = transpose(concat(transpose(f),transpose(e)));
	  k = j+a[i]-rooksNE(w,a[i],j)+1;
	  if (k<=nrows(M) and k<=ncols(M))
	    {
	      I = I+minor(M,k);
	    }
	}
    }
  return(I);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec w = 4,2,5,1,3;
  intvec a = 1,3;
  int n = 5;
  def R = flagRing(a,n);
  setring R;
  number p = 1/2;
  ideal I = oscConditionIdeal(p,w,a,n,"help");
  I;
}

/* Modified to agree with the new version
   of flagIdeal 29.04.07 by jr */
proc oscFlagIdeal (list points, list conditions, intvec multiplicities, intvec a, int n)
{
  int i,j,m;
  int k = 1;
  intvec w;
  ideal I;
  number p;
  for (i=1; i<= size(conditions); i++)
    {
      w = conditions[i]; 
      m = multiplicities[i];
      for (j=1; j<=m; j++)
	{
          p = points[k];
	  I = I + oscConditionIdeal(p,w,a,n);
          k = k+1;
	}
    }
  return(I);
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec w1 = 1,3,2,4;
  intvec w2 = 1,2,4,3;
  list conditions = w1,w2;
  intvec multiplicities = 3,2;
  intvec a = 2,3;
  int n = 4;
  def R = flagRing(a,n);
  setring R;
  list l = 1/2,1/3,4,-1,9,1/5,-325,1;
  ideal I = oscFlagIdeal(l,conditions, multiplicities,a,n);
  I;
}

proc univarpol (ideal G, int i)
{
  ideal B = kbase(G);
  return(charpoly(coeffs(reduce(var(i)*B,G),B), varstr(i))); 
}
example
{
  "EXAMPLE:"; echo = 2;
  intvec w1 = 1,3,2,4;
  intvec w2 = 1,2,4,3;
  list conditions = w1,w2;
  intvec multiplicities = 3,2;
  intvec a = 2,3;
  int n = 4;
  def R = flagRing(a,n);
  setring R;
  list l = 1/2,1/3,4,-1,9,1/5,-325,1;
  ideal I = flagIdeal(l,conditions, multiplicities,a,n);
  ideal G = std(I);
  poly f = univarpol(G,1);
  f;
}
/////////////////////////////////////////////////////////////////////////
//
//   numPoints  takes a permutation and determines the dimension of the 
//                subspace of the flag needed for its essential conditions.
//
/* numPoints   created by fs on 08.04.08.  */
proc numPoints (intvec w)
{
  int i,j;
  list tmp;
  int npoints = 0;

  for (i=1; i<size(w); i++) {
    if (w[i] > w[i+1]) {
      tmp = w[1..i];
      tmp = sort(tmp)[1];
      j = 1;
      while ( j == tmp[j] and j <= i ) {
        j++;
      }
      if ( j <= i and npoints < size(w)+1-tmp[j] ) {
        npoints = size(w)+1-tmp[j];
      }
    }
  }
  return(npoints);
}