-- Macaulay code to analyze semicontinuously stable 
-- measures of singularities of Schubert varieties. 
-- based on the paper ``Computing singularities of Schubert varieties''
-- by Alexander Woo and Alexander Yong

-- Author: Alexander Yong (email: ayong@math.umn.edu, ayong@fields.utoronto.ca)
--         Alexander Woo  (email: ayong@math.ucdavis.edu)
-- Version 0.2 (beta), date: February 22, 2006
-- See http://www.math.umn.edu/~ayong for current version
-- Please email any comments, suggestions, bugs to ayong@math.umn.edu

-- Quick instructions: get Macualay 2 and load it. 
-- type ``load "[..]/Schubsingular.v0.1.m2";'' to start
-- permutations are represented in computer
-- indexing {3,4,0,1,5,2} means 1->4, 2->5, 3->1, 4->2, 5->6, 6->3 etc
-- the main functions to be used are
-- locuscompute, mult, minresKL, cansheafrank, Gorconjcheck, runthroughperms
-- Explanations are given before the declarations of each function.
-- The first five are "one-time" calculations, while the last
-- is meant to facilitate computation along a range of permutations
-- example 1: mult({4,3,0,1,5,2}, {0,1,2,3,4,5}) computes the multiplicity
--            of X_{541263} at e_{id}
-- example 2: similarly cansheafrank({4,3,0,1,5,2},{0,1,2,3,4,5}) computes
--            the rank of the canonical sheaf there
-- example 3: runthroughperms(6, Gorconjcheck, 0, 719) checks the
--            non Gorenstein locus conjecture for all permutations in S_6
--            (from the one indexed "0" to the last indexed "719"=6!-1).
--            The code Gorconjcheck is intentionally verbose.
--	      It is useful to stagger the ranges to parallel check 
--            this conjecture and others.
-- >>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

-- >>>>>>>>>> Code to compute various kinds of singular loci <<<<<<<<<<<<<<<<<<<

