with(combinat):

print("Welcome to gVATTER, a Maple package for the enumeration of"):
print("permutations avoiding generalized permutation patterns."):
print("To see a list of available functions, type Help();"):
print("or to learn more about a particular function type Help(function_name);"):

Help:=proc()
if args=NULL then 
print("The available functions are:"):
print("red, allsubstrings, restrictedsubstrings, restrictedsubstringsend"): 
print("pcontainsq, pcontainsqS, pcontainsqset, pcontainsqsetS"):
print("pcontainsqend, pcontainsqendS, pcontainsqendset, pcontainsqendsetS"):
print("Sn, SnS, all01s, allpatterns, allpatternsS, allseqs, allseqsS"):
print("rev, revS, comp, compS, inv, invS"):
print("genrev, genrevS, gencomp, gencompS, geninv, geninvS, symm, symmS, symmclasses, symmclassesS"):
print("children, splitgp, fracletter, allfracletters, scenarios, scenariosS"):
print("getVector, scenariosWgaps, scenariosWgapsS"):
print("isRevDel, isRevDelS, isRevDelSet, isRevDelSetS, collapseGV, collapseGVS, posset, rdSet, rdSetS"):
print("isGapVector, isGapVectorS, pcontainsqparts, pcontainsqpartsS, restrictedsubstringsparts"):
print("Comps, ImpliedGVs, NewGVs, NewGVsS, GVs, GVsS, g1GTg2, obeysG"):
print("GandBChildren, GandBChildrenS, BuildSchemeS"):
print("InsertEntries, InsertionValues, letterCands"):
print("DeleteEntries, DeleteEntriesG, Miklos, SSeq, SSeqBF, SSeqBFS, classifyS"):
print("inversions, Snq, qinveff, qMiklos, qSeqS, Wilf, qWilf"):

elif args[1]=red then
print("red(L): inserts a list L and outputs its reduction"):
print("For example, red([3,5,4,4]) returns [1,3,2,2]."):

elif args[1]=allsubstrings then
print("allsubstrings(L,m): inputs a list L and an integer m"):
print("and returns all substrings of L of length m"):

elif args[1]=restrictedsubstrings then 
print("restrictedsubstrings(L,r): inputs a list L, and and list of"): 
print("0s and 1s r, and returns all substrings s of L of length nops(r)+1"):
print("where s[i] s[i+1] must have been adjacent in L if r[i]=0"):

elif args[1]=restrictedsubstringsend then
print("restrictedsubstringsend(L,r): same as restrictedsubstrings(L,r)"):
print("but only returns substrings that include the last letter of L"):

elif args[1]=pcontainsq then
print("pcontainsq(p,q): inputs a permutation p and a pattern q and outputs"): 
print("true if p contains q, false if p does not contain q"):
print("q is a generalized permutation pattern so it consists of a"): 
print("pair of lists [q1,q2] where q1 is a permutation, and q2 is"): 
print("a list of 0s and 1s of length nops(q1)-1, where q2[i]=0 means q1[i] and q1[i+1]"):
print("must be adjacent letters  in a copy of q1 and a 1 means that they are"):
print("not-necessarily-adjacent letters.  that is a 1 is equivalent to having a dash"):
print("in the generalized pattern notation"):

elif args[1]=pcontainsqS then
print("pcontainsqS(p,Q): inputs a permutation p and a set of patterns Q and outputs "):
print("true if p contains some member of Q, false if p avoids all members of Q"):
print("each member of Q is a generalized permutation pattern so it consists of a "):
print("pair of lists [q1,q2] where q1 is a permutation, and q2 is "):
print("a list of 0s and 1s of length nops(q1)-1, where q2[i]=0 means q1[i] and q1[i+1]"):
print("must be adjacent letters  in a copy of q1 and a 1 means that they are"):
print("not-necessarily-adjacent letters.  that is a 1 is equivalent to having a dash"):
print("in the generalized pattern notation"):

elif args[1]=pcontainsqset then
print("pcontainsqset(p,q): same as pcontainsq(p,q), but returns the set of subtrings"):
print("of p that are q patterns"):

elif args[1]=pcontainsqsetS then
print("pcontainsqsetS(p,Q): same as pcontainsqS(p,Q), but returns the set of subtrings"):
print("of p that are q patterns"):

elif args[1]=pcontainsqend then
print("pcontainsqend(p,q): same as pcontainsq(p,q) except returns true only if p"):
print("contains a copy of q that uses the last letter of p"):

elif args[1]=pcontainsqendS then
print("pcontainsqendS(p,Q): same as pcontainsqS(p,Q) except returns true only if p"):
print("contains a copy of q that uses the last letter of p"):

elif args[1]=pcontainsqendset then
print("pcontainsqendset(p,q): same as pcontainsqend(p,q), but returns the set of subtrings"):
print("of p that are q patterns"):

elif args[1]=pcontainsqendsetS then
print("pcontainsqendsetS(p,Q): same as pcontainsqendS(p,Q), but returns the set of subtrings"):
print("of p that are q patterns"):

elif args[1]=Sn then
print("Sn(gp,n): inputs a generalized pattern (see pcontainsq for notation) and an integer n"):
print("and outputs the number of permutations avoiding gp of length 0, 1, 2,... n"):

elif args[1]=SnS then
print("SnS(G,n): inputs a set G of generalized patterns (see pcontainsq for notation) and an integer n"):
print("and outputs the number of permutations avoiding all members of G of length 0, 1, 2,... n"):

elif args[1]=all01s then
print("all01s(n): produces the set of all strings of 0s and 1s of length n"):

elif args[1]=allpatterns then
print("allpatterns(n): produces the set of all generalized permutation patterns"):
print("of length n"):

elif args[1]=allpatternsS then
print("allpatternsS(N): produces the set of all sets of generalized permutation patterns"):
print("with lengths in list N"):

elif args[1]=allseqs then
print("allseqs(n): prints the set of all counting sequences formed by avoiding a"):
print("generalized permutation pattern of length n, organized by sets of patterns"):
print("that produce the same sequence"):

elif args[1]=allseqsS then
print("allseqsS(N): prints the set of all counting sequences formed by avoiding a"):
print("set of generalized permutation pattern of lengths in list N, organized by sets of patterns"):
print("that produce the same sequence"):

elif args[1]=rev then
print("rev(L): the reverse of list L"):

elif args[1]=revS then
print("revS(SL): the reverse of each list in the set SL"):

elif args[1]=comp then
print("comp(L): the complement of list L"):

elif args[1]=compS then
print("compS(SL): the complement of each list in the set SL"):

elif args[1]=inv then
print("inv(L): the inverse of list L"):

elif args[1]=invS then
print("invS(SL): the inverse of each list in the set SL"):

elif args[1]=genrev then
print("genrev(gp): the reverse of generalized pattern gp"):

elif args[1]=genrevS then
print("genrevS(G): the reverse of each generalized pattern in set G"):

elif args[1]=gencomp then
print("gencomp(gp): the complement of generalized pattern gp"):

elif args[1]=gencompS then
print("gencompS(G): the complement of each generalized pattern in set G"):

elif args[1]=geninv then
print("geninv(gp): the inverse of generalized pattern gp"):
print("this should really only be called for patterns where no adjacencies are required"):

elif args[1]=geninvS then
print("geninvS(G): the inverse of each generalized pattern in set G"):
print("this should really only be called for patterns where no adjacencies are required"):

elif args[1]=symm then
print("symm(gp): the trivial Wilf symmetries of generalized pattern gp"):

elif args[1]=symmS then
print("symmS(G): the trivial Wilf symmetries of generalized pattern set G"):

elif args[1]=symmclasses then
print("symmclasses(n): inputs an integer n and puts all generalized patterns of length n"):
print("into equivalence classes according to the symmetries of the square"):

elif args[1]=symmclassesS then
print("symmclassesS(N): inputs a list of integers N and puts all generalized patterns of lengths from N"):
print("into equivalence classes according to the symmetries of the square"):

elif args[1]=children then
print("children(pre): the children of prefix pre"):
print("i.e. the set of permutations of length nops(pre)+1"):
print("whose first nops(pre) elements reduce to pre"):

elif args[1]=splitgp then
print("splitgp(gp): inputs a generalized pattern gp and outputs all possible prefixes of gp"):

elif args[1]=fracletter then
print("fracletter(pre,pat,inst): inputs a prefix pre"):
print("a pattern pat, and an instant inst of all but the last letter of"):
print("pat in pre."):
print("then returns all possible ways to append a letter to pre and complete the"):
print("instance of pat"):
print("for example, try fracletter([2,3,1,4],[1,3,2],[1,4]);"):

elif args[1]=allfracletters then
print("allfracletters(pre,pat,inst): inputs a prefix pre, a pattern pat,"):
print("and an instance of the beginning of the pattern in pre"):
print("outputs the set of all permutations beginning with pre that extend the"):
print("given partial instance of pat into a complete instance of pat"):
print("for example, try allfracletters([2,3,1,4],[1,3,2],[3]);"):

elif args[1]=scenarios then
print("scenarios(pre,gp): inputs a prefix pre and a generalized pattern gp"):
print("and returns all extentions of pre to a permutation that contains generalized pattern"):
print("gp, partly in pre, partly using the newly appended letters"):
print("a scenario is a pair of lists -- the first list is the extension, and the "):
print("second list is the explicit set of letters of the prefix that are"):
print("involved in the forbidden pattern"):

elif args[1]=scenariosS then
print("scenariosS(pre,G): inputs a prefix pre and a generalized pattern set G"):
print("and returns all extentions of pre to a permutation that contains generalized pattern"):
print("gp in G, partly in pre, partly using the newly appended letters"):
print("a scenario is a pair of lists -- the first list is the extension, and the "):
print("second list is the explicit set of letters of the prefix that are"):
print("involved in the forbidden pattern"):

elif args[1]=getVector then
print("getVector(scen,pre): inputs a scenario and a prefix, and returns"):
print("the corresponding gap vector for the scenario with respect for the prefix"):
print("for example, try getVector([[2,3,1,4,5/2,7/2],[2,3,1,4]],[2,3,1,4]); vs. getVector([[2,3,1,4,3/2,7/2],[2,3,1,4]],[2,3,1,4]);."):

elif args[1]=scenariosWgaps then
print("scenariosWgaps(pre,gp,gaps): inputs a prefix pre, a generalized pattern gp,"):
print("and a set of gap vectors gaps"):
print("and returns all extentions of pre to a permutation that contains generalized pattern"):
print("gp, partly in pre, partly using the newly appended letters"):
print("but only includes extensions that obey the set of gap vectors gaps"):

elif args[1]=scenariosWgapsS then
print("scenariosWgapsS(pre,G,gaps): inputs a prefix pre, a generalized pattern set G,"):
print("and a set of gap vectors gaps"):
print("and returns all extentions of pre to a permutation that contains a generalized pattern of"):
print("G, partly in pre, partly using the newly appended letters"):
print("but only includes extensions that obey the set of gap vectors gaps"):

