####################################################################
#                                                                  #
#  Equivariant Schubert Calculator                                 #
#                                                                  #
#  A program for computations in the equivariant cohomology and    #
#  K-theory rings of generalized flag varieties G/P.               #
#                                                                  #
#  Written by Anders S. Buch.                                      #
#                                                                  #
####################################################################


####################################################################

####################################################################
#  This module implements basic operations of root systems         #
#  and Weyl groups.                                                #
####################################################################
#                                                                  #
#  Data structures:                                                #
#                                                                  #
#  Root system: Cartan matrix as list of lists.                    #
#                                                                  #
#  Root: [c_1,c_2,...,c_n]                                         #
#  c_i : coefficient of i-th simple root.                          #
#                                                                  #
#  Weight: [la_1,la_2,...,la_n]                                    #
#  la_i : coefficient of i-th fundamental weight.                  #
#                                                                  #
#  Coroot: [c_1,c_2,...,c_n]                                       #
#  c_i : coefficient of i-th simple coroot.                        #
#                                                                  #
#  Coweight: [la_1,la_2,...,la_n]                                  #
#  la_i : coefficient of i-th fundamental coweights.               #
#                                                                  #
#  Weyl group element:  The element w is represented as            #
#  the weight w^{-1}.[1$n].                                        #
#                                                                  #
#  Parabolic subgroup: {j_1, j_2, ..., j_p} represents             #
#  the subgroup generated by s_{j_1}, ..., s_{j_p}.                #
#                                                                  #
####################################################################

weyl := module()
option package;

export
  cartan_A, cartan_B, cartan_C, cartan_D, cartan_E, cartan_F, cartan_G,
  rs_new, rs_sum, rs_dual, rs_perm, rs_component, rs_simple_squares,
  rs_simple_neighbors, rs_simple_chain, rs_data, rs_simply_laced,
  pair_root_coroot, pair_root_root, pair_coroot_coroot,
  pair_weight_coroot, pair_coweight_root, pair_weight_coweight, is_long,
  is_short, root_to_coroot, root_to_weight, coroot_to_coweight,
  weight_to_root, coweight_to_coroot, simpref_root, simpref_coroot,
  simpref_weight, simpref_coweight, ref_root, ref_coroot, ref_weight,
  ref_coweight, weyl_id, weyl_longest, weyl_simpref, weyl_ref,
  weyl_length, weyl_imult, weyl_imult_reduced, weyl_imult_hecke,
  weyl_inverse, weyl_mult, weyl_mult_reduced, weyl_mult_hecke, act_root,
  act_coroot, act_weight, act_coweight, weyl_redexp, redexp_weyl,
  redexp_act_root, redexp_act_coroot, redexp_act_weight,
  redexp_act_coweight, max_parab, max_parab_index, pos_roots, high_root,
  c1tangent, weyl_is_minrep, weyl_is_maxrep, weyl_minrep, weyl_maxrep,
  weyl_minrep_diff, weyl_dual, bruhat_down, bruhat_down_all, bruhat_up,
  bruhat_up_all, bruhat_leq, bruhat_weakleft_down, bruhat_weakleft_down_all,
  bruhat_weakleft_up, bruhat_weakleft_up_all, bruhat_weakleft_leq,
  bruhat_weakright_down, bruhat_weakright_down_all, bruhat_weakright_up,
  bruhat_weakright_up_all, bruhat_weakright_leq, weyl_group_maxlen,
  weyl_group_layer, weyl_group;

local
  rs_inverse, rs_component_inner, order_closure;


####################################################################
#  Cartan matrices
####################################################################

cartan_A := proc(n)
  local i;
  if n<1 then RETURN(NULL); fi;
  if n=1 then RETURN([[2]]); fi;
  [[2,-1,0$(n-2)], seq([0$(i-2),-1,2,-1,0$(n-i-1)], i=2..n-1), [0$(n-2),-1,2]];
end:

cartan_B := proc(n)
  local A;
  if n < 2 then RETURN(NULL); fi;
  A := cartan_A(n);
  subsop(n-1=subsop(n=-2, A[n-1]), A);
end:

cartan_C := proc(n)
  local A;
  if n < 2 then RETURN(NULL); fi;
  A := cartan_A(n);
  subsop(n=subsop(n-1=-2, A[n]), A);
end:

cartan_D := proc(n)
  local A;
  if n < 3 then RETURN(NULL) fi;
  A := cartan_A(n);
  [op(1..n-3,A), [op(1..n-3,A[n-2]),2,-1,-1],
   [0$(n-3),-1,2,0], [0$(n-3),-1,0,2]];
end:

cartan_E := proc(n)
  local e8, i;
  if n < 6 or n > 8 then RETURN(NULL) fi;
  e8 := [[2, 0, -1, 0, 0, 0, 0, 0],
         [0, 2, 0, -1, 0, 0, 0, 0],
         [-1, 0, 2, -1, 0, 0, 0, 0],
         [0, -1, -1, 2, -1, 0, 0, 0],
         [0, 0, 0, -1, 2, -1, 0, 0],
         [0, 0, 0, 0, -1, 2, -1, 0],
         [0, 0, 0, 0, 0, -1, 2, -1],
         [0, 0, 0, 0, 0, 0, -1, 2]];
  [seq([op(1..n,e8[i])], i=1..n)];
end:

cartan_F := proc(n)
  if n <> 4 then RETURN(NULL) fi;
  [[2, -1, 0, 0], [-1, 2, -2, 0], [0, -1, 2, -1], [0, 0, -1, 2]];
end:

cartan_G := proc(n)
  if n <> 2 then RETURN(NULL) fi;
  [[2, -1], [-3, 2]];
end:


####################################################################
#  Create root systems
####################################################################

rs_new := proc(tp, rk)
  local tt, sn, n, R, i, j;
  if type(tp,list) then RETURN(tp); fi;
  if not type(tp,string) then RETURN(false); fi;
  if length(tp)>1 and nargs>1 then RETURN(false); fi;
  tt := substring(tp,1);
  sn := `if`(nargs=2, rk, parse(substring(tp,2..-1)));
  n  := abs(sn);
  if   tt="A" then R := cartan_A(n);
  elif tt="B" then R := cartan_B(n);
  elif tt="C" then R := cartan_C(n);
  elif tt="D" then R := cartan_D(n);
  elif tt="E" then R := cartan_E(n);
  elif tt="F" then R := cartan_F(n);
  elif tt="G" then R := cartan_G(n);
  else RETURN(false);
  fi;
  if not type(R,list) then RETURN(false); fi;
  if sn < 0 then R := [seq([seq(R[-i][-j], j=1..n)], i=1..n)]; fi;
  R;
end:

rs_sum := proc(R1, R2)
  local R, n, k, S, m, i;
  R := R1;
  n := nops(R1);
  for k from 2 to nargs do
    S := args[k];
    m := nops(S);
    R := [seq([op(R[i]),0$m],i=1..n), seq([0$n,op(S[i])],i=1..m)];
    n := n+m;
  od;
  R;
end:

rs_dual := proc(R)
  option remember;
  local i, j, n;
  n := nops(R);
  [seq([seq(R[j][i], j=1..n)], i=1..n)];
end:

rs_perm := proc(w, R)
  local n, wi, i, j;
  n := nops(R);
  wi := array(1..n);
  for i from 1 to n do wi[w[i]] := i; od;
  [seq([seq(R[wi[i]][wi[j]], j=1..n)], i=1..n)];
end:

rs_inverse := proc(R)
  option remember;
  local Ri, i, j, n;
  Ri := linalg[inverse](R);
  n := nops(R);
  [seq([seq(Ri[i,j], j=1..n)], i=1..n)];
end:

rs_component_inner := proc(i, R)
  option remember;
  local sr, res, todo, j, nbj, k;
  sr := {seq(j, j=1..nops(R))};
  res := {i};
  todo := {i};
  while todo <> {} do
    j := todo[1];
    todo := todo minus {j};
    nbj := select(k -> R[j][k]<>0, sr) minus res;
    res := res union nbj;
    todo := todo union nbj;
  od;
  res;
end:

rs_component := proc(al, R)
  local i;
  i := `if`(type(al,integer), al,
       min(seq(`if`(al[i]<>0, i, NULL), i=1..nops(R))));
  rs_component_inner(i, R);
end:

rs_simple_squares := proc(R)
  option remember;
  local n, slen, getlen, setlen, i;
  n := nops(R);
  slen := array([0$n]);
  getlen := proc(i, ln)
    local mn, j, k;
    slen[i] := -ln;
    mn := i;
    for j from 1 to n do
      if slen[j]=0 and R[i][j]<0 and R[j][i]<0 then
        k := getlen(j, ln * R[j][i] / R[i][j]);
        if slen[k] > slen[i] then mn := k; fi;
      fi;
    od;
    mn;
  end:
  setlen := proc(i, ln)
    local x, j;
    x := ln / slen[i];
    slen[i] := ln;
    for j from 1 to n do
      if slen[j]<0 and R[i][j]<0 and R[j][i]<0 then
        setlen(j, x * slen[j]);
      fi;
    od;
  end:
  for i from 1 to n do
    if slen[i]=0 then
      setlen(getlen(i, 2), 2);
    fi;
  od;
  [seq(slen[i], i=1..n)];
end:

rs_simple_neighbors := proc(i, R)
  local j;
  select(j -> R[i][j]<0 and R[j][i]<0, {seq(j,j=1..nops(R))});
end:

rs_simple_chain := proc(i, avoid, R)
  local res, lst, nxt;
  res := [];
  nxt := {i};
  lst := avoid;
  while nops(nxt) = 1 do
    res := [op(res), op(nxt)];
    nxt := rs_simple_neighbors(res[-1], R) minus lst;
    lst := {res[-1]};
  od;
  res;
end:


# If R is an irreducible root system, then return the pair [tp,w] where
# tp is the type of the root system, "A", "B", ..., or "G".
# w is the permutation of simple roots relative to Bourbaki notation.
# If R is not irreducible, then return false.
#
# The argument opt is a string.
# The behavior of rs_data can be modified my including characters in opt.
# The order of the characters in opt does not matter.
#
# The following characters effects the result of rs_data():
# "B": If R has type B2/C2, then treat it as B2.
# "C": If R has type B2/C2, then treat it as C2.
# "D": If R has type A3, then use type "D3".
# "-": If R has an involution, then apply this involution to w.
# "r": If R has type D4, then rotate to the right.
# "l": If R has type D4, then rotate to the left.
#
rs_data := proc(R, opt)
  option remember;
  local n, opt0, slen, nbrs, srts, endpt, i, j, rord, branchpt, branch,
        x, y, nx, ny;
  n := nops(R);
  opt0 := `if`(nargs=2, {seq(x,x=opt)}, {});
  slen := rs_simple_squares(R);
  nbrs := [seq(rs_simple_neighbors(j,R), j=1..n)];
  srts := {seq(j,j=1..n)};
  endpt := select(j -> nops(nbrs[j])<=1, srts);
  if nops(endpt) <= 2 then
    i := min(endpt);
    rord := rs_simple_chain(i, {}, R);
    if nops(rord) <> n then RETURN(false); fi;
    if {op(slen)} = {2} then
      if n=3 and "D" in opt0 then
        if "-" in opt0 then
          RETURN(["D", [rord[2], rord[3], rord[1]]]);
	else
          RETURN(["D", [rord[2], rord[1], rord[3]]]);
        fi;
      else
        if "-" in opt0 then rord := [seq(rord[-j], j=1..nops(rord))]; fi;
        RETURN(["A", rord]);
      fi;
    fi;
    if slen = [2,6] then RETURN(["G", [1,2]]); fi;
    if slen = [6,2] then RETURN(["G", [2,1]]); fi;
    if {op(slen)} <> {2,4} then RETURN(false); fi;
    if sort(slen) = [2,2,4,4] then
      if slen[rord[1]] = 2 then rord := [seq(rord[-j], j=1..nops(rord))]; fi;
      RETURN(["F", rord]);
    fi;
    if slen[rord[-1]] = slen[rord[-2]] then
      rord := [seq(rord[-j], j=1..nops(rord))];
    fi;
    if nops({seq(slen[rord[j]], j=1..n-1)}) <> 1 then RETURN(false); fi;
    if (n=2 and "B" in opt0 and slen[rord[1]]=2) or
       (n=2 and "C" in opt0 and slen[rord[1]]=4)
    then
      rord := [seq(rord[-j], j=1..nops(rord))];
    fi;
    RETURN([`if`(slen[rord[1]]=2, "C", "B"), rord]);
  fi;
  if {op(slen)} <> {2} then RETURN(false); fi;
  branchpt := select(j -> nops(nbrs[j])>=3, srts);
  if nops(branchpt) <> 1 then RETURN(false); fi;
  i := op(branchpt);
  branch := [seq(rs_simple_chain(j, {i}, R), j=nbrs[i])];
  if nops(branch) <> 3 then RETURN(false); fi;
  if `+`(seq(nops(x), x=branch)) <> n-1 then RETURN(false); fi;
  for x from 1 to 2 do
    for y from x+1 to 3 do
      nx := nops(branch[x]);
      ny := nops(branch[y]);
      if (nx = 1 and ny > 1) or (ny > 1 and nx > ny) then
        branch := subsop(x=branch[y], y=branch[x], branch);
      fi;
    od;
  od;
  if nops(branch[3]) <> 1 then RETURN(false); fi;
  if nops(branch[2]) = 1 then
    rord := [seq(branch[1][-x], x=1..nops(branch[1])),
             i, op(branch[2]), op(branch[3])];
    if "l" in opt0 and n=4 then
      rord := subsop(1=rord[3],3=rord[4],4=rord[1], rord);
    fi;
    if "r" in opt0 and n=4 then
      rord := subsop(1=rord[4],4=rord[3],3=rord[1], rord);
    fi;
    if "-" in opt0 then rord := subsop(-1=rord[-2],-2=rord[-1], rord); fi;
    RETURN(["D", rord]);
  fi;
  if nops(branch[1]) <> 2 then RETURN(false); fi;
  if not nops(branch[2]) in {2,3,4} then RETURN(false); fi;
  if "-" in opt0 and n=6 then
    branch := subsop(1=branch[2],2=branch[1], branch);
  fi;
  rord := [branch[1][2], branch[3][1], branch[1][1], i, op(branch[2])];
  RETURN(["E", rord]);