-- run through the Bruhat order, call some other function "invarianttype"
-- to compute multiplicity, rank of the canonical sheaf etc 
-- and compute the locus P_k, i.e., the locus where invariant type
-- has value at least k. E.g., if invarianttype=mult and k=2, 
-- this computes the singular locus of X_perm
locuscompute = (perm, invarianttype, k) -> (
	ourpermlength := permLength(perm);
	flag := 0;
	currentlength := ourpermlength;
	locus := {};
	value:=0;
	belowperm:=true;
	covered:=true;
	n:=#perm;
	thepermlist := permsbylength(n);
	nchoose2:=#thepermlist;
	colength:=#thepermlist-currentlength+1;
	currentlength=colength;
	currentlist := {};

	while(flag==0) do (
		flag=1;
		if(currentlength<(nchoose2)) then (
			currentlist = thepermlist#(currentlength);
			for j from 0 to (#currentlist-1) do (
				-- check if the permutation is worth calculating, i.e.,
				-- is it already covered by the locus, or not below 
				-- perm?
		
				belowperm=BruhatLeq(currentlist#j, perm);
				covered=ispermloi(currentlist#j, locus);
				if((belowperm==true) and (covered==false)) then (
					flag =0;  -- we stop when everything is
  						  -- not worth checking
					value=invarianttype(perm, currentlist#j);
					if(value>=k) then (
						locus = append(locus, currentlist#j);
					);
				);
			);
			currentlength = currentlength+1;
		);
	);
	locus
);

-- >>>>>>>>>>>>>>>> End of code to compute various kinds of singular loci <<<<<<<<<<<<<

-- >>>>>>>>>>>>>>>>>>>>  Code to compute various measures <<<<<<<<<<<<<<<<<<<<<<<<<<<<<

-- Code to compute the multiplicity of a Schubert variety "X_perm1" at the point "e_perm2"
mult = (perm1, perm2) -> (
	St:= createSt(perm2);
	rank:= matrix(rankmatrixweuse(perm1));
	Gt:= matrix(createGtmatrix(perm2));
	n:=#perm1;
	Jlist:= trim(sum(flatten(for i from 0 to n-1 list 
                           for j from 0 to n-1 list minors(rank_(n-i-1,j)+1, 
                             submatrix(Gt, {(n-i-1)..n-1}, {0..j})))));
	Jlist = substitute(Jlist, St);
	GBlist:=gb(Jlist);
	LTlist:=leadTerm(gens(GBlist));
	S:=createS(perm2);
	maplist=prepend(1, gens(S));
	f = map(S, St, maplist);
	ELTlist = f(LTlist);
	Dlist = degree(ideal(ELTlist));	
	Dlist
);

-- Compute a minimal free resolution of R/I_{perm2, perm1}
-- of the Kazhdan-Lusztig ideal of X_perm1 at e_perm2
-- minimality is with respect to the funny grading described
-- in the paper
minresKL = (perm1, perm2) -> (
	R=creategradedS(perm2);
	rankm:= matrix(rankmatrixweuse(perm1));	
	G1:=matrix(createGmatrix(perm2));
	n:=#perm1;
	Jlist:= trim(sum(flatten(for i from 0 to n-1 list 
                           for j from 0 to n-1 list minors(rankm_(n-i-1,j)+1, 
                             submatrix(G1, {(n-i-1)..n-1}, {0..j})))));
	Smodule:=R^1;
	resl:= prune res(Smodule/Jlist);
	resl
	
);

-- Compute rank of the canonical module of N_{perm2, perm1},
-- the Kazhdan-Lusztig ideal of X_{perm1} at e_{perm2}

-- computes the canonical sheaf rank using the minimal
-- free resolution given by minresKL
cansheafrank = (perm1, perm2) -> (
	resl:=minresKL(perm1, perm2);

	R=creategradedS(perm2);
	rankm:= matrix(rankmatrixweuse(perm1));	
	G1:=matrix(createGmatrix(perm2));
	n:=#perm1;
	Jlist:= trim(sum(flatten(for i from 0 to n-1 list 
                           for j from 0 to n-1 list minors(rankm_(n-i-1,j)+1, 
                             submatrix(G1, {(n-i-1)..n-1}, {0..j})))));
	ii:=codim(Jlist);
	if(length(resl)==ii) then (
		ans=rank(source(resl.dd_ii));
	)
	else (
		print(ERROR1); -- This should NEVER happen, report to 
			       -- ayong@math.umn.edu if it does
	);	
	ans
);

-- an alternate (and much slower than cansheafrank) method to
-- compute the rank of the canonical sheaf; kept here for debugging purposes
altcansheafrank = (perm1, perm2) -> (
	
	R=createS(perm2);
	rankm:= matrix(rankmatrixweuse(perm1));	
	G1:=matrix(createGmatrix(perm2));
	n:=#perm1;
	Jlist:= trim(sum(flatten(for i from 0 to n-1 list 
                           for j from 0 to n-1 list minors(rankm_(n-i-1,j)+1, 
                             submatrix(G1, {(n-i-1)..n-1}, {0..j})))));
	Smodule:=R^1;
	resl:=res(Smodule/Jlist);
	--print(codim(Jlist));
	maxideal:=ideal(gens(R));
	field:=R^1/maxideal;
	--print(betti(resl));
	--print(resl);
	ii:=codim(Jlist);
	TT:=Tor_ii(field, coker(resl.dd_1));
	ddd:=degree TT;
	print(ddd);
	ddd -- need to justify this degree statement
);

-- >>>>>>>>>>>>>>>>>>>>  End of code to compute various measures <<<<<<<<<<<<<<<<<<<<<<


-- >>>>>>>>>>>>>>>>>>>>  Code to check various conjectures/compute facts <<<<<<<<<<<<<<

-- given a function that returns 1 and 0 (true and false)
-- run through all perms in S_n from lower to upper
-- and figure out if there are counterexamples
runthroughperms = (n, fn, lower, upper) -> (
	results:={};
	answer1:=0;
	permsrun:=perms(n);
	for i from lower to upper do (
		answer1=fn(permsrun#i);
		print((i, permsrun#i, answer1));
		results=append(results, answer1);
	);
	results
);

-- code to check the Gorensteinness conjecture (using the faster
-- cansheafrank code to calculate the rank of the canonical
-- sheaf, see the aforementioned paper for discussion

Gorconjcheck = (perm) -> (
	conjGorlocus:={};
	notconjGorlocus:={};
	ans:=1;
	pass:=0;
	singlocus:={};
	--check if smooth (this could be improved)
	if(mult(perm, idPerm(#perm))==1) then (
		print(ISSMOOTH);
		pass=1;
		ans=1;
		singlocus={};
	);

	-- check Gorensteinness
	if(pass==0) then (
		if(cansheafrank(perm, idPerm(#perm))==1) then (
			print(ISGORENSTEIN);
			pass=1;
			ans=1;
		);
	);
	-- determine the singular locus if necessary
	if(pass==0) then (
		singlocus=locuscompute(perm, mult, 2);
		print((SINGULARLOCUSIS, singlocus));
	); 
	-- if the thing is smooth, or the locus has only one
	-- component, then there's nothing to check
	if(#singlocus<2) then (
		print(BORINGCASEBYWYI);
		ans=1;
		pass=1;)
	else (
		-- now determine the conjectural Gorenstein locus
		-- by checking which are not Gorenstein generically
		conjGorlocus={};
		notconjGorlocus={};
		csr:=0;
		for i from 0 to #singlocus-1 do (
			csr:=cansheafrank(perm, singlocus#i);
			if csr>1 then (
				conjGorlocus=append(conjGorlocus, singlocus#i);
			)
			else (
				notconjGorlocus=append(notconjGorlocus, singlocus#i);
			)	
		);
	);
	info:= (conjGorlocus, notconjGorlocus);
	print(info);
	if (#conjGorlocus==0) then (
		pass=1;
		ans=1;
		print(GORENSTEIN);
	);
	-- now we need to check that the elements in the not Gorenstein
	-- part of the maximal singular locus do not contribute to the
	-- Gorenstein locus. This means that we need to find _minimal_
	-- elements of the Bruhat order such that they are underneath
 	-- our non Gorenstein element, and _not_ under the Gorenstein guys
	-- we have to search from bottom up until we find a level that is
	-- saturated. THEN we do the cansheafrank calculations and
	-- verify that they are all equal to 1 as they should be, according
	-- to the conjecture

	if(pass==0) then (
		print(INTERESTINGCASE);
		permtotest:={};
		addable:=true;
		thepermlist:=permsbylength(#perm);
		isone:=1;

		for i from 0 to #notconjGorlocus-1 do (
			permtotest=notconjGorlocus#i;	
			print(permtotest);	
			flag:=1;
			searchlevel:=#thepermlist-1; -- go up the Bruhat order
			minelts:={};
			currentperms:={};

			while (flag==1) do (
			
				currentperms=thepermlist#searchlevel;
				flag=0;		
				for j from 0 to #currentperms-1 do (
					addable=true;
					-- if the permutation is underneath permtotest, and
					-- not under the conjGorlocus guys AND not bigger than
					-- current minelts, then add it to minelts, otherwise forget it
					addable=BruhatLeq(currentperms#j, permtotest);
					for k from 0 to #conjGorlocus-1 do (
						if(BruhatLeq(currentperms#j, conjGorlocus#k)==true) then (
							addable=false;
						);
					);	
					for k from 0 to #minelts-1 do (
						if(BruhatLeq(minelts#k, currentperms#j)==true) then (
							addable=false;
						);
					);
					if (addable == true) then (
						minelts=append(minelts, currentperms#j);
					);
				);
				-- we don't want to stop just because we have no min elts yet, we
				-- want to stop when we have min elts
				if(searchlevel>=permLength(permtotest)) then (
					flag=1;
				);
				searchlevel=searchlevel-1;
			);	
	
	
			-- at this point, we have a bunch of minelts, and we want to check 
			-- all of the can sheaf ranks are 1
			ans=1;
			print((permtotest, minelts));
			for i from 0 to #minelts-1 do (
	
				-- again, we apply fakecansheafrank to try to get
				-- a quicker answer
				if(cansheafrank(perm, minelts#i)>1) then (
					ans=0;
				);				
			);
		);
	);
	ans
);

-- Code to check A. Woo's Catalan conjecture (highest multiplicity over
-- all Schubert varieties is a Catalan number); specifically, it computes
-- the maximum of this highest multiplicity for all Schubert varieties
-- in Flags(C^n) 
checkwooconjmult = (n) -> (
	permstotest:=perms(n);
	multiplicitylist:={};
	currentmult:=0;
	for i from 0 to (#permstotest-1) do (
		currentmult=mult(permstotest#i, idPerm(n));
		print({i, permstotest#i, currentmult});
		multiplicitylist=append(multiplicitylist, currentmult);	
		collectGarbage();
	);	
	ans:=max(multiplicitylist);
	ans
);

-- same as checkwooconjmult, except allows for beginning and
-- ending ranges, to check the conjecture in parallel
checkwooconjmultrange = (n, begin, end) -> (

	permstotest:=perms(n);
	multiplicitylist:={};
	currentmult:=0;
	for i from begin to end do (
		currentmult=mult(permstotest#i, idPerm(n));
		print({i, permstotest#i, currentmult});
		multiplicitylist=append(multiplicitylist, currentmult);	
		collectGarbage();
	);	
	ans:=max(multiplicitylist);
	ans
);

-- code to compute the highest canonical sheaf ranks of all 
-- Schubert varieties in Flags(C^n) at e_id

highestcansheafrank = (n) -> (

	permstotest:=perms(n);
	cansheafranklist:={};
	cansheafranklist2:={};
	numGor:=0;
	currentcansheaf:=0;
	for i from 0 to (#permstotest-1) do (
		currentcansheaf=cansheafrank(permstotest#i, idPerm(n));
		if(currentcansheaf==1) then (
			numGor=numGor+1;
		);
		print({i, permstotest#i, currentcansheaf});
		-- cansheafranklist=append(cansheafranklist, {permstotest#i,currentcansheaf});
		cansheafranklist2=append(cansheafranklist2, currentcansheaf);	
		collectGarbage();
	);	
	ans:=max(cansheafranklist2);
	print(numGor);
	ans
);

-- >>>>>>>>>>>>>>>>>>End of code to check various conjectures/compute facts <<<<<<<<<<<

-- >>>>>>>>>>>>>>>>>>>>. Code to create the rings/matrices <<<<<<<<<<<<<<<<<<<<<<<<<<<<

-- create the G matrix for use when computing multiplicity

createGmatrix = (perm) ->(
	G:={};
	currentrow:={};
	nn:=#perm;
	for i from 0 to nn-1 do (
		currentrow={};
		for j from 0 to nn-1 do (
			if(i==perm#j) then (
				currentrow=append(currentrow,1); 
			);
			if(i<perm#j) then (
				currentrow=append(currentrow,0);
			);
			if(i>perm#j) then(
				if(j<((inverseOf(perm))#i)) then (
					currentrow=append(currentrow, x_(nn-(i+1)+1,(j+1)));
				)
				else (
					currentrow=append(currentrow, 0);
				);
			)

		);
		G = append(G, currentrow);
	);
	G
);

-- create the Gt matrix for use when computing multiplicity

createGtmatrix = (perm) ->(
	Gt:={};
	currentrow:={};
	nn:=#perm;
	for i from 0 to nn-1 do (
		currentrow={};
		for j from 0 to nn-1 do (
			if(i==perm#j) then (
				currentrow=append(currentrow,t); 
			);
			if(i<perm#j) then (
				currentrow=append(currentrow,0);
			);
			if(i>perm#j) then(
				if(j<((inverseOf(perm))#i)) then (
					currentrow=append(currentrow, x_(nn-(i+1)+1,(j+1)));
				)
				else (
					currentrow=append(currentrow, 0);
				);
			)

		);
		Gt = append(Gt, currentrow);
	);
	Gt
);

-- create the ring S (that _does not_ involve t and the "MonomialOrder...")

createS = (perm) -> (
	varlist={};		
	nn:=#perm;
	for i from 0 to nn-1 do (
		ii:=nn-1-i;
		for j from 0 to nn-1 do (
			if(ii>perm#j) then(
				if(j<((inverseOf(perm))#ii)) then (
					varlist=append(varlist, x_(nn-(ii+1)+1,(j+1)));
				);
			);

		);
	);
	QQ[varlist] 
);

-- create the ring St (that involves t and the variables used for a given v)

createSt = (perm) -> (
	varlist={t};		
	nn:=#perm;
	for i from 0 to nn-1 do (
		ii:=nn-1-i;
		for j from 0 to nn-1 do (
			if(ii>perm#j) then(
				if(j<((inverseOf(perm))#ii)) then (
					varlist=append(varlist, x_(nn-(ii+1)+1,(j+1)));
				);
			);

		);
	);
	QQ[varlist, MonomialOrder => Eliminate 1] 
);


-- create the ring S with "funny" grading from the paper 

creategradedS = (perm) -> (
	varlist={};		
	gradinglist:={};
	nn:=#perm;
	for i from 0 to nn-1 do (
		ii:=nn-1-i;
		for j from 0 to nn-1 do (
			if(ii>perm#j) then(
				if(j<((inverseOf(perm))#ii)) then (
					varlist=append(varlist, x_(nn-(ii+1)+1,(j+1)));
					iii:=ii+1;
					gradedi:=((inverseOf(perm))#(iii-1))+1;
					gradedj:=j+1;
					gradeddiff:=gradedi-gradedj;
					gradinglist=append(gradinglist,{gradeddiff}); 
				);
			);

		);
	);
	QQ[varlist, Degrees=>gradinglist]
);

-- >>>>>>>>>>>>>>>>>> End of Code to create the ring definitions <<<<<<<<<<<<<<<<<<<<<<<<<<

-->>>>>>>>>>>>>>>>> Permutation code, Thanks Allen Knutson <<<<<<<<<<<<<<<<<<

-- These are some basic operations on lists inexcusably missing from Macaulay.
insert = (l,n,x) -> (apply(#l+1, i->(
	       if (i<n) then l#i
	       else if (i>n) then l#(i-1)
	       else x) ) )

switchEntries = (l,a,b) -> apply(#l, i->(
	  if i == a then l_b
	  else if i == b then l_a
	  else l_i) )

-- This feeds a number into permutation in all possible places.
     
adjoinLast = (p) -> apply(#p+1, i->insert(p,#p-i,#p))

-- All permutations of size n, built inductively. They don't come in any
-- order useful to me.

-- All permutations of size n, built inductively. They don't come in any
-- order useful to me.
     
perms = (n) -> (
     if n == 1 then {{0}}
     else (x := perms(n-1);
	  flatten apply(#x, i -> adjoinLast(x#i)) )
     )

idPerm = (n) -> (toList (0..n-1))

-- this is an awful way to produce these, but this isn't the 
-- time-limiting step for me.

isKgrassmannian = (p,k) -> (good = true;
     scan(k-1,   i->(if p_i>p_(i+1) then good = false;));
     scan(#p-k-1, i->(if p_(k+i)>p_(k+i+1) then good = false;));
     good)

grassPerms = (k,n) -> select(perms(n),p->isKgrassmannian(p,k))     

-- These are perms fixing the last few entries. I want to do my calculations
-- inside large enough matrices to see stable phenomena.

shortPerms = (N,n) -> apply(perms(N), p->flatten {p, toList (N..n-1)})

-- Permutation matrix and associated rank matrix.

permMatrix = (p) -> matrix apply(#p, i-> 
     apply(#p, j->(if p_i==j then 1 else 0) ) )

lowerOnes = (n) -> matrix apply(n, i-> 
     apply(n, j->(if i>=j then 1 else 0) ) )

-- this gives the rank of intersections: 

rankMatrix = (p) -> lowerOnes(#p) * permMatrix(p) * transpose (lowerOnes(#p))

-- I care more about spans, and Schubert cells not antiSchubert.

spanMatrix = (p) ->(q = apply(n, i->(n-1-p_i));
	r = transpose (rankMatrix(q)); 
     matrix apply(n, i->apply(n, j->(i+1)+(j+1)-r_(i,j))) )

-- Length as a Coxeter element. sortedPerms produces a list in a total
-- order extending the Bruhat order, good for some inductive calculations.

permLength = (p) -> (l := 0;
     scan(#p, i->scan(i..#p-1, j ->(if p#i>p#j then l=l+1)));
     l)

sgn = (p) -> (l := permLength(p); if (l%2 == 0) then 1 else -1)

-- bubblesort - hah!
--sortByLength = (l) -> (scan(#l, i -> scan(i+1..#l-1, j -> (
--	       	    if permLength(l_i) > permLength(l_j) 
--	       	    then l = switchEntries(l,i,j) )));
--     l)

sortByLength = (l)->(fr := sort(apply(l,p->{permLength(p),p}));
     apply(fr, f->f_1))     

sortedPerms = (n) -> sortByLength(perms(n))
shortedPerms = (N,n) -> sortByLength(shortPerms(N,n))
sortedGrassPerms = (k,n) -> sortByLength(grassPerms(k,n))

--these are ridiculously slow, but they work
removeBeginning = (p)->(
     if (p == {}) then {} else
     (if (p_0 == 0) then removeBeginning(apply(#p-1, i->(-1+p_(i+1))))
	  else p));

removeEnd = (p)->(
     if (p == {}) then {} else
     (if (p_(#p-1) == #p-1) then removeEnd(apply(#p-1, i->p_i)) 
	  else p));

toStr = (p) -> (
     s := "";
     scan(p, i ->(s = (s | toString(i)) ));
     s)

findElt = (l,e) -> sum(#l, i -> (if l_i==e then i else 0))

-- this lists the places where two permutations differ
diffs = (p,q) -> select(toList (0..#p-1), i->(p_i != q_i))

inverseOf = (p) -> apply(#p, i->findElt(p,i))

switchValues = (p,a,b) -> switchEntries(p,findElt(p,a),findElt(p,b))

w0times = (p) ->apply(p, i->(#p-1-i))

timesw0 = (p) ->inverseOf(w0times(inverseOf(p)))

w0conj = (p) -> w0times(timesw0(p))

breaksAt = (p,i) ->(ans := (i>0);
     scan(i, j->(ans = ans and (p_j < i)));
     ans)

breaksStr = (p)->(ans := ""; lastBreak := 0;
     scan(#p, i->(if breaksAt(p,i) then (lastBreak = i; ans = ans | " ";);
	       ans = ans | toString(p_i - lastBreak); ));
     ans)

unbreakable = (p)->(ans := true;
     scan(#p, i->(ans = ans and not breaksAt(p,i)));
     ans)

lexLeq = (p,q)->(stillEq := true; ans := true;
     scan(#p, i->if stillEq then (if (p_i != q_i) then (stillEq = false;
		    if (p_i > q_i) then ans = false; ))); 
     ans)

-- this checks whether a switch gives a covering in the Bruhat order
switchableUp = (p,i,j)->(ans := true; if (p_i > p_j) then ans = false;
     scan((i+1..j-1), k->(if (p_i < p_k) and (p_k < p_j) then ans = false;));
     ans)

coverings = (p)->(ans := {};
     scan(#p, j->scan(j, i->(if switchableUp(p,i,j) 
		    then ans = flatten {ans, {switchEntries(p,i,j)}}; )));
     ans)

BruhatLeq = (w,v)->(wm := rankMatrix(w); vm := rankMatrix(v);
     notLeq = false;
     scan(#v, i->scan(#v, j->(if ((wm_(i,j)) < (vm_(i,j))) then notLeq = true;)));
     not notLeq)



essentialSet = (p)->(d := permDiagram(p);
     matrix apply(#p, j->apply(#p, i->(
		    if (d_i_j == 1) and
		    ((i==#p-1) or (d_(i+1)_j == 0)) and
		    ((j==#p-1) or (d_i_(j+1) == 0)) then 1 else 0))) )
-->>>>>>>>>>>>>>>>> End of Allen Knutson's permutation code <<<<<<<<<<<<<<<<<<<<<<

-->>>>>>>>>>>>>>>>> Miscellaneous <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-- flatten a sequence of different numbers 

flattenperm = (notperm) -> (

	tempseq:=();
	for k from 0 to #notperm do (
		tempseq=append(tempseq,0);
	);

	newtempseq:=();
	currentlist:=notperm;
	newcurrentlist:={};
	themin:=999;
	maxnotperm:=max(notperm);
	minpos:=0;
	for i from 0 to #notperm-1 do (
		themin=min(currentlist);
		minpos=findElt(currentlist, themin);
		newtempseq:=();
		newcurrentlist:={};
		-- set up the new flattened perm tempseq
		-- replace the position of the current min in currentlist with a large number 
		for j from 0 to #notperm-1 do (
			if (j==minpos) then (
				newtempseq=append(newtempseq, i);
				newcurrentlist=append(newcurrentlist, maxnotperm+1);
			)
			else (
				newcurrentlist=append(newcurrentlist,currentlist#j);
				newtempseq=append(newtempseq, tempseq#j);
			);
		);
		tempseq=newtempseq;
		currentlist=newcurrentlist;
	);

	ans:={};
	for j from 0 to #tempseq -1 do (
		ans=append(ans, tempseq#j);
	);
	ans
);

-- We need to convert the rank matrices Allen K. uses to the ones we use.

rankmatrixweuse = (perm)->(
	inmatrixform:=transpose(rankMatrix(w0times(perm)));
	Rankout:={};
	rowlist:={};
	for i from 0 to ((#perm)-1) do (
		rowlist:={};
		for j from 0 to ((#perm)-1) do (
			rowlist= append(rowlist, inmatrixform_((#perm)-i-1, j));
		);
		Rankout=append(Rankout, rowlist);
	);
	Rankout
);

-- run through the (sorted) list of permutations, and slot them
-- into a list of lists by Coxeter length

permsbylength = (n) -> (
	slist:= sortedPerms(n);
	bylengthlist:={};
	thislengthlist:={};
	nchoose2 = permLength(w0times(idPerm(n)));
	currentpos:= n!-1;
	for i from 0 to nchoose2 do (
		thislengthlist={};
		flag:=0;
		while(flag==0) do (
			if (permLength(slist#currentpos)==(nchoose2-i)) then (
				thislengthlist = append(thislengthlist, slist#currentpos);
				currentpos = currentpos-1;	
			)
			else (
				flag=1;
			);
		); 
		bylengthlist= append(bylengthlist, thislengthlist);
	);
	return bylengthlist
)

-- check if a permutation is in the lower order ideal
-- of the Bruhat order generated by a list of other permutations

ispermloi = (perm, permlist) -> (
	ans:=false;

	for i from 0 to (#permlist-1) do (
		if (BruhatLeq(perm, permlist#i)==true) then ans=true;
	);
	ans
);


-- >>>>>>>>>>>>>>>>> End of Miscellaneous <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<