elif args[1]=isRevDel then
print("isRevDel(pre,pat,r,gd): inputs a prefix pre, a generalized permutation pattern pat,"):
print("and a position r (1<=r<=nops(pre)), and an integer gd"):
print("then returns true if r is reversibly deletable and false if r is not reversibly deletable"):
print("to do this, computes all scenarios involving position r in a copy of forbidden pattern p,"):
print("and then deletes position r, checking if all these shorter scenarios still contain a "):
print("forbidden pattern."):
print("the integer gd is the maximum weight of a gap vector to consider in eliminating extra "):
print("scenarios.  gd is input by the user in the main scheme procedure"):

elif args[1]=isRevDelS then
print("isRevDelS(pre,P,r,gd): inputs a prefix pre, a generalized permutation pattern set P,"):
print("and a position r (1<=r<=nops(pre)), and an integer gd"):
print("then returns true if r is reversibly deletable and false if r is not reversibly deletable"):
print("to do this, computes all scenarios involving position r in a copy of forbidden pattern p in P,"):
print("and then deletes position r, checking if all these shorter scenarios still contain a "):
print("forbidden pattern"):
print("the integer gd is the maximum weight of a gap vector to consider in eliminating extra "):
print("scenarios.  gd is input by the user in the main scheme procedure"):

elif args[1]=isRevDelSet then
print("isRevDelSet(pre,pat,rset,gd): checks if the set of indices rset is reversibly deletable from"):
print("prefix pre, with forbidden pattern pat, and gap depth gd"):

elif args[1]=isRevDelSetS then
print("isRevDelSetS(pre,P,rset,gd): checks if the set of indices rset is reversibly deletable from"):
print("prefix pre, with forbidden pattern set P, and gap depth gd"):

elif args[1]=collapseGV then
print("collapseGV(g,rset,pre): inputs a gap vector g, a set of candidate reversibly deletable"):
print("elements rset, and a prefix pre and returns the gap vectors for pre once "):
print("the positions in rset are deleted"):

elif args[1]=collapseGVS then
print("collapseGVS(G,rset,pre): same as collapseGV, only inputs a set of gap vectors G"):
print("instead of just a single gap vector g"):

elif args[1]=posset then
print("posset(L,S): inputs a list L and a set S and returns the set of positions"):
print("of L where the actual letters in set S occur"):

elif args[1]=rdSet then
print("rdSet(pre,pat,gd): inputs a prefix pre, a forbidden pattern pat, and a maximum"):
print("gap vector weight gd and returns the set of reversibly deletable positions of"):
print("pre with respect to pat and gap vectors of maximum weight gd"):

elif args[1]=rdSetS then
print("rdSetS(pre,P,gd): inputs a prefix pre, a forbidden pattern set P, and a maximum"):
print("gap vector weight gd and returns the set of reversibly deletable positions of"):
print("pre with respect to P and gap vectors of maximum weight gd"):

elif args[1]=isGapVector then
print("isGapVector(pre,pat,gv): inputs a prefix pre of length l, a generalized pattern pat,"):
print("and a potential gap vector gv of length l+1, and returns true if gv is a "):
print("gap vector for pre with respect to pat, or false otherwise"):

elif args[1]=isGapVectorS then
print("isGapVectorS(pre,P,gv): inputs a prefix pre of length l, a generalized pattern set P,"):
print("and a potential gap vector gv of length l+1, and returns true if gv is a "):
print("gap vector for pre with respect to P, or false otherwise"):

elif args[1]=pcontainsqparts then
print("pcontainsqparts(p,q): inputs a pair of lists p and a generalized pattern q"):
print("and returns true if p(considered as p[1] with p[2] appended) contains the pattern"):
print("q such that any part of a q pattern with forced adjacent letters appears in the p[1]"):
print("section of p"):

elif args[1]=pcontainsqpartsS then
print("pcontainsqpartsS(p,Q): inputs a pair of lists p and a generalized pattern set Q"):
print("and returns true if p(considered as p[1] with p[2] appended) contains a pattern"):
print("in Q such that any part of a pattern with forced adjacent letters appears in the p[1]"):
print("section of p"):

elif args[1]=restrictedsubstringsparts then
print("restrictedsubstringsparts(L,r,k,n): inputs a list L, and and list of "):
print("0s and 1s r, and returns all substrings s of L of length nops(r)+1"):
print("where s[i] s[i+1] must have been adjacent in L if r[i]=0"):
print("also only returns substrings so that the first/last k entries come from "):
print("L[1]..L[n]"):

elif args[1]=Comps then
print("Comps(a,n): the set non-negative integer vectors of length n and sum a"):

elif args[1]=ImpliedGVs then
print("ImpliedGVs(gv,n): inputs a gap vector gv and an integer n"):
print("and outputs the gap vectors of sum n that are implied"):
print("to be gap vectors by gv"):

elif args[1]=NewGVs then
print("NewGVs(pat,pre,s,G): given a pattern pat, a prefix pre,"):
print("a positive integer s, and a set of previously discovered gap"):
print("vectors G, finds all new gap vectors of size s"):

elif args[1]=NewGVsS then
print("NewGVsS(P,pre,s,G): given a pattern set P, a prefix pre,"):
print("a positive integer s, and a set of previously discovered gap"):
print("vectors G, finds all new gap vectors of size s"):

elif args[1]=GVs then
print("GVs(pat,pre,s): given a pattern pat, and a prefix pre, returns the set of"):
print("gap vectors of size <=s"):

elif args[1]=GVsS then
print("GVsS(P,pre,s): given a pattern set P, and a prefix pre, returns the set of"):
print("gap vectors of size <=s"):

elif args[1]=g1GTg2 then
print("g1GTg2(g1,g2): returns true if vector g1 is componentwise greater than g2"):
print("returns false if g1 is not componentwise greater than g2"):
print("returns FAIL if g1 and g2 are of different lengths"):

elif args[1]=obeysG then
print("obeysG(v,gaps): inputs a vector v and a set of gap vectors gaps"):
print("returns true if v<g for all g in gaps, "):
print("returns false if v>=g for some gap vector g"):

elif args[1]=GandBChildren then
print("GandBChildren(pre,pat,gd): inputs a prefix pre, a forbidden pattern pat, and a positive"):
print("integer gd"):
print("returns two sets of triples [C,R,G] where C is a child of pre, R is reversible deletable"):
print("elements of C, and G is a set of gap vectors for C with respect to pat"):
print("the first set is triples where R<>{} and the second set is triples where R={}"):

elif args[1]=GandBChildrenS then 
print("GandBChildrenS(pre,P,gd): inputs a prefix pre, a forbidden pattern set P, and a positive"):
print("integer gd"):
print("returns two sets of triples [C,R,G] where C is a child of pre, R is reversible deletable"):
print("elements of C, and G is a set of gap vectors for C with respect to P"):
print("the first set is triples where R<>{} and the second set is triples where R={}"):

#elif args[1]=BuildScheme then
#print("BuildScheme(pat,gd,sd): inputs a generalized permutation pattern pat, and positive"):
#print("integers gd and sd. If there exists an enumeration scheme of depth <=sd with"):
#print("gap vectors of weight <=gd, then the scheme is returned as a set of tuples of the"):
#print("form [prefix,reversibly deletable elements, gap vectors]"):
#print("otherwise returns FAIL, along with a partial scheme of depth sd"):
#print("For example, try BuildScheme([[1,3,2,4],[1,0,1]],1,3);"):

elif args[1]=BuildSchemeS then
print("BuildSchemeS(P,gd,sd): inputs a generalized permutation pattern set P, and positive"):
print("integers gd and sd. If there exists an enumeration scheme of depth <=sd with"):
print("gap vectors of weight <=gd, then the scheme is returned as a set of tuples of the"):
print("form [prefix,reversibly deletable elements, gap vectors]"):
print("otherwise returns FAIL, along with a partial scheme of depth sd"):

elif args[1]=InsertEntries then
print("InsertEntries(pi,S): inputs a permutation pi and a set S of pairs"):
print("for each pair in S, s[1] tells a letter to insert into pi, and"): 
print("s[2] tells what position to insert s[1] into"):

elif args[1]=InsertionValues then
print("InsertionValues(s,pre,rset): inputs a permutation s, a desired prefix pre, and set of integers rset"):
print("such that 1<=r<=nops(pre) for all r in rset, and returns the set lists of values j that could be"):
print("inserted into s in the positions rset to produce prefix pre"):

elif args[1]=letterCands then
print("letterCands(n,k): inputs integers n and k such that n>=k"):
print("outputs all k tuples of distinct integers chosen from [n]"):

elif args[1]=DeleteEntries then
print("DeleteEntries(pi,S): deletes all the entries of"):
print("pi[i] for i in S and reduces"):

elif args[1]=DeleteEntriesG then
print("DeleteEntriesG(g,S): shrinks the vector g by removing the"):
print("barriers in the places indicated by S"):
print("For example, try: DeleteEntries([2,3,2],{2});"):

elif args[1]=Miklos then
print("Miklos(S,pi,v): Given a scheme S, and a prefix permutation"):
print("pi (that is part of the scheme) and a vector v of non-negative"):
print("integers v (of size nops(pi)+1) outputs the number"):
print("of permutations whose prefix reduces to pi and has"):
print("the gap-vector v."):

elif args[1]=SSeq then
print("SSeq(S,N): returns the number of permutations of length n avoiding the pattern"): 
print("that scheme S encodes for n from 1 to N."):

elif args[1]=SSeqBF then
print("SSeqBF(pat,N): returns the number of permutations of length n avoiding the pattern"):
print("pat, for n from 1 to N, by brute force computation"):

elif args[1]=SSeqBFS then
print("SSeqBFS(P,N): returns the number of permutations of length n avoiding the pattern"):
print("set P, for n from 1 to N, by brute force computation"):

#elif args[1]=classify then
#print("classify(n,gd,sd,se): inputs an integers n, gd, sd, and se, and reports all schemes and sequences that can"):
#print("be determined for a pattern of length n with maximum scheme depth sd and maximum"):
#print("gap vector weight gd.  gives the first se terms of the counting sequence for"):
#print("every class that has a scheme"):

elif args[1]=classifyS then
print("classifyS(N,gd,sd,se): inputs an integers n, gd, sd, and se, and reports all schemes and sequences that can"):
print("be determined for a pattern of length n with maximum scheme depth sd and maximum"):
print("gap vector weight gd.  gives the first se terms of the counting sequence for"):
print("every class that has a scheme"):

elif args[1]=inversions then
print("inversions(pi) counts the number of inversions of pi"):
print("This is usually denoted inv(pi), but that procedure name is already used in gVATTER for the inverse of pi"):

elif args[1]=Snq then
print("Snq(gp,n,q): inputs a generalized pattern (see pcontainsq for notation) and an integer n"):
print("and outputs sum(q^inversions(pi)) where the sum runs over the set"):
print("of permutations avoiding gp of length 0, 1, 2,... n"):

elif args[1]=qinveff then
print("qinveff(p, v, T) counts the number of inversions lost"):
print("when (simultaneously) removing p[t] for each t in T"): 
print("from a permutation with prefix p and spacing vector v."):

