In order to make use of the Stembridge coxeter Package, we must first load it. With this syntax, the file "coxeter2.4v.txt" must be in the same directory as this worksheet.ListTools is a Maple package that contains some necessary function for managing lists.read "coxeter2.4v.txt";
withcoxeter();
with(ListTools);The function comparePoints() takes two involution points in generator notation and a root system, e.g. A4, and calls the coxeter-package-defined function reduce() in order to determine if the two points are the same.comparePoints() is a boolean function as its only two values are true and false (which are constants defined in Maple): true if the points are equal, false if they are not.
reduce() takes a single list of generators and a root system and then uses the predefined relations of the root system (defined in the coxeter package) to determine a shortest path/list of generators to that point from the identity. In the case of comparePoints(), if reduce() returns an empty list, [], we know that the two points together lead back to the identity and therefore must be the same point.op() is a Maple function that returns the contents of a list without the brackets of the list, "[]". return is a Maple function that gives a value to the call to the function. comparePoints := proc(n::(list), m::(list), R)
# R = a root system data structure
# n & m = lists of integers representing a member of W(R)
description "Determine if two lists of generators end at the same point.";
if reduce([op(n), op(m)],R) = [] then
return true;
else
return false;
end if;
end proc;
The function PathsToTop() takes a complete Involution Poset as generated by findInvolPoset() and returns the total number of ascending paths from the identity to the topmost element.Given that we cannot efficiently make a copy of a nested list, which is what the InvolPoset is, this algorithm starts by checking to see if the given InvolPoset has already had its shortest paths defined: member([p],[indices(IP[0][[]])]) will be true if this is the case, and all that is needed is to print the shortest paths element of the topmost point and exit the function with return. Otherwise, - set the number of shortest paths of the identity element to 1- loop through the sizes of the InvolPoset - for each size: get a list of the points in that size --> PTS - loop through the list of points - for each point of the size# - indicates the beginning of a comment; anything following a # on the same line will not be read when running the procedurelocal - declares anything following as a local variable whose name and value are only defined within the functionglobal - printsort - sort a list of parameters (default in ascending order)FlattenOnce/Flatten - remove brackets from listsindices - gives a list of the indices of a listmember - boolean function to test if a given element is a member of a list for - looping function with restrictions, used to loop through listsopnopsremovePathsToTop := proc(IP)
local source, gen, GENS, pt, PTS, k, top_k, top_pt, short_paths, pathsToTop;
global p;
Description("Finds the number of shortest paths from the id element to the top of the poset. It is currently dependent on the output of findInvolPoset.");
#IP := copy(IP_); # make copy of given InvolPoset
pathsToTop := 0;
#print(sort(FlattenOnce([indices(IP)]))); #!!test!!
top_k := nops(FlattenOnce([indices(IP)]))-2; # get highest size of the Poset (for indexing)
top_pt := Flatten([indices(IP[top_k])]); # get the index of the top most point
#print(IP); #!!test!!
#print("[indices(IP[0][[]])] is ", [indices(IP[0][[]])]); #!!test!!
#print("[entries(IP[0][[]])] is ", [entries(IP[0][[]])]); #!!test!!
#print("indices ", [indices(IP[0][[]])]); #!!test!!
#print("IP[0][[]][p] is ", member([p],[indices(IP[0][[]])])); #!!test!!
if member([p],[indices(IP[0][[]])]) then
print("Total number of paths to the top is ",eval(IP[top_k][top_pt][p]));
return();
else
IP[0][[]][p] := 1; #initialize the p of the id to 1
end if;
# loop through sizes
for k from 1 to (nops([indices(IP)])-2) by 1 do
#print("k is ", k); #!!test!!
PTS := FlattenOnce([indices(IP[k])]); # set PTS to the indices of size k
#print("PTS is ", PTS); #!!test!!
# loop through points of size k
for pt in PTS do
#print("pt = ", pt); #!!test!!
#print("[indices(IP[",k,"][",pt,"])] is ", [indices(IP[k][pt])]);
GENS := FlattenOnce([indices(IP[k][pt])]);
IP[k][pt][p] := 0; # initialize shortest path of pt to 0
# loop through the generators pointing to pt
for gen in GENS do
source := eval(IP[k][pt][gen][1]); # source from which gen points
# current shortest paths + source shortest path
short_paths := (op(IP[k][pt][p]) + op(IP[k-1][source][p])); # shortest paths to current point
IP[k][pt][p] := short_paths;
#print("p is ", eval(IP[k][pt][p]));
end do;
end do;
end do;
pathsToTop := eval(IP[top_k][top_pt][p]);
print("Total number of paths to the top is ", pathsToTop);
end proc;The function findInvolPoset() findInvolPoset := proc(R)
# 0. Let the stack consist of the identity element of size 0, and set k = 0
local InvolPoset, id, k, temp, s, si, pt, pts, k1_pt, k1_pts, new_pt, point_unseen, numgen, gen, bar, source;
# define constants
numgen := nops(base(R));
id := []; # intialize the identity element
print ("The Involution Poset for", R);
# Establish the generator points
k := 0; # initialize size to 0
InvolPoset := table(); # initialize InvolPoset to a table
InvolPoset[k] := table(); # initialize InvolPoset[0] to a table
print(base(R));
pt := id;
InvolPoset[k][pt] := table(); # define identity element of size 0
# I. For* each* x* of* size* k from the* stack, do
pts := [indices(InvolPoset[k])];
`pts` := FlattenOnce(pts);
print("The Poset of ", R, " in terms of generators and sources (gen = source (bar or unbar).");
################## Start Algorithm ###################
while nops(pts) <> 0 do
print("\n");
print(nops(FlattenOnce([entries(InvolPoset[k])])),"element(s) of size ", k);
print("Size", k, " -- ", FlattenOnce([eval(InvolPoset[k])]), " -- ", "Size", k);
InvolPoset[k+1] := table(); # define next row
for pt in pts do
# A. For each si such that there is no pointer into x labeled si or si-bar
for si from 1 to numgen by 1 do
if not verify(si,FlattenOnce([indices(InvolPoset[k][pt])]), 'member') then
# (no ascending admissible sequence for x begins with si or si-bar) do:
# (i) Calculate y' = sixsi. If y' != x then let y = y' which is of
# size k+1. If y' = x then let y = six, which is of size k+1
source := pt; # set source to current test point
gen := si; # set gen to si
bar := `_`; # report barring
temp := reduce([si,op(pt), si],R); # set temp to sixsi
if comparePoints(temp, pt, R) then # if this is equal to x
temp := reduce([si, op(pt)], R); # set temp to six
bar := ` `; # report unbarring
end if;
new_pt := [op(temp)];
k1_pts := [indices(InvolPoset[k+1])];
`k1_pts` := FlattenOnce(k1_pts);
# (ii) For each element z of size k+1, check if new_pt=z if so put a pointer
# from x to y labeled si, (si-bar) (add sequence of y to list of ascending admissible sequences for z).
# If no such z add y to stack as new element of size k+1, with a pointer from x labeled si, si-bar.
point_unseen := true; # assume new point
for k1_pt in k1_pts do
if comparePoints(new_pt, k1_pt, R) then
point_unseen := false;
new_pt := k1_pt; # set new point to first found shortest path
break; # break out of loop
else
point_unseen := true;
end if;
end do;
if point_unseen then
InvolPoset[k+1][new_pt] := table(); # define new point as a table
k1_pts := [indices(InvolPoset[k+1])];
`k1_pts` := FlattenOnce(k1_pts);
end if;
InvolPoset[k+1][new_pt][gen] := [source,bar]; # link new point to source via gen
end if;
end do;
end do;
`k` := k+1;
pts := [indices(InvolPoset[k])];
`pts` := FlattenOnce(pts);
# II. If the current level is non-empty go to step [I]
end do;
print("\n\n");
print("The Poset of ", R, " has the following element/size pattern.");
for i from 0 to (nops([indices(InvolPoset)])-2) by 1 do
print(nops(FlattenOnce([entries(InvolPoset[i])]))," element(s) of size ", i);
end do;
#print("The Poset of ", R, " in terms of generators and sources (gen = source (bar or unbar).");
#for i from (nops([indices(InvolPoset)])-2) to 0 by -1 do
#print("Size", i, " -- ", FlattenOnce([eval(InvolPoset[i])]));
#end do;
PathsToTop(InvolPoset);
#return(eval(InvolPoset));
end proc;