end:

rs_simply_laced := proc(R)
  evalb(nops({op(rs_simple_squares(R))}) = 1);
end:


####################################################################
#  Pairings
####################################################################

pair_root_coroot := proc(al, be, R)
  local n, slen, be2, i, j;
  n := nops(R);
  `+`(seq(seq(al[i]* R[i][j]* be[j], j=1..n), i=1..n));
end:

pair_root_root := proc(al, be, R)
  local n, slen, i, j;
  n := nops(R);
  slen := rs_simple_squares(R);
  `+`(seq(seq(al[i] * R[i][j] * slen[j] * be[j], j=1..n), i=1..n)) / 2;
end:

pair_coroot_coroot := proc(al, be, R)
  pair_root_root(al, be, rs_dual(R));
end:

pair_weight_coroot := proc(mu, al)
  local i;
  `+`(seq(mu[i]*al[i], i=1..nops(mu)));
end:

pair_coweight_root := pair_weight_coroot:

pair_weight_coweight := proc(la, mu, R)
  local Ri, n, i, j;
  Ri := rs_inverse(R);
  n := nops(R);
  `+`(seq(seq(la[i]*Ri[i][j]*mu[j], j=1..n), i=1..n));
end:

is_long := proc(al, R)
  local ss, maxss, i;
  ss := rs_simple_squares(R);
  maxss := max(seq(ss[i], i=rs_component(al, R)));
  evalb(pair_root_root(al, al, R) = maxss);
end:

is_short := proc(al, R)
  local ss, minss, i;
  ss := rs_simple_squares(R);
  minss := min(seq(ss[i], i=rs_component(al, R)));
  evalb(pair_root_root(al, al, R) = minss);
end:


####################################################################
#  Conversions
####################################################################

root_to_coroot := proc(al, R)
  option remember;
  local slen, al2, n, i;
  n := nops(R);
  slen := rs_simple_squares(R);
  al2 := pair_root_root(al, al, R);
  [seq(al[i]*slen[i]/al2, i=1..n)];
end:

root_to_weight := proc(al, R)
  local n, i, j;
  n := nops(R);
  [seq(`+`(seq(al[i]*R[i][j], i=1..n)), j=1..n)];
end:

coroot_to_coweight := proc(al, R)
  local n, i, j;
  n := nops(R);
  [seq(`+`(seq(al[i]*R[j][i], i=1..n)), j=1..n)];
end:

weight_to_root := proc(la, R)
  local Ri, n, i, j;
  Ri := rs_inverse(R);
  n := nops(R);
  [seq(`+`(seq(la[i]*Ri[i][j], i=1..n)), j=1..n)];
end:

coweight_to_coroot := proc(la, R)
  local Ri, n, i, j;
  Ri := rs_inverse(R);
  n := nops(R);
  [seq(`+`(seq(la[i]*Ri[j][i], i=1..n)), j=1..n)];
end:


####################################################################
#  Simple reflections
####################################################################

simpref_root := proc(i, be, R)
  local n, c, j;
  n := nops(R);
  c := `+`(seq(be[j]*R[j][i], j=1..n));
  subsop(i=be[i]-c, be);
end:

simpref_coroot := proc(i, be, R)
  local n, c, j;
  n := nops(R);
  c := `+`(seq(be[j]*R[i][j], j=1..n));
  subsop(i=be[i]-c, be);
end:

simpref_weight := proc(i, la, R)
  local n, j;
  n := nops(R);
  [seq(la[j] - la[i]*R[i][j], j=1..n)];
end:

simpref_coweight := proc(i, la, R)
  local n, j;
  n := nops(R);
  [seq(la[j] - la[i]*R[j][i], j=1..n)];
end:


####################################################################
#  Reflection by roots
####################################################################

ref_root := proc(al, be, R)
  local n, alv, c, i;
  n := nops(R);
  c := 2 * pair_root_root(be, al, R) / pair_root_root(al, al, R);
  [seq(be[i] - c * al[i], i=1..n)];
end:

ref_coroot := proc(al, be, R)
  local n, alv, c, i;
  n := nops(R);
  alv := root_to_coroot(al, R);
  c := pair_root_coroot(al, be, R);
  [seq(be[i] - c * alv[i], i=1..n)];
end:

ref_weight := proc(al, mu, R)
  local n, alv, c, i, j;
  n := nops(R);
  alv := root_to_coroot(al, R);
  c := pair_weight_coroot(mu, alv);
  [seq(mu[j] - c*`+`(seq(al[i]*R[i][j],i=1..n)), j=1..n)];
end:

ref_coweight := proc(al, mu, R)
  local n, alv, c, i, j;
  n := nops(R);
  alv := root_to_coroot(al, R);
  c := pair_coweight_root(mu, al);
  [seq(mu[j] - c*`+`(seq(alv[i]*R[j][i],i=1..n)), j=1..n)];
end:


####################################################################
#  Weyl group operations
####################################################################
#  The Weyl group element w is represented as the weight
#  w^{-1}.[1$n].
####################################################################

weyl_id := proc(R)
  [1$nops(R)];
end:

weyl_longest := proc(R)
  [-1$nops(R)];
end:

weyl_simpref := proc(i, R)
  simpref_weight(i, [1$nops(R)], R);
end:

weyl_ref := proc(al, R)
  ref_weight(al, [1$nops(R)], R);
end:

weyl_length := proc(wt, R)
  local n, res, lam, i;
  n := nops(R);
  res := 0;
  lam := wt;
  while true do
    i := 1;
    while i <= n and lam[i] >= 0 do i := i+1; od;
    if i = n+1 then
      RETURN(res);
    fi;
    res := res + 1;
    lam := simpref_weight(i, lam, R);
  od;
end:

# Compute wt1 * wt2^{-1} as Weyl group elements.
# More precisely, return w^{-1}.[1$n] = v u^{-1}.[1$n], where
# w = u v^{-1}, u^{-1}.[1$n]=wt1, and v^{-1}.[1$n]=wt2
#
weyl_imult := proc(wt1, wt2, R)
  local n, lam, res, i;
  n := nops(R);
  lam := wt2;
  res := wt1;
  while true do
    i := 1;
    while i <= n and lam[i] >= 0 do i := i+1; od;
    if i = n+1 then
      RETURN(res);
    fi;
    lam := simpref_weight(i, lam, R);
    res := simpref_weight(i, res, R);
  od;
end:

weyl_imult_reduced := proc(wt1, wt2, R)
  local n, lam, res, i;
  n := nops(R);
  lam := wt2;
  res := wt1;
  while true do
    i := 1;
    while i <= n and lam[i] > 0 do i := i+1; od;
    if i = n+1 then
      RETURN(res);
    fi;
    if res[i] < 0 then RETURN(false); fi;
    lam := simpref_weight(i, lam, R);
    res := simpref_weight(i, res, R);
  od;
end:

weyl_imult_hecke := proc(wt1, wt2, R)
  local n, lam, res, i;
  n := nops(R);
  lam := wt2;
  res := wt1;
  while true do
    i := 1;
    while i <= n and lam[i] > 0 do i := i+1; od;
    if i = n+1 then
      RETURN(res);
    fi;
    lam := simpref_weight(i, lam, R);
    if res[i] > 0 then
      res := simpref_weight(i, res, R);
    fi;
  od;
end:

weyl_inverse := proc(wt, R)
  weyl_imult([1$nops(R)], wt, R);
end:

weyl_mult := proc(wt1, wt2, R)
  weyl_imult(wt1, weyl_inverse(wt2, R), R);
end:

weyl_mult_reduced := proc(wt1, wt2, R)
  weyl_imult_reduced(wt1, weyl_inverse(wt2, R), R);
end:

weyl_mult_hecke := proc(wt1, wt2, R)
  weyl_imult_hecke(wt1, weyl_inverse(wt2, R), R);
end:


####################################################################
#  Action by Weyl group elements
####################################################################

act_root := proc(wt, al, R)
  local n, lam, res, i;
  n := nops(R);
  lam := wt;
  res := al;
  while true do
    i := 1;
    while i <= n and lam[i] >= 0 do i := i+1; od;
    if i = n+1 then
      RETURN(res);
    fi;
    lam := simpref_weight(i, lam, R);
    res := simpref_root(i, res, R);
  od;
end:

act_coroot := proc(wt, al, R)
  local n, lam, res, i;
  n := nops(R);
  lam := wt;
  res := al;
  while true do
    i := 1;
    while i <= n and lam[i] >= 0 do i := i+1; od;
    if i = n+1 then
      RETURN(res);
    fi;
    lam := simpref_weight(i, lam, R);
    res := simpref_coroot(i, res, R);
  od;
end:

act_weight := proc(wt, la, R)
  weyl_imult(la, wt, R);
end:

act_coweight := proc(wt, la, R)
  local n, lam, res, i;
  n := nops(R);
  lam := wt;
  res := la;
  while true do
    i := 1;
    while i <= n and lam[i] >= 0 do i := i+1; od;
    if i = n+1 then
      RETURN(res);
    fi;
    lam := simpref_weight(i, lam, R);
    res := simpref_coweight(i, res, R);
  od;
end:


####################################################################
#  Reduced expressions
####################################################################

# Return reduced word for w such that w^{-1}.[1$n] = wt.
weyl_redexp := proc(wt, R)
  local n, wge, lam, i;
  n := nops(R);
  wge := [];
  lam := wt;
  while true do
    i := 1;
    while i <= n and lam[i] >= 0 do i := i+1; od;
    if i = n+1 then
      RETURN(wge);
    fi;
    wge := [i, op(wge)];
    lam := simpref_weight(i, lam, R);
  od;
end:

# Return wge^{-1}.[1$n]
redexp_weyl := proc(wge, R)
  local wt, i;
  wt := [1$nops(R)];
  for i in wge do
    wt := simpref_weight(i, wt, R);
  od;
  wt;
end:

redexp_act_root := proc(wge, al, R)
  local res, i;
  res := al;
  for i from nops(wge) to 1 by -1 do
    res := simpref_root(wge[i], res, R);
  od;
  res;
end:

redexp_act_coroot := proc(wge, al, R)
  local res, i;
  res := al;
  for i from nops(wge) to 1 by -1 do
    res := simpref_coroot(wge[i], res, R);
  od;
  res;
end:

redexp_act_weight := proc(wge, mu, R)
  local res, i;
  res := mu;
  for i from nops(wge) to 1 by -1 do
    res := simpref_weight(wge[i], res, R);
  od;
  res;
end:

redexp_act_coweight := proc(wge, mu, R)
  local res, i;
  res := mu;
  for i from nops(wge) to 1 by -1 do
    res := simpref_coweight(wge[i], res, R);
  od;
  res;
end:


####################################################################
#  Parabolic subgroups
####################################################################
#  A parabolic subgroup is represented by a subset of {1,2,...,n}.
####################################################################

max_parab := proc(k, R)
  local i;
  {seq(i,i=1..nops(R))} minus {k};
end:

max_parab_index := proc(R,P)
  local i, k;
  k := {seq(i,i=1..nops(R))} minus P;
  if nops(k) <> 1 then
    false;
  else
    op(k);
  fi;
end:

# Return set of all positive roots not in R_P
pos_roots := proc(R,P)
  option remember;
  local n, res, add_root, i, Pc, al;
  n := nops(R);
  res := {};
  add_root := proc(al)
    local c, i, j;
    if not member(al, res) then
      res := res union {al};
      for i from 1 to n do
        c := `+`(seq(al[j]*R[j][i], j=1..n));
	if c<0 then
          add_root(subsop(i=al[i]-c,al));
        fi;
      od;
    fi;
  end:
  for i from 1 to n do
    add_root([0$(i-1),1,0$(n-i)]);
  od;
  if nargs = 1 then RETURN(res); fi;
  Pc := {seq(i,i=1..n)} minus P;
  select(al -> {0,seq(al[i],i=Pc)}<>{0}, res);
end:

# Assumes R is irreducible.
high_root := proc(R)
  option remember;
  local high, al;
  high := [0$nops(R)];
  for al in pos_roots(R,{}) do
    if min(al - high) >= 0 then high := al; fi;
  od;
  high;
end:

c1tangent := proc(R,P)
  root_to_weight(`+`(op(pos_roots(R,P))), R);
end:

weyl_is_minrep := proc(wt, R,P)
  local i;
  evalb(min(seq(wt[i], i=P)) > 0);
end:

weyl_is_maxrep := proc(wt, R,P)
  local i;
  evalb(max(seq(wt[i], i=P)) < 0);
end:

weyl_minrep := proc(wt, R,P)
  local lm, i;
  lm := wt;
  while true do
    i := 1;
    while i <= nops(P) and lm[P[i]] > 0 do i := i+1; od;
    if i > nops(P) then RETURN(lm); fi;
    lm := simpref_weight(P[i], lm, R);
  od;
end:

weyl_minrep_diff := proc(wt, R,P)
  local res, lm, i;
  res := weyl_id(R);
  lm := wt;
  while true do
    i := 1;
    while i <= nops(P) and lm[P[i]] > 0 do i := i+1; od;
    if i > nops(P) then RETURN(weyl_inverse(res,R)); fi;
    lm := simpref_weight(P[i], lm, R);
    res := simpref_weight(P[i], res, R);
  od;
end:

weyl_maxrep := proc(wt, R,P)
  local lm, i;
  lm := wt;
  while true do
    i := 1;
    while i <= nops(P) and lm[P[i]] < 0 do i := i+1; od;
    if i > nops(P) then RETURN(lm); fi;
    lm := simpref_weight(P[i], lm, R);
  od;
end:

weyl_dual := proc(wt, R,P)
  weyl_minrep(-wt, R,P);
end:


####################################################################
#  Bruhat order
####################################################################

order_closure := proc(order_step, wt, R,P)
  local ws, res;
  ws := `if`(type(wt,set), wt, {wt});
  res := ws;
  while ws <> {} do
    ws := order_step(ws, R,P) minus res;
    res := res union ws;
  od;
  res;
end:

bruhat_down := proc(wt, R,P)
  local n, wts, res, w, lft, rgt, i, prd;
  n := nops(R);
  wts := `if`(type(wt,set), wt, {wt});
  res := {};
  for w in wts do
    lft := w;
    rgt := [1$n];
    while lft <> [1$n] do
      i := 1;
      while lft[i]>0 do i := i+1; od;
      lft := simpref_weight(i, lft, R);
      prd := weyl_imult_reduced(lft, rgt, R);
      if type(prd,list) and weyl_is_minrep(prd, R,P) then
        res := res union {prd};
      fi;
      rgt := simpref_weight(i, rgt, R);
    od;
  od;
  res;
end:

bruhat_down_all := proc(wt, R,P)
  local ws;
  order_closure(bruhat_down, wt, R,P);
end:

bruhat_up := proc(wt, R,P)
  local n, wts, res, w, lft, rgt, i, prd;
  n := nops(R);
  wts := `if`(type(wt,set), wt, {wt});
  res := {};
  for w in wts do
    lft := -w;   # = w_0*w    # NOT QUITE, FIXME!!!!!
    rgt := [1$n];
    while lft <> [1$n] do
      i := 1;
      while lft[i]>0 do i := i+1; od;
      lft := simpref_weight(i, lft, R);
      prd := weyl_imult_reduced(lft, rgt, R);
      if type(prd,list) and weyl_is_minrep(-prd, R,P) then
        res := res union {-prd};
      fi;
      rgt := simpref_weight(i, rgt, R);
    od;
  od;
  res;
end:

bruhat_up_all := proc(wt, R,P)
  local ws;
  order_closure(bruhat_up, wt, R,P);
end:

bruhat_leq := proc(wt1, wt2, R)
  local n, la, mu, i;
  n := nops(R);
  la := wt1;
  mu := wt2;
  while true do
    i := 1;
    while i<=n and mu[i]>0 do i := i+1; od;
    if i = n+1 then
      RETURN(evalb(la = [1$n]));
    fi;
    mu := simpref_weight(i, mu, R);
    if la[i]<0 then
      la := simpref_weight(i, la, R);
    fi;
  od;
end:


bruhat_weakleft_down := proc(wt, R,P)
  local n, wts, res, la, mu, mu1, i;
  n := nops(R);
  wts := `if`(type(wt,set), wt, {wt});
  res := {};
  for la in wts do
    mu := weyl_inverse(la, R);
    for i from 1 to n do
      if mu[i] < 0 then
        mu1 := weyl_inverse(simpref_weight(i, mu, R), R);
	if weyl_is_minrep(mu1, R,P) then
          res := res union {mu1};
        fi;
      fi;
    od;
  od;
  res;
end:

bruhat_weakleft_down_all := proc(wt, R,P)
  local ws;
  order_closure(bruhat_weakleft_down, wt, R,P);
end:

bruhat_weakleft_up := proc(wt, R,P)
  local n, wts, res, la, mu, i, mu1;
  n := nops(R);
  wts := `if`(type(wt,set), wt, {wt});
  res := {};
  for la in wts do
    mu := weyl_inverse(la, R);
    for i from 1 to n do
      if mu[i] > 0 then
        mu1 := weyl_inverse(simpref_weight(i, mu, R), R);
	if weyl_is_minrep(mu1, R,P) then
          res := res union {mu1};
        fi;
      fi;
    od;
  od;
  res;
end:

bruhat_weakleft_up_all := proc(wt, R,P)
  local ws;
  order_closure(bruhat_weakleft_up, wt, R,P);
end:

bruhat_weakleft_leq := proc(wt1, wt2, R)
  local n, la1, la2, i;
  n := nops(R);
  la1 := wt1;
  la2 := wt2;
  while true do
    i := 1;
    while i<=n and la1[i]>0 do i := i+1; od;
    if i=n+1 then RETURN(true); fi;
    if la2[i]>0 then RETURN(false); fi;
    la1 := simpref_weight(i, la1, R);
    la2 := simpref_weight(i, la2, R);
  od;
end:


bruhat_weakright_down := proc(wt, R)
  local n, wts, res, la, i;
  n := nops(R);
  wts := `if`(type(wt,set), wt, {wt});
  res := {};
  for la in wts do
    for i from 1 to n do
      if la[i] < 0 then
        res := res union {simpref_weight(i, la, R)};
      fi;
    od;
  od;
  res;
end:

bruhat_weakright_down_all := proc(wt, R)
  local ws;
  order_closure(bruhat_weakright_down, wt, R,0);
end:

bruhat_weakright_up := proc(wt, R)
  local n, wts, res, la, i;
  n := nops(R);
  wts := `if`(type(wt,set), wt, {wt});
  res := {};
  for la in wts do
    for i from 1 to n do
      if la[i] > 0 then
        res := res union {simpref_weight(i, la, R)};
      fi;
    od;
  od;
  res;
end:

bruhat_weakright_up_all := proc(wt, R)
  local ws;
  order_closure(bruhat_weakright_up, wt, R,0);
end:

bruhat_weakright_leq := proc(wt1, wt2, R)
  bruhat_weakleft_leq(weyl_inverse(wt1,R),
                      weyl_inverse(wt2,R), R);
end:


####################################################################
#  Weyl group
####################################################################

weyl_group_maxlen := proc(R,P)
  option remember;
  if nargs = 1 then
    weyl_length([-1$nops(R)], R);
  else
    weyl_length(weyl_minrep([-1$nops(R)], R,P), R);
  fi;
end:

weyl_group_layer := proc(len, R,P)
  option remember;
  local maxlen, n, PP;
  PP := `if`(nargs=2, {}, P);
  maxlen := weyl_group_maxlen(R,PP);
  n := nops(R);
  if len < 0 then
    {};
  elif len = 0 then
    {[1$n]};
  elif 2*len > maxlen then
    map(weyl_dual, weyl_group_layer(maxlen-len, R,PP), R,PP);
  elif PP = {} then
    bruhat_weakright_up(weyl_group_layer(len-1, R,PP), R);
  else
    bruhat_weakleft_up(weyl_group_layer(len-1, R,PP), R,PP);
  fi;
end:

weyl_group := proc(R,P)
  local d;
  map(op,[seq(weyl_group_layer(d, args), d=0..weyl_group_maxlen(args))]);
end:


####################################################################


end module:

###

####################################################################
#  This module carries out conversions between common indexing     #
#  objects for Schubert classes.                                   #
####################################################################

conv := module()
option package;

uses weyl;

export
  varX, mkX, sbX, mapXnew, mapX, mapXold,
  sp_mult, sp_inverse, sp_simpref, sp_descents, sp_length, sp_redexp0,
  redexp0_sp, sp_data, weyl_sp, sp_weyl, part_length, part_conj, sp_igrass,
  igrass_sp, is_igrass, weyl_igrass, igrass_weyl, is_comin, is_minus,
  comin_data, weyl_comin, comin_weyl, weyl_part, part_weyl,
  str_length, str_redexp, redexp_str, str_weyl, weyl_str, str_id;

local
  weyl_sp_inner, sp_weyl_inner, weyl_igrass_inner, igrass_weyl_inner,
  weyl_comin_inner, comin_weyl_inner, weyl_part_inner,
  str_weyl_inner, weyl_str_inner;


####################################################################
#  Apply function to linear combinations (or expressions)
#  of X[...] symbols.
####################################################################

mkX := proc(u)
  if type(u,list) then X[op(u)] elif u=false then 0 else u fi;
end:

varX := proc(Xex)
  local x;
  select(x -> type(x,indexed) and op(0,x)=`X`, indets(Xex));
end:

# The function f applied to a weight should return a weight, false, or
# a linear combination of X[...] symbols.
sbX := proc(f, xset)
  local x;
  {seq(x = mkX(f([op(x)], op(3..-1,[args]))), x=xset)};
end:

# Better method, but Maple error prevents it from working.
mapXnew := proc(f, Xex)
  local x;
  subs({seq(x = mkX(f([op(x)], op(3..-1,[args]))), x=varX(Xex))}, Xex);
end:

mapX := proc(f, Xex)
  local fres;
  if type(Xex,`+`) or type(Xex,`*`) or type(Xex,`^`) or type(Xex,`=`) then
    map2(mapX, args);
  elif type(Xex,list) or (type(Xex,indexed) and op(0,Xex)=`X`) then
    fres := f([op(Xex)], op(3..-1,[args]));
    if type(fres,list) then
      X[op(fres)];
    elif fres = false then
      0;
    else
      fres;
    fi;
  else
    Xex;
  fi;
end:


####################################################################
#  Signed permutations (for classical types)
####################################################################

sp_mult := proc(u, v)
  local i;
  [seq(u[abs(v[i])]*sign(v[i]), i=1..nops(v))];
end:

sp_inverse := proc(w)
  local n, wi, i;
  n := nops(w);
  wi := array(w);
  for i from 1 to nops(w) do
    wi[abs(w[i])] := sign(w[i])*i;
  od;
  [seq(wi[i], i=1..n)];
end:

sp_simpref := proc(i, tp, N)
  local w, j;
  w := [seq(j, j=1..N)];
  if i>0 then
    subsop(i=i+1, i+1=i, w);
  elif tp = "D" then
    subsop(1=-2, 2=-1, w);
  else
    subsop(1=-1, w);
  fi;
end:

sp_descents := proc(w, tp)
  local i, res;
  res := select(i -> w[i]>w[i+1], {seq(i,i=1..nops(w)-1)});
  if tp = "D" then
    res union `if`(w[1]+w[2]<0, {0}, {});
  else
    res union `if`(w[1]<0, {0}, {});
  fi;
end:

sp_length := proc(ww, tp)
  nops(sp_redexp0(ww, tp));
end:

sp_redexp0 := proc(ww, tp)
  local res, w, i, ln;
  res := [];
  w := ww;
  while true do
    ln := nops(res);
    for i from 1 to nops(w)-1 do
      if w[i]>w[i+1] then
        w := subsop(i=w[i+1],i+1=w[i], w);
        res := [i, op(res)];
      fi;
    od;
    if ln < nops(res) then next; fi;
    if w[1] > 0 then RETURN(res); fi;
    if tp="D" then
      w := subsop(1=-w[2], 2=-w[1], w);
    else
      w := subsop(1=-w[1], w);
    fi;
    res := [0, op(res)];
    if w[1]<0 then RETURN(false); fi;
  od;
end:

redexp0_sp := proc(wge, tp, N)
  local w, i;
  w := [seq(i,i=1..N)];
  for i in wge do
    if i>0 then
      w := subsop(i=w[i+1], i+1=w[i], w);
    elif tp="D" then
      w := subsop(1=-w[2], 2=-w[1], w);
    else
      w := subsop(1=-w[1], w);
    fi;
  od;
  w;
end:


# Return bijection between simple roots and descent positions.
# [tp, N, ds, sd]
# tp \in {"A","B","C","D"}
# N = size of signed permutations.
# ds = {d1=s1, ..., dn=sn} translation from descents to simple roots.
# sd = {s1=d1, ..., sn=dn} translation from simple roots to descents.
#
sp_data := proc(R,opt)
  option remember;
  local n, rsd, rord, m, i;
  n := nops(R);
  rsd := rs_data(args);
  if rsd = false then RETURN(false); fi;
  if not rsd[1] in {"A", "B", "C", "D"} then RETURN(false); fi;
  rord := rsd[2];
  m := `if`(rsd[1]="A", 0, 1);
  [rsd[1], n+1-m, {seq(i-m=rord[-i],i=1..n)}, {seq(rord[-i]=i-m,i=1..n)}];
end:

weyl_sp_inner := proc(wt, R,opt)
  option remember;
  local data;
  data := sp_data(R,opt);
  redexp0_sp(subs(data[4], weyl_redexp(wt, R)), data[1],data[2]);
end:

weyl_sp := proc(Xex, R,opt)
  if type(Xex,list) then weyl_sp_inner(args);
  else mapX(weyl_sp_inner, args); fi;
end:

sp_weyl_inner := proc(w, R,opt)
  option remember;
  local data;
  data := sp_data(R,opt);
  redexp_weyl(subs(data[3], sp_redexp0(w, data[1])), R);
end:

sp_weyl := proc(Xex, R,opt)
  if type(Xex,list) then sp_weyl_inner(args);
  else mapX(sp_weyl_inner, args); fi;
end:


####################################################################
#  String notation for type A
####################################################################

str_length := proc(s)
  local i, j;
  nops([seq(seq(`if`(s[i]>s[j],1,NULL), i=1..j-1), j=2..nops(s))]);
end:

redexp_str := proc(wge, s0)
  local s, i, j;
  s := s0;
  for i from nops(wge) to 1 by -1 do
    j := wge[i];
    s := subsop(j=s[j+1],j+1=s[j], s);
  od;
  s;
end:

str_redexp := proc(ss)
  local res, s, ln, i;
  res := [];
  s := ss;
  while true do
    ln := nops(res);
    for i from 1 to nops(s)-1 do
      if s[i] > s[i+1] then
        s := subsop(i=s[i+1],i+1=s[i], s);
	res := [op(res), i];
      fi;
    od;
    if ln = nops(res) then RETURN(res); fi;
  od;
end:

str_weyl_inner := proc(s, R,P,opt)
  option remember;
  local data;
  data := sp_data(R,opt);
  redexp_weyl(subs(data[3], str_redexp(s)), R);
end:

str_weyl := proc(Xex, R,P,opt)
  if type(Xex,list) then str_weyl_inner(args);
  else mapX(str_weyl_inner, args); fi;
end:

str_id := proc(R,P,opt)
  option remember;
  local data, steps, i;
  data := sp_data(R,opt);
  if data[1] <> "A" then RETURN(false); fi;
  steps := {i$i=1..nops(R)} minus subs(data[4], P);
  steps := [0, op(steps), data[2]];
  [seq((i-1)$(steps[i+1]-steps[i]), i=1..nops(steps)-1)];
end:

weyl_str_inner := proc(wt, R,P,opt)
  option remember;
  local data;
  data := sp_data(R,opt);
  redexp_str(subs(data[4], weyl_redexp(wt, R)), str_id(R,P,opt));
end:

weyl_str := proc(Xex, R,P,opt)
  if type(Xex,list) then weyl_str_inner(args);
  else mapX(weyl_str_inner, args); fi;
end:


####################################################################
#  Partitions for isotropic Grassmannians.
####################################################################

part_length := proc(la, k)
  local n, kk;
  n := nops(la);
  kk := `if`(nargs=1, 0, k);
  while n>0 and op(n,la)<=kk do n := n-1; od;
  n;
end:

part_conj := proc(la)
  local n, i;
  n := part_length(la);
  if n = 0 then RETURN([]); fi;
  [n$op(n,la), seq((n-i)$(op(n-i,la)-op(n-i+1,la)), i=1..n-1)];
end:

sp_igrass := proc(w, tp, k)
  local N, la, i, j, tpD;
  N := nops(w);
  tpD := `if`(tp="D",1,0);
  la := [seq(k+j-w[k+j]-`if`(w[k+j]<0,tpD,0)-`+`(seq(`if`(w[k+i]+w[k+j]<0,1,0),
         i=1..j)), j=1..N-k)];
  la := subs(0=NULL, la);
  if tp="D" and k>0 and w[1]<-1 then la := [op(la),0]; fi;
  la;
end:

igrass_sp := proc(la, tp, k,N)
  local tpD, la0, rgt, i, j, w;
  tpD := `if`(tp="D",1,0);
  la0 := [op(la),0$N];
  rgt := [seq(k+j-la0[j]-`if`(la0[j]>k,tpD,0)-
          `+`(seq(`if`(la0[i]+la0[j]>2*k-tpD+j-i and la0[i]>k,1,0),
          i=1..j)), j=1..N-k)];
  w := [op({seq(i,i=1..N)} minus map(abs, {op(rgt)})), op(rgt)];
  if nops(la)>0 and la[-1]=0 then w := subsop(1=-w[1],w); fi;
  if tp="D" and nops(select(x->x<0,w)) mod 2 = 1 then w := subs(1=-1,w); fi;
  w;
end:

is_igrass := proc(R,P,opt)
  local spd, i;
  spd := sp_data(R,opt);
  if spd = false then
    false;
  elif nops(P) = nops(R)-1 then
    true;
  elif spd[1] = "D" and P = subs(spd[3],{seq(i,i=2..nops(R)-1)}) then
    true;
  else
    false;
  fi;
end:

weyl_igrass_inner := proc(wt, R,P,opt)
  option remember;
  local data, desc, i, sp;
  if not is_igrass(R,P,opt) then RETURN(false); fi;
  data := sp_data(R,opt);
  desc := subs(data[4], {seq(i,i=1..nops(R))} minus P);
  sp := redexp0_sp(subs(data[4], weyl_redexp(wt, R)), data[1],data[2]);
  sp_igrass(sp, data[1], max(desc));
end:

weyl_igrass := proc(Xex, R,P,opt)
  if type(Xex,list) then weyl_igrass_inner(args);
  else mapX(weyl_igrass_inner, args); fi;
end:

igrass_weyl_inner := proc(la, R,P,opt)
  option remember;
  local data, desc, i, sp;
  if not is_igrass(R,P,opt) then RETURN(false); fi;
  data := sp_data(R,opt);
  desc := subs(data[4], {seq(i,i=1..nops(R))} minus P);
  sp := igrass_sp(la, data[1], max(desc), data[2]);
  redexp_weyl(subs(data[3], sp_redexp0(sp, data[1])), R);
end:

igrass_weyl := proc(Xex, R,P,opt)
  if type(Xex,list) then igrass_weyl_inner(args);
  else mapX(igrass_weyl_inner, args); fi;
end:


####################################################################
#  Partitions for cominuscule varieties.
####################################################################

is_comin := proc(R,P)
  local x, high;
  x := max_parab_index(R,P);
  if x = false then RETURN(false); fi;
  high := high_root(R);
  evalb(high[x] = 1);
end:

is_minus := proc(R,P)
  is_comin(rs_dual(R),P);
end:

comin_data := proc(R,P,opt)
  option remember;
  local n, x, rsdata, sb, i, j, k, diag, res;
  n := nops(R);
  x := max_parab_index(R,P);
  if x = false then RETURN(false); fi;
  rsdata := rs_data(R,opt);
  sb := {seq(j=rsdata[2][j], j=1..n)};
  member(x, rsdata[2], 'k');
  if rsdata[1] = "A" then
    RETURN(subs(sb, [seq([seq(j-i, j=k..n)], i=0..k-1)]));
  elif rsdata[1] in {"B","C"} then
    if k = 1 then
      RETURN(subs(sb, [[seq(j, j=1..n), seq(n-j,j=1..n-1)]]));
    elif k = n then
      RETURN(subs(sb, [seq([seq(n-j, j=0..n-i)], i=1..n)]));
    else
      RETURN(false);
    fi;
  elif rsdata[1] = "D" then
    if k = 1 then
      RETURN(subs(sb, [[seq(j,j=1..n-1)], [n, seq(n-1-j,j=1..n-2)]]));
    elif k >= n-1 then
      diag := [2*n-1-k, k];
      res := [seq([diag[(i mod 2)+1],seq(n-2-j, j=0..n-2-i)],i=1..n-1)];
      RETURN(subs(sb, res));
    else
      RETURN(false);
    fi;
  elif rsdata[1] = "E" then
    if n = 6 and k = 1 then
      RETURN(subs(sb, [[1,3,4,2],[5,4,3,1],[6,5,4,3],[2,4,5,6]]));
    elif n = 6 and k = 6 then
      RETURN(subs(sb, [[6,5,4,2],[3,4,5,6],[1,3,4,5],[2,4,3,1]]));
    elif n = 7 and k = 7 then
      RETURN(subs(sb, [[7,6,5,4,2],[3,4,5,6,7],[1,3,4,5,6],
                       [2,4,5],[3,4,2],[1,3,4],[5],[6],[7]]));
    else
      RETURN(false);
    fi;
  else
    RETURN(false);
  fi;
end:

weyl_comin_inner := proc(wt, R,P,opt)
  option remember;
  local data, wt1, la, rw, i;
  data := comin_data(R,P,opt);
  if data = false then RETURN(false); fi;
  wt1 := wt;
  la := [];
  for rw in data do
    i := 0;
    while i < nops(rw) and wt1[rw[i+1]]<0 do
      i := i+1;
      wt1 := simpref_weight(rw[i], wt1, R);
    od;
    if i>0 then la := [op(la),i]; fi;
  od;
  la;
end:

weyl_comin := proc(Xex, R,P,opt)
  if type(Xex,list) then weyl_comin_inner(args);
  else mapX(weyl_comin_inner, args); fi;
end:

comin_weyl_inner := proc(la, R,P,opt)
  option remember;
  local data, re, i;
  data := comin_data(R,P,opt);
  if data = false then RETURN(false); fi;
  re := [seq(op(1..la[i],data[i]),i=1..nops(la))];
  redexp_weyl([seq(re[-i],i=1..nops(re))], R);
end:

comin_weyl := proc(Xex, R,P,opt)
  if type(Xex,list) then comin_weyl_inner(args);
  else mapX(comin_weyl_inner, args); fi;
end:


####################################################################
#  Partitions in all cases (defaults to comin notation)
####################################################################

weyl_part_inner := proc(wt, R,P,opt)
  local i, PP, cd, x;
  if P <> {} then
    PP := P;
    if not weyl_is_minrep(wt, R,PP) then RETURN(false); fi;
  else
    if wt = [1$nops(R)] then RETURN([]); fi;
    PP := select(i -> wt[i]>0, {seq(i,i=1..nops(R))});
  fi;
  cd := `if`("i" in {seq(x,x=opt)}, false, comin_data(R,PP,opt));
  if cd <> false then
    weyl_comin_inner(wt, R,PP,opt);
  else
    weyl_igrass_inner(wt, R,PP,opt);
  fi;
end:

weyl_part := proc(Xex, R,P,opt)
  if type(Xex,list) then weyl_part_inner(args);
  else mapX(weyl_part_inner, args); fi;
end:

part_weyl := proc(Xex, R,P,opt)
  local opt0, x, cd;
  cd := `if`("i" in {seq(x,x=opt)}, false, comin_data(R,P,opt));
  if cd <> false then
    comin_weyl(args);
  else
    igrass_weyl(args);
  fi;
end:


####################################################################


end module:

###

####################################################################
#  This module implements multiplication of Schubert classes in    #
#  the equivariant cohomology and K-theory rings of generalized    #
#  flag varieties G/P.                                             #
####################################################################

equiv := module()
option package;

uses weyl, conv;

export
  schubrest_h, htmult, hmult, htexpand, hexpand, project_h,
  schubrest_k, ktmult, kmult, ktexpand, kexpand, project_k, kdual,
  kundual, T2t, betapower, altsign, getterm, lowterm, lowdegree,
  htact, htopposite, ktact, ktopposite;

local
  schubrest_h_inner, project_h_inner, schubrest_k_inner,
  project_k_inner, divide_laurent;


####################################################################
#  Equivariant cohomology
####################################################################

# In type A:  t[i] = y_{i+1} - y_i  where y_i = -c_1(C e_i).

# Restriction of X(wt1) to wt2.B
schubrest_h_inner := proc(wt1, wt2, R)
  option remember;
  local n, w, v, v1, val, tval, w1, i, j;
  n := nops(R);
  w := wt1;
  v := wt2;
  if w = [1$n] then RETURN(1); fi;

  while true do
    i := 1;
    while i <= n and (w[i]<0 or v[i]>0) do i := i+1; od;
    if i = n+1 then break; fi;
    v := simpref_weight(i, v, R);
  od;
  if not bruhat_leq(w, v, R) then RETURN(0); fi;

  i := 1;
  while v[i]>0 do i := i+1; od;
  v1 := simpref_weight(i, v, R);
  w1 := simpref_weight(i, w, R);
  val := act_root(v1, [0$(i-1),1,0$(n-i)], R);
  tval := `+`(seq(val[j]*t[j], j=1..n));
  expand(schubrest_h_inner(w, v1, R) + tval * schubrest_h_inner(w1, v1, R));
end:

schubrest_h := proc(Xlc, wt2, R)
  mapX(schubrest_h_inner, args);
end:

htmult := proc(u, v, R)
  option remember;
  local n, wt1, wt2, P, i, len1, len2, con1, con2, len, w, res,
        layer, res1, num, q;
  n := nops(R);
  wt1 := [op(u)];
  wt2 := [op(v)];
  P := select(i -> (wt1[i]>0 and wt2[i]>0), {seq(i,i=1..n)});
  len1 := weyl_length(wt1, R);
  len2 := weyl_length(wt2, R);
  con1 := {wt1};
  con2 := {wt2};
  if len1 < len2 then
    for i from 1 to len2-len1 do con1 := bruhat_up(con1, R,P); od;
  elif len1 > len2 then
    for i from 1 to len1-len2 do con2 := bruhat_up(con2, R,P); od;
  fi;
  len := max(len1, len2);
  res := 0;
  while con1<>{} and con2<>{} do
    layer := con1 intersect con2;
    res1 := 0;
    for w in layer do
      num := expand(schubrest_h_inner(wt1,w,R) * schubrest_h_inner(wt2,w,R)
             - schubrest_h(res,w,R));
      if num <> 0 then
        divide(num, schubrest_h_inner(w,w,R), 'q');
        res1 := res1 + q * X[op(w)];
      fi;
    od;
    res := res + res1;
    len := len + 1;
    if len > len1 + len2 then break; fi;
    con1 := bruhat_up(con1, R,P);
    con2 := bruhat_up(con2, R,P);
  od;
  res;
end:

hmult := proc(wt1, wt2, R)
  local sb, i;
  sb := {seq(t[i]=0, i=1..nops(R))};
  subs(sb, htmult(wt1, wt2, R));
end:

htexpand := proc(ex, R)
  local P, i, x, exx, res, w, num, q;
  P := {seq(i, i=1..nops(R))};
  for x in indets(ex) do
    if type(x,indexed) and op(0,x)=`X` then
      P := P minus select(i -> op(i,x)<0, P);
    fi;
  od;
  exx := ex;
  res := 0;
  for w in weyl_group(R,P) do
    num := expand(schubrest_h(exx, w, R));
    if num <> 0 then
      divide(num, schubrest_h_inner(w,w,R), 'q');
      res := res + q * X[op(w)];
      exx := exx - q * X[op(w)];
    fi;
  od;
  res;
end:

hexpand := proc(ex, R)
  local sb, i;
  sb := {seq(t[i]=0, i=1..nops(R))};
  subs(sb, htexpand(ex, R));
end:

project_h_inner := proc(u, Q, R,P)
  local a, ua;
  a := weyl_minrep(weyl_maxrep([1$nops(R)], R,Q), R,P);
  ua := weyl_imult_reduced(-u, a, R);
  if ua = false then false; else -ua; fi;
end:

# Compute pull-push: H_T(X/P) --> H_T(X/(P \cap Q)) --> H_T(X/Q)
project_h := proc(Xlc, Q, R,P)
  mapX(project_h_inner, args);
end:

htact := proc(w, ex, R,P)
  local n, ar, sb, i, j, wi, res, u, wiu, num, q;
  n := nops(R);
  ar := [seq(act_root(w, subsop(i=1,[0$n]), R), i=1..n)];
  sb := {seq(t[i] = `+`(seq(ar[i][j] * t[j], j=1..n)), i=1..n)};
  wi := weyl_inverse(w, R);
  res := 0;
  for u in weyl_group(R,P) do
    wiu := weyl_minrep(weyl_mult(wi, u, R), R,P);
    num := expand(subs(sb, schubrest_h(ex, wiu, R)) - schubrest_h(res, u, R));
    if num <> 0 then
      divide(num, schubrest_h_inner(u,u,R), 'q');
      res := res + q * X[op(u)];
    fi;
  od;
  res;
end:

htopposite := proc(ex, R,P)
  htact(weyl_longest(R), ex, R,P);
end:


##################################################################
#  Equivariant K-theory
##################################################################

# Restriction of X(wt1) to wt2.B
schubrest_k_inner := proc(wt1, wt2, R)
  option remember;
  local n, w, v, v1, val, Tval, w1, i, j;
  n := nops(R);
  w := wt1;
  v := wt2;
  if w = [1$n] then RETURN(1); fi;

  while true do
    i := 1;
    while i <= n and (w[i]<0 or v[i]>0) do i := i+1; od;
    if i = n+1 then break; fi;
    v := simpref_weight(i, v, R);
  od;
  if not bruhat_leq(w, v, R) then RETURN(0); fi;

  i := 1;
  while v[i]>0 do i := i+1; od;
  v1 := simpref_weight(i, v, R);
  w1 := simpref_weight(i, w, R);
  val := act_root(v1, [0$(i-1),1,0$(n-i)], R);
  Tval := `*`(seq(T[j]^(val[j]), j=1..n));
  expand(Tval * schubrest_k_inner(w, v1, R) +
         (1-Tval) * schubrest_k_inner(w1, v1, R));
end:

schubrest_k := proc(Xlc, wt2, R)
  mapX(schubrest_k_inner, args);
end:

ktmult := proc(u, v, R)
  option remember;
  local n, wt1, wt2, P, i, len1, len2, con1, con2, w, res,
        layer, res1, num, q;
  n := nops(R);
  wt1 := [op(u)];
  wt2 := [op(v)];
  P := select(i -> (wt1[i]>0 and wt2[i]>0), {seq(i,i=1..n)});
  len1 := weyl_length(wt1, R);
  len2 := weyl_length(wt2, R);
  con1 := {wt1};
  con2 := {wt2};
  if len1 < len2 then
    for i from 1 to len2-len1 do con1 := bruhat_up(con1, R,P); od;
  elif len1 > len2 then
    for i from 1 to len1-len2 do con2 := bruhat_up(con2, R,P); od;
  fi;
  res := 0;
  while con1<>{} and con2<>{} do
    layer := con1 intersect con2;
    res1 := 0;
    for w in layer do
      num := expand(schubrest_k_inner(wt1,w,R) * schubrest_k_inner(wt2,w,R)
             - schubrest_k(res,w,R));
      if num <> 0 then
        divide(num, schubrest_k_inner(w,w,R), 'q');
        res1 := res1 + q * X[op(w)];
      fi;
    od;
    res := res + res1;
    con1 := bruhat_up(con1, R,P);
    con2 := bruhat_up(con2, R,P);
  od;
  res;
end:

kmult := proc(wt1, wt2, R)
  local sb, i;
  sb := {seq(T[i]=1, i=1..nops(R))};
  subs(sb, ktmult(wt1, wt2, R));
end:

# f is a Laurent polynomial, g is an irreducible polynomial.
divide_laurent := proc(f, g)
  local ff, mm, v, q;
  ff := expand(f);
  mm := `*`(seq(v^(degree(subs(v=1/v,ff),v)), v=indets(f)));
  divide(expand(ff * mm), g, 'q');
  expand(q / mm);
end:

ktexpand := proc(ex, R)
  local P, i, x, exx, res, w, num, q;
  P := {seq(i, i=1..nops(R))};
  for x in indets(ex) do
    if type(x,indexed) and op(0,x)=`X` then
      P := P minus select(i -> op(i,x)<0, P);
    fi;
  od;
  exx := ex;
  res := 0;
  for w in weyl_group(R,P) do
    num := expand(schubrest_k(exx, w, R));
    if num <> 0 then
      q := divide_laurent(num, schubrest_k_inner(w,w,R));
      res := res + q * X[op(w)];
      exx := exx - q * X[op(w)];
    fi;
  od;
  res;
end:

kexpand := proc(ex, R)
  local sb, i;
  sb := {seq(T[i]=1, i=1..nops(R))};
  subs(sb, ktexpand(ex, R));
end:

project_k := proc(Xlc, Q, R)
  mapX(weyl_minrep, Xlc, R,Q);
end:

kdual := proc(Xex, R,P)
  local ex, var, x, bas, res, u, sb, c, v;
  ex := expand(Xex);
  res := 0;
  for u in weyl_group(R,P) do
    sb := {seq(v = `if`(type(v,indexed) and op(0,v)=`X` and
                        bruhat_leq([op(v)], u, R,P), 1, 0), v=indets(res))};
    c := coeff(ex,X[op(u)]) - subs(sb,res);
    res := res + c * X[op(u)];
  od;
  res;
end:

kundual := proc(Xex, R,P)
  local ex, var, x, res, u, sb;
  ex := expand(Xex);
  var := select(x -> type(x,indexed) and op(0,x)=`X`, indets(ex));
  res := 0;
  for u in weyl_group(R,P) do
    sb := {seq(x = `if`(bruhat_leq([op(x)], u, R,P), 1, 0), x=var)};
    res := res + subs(sb, ex) * X[op(u)];
  od;
  res;
end:

ktact := proc(w, ex, R,P)
  local ex1, n, ar, sb, i, j, wi, res, u, wiu, num, q;
  ex1 := subs({seq(t[i] = 1-T[i], i=1..nops(R))}, ex);
  n := nops(R);
  ar := [seq(act_root(w, subsop(i=1,[0$n]), R), i=1..n)];
  sb := {seq(T[i] = `*`(seq(T[j]^(ar[i][j]), j=1..n)), i=1..n)};
  wi := weyl_inverse(w, R);
  res := 0;
  for u in weyl_group(R,P) do
    wiu := weyl_minrep(weyl_mult(wi, u, R), R,P);
    num := expand(subs(sb, schubrest_k(ex1, wiu, R)) - schubrest_k(res, u, R));
    if num <> 0 then
      q := divide_laurent(num, schubrest_k_inner(u,u,R));
      res := res + q * X[op(u)];
    fi;
  od;
  res;
end:

ktopposite := proc(ex, R,P)
  ktact(weyl_longest(R), ex, R,P);
end:


####################################################################
#  Leading term and alternating signs
#  The variable q has degree `+`(c1tangent(R,P)).
####################################################################

T2t := proc(Xex)
  local res, vars, v;
  res := expand(Xex);
  vars := indets(res);
  for v in vars do
    if type(v,indexed) and op(0,v)=`T` then
      res := expand(subs(v = 1 - t[op(v)], res));
    fi;
  od;
  res;
end:

betapower := proc(Xex, R,P)
  local res, vars, Xvars, v, qdeg, sb, i;
  res := T2t(Xex);
  vars := indets(res);
  Xvars := select(v -> type(v,indexed) and op(0,v)=`X`, vars);
  qdeg := `if`(q in vars, `+`(op(c1tangent(R,P))), 0);
  sb := {seq(v = v*_beta_^weyl_length([op(v)],R), v=Xvars),
         seq(t[i]=_beta_*t[i],i=1..nops(R)), q = q*_beta_^qdeg};
  subs(sb, res);
end:

altsign := proc(Xlc, R,P)
  subs(_beta_=-1, betapower(args));
end:

getterm := proc(Xlc, d, R,P)
  subs(_beta_=1, coeff(betapower(Xlc, op(3..-1,[args])), _beta_, d));
end:

lowterm := proc(Xlc, R,P)
  local lc;
  lc := betapower(args);
  subs(_beta_=1, coeff(lc, _beta_, ldegree(lc, _beta_)));
end:

lowdegree := proc(Xlc, R,P)
  ldegree(betapower(args), _beta_);
end:


####################################################################


end module:

###

####################################################################
#  Quantum cohomology and K-theory of cominuscule spaces           #
####################################################################

qcomin := module()
option package;

uses weyl, conv, equiv;

export
  qcomin_data, comin_dX2, comin_dX3, comin_projgw_h, comin_qhtmult,
  comin_qhmult, comin_projgw_k, comin_odot, comin_qktmult, comin_qkmult;


####################################################################
#  Compute CMP data for cominuscule variety
####################################################################

qcomin_data := proc(R,P)
  option remember;
  local n, sr, x, rsdata, sb, i, j, k, r, dX3, d;
  n := nops(R);
  sr := {seq(x, x=1..n)};
  x := max_parab_index(R,P);
  if x = false then RETURN(false); fi;
  rsdata := rs_data(R,"");
  sb := {seq(j=rsdata[2][j], j=1..n)};
  member(x, rsdata[2], 'k');

  if rsdata[1] = "A" then
    r := n+1-k;
    dX3 := min(2*k, 2*r, max(k,r));
    RETURN(subs(sb, [seq(sr minus {k-d,k+d}, d=0..dX3-1)]));

  elif rsdata[1] = "B" then
    if k <> 1 then RETURN(false); fi;
    RETURN(subs(sb, [sr minus {1}, sr minus {2}]));

  elif rsdata[1] = "C" then
    if k <> n then RETURN(false); fi;
    RETURN(subs(sb, [seq(sr minus {n-d}, d=0..n-1)]));

  elif rsdata[1] = "D" then
    if k = 1 then
      RETURN(subs(sb, [sr minus {1}, sr minus {2}]));
    elif k = n-1 then
      RETURN(subs(sb, [sr minus {n-1}, seq(sr minus {n-2*d}, d=1..(n-1)/2)]));
    elif k = n then
      RETURN(subs(sb, [seq(sr minus {n-2*d}, d=0..(n-1)/2)]));
    else
      RETURN(false);
    fi;

  elif rsdata[1] = "E" then
    if n=6 and k=1 then
      RETURN(subs(sb, [sr minus {1}, sr minus {3}, sr minus {6},
             [1,2,3,4,5,6]]));
    elif n=6 and k=6 then
      RETURN(subs(sb, [sr minus {6}, sr minus {5}, sr minus {1},
             [6,2,5,4,3,1]]));
    elif n=7 and k=7 then
      RETURN(subs(sb, [sr minus {7}, sr minus {6}, sr minus {1}]));
    else
      RETURN(false);
    fi;

  else
    RETURN(false);
  fi;
end:

comin_dX2 := proc(R,P)
  option remember;
  local x, i;
  x := max_parab_index(R,P);
  nops(select(i -> i=x,
       weyl_redexp(weyl_minrep([-1$nops(R)], R,P), R)));
end:

comin_dX3 := proc(R,P)
  nops(qcomin_data(R,P));
end:


####################################################################
#  Equivariant qantum cohomology
####################################################################

comin_projgw_h := proc(u,v, d, R,P)
  local qc, qc1, one, pt, div, Pu, Pv;
  qc := qcomin_data(R,P);
  if qc = false then RETURN(false); fi;
  if d > comin_dX2(R,P) then
    0;
  elif d = nops(qc) then
    pt := weyl_minrep([-1$nops(R)], R,P);
    if [op(u)] = pt and [op(v)] = pt then
      X[1$nops(R)];
    else
      0;
    fi;
  else
    Pu := project_h(X[op(u)], qc[d+1], R,P);
    Pv := project_h(X[op(v)], qc[d+1], R,P);
    if Pu=0 or Pv=0 then RETURN(0); fi;
    project_h(htmult(Pu, Pv, R), P, R,qc[d+1]);
  fi;
end:

comin_qhtmult := proc(u, v, R,P)
  local qc, dX2, d;
  qc := qcomin_data(R,P);
  if qc = false then RETURN(false); fi;
  dX2 := comin_dX2(R,P);
  expand(`+`(seq(q^d * comin_projgw_h(u,v, d, R,P), d=0..dX2)));
end:

comin_qhmult := proc(u, v, R,P)
  local sb, i;
  sb := {seq(t[i]=0, i=1..nops(R))};
  subs(sb, comin_qhtmult(args));
end:


####################################################################
#  Equivariant qantum K-theory
####################################################################

comin_projgw_k := proc(u,v, d, R,P)
  local qc, Q, one, pt, div, tt, Pu, Pv;
  qc := qcomin_data(R,P);
  if qc = false then RETURN(false); fi;
  if d >= nops(qc) then RETURN(X[1$nops(R)]); fi;
  Q := qc[d+1];
  if type(Q,list) then
    one := [1$6];
    pt := subsop(Q[1]=-11, one);
    if {[op(u)], [op(v)]} = {pt} then
      div := subsop(Q[1]=-1,Q[3]=2, one);
      tt := T[Q[3]]*T[Q[4]]^2*T[Q[5]]^2*T[Q[2]]*T[Q[6]]^2;
      X[op(one)] - tt * X[op(one)] + tt * X[op(div)];
    else
      X[op(one)];
    fi;
  else
    Pu := project_k(X[op(u)], Q, R);
    Pv := project_k(X[op(v)], Q, R);
    project_k(ktmult(Pu, Pv, R), P, R);
  fi;
end:

comin_odot := proc(u, v, maxd, R,P)
  local qc, d;
  qc := qcomin_data(R,P);
  if qc = false then RETURN(false); fi;
  expand(`+`(seq(q^d * comin_projgw_k(u,v, d, R,P), d=0..maxd)));
end:

comin_qktmult := proc(u, v, R,P)
  local qc, dX2, qc2, odot0, odot1;
  qc := qcomin_data(R,P);
  if qc = false then RETURN(false); fi;
  dX2 := comin_dX2(R,P);
  qc2 := `if`(nops(qc)=1, {1}, qc[2]);
  odot0 := comin_odot(u, v, dX2, R,P);
  odot1 := project_k(project_k(subs(q^dX2=0, odot0), qc2, R), P, R);
  expand(odot0 - q * odot1);
end:

comin_qkmult := proc(u, v, R,P)
  local sb, i;
  sb := {seq(T[i]=1, i=1..nops(R))};
  subs(sb, comin_qktmult(args));
end:


####################################################################


end module:

###

####################################################################
#  Curve neighborhoods of Schubert varieties                       #
####################################################################

cnbhd := module()
option package;

uses weyl;

export
  root_degree, is_cosmall, curve_nbhd;


# Degree of T-stable curve in G/P from 1.P to s_\al.P.
root_degree := proc(al, R,P)
  local alv, i;
  alv := root_to_coroot(al, R);
  [seq(`if`(i in P, 0, alv[i]), i=1..nops(R))];
end:

# Check if the root al is P-cosmall
is_cosmall := proc(al, R,P)
  local lsal, pair1;
  lsal := weyl_length(weyl_minrep(weyl_ref(al, R), R,P), R);
  pair1 := pair_weight_coroot(c1tangent(R,P), root_to_coroot(al,R)) - 1;
  evalb(lsal = pair1);
end:

# Return Weyl group element of Gamma_d(X_u)
curve_nbhd := proc(u, d0, R,P)
  local n, x, d, roots, res, almax, al, df, dfmax, i;
  n := nops(R);
  if type(d0,integer) then
    x := max_parab_index(R,P);
    if x = false then RETURN(false); fi;
    d := [0$(x-1), d0, 0$(n-x)];
  else
    d := d0;
  fi;
  if {0,seq(d[i],i=P)} <> {0} or min(d) < 0 then RETURN(false); fi;
  roots := pos_roots(R,P);
  res := u;
  while max(d) > 0 do
    almax := [0$n];
    for al in roots do
      if min(al - almax) < 0 then next; fi;
      df := d - root_degree(al, R,P);
      if min(df) >= 0 then
        almax := al;
        dfmax := df;
      fi;
    od;
    res := weyl_mult_hecke(res, weyl_ref(almax,R), R);
    d := dfmax;
  od;
  weyl_minrep(res, R,P);
end:


####################################################################


end:

###

####################################################################


####################################################################
#  This module administers default arguments to the functions      #
#  defined in the above core modules.                              #
####################################################################

equivcalc := module()
option package;

export
  get_rs_string, set_rs, get_rs, set_parab, get_parab, set_opt, get_opt,
  rs, Fl, Gr, OF, OG, SF, SG, argR, argRP, argRPo, argRo, cartan_A,
  cartan_B, cartan_C, cartan_D, cartan_E, cartan_F, cartan_G, rs_new,
  rs_sum, rs_dual, rs_perm, rs_component, rs_simple_squares,
  rs_simple_neighbors, rs_simple_chain, rs_data, rs_simply_laced,
  pair_root_coroot, pair_root_root, pair_coroot_coroot,
  pair_weight_coroot, pair_coweight_root, pair_weight_coweight, is_long,
  is_short, root_to_coroot, root_to_weight, coroot_to_coweight,
  weight_to_root, coweight_to_coroot, simpref_root, simpref_coroot,
  simpref_weight, simpref_coweight, ref_root, ref_coroot, ref_weight,
  ref_coweight, weyl_id, weyl_longest, weyl_simpref, weyl_ref,
  weyl_length, weyl_imult, weyl_imult_reduced, weyl_imult_hecke,
  weyl_inverse, weyl_mult, weyl_mult_reduced, weyl_mult_hecke, act_root,
  act_coroot, act_weight, act_coweight, weyl_redexp, redexp_weyl,
  redexp_act_root, redexp_act_coroot, redexp_act_weight,
  redexp_act_coweight, max_parab, max_parab_index, pos_roots, high_root,
  c1tangent, weyl_is_minrep, weyl_is_maxrep, weyl_minrep, weyl_maxrep,
  weyl_minrep_diff, weyl_dual, bruhat_down, bruhat_down_all, bruhat_up,
  bruhat_up_all, bruhat_leq, bruhat_weakleft_down,
  bruhat_weakleft_down_all, bruhat_weakleft_up, bruhat_weakleft_up_all,
  bruhat_weakleft_leq, bruhat_weakright_down, bruhat_weakright_down_all,
  bruhat_weakright_up, bruhat_weakright_up_all, bruhat_weakright_leq,
  weyl_group_maxlen, weyl_group_layer, weyl_group, varX, mkX, sbX,
  mapXnew, mapX, mapXold, sp_mult, sp_inverse, sp_simpref, sp_descents,
  sp_length, sp_redexp0, redexp0_sp, sp_data, weyl_sp, sp_weyl,
  part_length, part_conj, sp_igrass, igrass_sp, is_igrass, weyl_igrass,
  igrass_weyl, is_comin, is_minus, comin_data, weyl_comin, comin_weyl,
  weyl_part, part_weyl, str_length, str_redexp, redexp_str, str_weyl,
  weyl_str, str_id, schubrest_h, htmult, hmult, htexpand, hexpand,
  project_h, schubrest_k, ktmult, kmult, ktexpand, kexpand, project_k,
  kdual, kundual, T2t, betapower, altsign, getterm, lowterm, lowdegree,
  htact, htopposite, ktact, ktopposite, qcomin_data, comin_dX2,
  comin_dX3, comin_projgw_h, comin_qhtmult, comin_qhmult,
  comin_projgw_k, comin_odot, comin_qktmult, comin_qkmult, root_degree,
  is_cosmall, curve_nbhd;

local
  current_rs, current_parab, current_opt;


####################################################################
#  Administer current root system
####################################################################

current_rs    := weyl:-rs_new("A1");
current_parab := {};
current_opt   := "";

get_rs_string := proc()
  local R, data, rootsys_str, srl, i, P, parab_str;
  R := current_rs;
  data := weyl:-rs_data(R,current_opt);
  if data = false then
    rootsys_str := cat("Reducible root system of rank ", nops(R));
  else
    srl := data[2];
    rootsys_str := cat(data[1], nops(srl), "  ",
      srl[1], seq(cat(",",srl[i]), i=2..nops(srl)));
  fi;
  P := current_parab;
  if P = {} then
    parab_str := "{}";
  else
    parab_str := cat("{", P[1], seq(cat(",",P[i]), i=2..nops(P)), "}");
  fi;
  cat(rootsys_str, "  ", parab_str);
end:

set_rs := proc(R,P)
  if nargs = 0 then RETURN(get_rs_string()); fi;
  current_rs := weyl:-rs_new(R);
  if nargs = 1 then
    current_parab := {};
  elif type(args[2],integer) then
    current_parab := weyl:-max_parab(args[2], current_rs);
  else
    current_parab := args[2];
  fi;
  get_rs_string();
end:

get_rs := proc()
  current_rs;
end:

set_parab := proc(P)
  if type(P,integer) then
    current_parab := weyl:-max_parab(P, current_rs);
  else
    current_parab := P;
  fi;
  get_rs_string();
end:

get_parab := proc()
  current_parab;
end:

set_opt := proc(opt)
  current_opt := opt;
  get_rs_string();
end:

get_opt := proc()
  current_opt;
end:


####################################################################
#  Flag varieties and Grassmannians of classical types
####################################################################

rs := set_rs;

Fl := proc()
  local n, i;
  n := args[-1] - 1;
  current_rs    := weyl:-rs_new("A", n);
  if nargs = 1 then
    current_parab := {};
  else
    current_parab := {seq(i, i=1..n)} minus {op(1..-2,[args])};
  fi;
  current_opt   := "A-";
  get_rs_string();
end:

Gr := proc(m, N)
  current_rs    := weyl:-rs_new("A", N-1);
  current_parab := weyl:-max_parab(m, current_rs);
  current_opt   := "A";
  get_rs_string();
end:

OF := proc()
  local tp, n, P, i;
  tp := `if`(args[-1] mod 2 = 1, "B", "D");
  n := trunc(args[-1]/2);
  current_rs := weyl:-rs_new(tp, n);
  if nargs = 1 then
    P := {};
  else
    P := {seq(i, i=1..n)} minus {op(1..-2,[args])};
    if tp = "D" and not n-1 in P then
      P := P minus {n};
    fi;
  fi;
  current_parab := P;
  current_opt := tp;
  get_rs_string();
end:

OG := proc(m, N)
  OF(m, N);
end:

SF := proc()
  local n, i;
  n := trunc(args[-1]/2);
  current_rs := weyl:-rs_new("C", n);
  if nargs = 1 then
    current_parab := {};
  else
    current_parab := {seq(i, i=1..n)} minus {op(1..-2,[args])};
  fi;
  current_opt := tp;
  get_rs_string();
end:

SG := proc(m, N)
  SF(m, N);
end:


####################################################################
#  Process default arguments
####################################################################

argR := proc(i, R)
  if nargs=i then RETURN(current_rs); fi;
  `if`(type(args[i+1],list), args[i+1], weyl:-rs_new(args[i+1]));
end:

argRP := proc(i, R,P)
  local RR, PP;
  if nargs=i then RETURN(current_rs, current_parab); fi;
  RR := `if`(type(args[i+1],list), args[i+1], rs_new(args[i+1]));
  PP := `if`(nargs=i+1, {}, `if`(type(args[i+2],integer),
    weyl:-max_parab(args[i+2],RR), args[i+2]));
  RR, PP;
end:

argRPo := proc(i, R,P,opt)
  local RR, PP;
  if nargs=i then RETURN(current_rs, current_parab, current_opt); fi;
  RR := `if`(type(args[i+1],list), args[i+1], rs_new(args[i+1]));
  PP := `if`(nargs=i+1, {}, `if`(type(args[i+2],integer),
    weyl:-max_parab(args[i+2],RR), args[i+2]));
  if nargs <= i+2 then
    RR, PP, current_opt;
  else
    RR, PP, args[i+3];
  fi;
end:

argRo := proc(i, R,opt)
  local RR;
  if nargs=i then RETURN(current_rs, current_opt); fi;
  RR := `if`(type(args[i+1],list), args[i+1], rs_new(args[i+1]));
  if nargs = i+1 then
    RR, current_opt;
  else
    RR, args[i+2];
  fi;
end:


####################################################################
#  Function wrappers
####################################################################

cartan_A := weyl:-cartan_A:

cartan_B := weyl:-cartan_B:

cartan_C := weyl:-cartan_C:

cartan_D := weyl:-cartan_D:

cartan_E := weyl:-cartan_E:

cartan_F := weyl:-cartan_F:

cartan_G := weyl:-cartan_G:

rs_new := weyl:-rs_new:

rs_sum := weyl:-rs_sum:

rs_dual := proc(R)
  local RR; RR := argR(1,args);
  weyl:-rs_dual(RR);
end:

rs_perm := proc(w, R)
  local RR; RR := argR(2,args);
  weyl:-rs_perm(w, RR);
end:

rs_component := proc(al, R)
  local RR; RR := argR(2,args);
  weyl:-rs_component(al, RR);
end:

rs_simple_squares := proc(R)
  local RR; RR := argR(1,args);
  weyl:-rs_simple_squares(RR);
end:

rs_simple_neighbors := proc(i, R)
  local RR; RR := argR(2,args);
  weyl:-rs_simple_neighbors(i, RR);
end:

rs_simple_chain := proc(i, avoid, R)
  local RR; RR := argR(3,args);
  weyl:-rs_simple_chain(i, avoid, RR);
end:

rs_data := proc(R, opt)
  local RR,oo; RR,oo := argRo(1,args);
  weyl:-rs_data(RR,oo);
end:

rs_simply_laced := proc(R)
  local RR; RR := argR(1,args);
  weyl:-rs_simply_laced(RR);
end:

pair_root_coroot := proc(al, be, R)
  local RR; RR := argR(3,args);
  weyl:-pair_root_coroot(al, be, RR);
end:

pair_root_root := proc(al, be, R)
  local RR; RR := argR(3,args);
  weyl:-pair_root_root(al, be, RR);
end:

pair_coroot_coroot := proc(al, be, R)
  local RR; RR := argR(3,args);
  weyl:-pair_coroot_coroot(al, be, RR);
end:

pair_weight_coroot := weyl:-pair_weight_coroot:

pair_coweight_root := weyl:-pair_coweight_root:

pair_weight_coweight := proc(la, mu, R)
  local RR; RR := argR(3,args);
  weyl:-pair_weight_coweight(la, mu, RR);
end:

is_long := proc(al, R)
  local RR; RR := argR(2,args);
  weyl:-is_long(al, RR);
end:

is_short := proc(al, R)
  local RR; RR := argR(2,args);
  weyl:-is_short(al, RR);
end:

root_to_coroot := proc(al, R)
  local RR; RR := argR(2,args);
  weyl:-root_to_coroot(al, RR);
end:

root_to_weight := proc(al, R)
  local RR; RR := argR(2,args);
  weyl:-root_to_weight(al, RR);
end:

coroot_to_coweight := proc(al, R)
  local RR; RR := argR(2,args);
  weyl:-coroot_to_coweight(al, RR);
end:

weight_to_root := proc(la, R)
  local RR; RR := argR(2,args);
  weyl:-weight_to_root(la, RR);
end:

coweight_to_coroot := proc(la, R)
  local RR; RR := argR(2,args);
  weyl:-coweight_to_coroot(la, RR);
end:

simpref_root := proc(i, be, R)
  local RR; RR := argR(3,args);
  weyl:-simpref_root(i, be, RR);
end:

simpref_coroot := proc(i, be, R)
  local RR; RR := argR(3,args);
  weyl:-simpref_coroot(i, be, RR);
end:

simpref_weight := proc(i, la, R)
  local RR; RR := argR(3,args);
  weyl:-simpref_weight(i, la, RR);
end:

simpref_coweight := proc(i, la, R)
  local RR; RR := argR(3,args);
  weyl:-simpref_coweight(i, la, RR);
end:

ref_root := proc(al, be, R)
  local RR; RR := argR(3,args);
  weyl:-ref_root(al, be, RR);
end:

ref_coroot := proc(al, be, R)
  local RR; RR := argR(3,args);
  weyl:-ref_coroot(al, be, RR);
end:

ref_weight := proc(al, mu, R)
  local RR; RR := argR(3,args);
  weyl:-ref_weight(al, mu, RR);
end:

ref_coweight := proc(al, mu, R)
  local RR; RR := argR(3,args);
  weyl:-ref_coweight(al, mu, RR);
end:

weyl_id := proc(R)
  local RR; RR := argR(1,args);
  weyl:-weyl_id(RR);
end:

weyl_longest := proc(R)
  local RR; RR := argR(1,args);
  weyl:-weyl_longest(RR);
end:

weyl_simpref := proc(i, R)
  local RR; RR := argR(2,args);
  weyl:-weyl_simpref(i, RR);
end:

weyl_ref := proc(al, R)
  local RR; RR := argR(2,args);
  weyl:-weyl_ref(al, RR);
end:

weyl_length := proc(wt, R)
  local RR; RR := argR(2,args);
  weyl:-weyl_length(wt, RR);
end:

weyl_imult := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  weyl:-weyl_imult(wt1, wt2, RR);
end:

weyl_imult_reduced := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  weyl:-weyl_imult_reduced(wt1, wt2, RR);
end:

weyl_imult_hecke := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  weyl:-weyl_imult_hecke(wt1, wt2, RR);
end:

weyl_inverse := proc(wt, R)
  local RR; RR := argR(2,args);
  weyl:-weyl_inverse(wt, RR);
end:

weyl_mult := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  weyl:-weyl_mult(wt1, wt2, RR);
end:

weyl_mult_reduced := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  weyl:-weyl_mult_reduced(wt1, wt2, RR);
end:

weyl_mult_hecke := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  weyl:-weyl_mult_hecke(wt1, wt2, RR);
end:

act_root := proc(wt, al, R)
  local RR; RR := argR(3,args);
  weyl:-act_root(wt, al, RR);
end:

act_coroot := proc(wt, al, R)
  local RR; RR := argR(3,args);
  weyl:-act_coroot(wt, al, RR);
end:

act_weight := proc(wt, la, R)
  local RR; RR := argR(3,args);
  weyl:-act_weight(wt, la, RR);
end:

act_coweight := proc(wt, la, R)
  local RR; RR := argR(3,args);
  weyl:-act_coweight(wt, la, RR);
end:

weyl_redexp := proc(wt, R)
  local RR; RR := argR(2,args);
  weyl:-weyl_redexp(wt, RR);
end:

redexp_weyl := proc(wge, R)
  local RR; RR := argR(2,args);
  weyl:-redexp_weyl(wge, RR);
end:

redexp_act_root := proc(wge, al, R)
  local RR; RR := argR(3,args);
  weyl:-redexp_act_root(wge, al, RR);
end:

redexp_act_coroot := proc(wge, al, R)
  local RR; RR := argR(3,args);
  weyl:-redexp_act_coroot(wge, al, RR);
end:

redexp_act_weight := proc(wge, mu, R)
  local RR; RR := argR(3,args);
  weyl:-redexp_act_weight(wge, mu, RR);
end:

redexp_act_coweight := proc(wge, mu, R)
  local RR; RR := argR(3,args);
  weyl:-redexp_act_coweight(wge, mu, RR);
end:

max_parab := proc(k, R)
  local RR; RR := argR(2,args);
  weyl:-max_parab(k, RR);
end:

max_parab_index := proc(R,P)
  local RR,PP; RR,PP := argRP(1,args);
  weyl:-max_parab_index(RR,PP);
end:

pos_roots := proc(R,P)
  local RR,PP; RR,PP := argRP(1,args);
  weyl:-pos_roots(RR,PP);
end:

high_root := proc(R)
  local RR; RR := argR(1,args);
  weyl:-high_root(RR);
end:

c1tangent := proc(R,P)
  local RR,PP; RR,PP := argRP(1,args);
  weyl:-c1tangent(RR,PP);
end:

weyl_is_minrep := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-weyl_is_minrep(wt, RR,PP);
end:

weyl_is_maxrep := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-weyl_is_maxrep(wt, RR,PP);
end:

weyl_minrep := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-weyl_minrep(wt, RR,PP);
end:

weyl_minrep_diff := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-weyl_minrep_diff(wt, RR,PP);
end:

weyl_maxrep := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-weyl_maxrep(wt, RR,PP);
end:

weyl_dual := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-weyl_dual(wt, RR,PP);
end:

bruhat_down := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-bruhat_down(wt, RR,PP);
end:

bruhat_down_all := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-bruhat_down_all(wt, RR,PP);
end:

bruhat_up := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-bruhat_up(wt, RR,PP);
end:

bruhat_up_all := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-bruhat_up_all(wt, RR,PP);
end:

bruhat_leq := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  weyl:-bruhat_leq(wt1, wt2, RR);
end:

bruhat_weakleft_down := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-bruhat_weakleft_down(wt, RR,PP);
end:

bruhat_weakleft_down_all := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-bruhat_weakleft_down_all(wt, RR,PP);
end:

bruhat_weakleft_up := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-bruhat_weakleft_up(wt, RR,PP);
end:

bruhat_weakleft_up_all := proc(wt, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-bruhat_weakleft_up_all(wt, RR,PP);
end:

bruhat_weakleft_leq := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  weyl:-bruhat_weakleft_leq(wt1, wt2, RR);
end:

bruhat_weakright_down := proc(wt, R)
  local RR; RR := argR(2,args);
  weyl:-bruhat_weakright_down(wt, RR);
end:

bruhat_weakright_down_all := proc(wt, R)
  local RR; RR := argR(2,args);
  weyl:-bruhat_weakright_down_all(wt, RR);
end:

bruhat_weakright_up := proc(wt, R)
  local RR; RR := argR(2,args);
  weyl:-bruhat_weakright_up(wt, RR);
end:

bruhat_weakright_up_all := proc(wt, R)
  local RR; RR := argR(2,args);
  weyl:-bruhat_weakright_up_all(wt, RR);
end:

bruhat_weakright_leq := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  weyl:-bruhat_weakright_leq(wt1, wt2, RR);
end:

weyl_group_maxlen := proc(R,P)
  local RR,PP; RR,PP := argRP(1,args);
  weyl:-weyl_group_maxlen(RR,PP);
end:

weyl_group_layer := proc(len, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  weyl:-weyl_group_layer(len, RR,PP);
end:

weyl_group := proc(R,P)
  local RR,PP; RR,PP := argRP(1,args);
  weyl:-weyl_group(RR,PP);
end:

mkX := conv:-mkX:

varX := conv:-varX:

sbX := conv:-sbX:

mapXnew := conv:-mapXnew:

mapX := conv:-mapX:

sp_mult := conv:-sp_mult:

sp_inverse := conv:-sp_inverse:

sp_simpref := conv:-sp_simpref:

sp_descents := conv:-sp_descents:

sp_length := conv:-sp_length:

sp_redexp0 := conv:-sp_redexp0:

redexp0_sp := conv:-redexp0_sp:

sp_data := proc(R,opt)
  local RR,oo; RR,oo := argRo(1,args);
  conv:-sp_data(RR,oo);
end:

weyl_sp := proc(Xex, R,opt)
  local RR,oo; RR,oo := argRo(2,args);
  conv:-weyl_sp(Xex, RR,oo);
end:

sp_weyl := proc(Xex, R,opt)
  local RR,oo; RR,oo := argRo(2,args);
  conv:-sp_weyl(Xex, RR,oo);
end:

str_length := conv:-str_length:

redexp_str := conv:-redexp_str:

str_redexp := conv:-str_redexp:

str_weyl := proc(Xex, R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(2,args);
  conv:-str_weyl(Xex, RR,PP,oo);
end:

str_id := proc(R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(1,args);
  conv:-str_id(RR,PP,oo);
end:

weyl_str := proc(Xex, R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(2,args);
  conv:-weyl_str(Xex, RR,PP,oo);
end:

part_length := conv:-part_length:

part_conj := conv:-part_conj:

sp_igrass := conv:-sp_igrass:

igrass_sp := conv:-igrass_sp:

is_igrass := proc(R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(1,args);
  conv:-is_igrass(RR,PP,oo);
end:

weyl_igrass := proc(Xex, R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(2,args);
  conv:-weyl_igrass(Xex, RR,PP,oo);
end:

igrass_weyl := proc(Xex, R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(2,args);
  conv:-igrass_weyl(Xex, RR,PP,oo);
end:

is_comin := proc(R,P)
  local RR,PP; RR,PP := argRP(1,args);
  conv:-is_comin(RR,PP);
end:

is_minus := proc(R,P)
  local RR,PP; RR,PP := argRP(1,args);
  conv:-is_minus(RR,PP);
end:

comin_data := proc(R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(1,args);
  conv:-comin_data(RR,PP,oo);
end:

weyl_comin := proc(Xex, R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(2,args);
  conv:-weyl_comin(Xex, RR,PP,oo);
end:

comin_weyl := proc(Xex, R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(2,args);
  conv:-comin_weyl(Xex, RR,PP,oo);
end:

weyl_part := proc(Xex, R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(2,args);
  conv:-weyl_part(Xex, RR,PP,oo);
end:

part_weyl := proc(Xex, R,P,opt)
  local RR,PP,oo; RR,PP,oo := argRPo(2,args);
  conv:-part_weyl(Xex, RR,PP,oo);
end:

schubrest_h := proc(Xlc, wt2, R)
  local RR; RR := argR(3,args);
  equiv:-schubrest_h(Xlc, wt2, RR);
end:

htmult := proc(u, v, R)
  local RR; RR := argR(3,args);
  equiv:-htmult(u, v, RR);
end:

hmult := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  equiv:-hmult(wt1, wt2, RR);
end:

htexpand := proc(ex, R)
  local RR; RR := argR(2,args);
  equiv:-htexpand(ex, RR);
end:

hexpand := proc(ex, R)
  local RR; RR := argR(2,args);
  equiv:-hexpand(ex, RR);
end:

project_h := proc(Xlc, Q, R,P)
  local RR,PP; RR,PP := argRP(3,args);
  equiv:-project_h(Xlc, Q, RR,PP);
end:

htact := proc(w, ex, R,P)
  local RR,PP; RR,PP := argRP(3,args);
  equiv:-htact(w, ex, RR,PP);
end:

htopposite := proc(ex, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  equiv:-htopposite(ex, RR,PP);
end:

schubrest_k := proc(Xlc, wt2, R)
  local RR; RR := argR(3,args);
  equiv:-schubrest_k(Xlc, wt2, RR);
end:

ktmult := proc(u, v, R)
  local RR; RR := argR(3,args);
  equiv:-ktmult(u, v, RR);
end:

kmult := proc(wt1, wt2, R)
  local RR; RR := argR(3,args);
  equiv:-kmult(wt1, wt2, RR);
end:

ktexpand := proc(ex, R)
  local RR; RR := argR(2,args);
  equiv:-ktexpand(ex, RR);
end:

kexpand := proc(ex, R)
  local RR; RR := argR(2,args);
  equiv:-kexpand(ex, RR);
end:

project_k := proc(Xlc, Q, R)
  local RR; RR := argR(3,args);
  equiv:-project_k(Xlc, Q, RR);
end:

kdual := proc(Xex, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  equiv:-kdual(Xex, RR,PP);
end:

kundual := proc(Xex, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  equiv:-kundual(Xex, RR,PP);
end:

ktact := proc(w, ex, R,P)
  local RR,PP; RR,PP := argRP(3,args);
  equiv:-ktact(w, ex, RR,PP);
end:

ktopposite := proc(ex, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  equiv:-ktopposite(ex, RR,PP);
end:

T2t := equiv:-T2t:

betapower := proc(Xex, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  equiv:-betapower(Xex, RR,PP);
end:

altsign := proc(Xlc, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  equiv:-altsign(Xlc, RR,PP);
end:

getterm := proc(Xlc, d, R,P)
  local RR,PP; RR,PP := argRP(3,args);
  equiv:-getterm(Xlc, d, RR,PP);
end:

lowterm := proc(Xlc, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  equiv:-lowterm(Xlc, RR,PP);
end:

lowdegree := proc(Xlc, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  equiv:-lowdegree(Xlc, RR,PP);
end:

qcomin_data := proc(R,P)
  local RR,PP; RR,PP := argRP(1,args);
  qcomin:-qcomin_data(RR,PP);
end:

comin_dX2 := proc(R,P)
  local RR,PP; RR,PP := argRP(1,args);
  qcomin:-comin_dX2(RR,PP);
end:

comin_dX3 := proc(R,P)
  local RR,PP; RR,PP := argRP(1,args);
  qcomin:-comin_dX3(RR,PP);
end:

comin_projgw_h := proc(u,v, d, R,P)
  local RR,PP; RR,PP := argRP(4,args);
  qcomin:-comin_projgw_h(u, v, d, RR,PP);
end:

comin_qhtmult := proc(u, v, R,P)
  local RR,PP; RR,PP := argRP(3,args);
  qcomin:-comin_qhtmult(u, v, RR,PP);
end:

comin_qhmult := proc(u, v, R,P)
  local RR,PP; RR,PP := argRP(3,args);
  qcomin:-comin_qhmult(u, v, RR,PP);
end:

comin_projgw_k := proc(u,v, d, R,P)
  local RR,PP; RR,PP := argRP(4,args);
  qcomin:-comin_projgw_k(u, v, d, RR,PP);
end:

comin_odot := proc(u, v, maxd, R,P)
  local RR,PP; RR,PP := argRP(4,args);
  qcomin:-comin_odot(u, v, maxd, RR,PP);
end:

comin_qktmult := proc(u, v, R,P)
  local RR,PP; RR,PP := argRP(3,args);
  qcomin:-comin_qktmult(u, v, RR,PP);
end:

comin_qkmult := proc(u, v, R,P)
  local RR,PP; RR,PP := argRP(3,args);
  qcomin:-comin_qkmult(u, v, RR,PP);
end:

root_degree := proc(al, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  cnbhd:-root_degree(al, RR,PP);
end:

is_cosmall := proc(al, R,P)
  local RR,PP; RR,PP := argRP(2,args);
  cnbhd:-is_cosmall(al, RR,PP);
end:

curve_nbhd := proc(u, d0, R,P)
  local RR,PP; RR,PP := argRP(3,args);
  cnbhd:-curve_nbhd(u, d0, RR,PP);
end:

####################################################################


end module:

###