elif args[1]=qMiklos then
print("qMiklos(S,pi,v,q): Given a scheme S, and a prefix permutation"):
print("pi (that is part of the scheme) and a vector v of non-negative"):
print("integers v (of size nops(pi)+1) outputs the polynomial in q"):
print("enumerating (according to inv) the number of permutations whose "):
print("prefix reduces to pi and has the gap-vector v. For example try:"):
print("qMiklos(BuildSchemeS([[1,3,2,4],[1,0,1]],1,3),[],[5],q);"):

elif args[1]=qSeqS then
print("qSeqS(S,K,q): the first K terms (starting at 0)"):
print("computed by the enumeration scheme S, "):
print("for example try: qSeqS(BuildSchemeS([[1,3,2,4],[1,0,1]],1,3),20,q);"):

elif args[1]=Wilf then
print("Wilf(S,n): inputs a set of patterns S and a positive integer n"):
print("and returns the set of permutations of length n"):
print("avoiding all patterns in S"):
print("For example, Wilf({[[1,3,2,4],[1,0,1]]},5);"):

elif args[1]=qWilf then
print("qWilf(S,n,q): inputs a set of patterns S, a positive integer n, and"):
print("variable q, and q-counts the number of permutations avoiding S"):
print("of length n, according to number of inversions."):
print("For example, try qWilf({[[1,3,2,4],[1,0,1]]},5,q);"):

else
print("Sorry, there is no function called ", args[1],"."):
print("Type Help(); to see a list of available functions."):

fi:

end:


#red(L):inserts a list L and outputs its reduction
red:=proc(L) local L2,i,L3:
L2:=[]:

for i from 1 to nops(L) do:
if L[i]<>null then
L2:=[op(L2),L[i]]:
fi:
od:

L2:=red2(L2):
L3:=[]:
for i from 1 to nops(L) do
if L[i]=null then
L3:=[op(L3),null]:
else L3:=[op(L3),L2[1]]:
L2:=[op(2..nops(L2),L2)]:
fi:
od:
L3:
end:

red2:=proc(L) local L2,i:
L2:=sort([op({op(L)})]):
subs({seq(L2[i]=i,i=1..nops(L2))},L):
end:

#allsubstrings(L,m): inputs a list L and an integer m
#and returns all substrings of L of length m
allsubstrings:=proc(L,m) local pos,S,p:
pos:=choose([$1..nops(L)],m):
S:={}:
for p in pos do
S:=S union {[seq(L[p[i]],i=1..nops(p))]}:
od:
S:
end:


#restrictedsubstrings(L,r): inputs a list L, and and list of 
#0s and 1s r, and returns all substrings s of L of length nops(r)+1
#where s[i] s[i+1] must have been adjacent in L if r[i]=0
restrictedsubstrings:=proc(L,r) local pos,S,p,pos2,i,S2,s:
pos:=choose([$1..nops(L)],nops(r)+1):
S:={}:
pos2:={op(pos)}:
for p in pos do
for i from 1 to nops(r) do
if r[i]=0 and p[i+1]<>p[i]+1 then pos2:=pos2 minus {p}: fi:
od:
od:

for p in pos2 do
S:=S union {[seq(L[p[i]],i=1..nops(p))]}:
od:
S2:=S:
for s in S do
if member(null,{op(s)}) then S2:=S2 minus {s}: fi:
od:
S2:
end:

#restrictedsubstringsend(L,r): same as restrictedsubstrings(L,r)
#but only returns substrings that include the last letter of L
restrictedsubstringsend:=proc(L,r) local pos,S,p,pos2,i,S2,s:
pos:=choose([$1..nops(L)-1],nops(r)):
S:={}:
pos2:={op(pos)}:
pos2:={seq([op(p),nops(L)],p in pos2)}:
pos:=pos2:

for p in pos do
for i from 1 to nops(r) do
if r[i]=0 and p[i+1]<>p[i]+1 then pos2:=pos2 minus {p}: fi:
od:
od:

for p in pos2 do
S:=S union {[seq(L[p[i]],i=1..nops(p))]}:
od:
S2:=S:
for s in S do
if member(null,{op(s)}) then S2:=S2 minus {s}: fi:
od:
S2:
end:

#pcontainsq(p,q): inputs a permutation p and a pattern q and outputs 
#true if p contains q, false if p does not contain q
#q is a generalized permutation pattern so it consists of a 
#pair of lists [q1,q2] where q1 is a permutation, and q2 is 
#a list of 0s and 1s of length nops(q1)-1, where q2[i]=0 means q1[i] and q1[i+1]
#must be adjacent letters  in a copy of q1 and a 1 means that they are
#not-necessarily-adjacent letters.  that is a 1 is equivalent to having a dash
#in the generalized pattern notation
pcontainsq:=proc(p,q) local pat,r,str,s:
pat:=q[1]:
r:=q[2]:
str:=restrictedsubstrings(p,r):
for s in str do
if evalb(red(s)=pat) then return true: fi:
od:
return false:
end:

#pcontainsqS(p,Q): inputs a permutation p and a set of patterns Q and outputs 
#true if p contains some member of Q, false if p avoids all members of Q
#each member of Q is a generalized permutation pattern so it consists of a 
#pair of lists [q1,q2] where q1 is a permutation, and q2 is 
#a list of 0s and 1s of length nops(q1)-1, where q2[i]=0 means q1[i] and q1[i+1]
#must be adjacent letters  in a copy of q1 and a 1 means that they are
#not-necessarily-adjacent letters.  that is a 1 is equivalent to having a dash
#in the generalized pattern notation
pcontainsqS:=proc(p,Q) local pat,r,str,s,q:
for q in Q do
pat:=q[1]:
r:=q[2]:
str:=restrictedsubstrings(p,r):
for s in str do
if evalb(red(s)=pat) then return true: fi:
od:
od:
return false:
end:

#pcontainsqset(p,q): same as pcontainsq(p,q), but returns the set of subtrings
#of p that are q patterns
pcontainsqset:=proc(p,q) local pat,r,str,s,S:
pat:=q[1]:
r:=q[2]:
S:={}:
str:=restrictedsubstrings(p,r):
for s in str do
if evalb(red(s)=pat) then S:=S union {s}: fi:
od:
return S:
end:

#pcontainsqsetS(p,Q): same as pcontainsqS(p,Q), but returns the set of subtrings
#of p that are q patterns
pcontainsqsetS:=proc(p,Q) local pat,r,str,s,S,q:
S:={}:
for q in Q do
pat:=q[1]:
r:=q[2]:
str:=restrictedsubstrings(p,r):
for s in str do
if evalb(red(s)=pat) then S:=S union {s}: fi:
od:
od:
return S:
end:

#pcontainsqend(p,q): same as pcontainsq(p,q) except returns true only if p
#contains a copy of q that uses the last letter of p
pcontainsqend:=proc(p,q) local pat,r,str,s:
pat:=q[1]:
r:=q[2]:
str:=restrictedsubstringsend(p,r):
for s in str do
if evalb(red(s)=pat) then return true: fi:
od:
return false:
end:

#pcontainsqendS(p,Q): same as pcontainsqS(p,Q) except returns true only if p
#contains a copy of q that uses the last letter of p
pcontainsqendS:=proc(p,Q) local pat,r,str,s,q:
for q in Q do
pat:=q[1]:
r:=q[2]:
str:=restrictedsubstringsend(p,r):
for s in str do
if evalb(red(s)=pat) then return true: fi:
od:
od:
return false:
end:

#pcontainsqendset(p,q): same as pcontainsqend(p,q), but returns the set of subtrings
#of p that are q patterns
pcontainsqendset:=proc(p,q) local pat,r,str,s,S:
pat:=q[1]:
r:=q[2]:
S:={}:
str:=restrictedsubstringsend(p,r):
for s in str do
if evalb(red(s)=pat) then S:=S union {s}: fi:
od:
return S:
end:

#pcontainsqendsetS(p,Q): same as pcontainsqendS(p,Q), but returns the set of subtrings
#of p that are q patterns
pcontainsqendsetS:=proc(p,Q) local pat,r,str,s,S,q:
S:={}:
for q in Q do
pat:=q[1]:
r:=q[2]:
str:=restrictedsubstringsend(p,r):
for s in str do
if evalb(red(s)=pat) then S:=S union {s}: fi:
od:
od:
return S:
end:

#Sn(gp,n): inputs a generalized pattern (see pcontainsq for notation) and an integer n
#and outputs the number of permutations avoiding gp of length 0, 1, 2,... n
Sn:=proc(gp,n) local L,i,perms,p,perms2:
L:=[]:
for i from 0 to n do
perms:={op(permute(i))}:
perms2:=perms:
for p in perms do
if pcontainsq(p,gp)
then perms2:=perms2 minus {p}: fi:
od:
L:=[op(L),nops(perms2)]:
od:
L:
end:

#SnS(G,n): inputs a set G of generalized patterns (see pcontainsq for notation) and an integer n
#and outputs the number of permutations avoiding all members of G of length 0, 1, 2,... n
SnS:=proc(G,n) local L,i,perms,p,perms2:
L:=[]:
for i from 0 to n do
perms:={op(permute(i))}:
perms2:=perms:
for p in perms do
if pcontainsqS(p,G)
then perms2:=perms2 minus {p}: fi:
od:
L:=[op(L),nops(perms2)]:
od:
L:
end:

#all01s(n): produces the set of all strings of 0s and 1s of length n
all01s:=proc(n) local S, s, S2: option remember:
if n=0 then return {[]}: fi:
S:=all01s(n-1):
S2:={}:
for s in S do
S2:=S2 union {[op(s),0],[op(s),1]}:
od:
S2:
end:

#allpatterns(n): produces the set of all generalized permutation patterns
#of length n
allpatterns:=proc(n) local P,R,S,p,r:
P:=permute(n):
R:=all01s(n-1):
S:={}:
for p in P do
for r in R do
S:=S union {[p,r]}:
od:
od:
end:

#allpatternsS(N): produces the set of all sets of generalized permutation patterns
#with lengths in list N
allpatternsS:=proc(N) local P,p,i,NP,P2,np:
P:=allpatterns(N[1]):
P:={seq({p},p in P)}:

for i from 2 to nops(N) do
NP:=allpatterns(N[i]):
P2:={}:

for np in NP do
for p in P do
if not member(np,p) then
P2:=P2 union {p union {np}}:
fi:
od:
od:

P:=P2:
od:
P:
end:


#allseqs(n): prints the set of all counting sequences formed by avoiding a
#generalized permutation pattern of length n, organized by sets of patterns
#that produce the same sequence
allseqs:=proc(n) local P,p,L,Seqs,S:
P:=allpatterns(n):
Seqs:={}:
for p in P do
S:=Sn(p,7):
if member(S,Seqs) then 
L[S]:=L[S] union {p}:
else
Seqs:=Seqs union {S}:
L[S]:={p}:
fi:
od:
print("There are at least ", nops(Seqs), " Wilf classes."):
for S in Seqs do
print("The patterns:"):
print(L[S]):
print("have the sequence ", S):
od:
end:

#allseqsS(N): prints the set of all counting sequences formed by avoiding a
#set of generalized permutation pattern of lengths in list N, organized by sets of patterns
#that produce the same sequence
allseqsS:=proc(N) local NP,P,p,L,Seqs,S,np,P2,i:
P:=allpatterns(N[1]):
P:={seq({p},p in P)}:

for i from 2 to nops(N) do
NP:=allpatterns(N[i]):
P2:={}:

for np in NP do
for p in P do
if not member(np,p) then
P2:=P2 union {p union {np}}:
fi:
od:
od:

P:=P2:
od:

#P is now the set of all patterns sets with lengths in list N

Seqs:={}:
for p in P do
S:=SnS(p,7):
if member(S,Seqs) then 
L[S]:=L[S] union {p}:
else
Seqs:=Seqs union {S}:
L[S]:={p}:
fi:
od:
print("There are at least ", nops(Seqs), " Wilf classes."):
for S in Seqs do
print("The patterns:"):
print(L[S]):
print("have the sequence ", S):
od:
end:

#rev(L): the reverse of list L
rev:=proc(L)
[seq(L[nops(L)+1-i],i=1..nops(L))]:
end:

#revS(SL): the reverse of each list in the set SL
revS:=proc(SL) local S, L:
S:={}:
for L in SL do
S:=S union {[seq(L[nops(L)+1-i],i=1..nops(L))]}:
od:
S:
end:

#comp(L): the complement of list L
comp:=proc(L)
[seq(nops(L)+1-L[i],i=1..nops(L))]:
end:

#compS(SL): the complement of each list in the set SL
compS:=proc(SL) local S, L:
S:={}:
for L in SL do
S:=S union {[seq(nops(L)+1-L[i],i=1..nops(L))]}:
od:
S:
end:

#inv(L): the inverse of list L
inv:=proc(L) local L2,i:
for i from 1 to nops(L) do
L2[L[i]]:=i:
od:
[seq(L2[i],i=1..nops(L))]:
end:

#invS(SL): the inverse of each list in the set SL
invS:=proc(SL) local L,S:
S:={}:
for L in SL do
S:=S union {inv(L)}:
od:
S:
end:

#genrev(gp): the reverse of generalized pattern gp
genrev:=proc(gp)
[rev(gp[1]),rev(gp[2])]:
end:

#genrevS(G): the reverse of each generalized pattern in set G
genrevS:=proc(G) local gp,S:
S:={}:
for gp in G do
S:=S union {[rev(gp[1]),rev(gp[2])]}:
od:
S:
end:

#gencomp(gp): the complement of generalized pattern gp
gencomp:=proc(gp)
[comp(gp[1]),gp[2]]:
end:

#gencompS(G): the complement of each generalized pattern in set G
gencompS:=proc(G) local S, gp:
 map(gp->gencomp(gp), G):
end:

#geninv(gp): the inverse of generalized pattern gp
#this should really only be called for patterns where no adjacencies are required
geninv:=proc(gp)
[inv(gp[1]),gp[2]]:
end:

#geninvS(G): the inverse of each generalized pattern in set G
#this should really only be called for patterns where no adjacencies are required
geninvS:=proc(G) local S, gp:
S:={}:
for gp in G do
S:=S union {[inv(gp[1]),gp[2]]}:
od:
S:
end:

#symm(gp): the trivial Wilf symmetries of generalized pattern gp
symm:=proc(gp)
if member(0,{op(gp[2])}) then return {gp, genrev(gencomp(gp)), gencomp(gp), genrev(gp)}:
else return
{gp,genrev(geninv(gp)),gencomp(genrev(gp)),geninv(genrev(gp)),genrev(gp),geninv(gencomp(genrev(gp))),gencomp(gp),geninv(gp)}:
fi:
end:

#symmS(G): the trivial Wilf symmetries of generalized pattern set G
symmS:=proc(G) local gp:
if member(0,{seq(op(gp[2]),gp in G)}) then return {G, genrevS(gencompS(G)), gencompS(G), genrevS(G)}:
else return
{G,genrevS(geninvS(G)),gencompS(genrevS(G)),geninvS(genrevS(G)),genrevS(G),geninvS(gencompS(genrevS(G))),gencompS(G),geninvS(G)}:
fi:
end:

#symmclasses(n): inputs an integer n and puts all generalized patterns of length n
#into equivalence classes according to the symmetries of the square
symmclasses:=proc(n) local S,C:
S:=allpatterns(n):
C:={}:
while S<>{} do
C:=C union {symm(S[1])}:
S:=S minus symm(S[1]):
od:
C:
end:

#symmclassesS(N): inputs a list of integers N and puts all generalized patterns of lengths from N
#into equivalence classes according to the symmetries of the square
symmclassesS:=proc(N) local S,C,p,NP,P2,np,i,s,S2:
  S:=allpatterns(N[1]):
  S:={seq({p},p in S)}:

  for i from 2 to nops(N) do
    NP:=allpatterns(N[i]):
    P2:={}:

    for np in NP do
       for p in S do
         if not member(np,p) then
            P2:=P2 union {p union {np}}:
         fi:
       od:
    od:

    S:=P2:
  od:

#S is now the set of all patterns sets with lengths in list N

  S2:=S:
  for s in S2 do
    if redundantPats(s) then
     S:=S minus {s}:
    fi:
  od:


  C:={}:
  while S<>{} do
     C:=C union {symmS(S[1])}:
     S:=S minus symmS(S[1]):
  od:
 C:
end:


#Removes from S every pattern-set in S whose complement also appears in S.
CutCompls:=proc(S)
 local S1, p:

 S1:={}:
 for p in S do
  if not member(gencompS(p), S1) then S1:=S1 union {p}: fi:
 od:

 return S1:
end:


dashp:=proc(gp) local L,gp1,gp2,i:
gp1:=gp[1]:
gp2:=gp[2]:
L:=[]:
for i from 1 to nops(gp2) do
if gp2[i]=1 then
L:=[op(L),gp1[i],null]:
else 
L:=[op(L),gp1[i]]:
fi:
od:
L:=[op(L),gp1[nops(gp1)]]:
end:

redundantPats:=proc(S) local s, s2:
for s in S do
s2:=dashp(s):
if pcontainsqS(s2,S minus {s}) then return true: fi:
od:
false:
end:

#children(pre): the children of prefix pre
#i.e. the set of permutations of length nops(pre)+1
#whose first nops(pre) elements reduce to pre
children:=proc(pre) local n:
n:=nops(pre):
{seq(red([op(pre),i+1/2]),i=0..n)}:
end:

#splitgp(gp): inputs a generalized pattern gp and outputs all possible prefixes of gp
splitgp:=proc(gp)
{seq([[op(1..i,gp[1])],[op(i+1..nops(gp[1]),gp[1])],[op(1..i-1,gp[2])],[op(i..nops(gp[2]),gp[2])]],i=1..nops(gp[1])-1)}:
end:

#fracletter(pre,pat,inst): inputs a prefix pre
#a pattern pat, and an instant inst of all but the last letter of
#pat in pre.
#then returns all possible ways to append a letter to pre and complete the
#instance of pat
#for example, try fracletter([2,3,1,4],[1,3,2],[1,4]);
fracletter:=proc(pre,pat,inst) local S,S2,s:
S:=[0,op(sort(pre)),max(op(pre))+1]:
S:=[seq((S[i]+S[i+1])/2,i=1..nops(S)-1)]:
S2:={}:
for s in S do
if red([op(inst),s])=pat then
S2:=S2 union {[op(inst),s]}:
fi:
od:
S2:
end:

#allfracletters(pre,pat,inst): inputs a prefix pre, a pattern pat,
#and an instance of the beginning of the pattern in pre
#outputs the set of all permutations beginning with pre that extend the
#given partial instance of pat into a complete instance of pat
#for example, try allfracletters([2,3,1,4],[1,3,2],[3]);
allfracletters:=proc(pre,pat,inst) local S,s,S2,pat2,i,pre2:
S:={inst}:

for i from nops(inst)+1 to nops(pat) do
pat2:=red([op(1..i,pat)]):
S2:={}:
for s in S do
pre2:=[op(pre), op(nops(inst)+1..nops(s),s)]:
S2:=S2 union fracletter(pre2,pat2,s):
S:=S2:
od:
od:
S2:={}:
for s in S do:
S2:=S2 union {[pre,[op(nops(inst)+1..nops(s),s)],inst]}:
od:
S2:
end:

#scenarios(pre,gp): inputs a prefix pre and a generalized pattern gp
#and returns all extentions of pre to a permutation that contains generalized pattern
#gp, partly in pre, partly using the newly appended letters
#a scenario is a pair of lists -- the first list is the extension, and the 
#second list is the explicit set of letters of the prefix that are
#involved in the forbidden pattern
scenarios:=proc(pre,gp) local S,s,T,S2,t,C,i,c,c2,j:
S:=splitgp(gp):
if pre=[] then return {}: fi:
#print(S):
#S is the set of all ways the pattern gp might be split between prefix and tail
S2:={}:

for s in S do

if pcontainsq(pre,[red(s[1]),s[3]]) then

if s[4][1]=1 then
T:=pcontainsqset(pre,[red(s[1]),s[3]]):
elif s[4][1]=0 then
T:=pcontainsqendset(pre,[red(s[1]),s[3]]):
fi:

for t in T do
C:=allfracletters(pre,gp[1],t):

for c in C do
c2:=[]:
#print(s[4],c[2]):
for i from 1 to nops(s[4]) do
if s[4][i]=1 then c2:=[op(c2),null,c[2][i]]:
else
c2:=[op(c2),c[2][i]]:
fi:
od:

S2:=S2 union {[[op(c[1]),op(c2)],c[3]]}:
od:
od:
fi:
od:

S2:
end:

#scenariosS(pre,G): inputs a prefix pre and a generalized pattern set G
#and returns all extentions of pre to a permutation that contains generalized pattern
#gp in G, partly in pre, partly using the newly appended letters
#a scenario is a pair of lists -- the first list is the extension, and the 
#second list is the explicit set of letters of the prefix that are
#involved in the forbidden pattern
scenariosS:=proc(pre,G) local S, gp,S2,s:
S:={}:
for gp in G do
S2:=scenarios(pre,gp):
#for s in S2 do
#S:=S union {[op(s),gp]}:
#od:
S:=S union S2:
od:
S:
end:

collapsescen:=proc(S) local S1,So,i:
So:=S[1]:
S1:=[]:
for i from 1 to nops(So) do
if So[i]<>null then
S1:=[op(S1),So[i]]:
fi:
od:

[S1,S[2]]:
end:

#getVector(scen,pre): inputs a scenario and a prefix, and returns
#the corresponding gap vector for the scenario with respect for the prefix
#for example, try getVector([[2,3,1,4,5/2,7/2],[2,3,1,4]],[2,3,1,4]); vs. getVector([[2,3,1,4,3/2,7/2],[2,3,1,4]],[2,3,1,4]);.
getVector:=proc(scen,pre) local v, i,ps,j,scen2:

scen2:=collapsescen(scen):

if nops(pre)>nops(scen2[1]) then return FAIL:
fi:
v:=[0$nops(pre)+1]:
ps:=sort(pre):

for i from nops(pre)+1 to nops(scen2[1]) do
if scen2[1][i]<ps[1] then v[1]:=v[1]+1:
elif scen2[1][i]>ps[nops(ps)] then v[nops(pre)+1]:=v[nops(pre)+1]+1:
else
for j from 1 to nops(ps)-1 do
if scen2[1][i]>ps[j] and scen2[1][i]<ps[j+1] then
v[j+1]:=v[j+1]+1:
fi:
od:
fi:
od:
return v:
end:

#scenariosWgaps(pre,gp,gaps): inputs a prefix pre, a generalized pattern gp,
#and a set of gap vectors gaps
#and returns all extentions of pre to a permutation that contains generalized pattern
#gp, partly in pre, partly using the newly appended letters
#but only includes extensions that obey the set of gap vectors gaps
scenariosWgaps:=proc(pre,gp,gaps) local S,s,v,S2:
S:=scenarios(pre,gp):
#print(S):
S2:={}:
for s in S do
v:=getVector(s,pre):

if obeysG(v,gaps) then S2:=S2 union {s}: fi:
od:
S2:
end:

#scenariosWgapsS(pre,G,gaps): inputs a prefix pre, a generalized pattern set G,
#and a set of gap vectors gaps
#and returns all extentions of pre to a permutation that contains a generalized pattern of
#G, partly in pre, partly using the newly appended letters
#but only includes extensions that obey the set of gap vectors gaps
scenariosWgapsS:=proc(pre,G,gaps) local S,s,v,S2:
S:=scenariosS(pre,G):
#print(S):
S2:={}:
for s in S do
v:=getVector(s,pre):

if obeysG(v,gaps) then S2:=S2 union {s}: fi:
od:
S2:
end:

#isRevDel(pre,pat,r,gd): inputs a prefix pre, a generalized permutation pattern pat,
#and a position r (1<=r<=nops(pre)), and an integer gd
#then returns true if r is reversibly deletable and false if r is not reversibly deletable
#to do this, computes all scenarios involving position r in a copy of forbidden pattern p,
#and then deletes position r, checking if all these shorter scenarios still contain a 
#forbidden pattern
#the integer gd is the maximum weight of a gap vector to consider in eliminating extra 
#scenarios.  gd is input by the user in the main scheme procedure
isRevDel:=proc(pre,pat,r,gd) local G,S,s,S2,S3,i,IS,I2:

#first half checks that deleting position r from a pat-containing perm always produces
#a pat-containing perm

G:=GVs(pat,pre,gd):
S:=scenariosWgaps(pre,pat,G):
S2:={}:
for s in S do
if member(pre[r],{op(s[2])}) then S2:=S2 union {s}:
fi:
od:
#S2 is the set of scenarios involving pre[r]
#print(S2):
S3:={}:

for s in S2 do
S3:=S3 union {[op(1..r-1,s[1]),op(r+1..nops(s[1]),s[1])]}:
od:
#S3 is the set of scenarios from S2 with pre[r] deleted
#print(S3):

for s in S3 do
if not pcontainsq(s,pat) then return false:
fi:
od:

#second half checks that re-inserting r into a pat-containing perm always produces
#a pat-containing perm

G:=collapseGVS(GVs(pat,pre,gd),rset,pre):
S:=scenariosWgaps(DeleteEntries(pre,{r}),pat,G):
S2:={seq(s[1],s in S)}:
#S2 is the set of scenarios with no r involved
#print(S2):
S3:={}:

for s in S2 do
#print(InsertionValues(s,pre,r)):
S3:=S3 union {seq(InsertEntries(s,{[j,r]}),j in InsertionValues(s,pre,r))}:
od:
#S3 is the set of scenarios from S2 with pre[r] re-inserted
#print(S3):

for s in S3 do
if not pcontainsq(s,pat) then return false:
fi:
od:

true:

end:

#isRevDelS(pre,P,r,gd): inputs a prefix pre, a generalized permutation pattern set P,
#and a position r (1<=r<=nops(pre)), and an integer gd
#then returns true if r is reversibly deletable and false if r is not reversibly deletable
#to do this, computes all scenarios involving position r in a copy of forbidden pattern p in P,
#and then deletes position r, checking if all these shorter scenarios still contain a 
#forbidden pattern
#the integer gd is the maximum weight of a gap vector to consider in eliminating extra 
#scenarios.  gd is input by the user in the main scheme procedure
isRevDelS:=proc(pre,P,r,gd) local G,S,s,S2,S3,i,IS,I2:

#first half checks that deleting position r from a pat-containing perm always produces
#a pat-containing perm

G:=GVsS(P,pre,gd):
S:=scenariosWgapsS(pre,P,G):
S2:={}:
for s in S do
if member(pre[r],{op(s[2])}) then S2:=S2 union {s}:
fi:
od:
#S2 is the set of scenarios involving pre[r]
#print(S2):
S3:={}:

for s in S2 do
S3:=S3 union {[op(1..r-1,s[1]),op(r+1..nops(s[1]),s[1])]}:
od:
#S3 is the set of scenarios from S2 with pre[r] deleted
#print(S3):

for s in S3 do
if not pcontainsqS(s,P) then return false:
fi:
od:

#second half checks that re-inserting r into a pat-containing perm always produces
#a pat-containing perm

G:=collapseGVS(GVsS(P,pre,gd),rset,pre):
S:=scenariosWgapsS(DeleteEntries(pre,{r}),P,G):
S2:={seq(s[1],s in S)}:
#S2 is the set of scenarios with no r involved
#print(S2):
S3:={}:

for s in S2 do
#print(InsertionValues(s,pre,r)):
S3:=S3 union {seq(InsertEntries(s,{[j,r]}),j in InsertionValues(s,pre,r))}:
od:
#S3 is the set of scenarios from S2 with pre[r] re-inserted
#print(S3):

for s in S3 do
if not pcontainsqS(s,P) then return false:
fi:
od:

true:

end:

#isRevDelSet(pre,pat,rset,gd): checks if the set of indices rset is reversibly deletable from
#prefix pre, with forbidden pattern pat, and gap depth gd
isRevDelSet:=proc(pre,pat,rset,gd) local G,S,s,S2,S3,i,IS,I2,rs,j:
#first half checks that deleting position r from a pat-containing perm always produces
#a pat-containing perm
G:=GVs(pat,pre,gd):
S:=scenariosWgaps(pre,pat,G):
#print("S",S):
S2:={}:
for s in S do
if nops({seq(pre[rs],rs in rset)} intersect {op(s[2])})>0 then S2:=S2 union {s}:
fi:
od:
#S2 is the set of scenarios involving pre[rset]
#print("S2",S2):
S3:={}:

for s in S2 do
S3:=S3 union {DeleteEntries(s[1],rset)}:
od:
#S3 is the set of scenarios from S2 with pre[r] deleted
#print("S3", S3):

for s in S3 do
if not pcontainsq(s,pat) then return false:
fi:

od:

#second half checks that re-inserting r into a pat-containing perm always produces
#a pat-containing perm

#print(pat,DeleteEntries(pre,rset),gd):
G:=collapseGVS(GVs(pat,pre,gd),rset,pre):
#print(DeleteEntries(pre,rset),pat,G):
S:=scenariosWgaps(DeleteEntries(pre,rset),pat,G):
#print(S):
S2:={seq(red(s[1]),s in S)}:
#S2 is the set of scenarios with no rset involved
#print(S2):
S3:={}:

for s in S2 do
#print(InsertionValues(s,pre,rset)):
for j in InsertionValues(s,pre,rset) do
S3:=S3 union {InsertEntries(s,{seq([j[i],rset[i]],i=1..nops(rset))})}:
od:
od:
#S3 is the set of scenarios from S2 with pre[r] re-inserted
#print(S3):

for s in S3 do
if not pcontainsq(s,pat) then return false:
fi:
od:

true:

end:

#isRevDelSetS(pre,P,rset,gd): checks if the set of indices rset is reversibly deletable from
#prefix pre, with forbidden pattern set P, and gap depth gd
isRevDelSetS:=proc(pre,P,rset,gd) local G,S,s,S2,S3,i,IS,I2,rs,j:
#first half checks that deleting position r from a pat-containing perm always produces
#a pat-containing perm
G:=GVsS(P,pre,gd):
S:=scenariosWgapsS(pre,P,G):
#print("S",S):
S2:={}:
for s in S do
if nops({seq(pre[rs],rs in rset)} intersect {op(s[2])})>0 then S2:=S2 union {s}:
fi:
od:
#S2 is the set of scenarios involving pre[rset]
#print("S2",S2):
S3:={}:

for s in S2 do
#print(s[1],rset,DeleteEntries(s[1],rset)):
S3:=S3 union {DeleteEntries(s[1],rset)}:
od:
#S3 is the set of scenarios from S2 with pre[r] deleted
#print("S3", S3):

for s in S3 do
if not pcontainsqS(s,P) then return false:
fi:

od:

#second half checks that re-inserting r into a pat-containing perm always produces
#a pat-containing perm
#print(pcontainsqS(DeleteEntries(pre,rset),P), not pcontainsqS(pre,P)):

if pcontainsqS(DeleteEntries(pre,rset),P) and not pcontainsqS(pre,P) then return false: fi:


#print(P,DeleteEntries(pre,rset),gd):
#G:=GVsS(P,DeleteEntries(pre,rset),gd):
#print(GVsS(P,DeleteEntries(pre,rset),gd)):

G:=collapseGVS(P,pre,rset,gd):
#G:=GVsS(P,DeleteEntries(pre,rset),gd):
#print(G):
#print(DeleteEntries(pre,rset),P,G):

S:=scenariosWgapsS(DeleteEntries(pre,rset),P,G):
#print(S):
S2:={seq(red(s[1]),s in S)}:
#S2 is the set of scenarios with no rset involved
#print(S2):
S3:={}:

for s in S2 do
#print(InsertionValues(s,pre,rset)):
for j in InsertionValues(s,pre,rset) do
S3:=S3 union {InsertEntries(s,{seq([j[i],rset[i]],i=1..nops(rset))})}:
od:
od:
#S3 is the set of scenarios from S2 with pre[r] re-inserted
#print(S3):

for s in S3 do
if not pcontainsqS(s,P) then return false:
fi:
od:

true:

end:

splitGV:=proc(g,lets) local i,A,a,G,G2,lets2,g2:
#print(g,lets):
G:={g}:
G2:={}:
lets2:=lets:
while nops(lets2)>0 do
i:=min(op(lets2)):

for g2 in G do
A:=Comps(g2[i],2):
for a in A do
G2:=G2 union {[op(1..i-1,g2),op(a),op(i+1..nops(g2),g2)]}:
od:
od:
G:=G2:
G2:={}:
lets2:=lets2 minus {i}:
od:
G:
end:




#collapseGV(g,rset,pre): inputs a gap vector g, a set of candidate reversibly deletable
#elements rset, and a prefix pre and returns the gap vectors for pre once 
#the positions in rset are deleted
collapseGV:=proc(g,rset,pre) local g2,r,rset2,i:
g2:=g:
rset2:={seq(pre[r],r in rset)}:

while nops(rset2)>0 do
r:=max(op(rset2)):
g2:=[op(1..r-1,g2),min(g2[r],g2[r+1]),op(r+2..nops(g2),g2)]:
rset2:=rset2 minus {r}:
od:
g2:
end:

collapseGVS:=proc(P,pre,rset,gd) local Gbig,Gsmall,Gfinal,g,lets:
Gbig:=GVsS(P,pre,gd):
Gsmall:=GVsS(P,DeleteEntries(pre,rset),gd):
Gfinal:={}:

lets:={seq(pre[r],r in rset)}:
#print(Gbig,Gsmall,lets):

for g in Gsmall do
if splitGV(g,lets) subset Gbig then Gfinal:=Gfinal union {g}: fi:

od:
Gfinal:
end:


#collapseGVS(G,rset,pre): same as collapseGV, only inputs a set of gap vectors G
#instead of just a single gap vector g
#collapseGVS:=proc(G,rset,pre) local S,g:
#if G={[0$nops(pre)+1]} then return {[0$nops(pre)-nops(rset)+1]}: fi:

#S:={}:
#for g in G do
#if {op(collapseGV(g,rset,pre))}<>{0} then
#S:=S union {collapseGV(g,rset,pre)}:
#fi:
#od:

#S:
#end:


#posset(L,S): inputs a list L and a set S and returns the set of positions
#of L where the actual letters in set S occur
posset:=proc(L,S) local S2,i:
S2:={}:
for i from 1 to nops(L) do
if member(L[i],S) then S2:=S2 union {i}: fi:
od:
S2:
end:

#rdSet(pre,pat,gd): inputs a prefix pre, a forbidden pattern pat, and a maximum
#gap vector weight gd and returns the set of reversibly deletable positions of
#pre with respect to pat and gap vectors of maximum weight gd
rdSet:=proc(pre,pat,gd) local i, S,GS,SS,s:
#S:={}:
#for i from 1 to nops(pre) do
#if isRevDel(pre,pat,i,gd) then
#S:=S union {i}:
#fi:
#od:

#if isRevDelSet(pre,pat,S,gd) then return S:
#else 
#GS:={}:
#for i from nops(S) to 1 by -1 while GS={} do
#SS:=choose(S,i):
#for s in SS do
#if isRevDelSet(pre,pat,s,gd) then GS:=s: fi:
#od:
#od:
#fi:

for i from nops(pre) to 1 by -1 do
S:=choose({$1..nops(pre)},i):
for s in S do
#print(s):
if isRevDelSet(pre,pat,s,gd) then return s:
fi:
od:
od:

{}:

end:


#rdSetS(pre,P,gd): inputs a prefix pre, a forbidden pattern set P, and a maximum
#gap vector weight gd and returns the set of reversibly deletable positions of
#pre with respect to P and gap vectors of maximum weight gd
rdSetS:=proc(pre,P,gd) local i, S,GS,SS,s:
#S:={}:
#for i from 1 to nops(pre) do
#if isRevDel(pre,P,i,gd) then
#S:=S union {i}:
#fi:
#od:

#if isRevDelSet(pre,P,S,gd) then return S:
#else 
#GS:={}:
#for i from nops(S) to 1 by -1 while GS={} do
#SS:=choose(S,i):
#for s in SS do
#if isRevDelSet(pre,P,s,gd) then GS:=s: fi:
#od:
#od:
#fi:

for i from nops(pre) to 1 by -1 do
S:=choose({$1..nops(pre)},i):
for s in S do
#print(s):
if isRevDelSetS(pre,P,s,gd) then return s:
fi:
od:
od:

{}:

end:


#isGapVector(pre,pat,gv): inputs a prefix pre of length l, a generalized pattern pat,
#and a potential gap vector gv of length l+1, and returns true if gv is a 
#gap vector for pre with respect to pat, or false otherwise
isGapVector:=proc(pre,pat,gv) local L,S,i,S2,R,s:
if {op(pat[2])}={0} then return false: fi:
if pat[2][nops(pat[2])]=0 then return false: fi:

  if nops(pre)<>nops(gv)-1 then print("ERROR, gap vector ", gv, " is an inappropriate length for prefix", pre):
  fi:

L:=sort(pre):
L:=[0,op(L),nops(pre)+1]:

S:={}:

for i from 1 to nops(gv) do
  S:=S union {seq(L[i]+j/(gv[i]+1),j=1..gv[i])}:
od:

S2:=permute(S):
R:={}:
for s in S2 do
R:=R union {[pre,s]}:
od:
#print(R):
evalb({seq(pcontainsqparts(r,pat),r in R)}={true});
end:

#isGapVectorS(pre,P,gv): inputs a prefix pre of length l, a generalized pattern set P,
#and a potential gap vector gv of length l+1, and returns true if gv is a 
#gap vector for pre with respect to P, or false otherwise
isGapVectorS:=proc(pre,P,gv) local pat,L,S,i,S2,R,s:
#for pat in P do
#if isGapVector(pre,pat,gv) then return true: fi:
#od:

#false:
#end:

#print({seq(op(pat[2]),pat in P)},{seq(pat[2][nops(pat[2])],pat in P)}):

if {seq(op(pat[2]),pat in P)}={0} then return false: fi:
if {seq(pat[2][nops(pat[2])],pat in P)}={0} then return false: fi:

  if nops(pre)<>nops(gv)-1 then print("ERROR, gap vector ", gv, " is an inappropriate length for prefix", pre):
  fi:

L:=sort(pre):
L:=[0,op(L),nops(pre)+1]:

S:={}:

for i from 1 to nops(gv) do
  S:=S union {seq(L[i]+j/(gv[i]+1),j=1..gv[i])}:
od:


S2:=permute(S):
R:={}:
for s in S2 do
R:=R union {[pre,s]}:
od:
#print(R):

evalb({seq(pcontainsqpartsS(r,P),r in R)}={true}):

end:

#pcontainsqparts(p,q): inputs a pair of lists p and a generalized pattern q
#and returns true if p(considered as p[1] with p[2] appended) contains the pattern
#q such that any part of a q pattern with forced adjacent letters appears in the p[1]
#section of p
pcontainsqparts:=proc(p,q) local pat,r,str,s,pfull,k,i:
pfull:=[op(p[1]),op(p[2])]:
pat:=q[1]:
r:=q[2]:
k:=0:
for i from 1 to nops(r) do
if r[i]=0 then k:=i:
fi:
od:
#k is the position of the last 0 in r

str:=restrictedsubstringsparts(pfull,r,k+1,nops(p[1])):
#print(pfull,str):
for s in str do
if evalb(red(s)=pat) then return true: fi:
od:
return false:
end:

#pcontainsqpartsS(p,Q): inputs a pair of lists p and a generalized pattern set Q
#and returns true if p(considered as p[1] with p[2] appended) contains a pattern
#in Q such that any part of a pattern with forced adjacent letters appears in the p[1]
#section of p
pcontainsqpartsS:=proc(p,Q) local pat,r,str,s,pfull,k,i,q:
pfull:=[op(p[1]),op(p[2])]:

for q in Q do
pat:=q[1]:
r:=q[2]:
k:=0:
for i from 1 to nops(r) do
if r[i]=0 then k:=i:
fi:
od:
#k is the position of the last 0 in r

str:=restrictedsubstringsparts(pfull,r,k+1,nops(p[1])):
#print(pfull,str):
for s in str do
if evalb(red(s)=pat) then return true: fi:
od:
od:

return false:
end:

#restrictedsubstringsparts(L,r,k,n): inputs a list L, and and list of 
#0s and 1s r, and returns all substrings s of L of length nops(r)+1
#where s[i] s[i+1] must have been adjacent in L if r[i]=0
#also only returns substrings so that the first/last k entries come from 
#L[1]..L[n]
restrictedsubstringsparts:=proc(L,r,k,n) local pos,S,p,pos2,i:
pos:=choose([$1..nops(L)],nops(r)+1):
pos2:={}:

#print(pos):

if k<=nops(r)+1 then

for p in pos do
if {op(1..k,p)} subset {$1..n} then pos2:=pos2 union {p}: fi:
od:
pos:=pos2:
fi:

S:={}:
pos2:={op(pos)}:
for p in pos do
for i from 1 to nops(r) do
if r[i]=0 and p[i+1]<>p[i]+1 then pos2:=pos2 minus {p}: fi:
od:
od:

for p in pos2 do
S:=S union {[seq(L[p[i]],i=1..nops(p))]}:
od:
S:
end:

#Comps(a,n): the set non-negative integer vectors of length n and sum a
Comps:=proc(a,n) local S,R,s,i:
if n=1 then return {[a]}: fi:
if a=0 then return {[0$n]}: fi:

R:={}:
for i from 0 to a do
S:=Comps(a-i,n-1):
for s in S do
R:=R union {[i,op(s)]}:
od:
od:
R:
end:

#ImpliedGVs(gv,n): inputs a gap vector gv and an integer n
#and outputs the gap vectors of sum n that are implied
#to be gap vectors by gv
ImpliedGVs:=proc(gv,n) local S:
S:=Comps(n-convert(gv,`+`),nops(gv)):
{seq(gv+s,s in S)}:
end:

#NewGVs(pat,pre,s,G): given a pattern pat, a prefix pre,
#a positive integer s, and a set of previously discovered gap
#vectors G, finds all new gap vectors of size s
NewGVs:=proc(pat,pre,s,G) local cands,R,c:
cands:=Comps(s,nops(pre)+1) minus {seq(op(ImpliedGVs(g,s)),g in G)}:
R:={}:
for c in cands do
if isGapVector(pre,pat,c) then
R:=R union {c}:
fi:
od:
R:
end:

#NewGVsS(P,pre,s,G): given a pattern set P, a prefix pre,
#a positive integer s, and a set of previously discovered gap
#vectors G, finds all new gap vectors of size s
NewGVsS:=proc(P,pre,s,G) local cands,R,c:
cands:=Comps(s,nops(pre)+1) minus {seq(op(ImpliedGVs(g,s)),g in G)}:
R:={}:
for c in cands do
if isGapVectorS(pre,P,c) then
R:=R union {c}:
fi:
od:
R:
end:

#GVs(pat,pre,s): given a pattern pat, and a prefix pre, returns the set of
#gap vectors of size <=s
GVs:=proc(pat,pre,s) local G,i:
G:={}:
for i from 0 to s do
G:=G union NewGVs(pat,pre,i,G):
od:
G:
end:

#GVsS(P,pre,s): given a pattern set P, and a prefix pre, returns the set of
#gap vectors of size <=s
GVsS:=proc(P,pre,s) local G,i:
G:={}:
for i from 0 to s do
G:=G union NewGVsS(P,pre,i,G):
od:
G:
end:

#g1GTg2(g1,g2): returns true if vector g1 is componentwise greater than g2
#returns false if g1 is not componentwise greater than g2
#returns FAIL if g1 and g2 are of different lengths
g1GTg2:=proc(g1,g2) local i:
if nops(g1)<>nops(g2) then return FAIL: fi:
if evalb({seq(evalb(g1[i]>=g2[i]),i=1..nops(g1))}={true}) then return true:
else return false:
fi:
end:

#obeysG(v,gaps): inputs a vector v and a set of gap vectors gaps
#returns true if v<g for all g in gaps, 
#returns false if v>=g for some gap vector g
obeysG:=proc(v,gaps) local g:
for g in gaps do
if g1GTg2(v,g) then return false:
fi:
od:
return true:
end:

#GandBChildren(pre,pat,gd): inputs a prefix pre, a forbidden pattern pat, and a positive
#integer gd
#returns two sets of triples [C,R,G] where C is a child of pre, R is reversible deletable
#elements of C, and G is a set of gap vectors for C with respect to pat
#the first set is triples where R<>{} and the second set is triples where R={}
GandBChildren:=proc(pre,pat,gd) local C,G,B,c,Gaps,RDs, FirstBlock:

  #FirstBlock is the length of initial consecutive substring
  #  e.g. in 124-35, FirstBlock=3
FirstBlock:=ListTools[Search](1,pat[2]):
  #if the whole pattern is consecutive, the above yields 0, so this must be corrected
if FirstBlock=0 then FirstBlock:=nops(pat[1]): fi:

C:=children(pre):
G:={}:
B:={}:

for c in C do
#print(c):
  if nops(c)<FirstBlock then
   Gaps:={}:
   RDs:=rdSet(c,pat,0):
   else

   Gaps:=GVs(pat,c,gd):
   if c=pat[1] then RDs:={$1..nops(pat[1])}: Gaps:={[0$nops(pat[1])+1]}:
		elif pcontainsqS(c,pat) then RDs:={$1..nops(pat[1])}: Gaps:={[0$nops(c)+1]}:
               else RDs:=rdSetS(c,pat,gd):

   fi:
  fi:

  if RDs<>{} then G:=G union {[c,RDs,Gaps]}:
  else B:=B union {[c,RDs,Gaps]}:
  fi:

od:

[G,B]:
end:

#GandBChildrenS(pre,P,gd): inputs a prefix pre, a forbidden pattern set P, and a positive
#integer gd
#returns two sets of triples [C,R,G] where C is a child of pre, R is reversible deletable
#elements of C, and G is a set of gap vectors for C with respect to P
#the first set is triples where R<>{} and the second set is triples where R={}
GandBChildrenS:=proc(pre,P,gd) local C,G,B,c,Gaps,RDs, FirstBlock,pats:

  #FirstBlock is the length of initial consecutive substring
  #  e.g. in 124-35, FirstBlock=3
#FirstBlock:=ListTools[Search](1,pat[2]):
  #if the whole pattern is consecutive, the above yields 0, so this must be corrected
#if FirstBlock=0 then FirstBlock:=nops(pat[1]): fi:

C:=children(pre):
G:={}:
B:={}:

for c in C do
#print(c):
#  if nops(c)<FirstBlock then
#   Gaps:={}:
#   RDs:=rdSetS(c,P,0):
#   else
pats:={seq(p[1],p in P)}:
   Gaps:=GVsS(P,c,gd):
   if member(c,pats) then RDs:={$1..nops(c)}: Gaps:={[0$nops(c)+1]}:
		elif pcontainsqS(c,P) then RDs:={$1..nops(c)}: Gaps:={[0$nops(c)+1]}:
               else RDs:=rdSetS(c,P,gd):

   fi:
#  fi:

  if RDs<>{} then G:=G union {[c,RDs,Gaps]}:
  else B:=B union {[c,RDs,Gaps]}:
  fi:

od:

[G,B]:
end:

#BuildScheme(pat,gd,sd): inputs a generalized permutation pattern pat, and positive
#integers gd and sd. If there exists an enumeration scheme of depth <=sd with
#gap vectors of weight <=gd, then the scheme is returned as a set of tuples of the
#form [prefix,reversibly deletable elements, gap vectors]
#otherwise returns FAIL, along with a partial scheme of depth sd
#BuildScheme:=proc(pat,gd,sd) local S,Temp,t,G,Temp2,i:
#S:={[[],{},{}]}:
#Temp:=S:
#Temp2:={}:

#for i from 1 to sd do

#for t in Temp do
#G:=GandBChildren(t[1],pat,gd):
#S:=S union G[1]:
#S:=S union G[2]:
#Temp2:=Temp2 union G[2]:
#od:

#if Temp2={} then return S: fi:

#Temp:=Temp2:
#Temp2:={}:

#od:

#print("FAIL: the partial scheme so far is: ", S):
#return [0]:
#end:

#BuildSchemeS(P,gd,sd): inputs a generalized permutation pattern set P, and positive
#integers gd and sd. If there exists an enumeration scheme of depth <=sd with
#gap vectors of weight <=gd, then the scheme is returned as a set of tuples of the
#form [prefix,reversibly deletable elements, gap vectors]
#otherwise returns FAIL, along with a partial scheme of depth sd
BuildSchemeS:=proc(P,gd,sd) local S,Temp,t,G,Temp2,i:
if member([[1],[]],P) then return {[[],{},{}],[[1],{1},{[0,0]}]}: fi:


S:={[[],{},{}]}:
Temp:=S:
Temp2:={}:

for i from 1 to sd do

for t in Temp do
G:=GandBChildrenS(t[1],P,gd):
S:=S union G[1]:
S:=S union G[2]:
Temp2:=Temp2 union G[2]:
od:

if Temp2={} then 

if S<>[0] and SSeq(S,7)<>SSeqBFS(P,7) then return [null,SSeq(S,7),SSeqBFS(P,7),S]: fi:

return S: fi:

Temp:=Temp2:
Temp2:={}:

od:



#print("FAIL: the partial scheme so far is: ", S):
return [0]:
end:

#InsertEntries(pi,S): inputs a permutation pi and a set S of pairs
#for each pair in S, s[1] tells a letter to insert into pi, and 
#s[2] tells what position to insert s[1] into
InsertEntries:=proc(pi,S) local L,pi2,i,j,P,pi3,s:
#print(pi,S):
L:=sort([seq(s[1],s in S)]):
P:=sort([seq(s[2],s in S)]):
pi2:=pi:
for i from 1 to nops(L) do
for j from 1 to nops(pi2) do
if pi2[j]<>null then
if pi2[j]>=L[i] then pi2[j]:=pi2[j]+1: fi:
fi:
od:
od:
pi3:=[]:
for i from 1 to nops(pi)+nops(S) do
if member(i,P) then
for s in S do

if s[2]=i then pi3:=[op(pi3),s[1]]: fi:
od:

else pi3:=[op(pi3),pi2[1]]:
pi2:=[op(2..nops(pi2),pi2)]:
fi:
od:
pi3:

end:

#InsertionValues(s,pre,rset): inputs a permutation s, a desired prefix pre, and set of integers rset
#such that 1<=r<=nops(pre) for all r in rset, and returns the set lists of values j that could be
#inserted into s in the positions rset to produce prefix pre
InsertionValues:=proc(s,pre,rset) local smallpre,j,S,i:
smallpre:=DeleteEntries(pre,rset):
S:={}:
for j in letterCands(nops(s)+nops(rset),nops(rset)) do
if evalb(red([op(1..nops(pre),InsertEntries(s,{seq([j[i],rset[i]],i=1..nops(rset))}))])=pre) then
S:=S union {j}:
fi:
od:

S:
end:

#letterCands(n,k): inputs integers n and k such that n>=k
#outputs all k tuples of distinct integers chosen from [n]
letterCands:=proc(n,k) local S,s:
S:=choose([$1..n],k):
{seq(op(permute(s)), s in S)}:
end:

####
# The following is adapted from the original VATTER package
####

#DeleteEntries(pi,S): deletes all the entries of
#pi[i] for i in S and reduces
DeleteEntries:=proc(pi,S) local k,i,S1:
k:=nops(pi):

if S minus {seq(i,i=1..k)}<>{} then
 ERROR(`bad input`):
fi:

S1:= {seq(i,i=1..k)} minus S:
S1:=sort(convert(S1,list)):

red([seq(pi[S1[i]],i=1..nops(S1))]):
end:


#DeleteEntriesG(g,S): shrinks the vector g by removing the
#barriers in the places indicated by S
#For example, try: DeleteEntries([2,3,2],{2});
DeleteEntriesG:=proc(g,S) local r,S1,g1,i:

if S={} then
 RETURN(g):
fi:

r:=min(op(S)):

g1:=[op(1..r-1,g),g[r]+g[r+1],op(r+2..nops(g),g)]:
if nops(S)=1 then
RETURN(g1):
 else
 S1:=S minus {r}:
 S1:={seq(S1[i]-1,i=1..nops(S1))}:
 RETURN(DeleteEntriesG(g1,S1)):
fi:

end:


#Miklos(S,pi,v): Given a scheme S, and a prefix permutation
#pi (that is part of the scheme) and a vector v of non-negative
#integers v (of size nops(pi)+1) outputs the number
#of permutations whose prefix reduces to pi and has
#the gap-vector v. For example try:
#Miklos(SchemeFast({[1,2,3]},2,1),[],[5]);
Miklos:=proc(S,pi,v, verbose:=false) local i,lu,GapVectors,RD,g,pi1,v1,su,j,L1:
option remember:

if nops(pi)+1<>nops(v) then
 ERROR(`Bad input: the third argument should be one longer than the sec.`):
fi:

if verbose then
 print(``);
 print(pi, v);
fi:

for i from 1 to nops(S) do
 if S[i][1]=pi then
  lu:=S[i]:
  break:
 fi:
od:

if i=nops(S)+1 then
 RETURN(`prefix not found`, FAIL):
fi:

RD:=lu[2]:
GapVectors:=lu[3]:
#print(RD,GapVectors):

#if member(0,RD) then
# if verbose then print(`Return 0: Prefix contains forbidden pattern`): fi:
# RETURN(0):
#fi:


#if v=[0$nops(v)] then
# if verbose then print(`Return 1: 0 Gap vector.`):  fi:
# RETURN(1):
#fi:
#Check if prefix is exhaustive, i.e. all letters appear in the prefix
if v=[0$nops(v)] and not member([0$nops(v)],GapVectors) then
 if verbose then print(`Return 1: 0 Gap vector.`):  fi:
 RETURN(1):
fi:


for g in GapVectors do
 if {seq(evalb(v[j]>=g[j]),j=1..nops(v))}={true} then
  if verbose then print(`Return 0: Gap vector criterion violated for g=`,g): fi:
  RETURN(0):
 fi:
od:


if RD<>{} then
  pi1:=DeleteEntries(pi,RD):
  L1:=sort(convert(RD,list)):
  L1:={seq(pi[L1[i]],i=1..nops(L1))}:
  v1:=DeleteEntriesG(v,L1):

  if verbose then print(`Deleting entries`, RD, pi1, v1): fi:
  if verbose then print(`Return: `, Miklos(S,pi1,v1)): fi:

  RETURN(Miklos(S,pi1,v1)):
fi:

su:=0:

for pi1 in children(pi) do
 i:=pi1[-1]:  #This is the letter added to form the child pi1
 for j from 0 to v[i]-1 do
   v1:=[op(1..i-1,v),j,v[i]-1-j,op(i+1..nops(v),v)]:
   if verbose then print(`adding children`, pi1, v1); fi:
   if verbose then print(`summand: `, Miklos(S,pi1,v1)): fi:
   su:=su+Miklos(S,pi1,v1):
 od:
od:
su:
end:

#SSeq(S,N): returns the number of permutations of length n avoiding the pattern 
#that scheme S encodes for n from 1 to N.
SSeq:=proc(S,N)
 [seq(Miklos(S,[],[n]), n=1..N)]:
end:

#SSeqBF(pat,N): returns the number of permutations of length n avoiding the pattern
#pat, for n from 1 to N, by brute force computation
SSeqBF:=proc(pat,N) local p:
 [seq(nops(remove(p->pcontainsq(p,pat), permute(n))),n=1..N)]:
end:

#SSeqBFS(P,N): returns the number of permutations of length n avoiding the pattern
#set P, for n from 1 to N, by brute force computation
SSeqBFS:=proc(P,N) local p:
 [seq(nops(remove(p->pcontainsqS(p,P), permute(n))),n=1..N)]:
end:

#classify(n,gd,sd,se): inputs an integers n, gd, sd, and se, and reports all schemes and sequences that can
#be determined for a pattern of length n with maximum scheme depth sd and maximum
#gap vector weight gd.  gives the first se terms of the counting sequence for
#every class that has a scheme
#classify:=proc(n,gd,sd,se) local C,g,b,havescheme,c,p,B,S:
#C:=symmclasses(n):
#print("There are ", nops(C), " equivalence classes of generalized patterns of length ", n):
#
#g:=0:
#b:=0:
#B:={}:
#
#for c in C do
#havescheme:=false:
#for p in c while havescheme=false do
#S:=BuildScheme(p,gd,sd):
#if evalb(S<>[0]) and evalb(S<>[null]) then 
#g:=g+1:
#print("For the class ", c, " the pattern ", p, " has scheme:"):
#print(S):
#print("The first ", se, " terms of the counting sequence are:"):
#print(SSeq(S,se)):
#print(""):
#havescheme:=true:
#fi:
#od:
#if havescheme=false then
#b:=b+1:
#B:=B union {c}:
#fi:
#od:
#print("Out of the ", nops(C), " equivalence classes ", g, "(or ", evalf(g/nops(C)*100)," %) classes have enumeration schemes."):
#print(b, "(or ", evalf(b/nops(C)*100)," %) classes do not have enumeration schemes of depth <=", sd, ", with gap vectors of weight <=", gd):
#print("The classes that failed are: "):
#print(B):

#end:

#classifyS(N,gd,sd,se): inputs an integers n, gd, sd, and se, and reports all schemes and sequences that can
#be determined for a pattern of length n with maximum scheme depth sd and maximum
#gap vector weight gd.  gives the first se terms of the counting sequence for
#every class that has a scheme
classifyS:=proc(N,gd,sd,se) local C,g,b,havescheme,c,p,P,B1,B2,S, NC, i:
C:=symmclassesS(N):
NC:=nops(C):
print("There are ", NC, " equivalence classes of generalized patterns of lengths ", N):

g:=0:
b:=0:
B1:={}:
B2:={}:

for i from 1 to NC do
  print("Class ", i, " is:"):
  print(C[i]);

   #These next four lines reduce C[i] to a set c where complements are removed
   #This is OK, since a pattern set P has a scheme
   #                   of depth d iff its complement P^c does.
   c:={}:
   for P in C[i] do
    if not member(gencompS(P), c) then c:=c union {P}: fi:
   od:

   havescheme:=false:

   for p in c while havescheme=false do
     print(p):
     S:=BuildSchemeS(p,gd,sd):
     if evalb(S<>[0]) and evalb(S<>[null]) then 
        g:=g+1:
        print("For the class ", C[i], " the pattern set ", p, " has scheme:"):
        print(S):
        print("The first ", se, " terms of the counting sequence are:"):
        print(SSeq(S,se)):
        print(""):
        havescheme:=true:
        forget(Miklos):
     fi:
   od:
   if havescheme=false then
      b:=b+1:
     if S=[null] then
        B2:=B2 union {c}:
        print("For the class ", c, " the pattern set ", p, " has a false scheme."):
        else
        B1:=B1 union {c}:
     fi:
   fi:
od:
print("Out of the ", nops(C), " equivalence classes ", g, "(or ", evalf(g/nops(C)*100)," %) classes have enumeration schemes."):
print(b, "(or ", evalf(b/nops(C)*100)," %) classes do not have enumeration schemes of depth <=", sd, ", with gap vectors of weight <=", gd):
print("The classes that failed are: "):
print(B1):
if B2<>{} then
print("The classes that produced erroenous schemes are:"):
print(B2):
fi:

end:


#inversions(pi) counts the number of inversions of pi
#This is usually denoted inv(pi), but that procedure name is already used in gVATTER for the inverse of pi
inversions:=proc(pi) local pair, M:
 M:=0:
 for pair in choose(nops(pi), 2) do
  if pi[pair[1]]>pi[pair[2]] then M:=M+1: fi:
 od:
M:
end:

qweight:=proc(S,q) local p:
 sort(add(q^inversions(p), p in S),q,ascending):
end:


#Snq(gp,n,q): inputs a generalized pattern (see pcontainsq for notation) and an integer n
#and outputs sum(q^inversions(pi)) where the sum runs over the set
#of permutations avoiding gp of length 0, 1, 2,... n
Snq:=proc(gp,n,q) local L,i,perms,p,perms2:
L:=[]:
for i from 0 to n do
 perms:={op(permute(i))}:
 perms2:=remove(p->pcontainsq(p,gp), perms):


 L:=[op(L),qweight(perms2,q)]:
od:
L:
end:


#qinveff(p, v, T) counts the number of inversions lost
#when (simultaneously) removing p[t] for each t in T 
#from a permutation with prefix p and spacing vector v.
qinveff := proc (p, v, T) local t, M, i, contrib, deletedword; 

M:=0:

for t in T do
  contrib:=add(v[i]+1, i=1..p[t]) - 1 + add(signum(p[i]-p[t]),i=1..t-1):
  M:=M+contrib:
od:

deletedword:=[seq( p[t], t in T)]:

M:=M - inversions(deletedword):

return M:
end:




#qMiklos(S,pi,v,q): Given a scheme S, and a prefix permutation
#pi (that is part of the scheme) and a vector v of non-negative
#integers v (of size nops(pi)+1) outputs the polynomial in q
#enumerating (according to inv) the number of permutations whose 
#prefix reduces to pi and has the gap-vector v. For example try:
#qMiklos(SchemeFast({[1,2,3]},2,1),[],[5]);
qMiklos:=proc(S,pi,v,q, verbose:=false) local i,lu,RD, GapVectors,g,pi1,v1,su,j,L1:
option remember:

if nops(pi)+1<>nops(v) then
 ERROR(`Bad input: the third argument should be one longer than the sec.`):
fi:

if verbose then
 print(``);
 print(pi, v);
fi:

for i from 1 to nops(S) do
 if S[i][1]=pi then
  lu:=S[i]:
  break:
 fi:
od:

if i=nops(S)+1 then
 RETURN(FAIL):
fi:

RD:=lu[2]:
GapVectors:=lu[3]:

#Check if the prefix already has the pattern (indicated by a 0 in RD)
#if member(0,RD) then
# if verbose then print(`Return 0: Prefix contains forbidden pattern`): fi:
# RETURN(0):
#fi:


#Check if prefix is exhaustive, i.e. all letters appear in the prefix
#if v=[0$nops(v)] then
# if verbose then print(`Return q^inversions(pi): 0 Gap vector.`):  fi:
# RETURN(q^inversions(pi))
#fi:
if v=[0$nops(v)] and not member([0$nops(v)],GapVectors) then
 if verbose then print(`Return q^inversions(pi): 0 Gap vector.`):  fi:
 RETURN(q^inversions(pi)):
fi:

#Check gap vector criterion
for g in GapVectors do
 if {seq(evalb(v[j]>=g[j]),j=1..nops(v))}={true} then
  if verbose then print(`Return 0: Gap vector criterion violated for g=`,g): fi:
  RETURN(0):
 fi:
od:


if RD<>{} then
  pi1:=DeleteEntries(pi,RD):
  L1:=sort(convert(RD,list)):
  L1:={seq(pi[L1[i]],i=1..nops(L1))}:
  v1:=DeleteEntriesG(v,L1):

  if verbose then print(`Deleting entries`, RD, pi1, v1): fi:
  if verbose then print(`Return: `, Miklos(S,pi1,v1)): fi:

  RETURN(sort(expand(q^(qinveff(pi, v, RD)) * qMiklos(S,pi1,v1,q)))):
fi:



su:=0:

for pi1 in children(pi) do
 i:=pi1[-1]:  #This is the letter added to form the child pi1
 for j from 0 to v[i]-1 do
   v1:=[op(1..i-1,v),j,v[i]-1-j,op(i+1..nops(v),v)]:
   if verbose then print(`adding children`, pi1, v1); fi:
   if verbose then print(`summand: `, Miklos(S,pi1,v1)): fi:
   su:=su+qMiklos(S,pi1,v1,q):
 od:
od:

su:
end:



#qSeqS(S,K,q): the first K terms (starting at 0)
#computed by the enumeration scheme S, 
#for example try: SeqS(SchemeFast(6,2,{[1,2,3]}),20,q);
qSeqS:=proc(S,K,q,nice:=true) local n: 
if nice and type(q,symbol) then
   return [1,seq(sort(expand(qMiklos(S,[],[n],q)),q,ascending) ,n=1..K)]:
else
   return [1,seq(qMiklos(S,[],[n],q), n=1..K)]:
fi:
end:

#Wilf(S,n): inputs a set of patterns S and a positive integer n
#and returns the set of permutations of length n
#avoiding all patterns in S
#For example, Wilf({[[1,3,2,4],[1,0,1]]},5);
Wilf:=proc(S,n) local S2,s,R:
S2:=permute(n):
R:={}:
for s in S2 do
if {seq(pcontainsq(s,s1),s1 in S)}={false} then
R:=R union {s}:
fi:
od:
R:
end:

#qWilf(S,n,q): inputs a set of patterns S, a positive integer n, and
#variable q, and q-counts the number of permutations avoiding S
#of length n, according to number of inversions.
#For example, try qWilf({[[1,3,2,4],[1,0,1]]},5,q);
qWilf:=proc(S,n,q) local W,w:
W:=Wilf(S,n):
add(q^inversions(w),w in W):
end: