######################################################################
##HERB: Save this file as HERB. To use it, stay in the               #
##same directory, get into Maple (by typing: maple <Enter> )         #
##and then type:  read HERB : <Enter>                                #
##Then follow the instructions given there                           #
##                                                                   #
##Written by Doron Zeilberger, Temple University ,                   #
#zeilberg@math.temple.edu.                                           # 
#######################################################################
 
#Created: Dec. 5 11, 1997
#This version: April 16, 1997
#HERB: A Maple package to study Wilf classes
#Please report bugs to zeilberg@math.temple.edu
 
 
 
print(`Created: Dec. 5, 1997.`):
print(`This version: April 16, 1997`):
lprint(``):
print(`Written by Doron Zeilberger, zeilberg@math.temple.edu`):
lprint(``):
print(`This is HERB, named in honor of Herb Wilf,`):
print(`to study Wilf classes of permutations`):
print(`It accompanies a forthcoming paper by Zeilberger`):
lprint(``):
print(`Please report bugs to zeilberg@math.temple.edu`):
lprint(``):
 print(`The most current version of this  package and paper`):
 print(` are  available from`):
 print(`http://www.math.temple.edu/~zeilberg`):
 print(`For a list of the procedures type ezra(), for help with`):
 print(`a specific procedure, type ezra(procedure_name)`):
 print(``):
ezra:=proc()
if args=NULL then
 print(` EJulian, EMiklos, EScheme`):
 print(`Herb, HerbP, GWilf, IsItDec, IsItInc, NuSins,Ruth, RuthSeriesI,  `):
 print(` RuthSeriesD, SINS, Wilf, WilfBeg, WilfRedBeg `):
fi:
 
if nops([args])=1 and op(1,[args])=GWilf then
print(`GWilf(n,r,Patterns): The set of permutations of [1,n]`):
print(`avoiding the patterns in Patterns and having exactly`):
print(`r occurrences of the patterns in Patterns`):
fi:
 
if nops([args])=1 and op(1,[args])=SINS then
print(`SINS(n,Patterns): A breakup of the permutations`):
print(`of {1,2,...,n} according to the number of sins`):
print(`(i.e. the number of occurrences of the patterns`):
print(`in Patterns)`):
fi:
 
if nops([args])=1 and op(1,[args])=NuSins then
print(`NuSins(pi,Patterns): The number of occurences of the patterns`):
print(`in the set Patterns in Patterns in the perms pi`):
 
fi:
 
if nops([args])=1 and op(1,[args])=IsItDec then
print(`IsItDec(n,Patterns,tau,r): Is it true or false that`):
print(`the sets obtained from Ruth(n,Patterns,tau,resh), by varying`):
print(`the r^th component of resh is always decreasing`):
fi:
 
if nops([args])=1 and op(1,[args])=IsItInc then
print(`IsItInc(n,Patterns,tau,r): Is it true or false that`):
print(`the sets obtained from Ruth(n,Patterns,tau,resh), by varying`):
print(`the r^th component of resh is always increasing`):
fi:
 
if nops([args])=1 and op(1,[args])=RuthSeriesI then
print(`RuthSeriesI(n,Patterns,tau,resh1,r): Given a set`):
print(`of patterns Patterns, and a prefix permutation tau`):
print(`and a list, resh1, shorter by one than tau`):
print(`checks whether the sets Ruth(n,Patterns,tau,resh) `):
print(`with the resh ranging over all the ways of literally`):
print(`inserting a new element at the r^th place of resh1`):
print(`is an Increasing family, and if it is, returns the`):
print(`differences. If it fails, it returns 0`):
fi:
 
 
if nops([args])=1 and op(1,[args])=RuthSeriesD then
print(`RuthSeriesD(n,Patterns,tau,resh1,r): Given a set`):
print(`of patterns Patterns, and a prefix permutation tau`):
print(`and a list, resh1, shorter by one than tau`):
print(`checks whether the sets Ruth(n,Patterns,tau,resh) `):
print(`with the resh ranging over all the ways of literally`):
print(`inserting a new element at the r^th place of resh1`):
print(`is an Decreasing family, and if it is, returns the`):
print(`differences. If it fails, it returns 0`):
fi:
 
if nops([args])=1 and op(1,[args])=Ruth then
print(`Ruth(n,Patterns,tau,resh): Given an integer n`):
print(`and a set of patterns Patterns, and a prefix`):
print(`permutation of length k, and and increasing`):
print(`sequence resh of length nops(tau) between 1`):
print(`and n+nops(tau), returns all permutations `):
print(`of length n+nops(tau) that`):
print(`start with resh arranged according to tau`):
print(`after the prefix is chopped off and`):
print(`the rest reduced, getting a certian subset`):
print(`of Wilf(n,Patterns)`):
fi:
 
 
if nops([args])=1 and op(1,[args])=BneiWilf then
print(`BneiWilf(n,Patterns): A breakup of Wilf(n,Patterns)`):
print(`according to the number of children`):
fi:
 
if nops([args])=1 and op(1,[args])=Banim then
print(`Banim(per,Patterns): If per is a member of Wilf(n,Patterns)`):
print(`output its set of children that belong to Wilf(n+1,Patterns)`):
fi:
 
if nops([args])=1 and op(1,[args])=dWilfRed then
print(`dWilfRed(n,i,Patterns): Wilf(n-1,i,Patterns)i-Wilf(n,i,Patterns),`):
print(`i.e. dWilf(n,i,Patterns) with the last element chopped`):
print(`and the rest reduced`):
fi:
 
if nops([args])=1 and op(1,[args])=dWilf then
print(`dWilf(n,i,Patterns): Wilf(n-1,Patterns)i-Wilf(n,Patterns)`):
fi:
 
 
if nops([args])=1 and op(1,[args])=WilfRedBeg then
print(`WilfRedBeg(n,Patterns,Beg): The set of permutations`):
print(`of length n+nops(Beg) that avoid the patterns in Patterns, and`):
print(`that start with Beg, with Beg chopped, and then reduced`):
print(`getting the  set of permutations of [1,n] such that if you`):
print(`stick Beg at the beginning, make room for it, by renaming`):
print(`the rest, you get a permutation that is free of the`):
print(`patterns of Patterns`):
fi:
 
if nops([args])=1 and op(1,[args])=Diffi then
print(`Diffi(n,i,Patterns): The set `):
print(`Wilf(n,Patterns) minus redu(WilfBeg(n+1,Patterns,[i])\i)`):
print(`in other words the set of all permutations of length n`):
print(`avoiding the patterns in Patterns, such that inserting`):
print(`i at the beginning will ruin them`):
fi:
 
if nops([args])=1 and op(1,[args])=Findj then
print(`Findj(sigma,Patterns): Given a prefix permutation sigma and`):
print(`a set of patterns Patterns, finds the members j of sigma`):
print(`such that any permutation pi in Wilf(n,Patterns) whose`):
print(`first nops(sigma) entries reduce to sigma must be such that`):
print(`the entries in the places occupied in sigma by j and j+1`):
print(`must be consecutive`):
print(`(i.e.  pi[sigma^(-1)[j+1]]-pi[sigma^(-1)[j]]=1)`):
print(`if j=0 it means that the entry in the place occupied`):
print(`by 1 in sigma must be 1. If j=nops(sigma) it means that`):
print(`the entry occupied by nops(sigma) in sigma must be n`):
fi:
 
if nops([args])=1 and op(1,[args])=EventsJ then
print(`EventsJ(sigma,Patterns):`):
print(`Given a prefix permutation sigma, and a set of`):
print(`pattern permutation, Patterns, finds alla`):
print(`possible events , subsets of [1,nops(sigma)] with`):
print(`the accompanying tau of Patterns that make it works`):
print(`The output is a set of ordered pairs : (recall that a pair`):
print(`is a list of two elements), the first member of each such pair`):
print(`is the subset of [1,nops(sigma)], the second member is`):
print(`the successful permutation tau from Patterns`):
print(`they should also be consistend with Findj(sigma,Patterns)`):
fi:
 
if nops([args])=1 and op(1,[args])=CheckEventJ then
print(`CheckEventJ(sigma,tau,Event,J): Given a prefix permutation`):
print(`sigma and a pattern permutation tau and an event Event`):
print(`(a subset of {1, ..., nops(sigma)}) and a set of integers`):
print(`J={j} , 0<=j<=nops(sigma), checks whether the existence of`):
print(`the Event contradicts that j  is a member of Findj(sigma,tau)`):
fi:
 
if nops([args])=1 and op(1,[args])=CheckEventj then
print(`CheckEventj(sigma,tau,Event,j): Given a prefix permutation`):
print(`sigma and a pattern permutation tau and an event Event`):
print(`(a subset of {1, ..., nops(sigma)}) and an integer`):
print(`j , 0<=j<=nops(sigma), checks whether the existence of`):
print(`the Event contradicts that j is a member of Findj(sigma,tau)`):
fi:
 
 
if nops([args])=1 and op(1,[args])=Events1 then
print(`Events1(sigma,tau): Given a prefix permutation sigma`):
print(`and a pattern permutation tau , finds all the subsets`):
print(`of places of [1,nops(sigma)] that produce "events" i.e.`):
print(`[sigma[i_1], ..., sigma[i_r]] reduces to a prefix of`):
print(` tau`):
fi:
 
if nops([args])=1 and op(1,[args])=Events then
print(`Events(sigma,Patterns):`):
print(`Given a prefix permutation sigma, and a set of`):
print(`pattern permutation, Patterns, finds all`):
print(`possible events , subsets of [1,nops(sigma)] with`):
print(`the accompanying tau of Patterns that make it works`):
print(`The output is a set of ordered pairs : (recall that a pair`):
print(`is a list of two elements), the first member of each such pair`):
print(`is the subset of [1,nops(sigma)], the second member is`):
print(`the successful permutation tau from Patterns`):
fi:
 
 
if nops([args])=1 and op(1,[args])=perush1 then
print(`perush1(tau,x,y,i)`):
print(`Given a permutation tau, two literals, x and y, and`):
print(`a list of places i (of length s<nops(tau)=k)`):
print(`interprets what it means for `):
print(`x[i[1]],..., x[i[s]],y[1], ...y[k-s] to reduce to tau`):
fi:
 
if nops([args])=1 and op(1,[args])=perush then
print(`perush(sigma,x)`):
print(`Given a permutation sigma, and a letter x`):
print(`it interprets what it means for x[1],..., x[m]`):
print(`to reduce to sigma`):
fi:
 
if nops([args])=1 and op(1,[args])=Testi then
print(`Given a prefix permutation, sigma, and a set of`):
print(`patterns, Patterns, and an integer in the closed`):
print(`interval between 1 and nops(sigma), decides whether inserting`):
print(`the entry at the i^th place is "harmless", i.e.`):
print(`any patterns that it might participate in imply`):
print(`previous patterns where he did not participate`):
fi:
 
 
 
if nops([args])=1 and op(1,[args])=EFindj then
 
print(`EFindj(pref,Patterns,L): Given a permutation, pref,`):
print(`and a set of patterns, Patterns, `):
print(`Emprically finds a j , (0<=<j<=k (=nops(pref)) )`):
print(`[if any]`):
print(`such that the set of k-prefixes of permutations of length n,`):
print(`v say, that avoid the patterns in Patterns`):
print(`(for nops(pref)<=n<=L) that reduce to pref has the property that`):
print(`that v[pref^(-1)[j+1]]=v[pref^(-1)[j]]+1`):
print(`if v[pref^(-1)[1]] is always 1 then j=0, if v[pref^(-1)[k]] is`):
print(`always n then j=n, if there is no such j, then j:=-1`):
 
fi:
 
if nops([args])=1 and op(1,[args])=ETestj then
print(`ETestj(tau,Patterns,L,j): Given a permutation, tau,`):
print(`and a set of patterns, Patterns,  and a j , (0<=<j<=k (=nops(tau)) )`):
print(`empirically tests whether it is true that `):
print(`the set of k-prefixes of permutations  length n,`):
print(`v say`):
print(`(for nops(tau)<=n<=L) that reduce to pref has the property that`):
print(`that v[tau^(-1)[j+1]]=v[tau^(-1)[j]]+1`):
print(`if v[tau^(-1)[1]] is always 1 then j=0, if v[tau^(-1)[k]] is`):
print(`always n then j=n, if there is no such j, then j:=-1`):
fi:
 
if nops([args])=1 and op(1,[args])=HaimOkvimMila then
print(`HaimOkvimMila(w,i,j): Given a word w, and two places`):
print(`i and j between decides whether the letter in the`):
print(`j^th place is one more then the letter at the i^th place`):
fi:
 
if nops([args])=1 and op(1,[args])=HerbP then
print(`HerbP(n,k,Patterns): The k-prefixes of the elements of`):
print(`Wilf(n,Patterns) broken up`):
print(`into a table with all reductions of startes of length k`):
print(`that avoid the patterns in the set of patterns Patterns`):
fi:
 
 
if nops([args])=1 and op(1,[args])=EMiklos then
print(`EMiklos(n,Patterns,GVUL,L): The number of permutations of length`):
print(`n avoiding the permutations in the set Patterns,`):
print(`i.e. the cardinality of Wilf(n,Patterns)`):
fi:
 
if nops([args])=1 and op(1,[args])=EJulian then
print(`EJulian(n,tau,vect,Patterns,GVUL,L)`): 
print(`Given an integer n, a`):
print(`permutation tau, a vector of distinct integers`):
print(`<=n, and a Scheme uses the Scheme`):
print(`to compute the number of permutations of`):
print(`length n that that with vect and avoid the`):
print(`pattern that came from Scheme`):
fi:
 
if nops([args])=1 and op(1,[args])=Refinements then
print(`Refinements(permu,Patterns): All the refinements of permu`):
print(` (i.e. permutations of length one more, s.t. chopping`):
print(`the last letter reduces to permu) that avoid the`):
print(`patterns in Patterns`):
fi:
 
if nops([args])=1 and op(1,[args])=EScheme then
print(`EScheme(Patterns,GVUL,L): Given a set of permutations`):
print(` (of various lengths)`):
print(`Patterns, Empirically finds a scheme [Redu,Expa,A,B] where`):
print(`Redu is a set of reducible prefix-permutations with respect to`):
print(`Patterns, Expa is the set of expandible ones, A is a table `):
print(`where A[tau] is the place (between 1 and nops(tau)) that says`):
print(`where to delete, for tau in Redu.`):
print(`and C[tau] is a table that says the Findj of tau.`):
print(`[i.e. the restriction, if any on the prefixes]`):
print(` B is a table `):
print(`where B[tau] is the set of refinements of tau, of length one`):
print(`more. For this to be a scheme, the deleted versions of all`):
print(`tau in Redu, and all the all B[tau] must `):
print(`GVUL is the maximal permitted prefix size on either`):
print(`Redu or Expa, L is the limit of EFindi.`):
print(`If unsucessul, it returns 0`):
lprint(``):
print(`Once again: the syntax is: EScheme(Patterns,GVUL,L)`):
fi:
 
 
if nops([args])=1 and op(1,[args])=EFindi then
print(`EFindi(pref,Patterns,L,J): Given a permutation prefix`):
print(`and a set of patterns, Patterns, finds  i's, (1<=i<=nops(tau))`):
print(`such that the set of permutations of length n`):
print(`(for n<=L) that avoid the patterns in Patterns, and`):
print(`that start with tau is identical, after deleting the`):
print(`i-th letter to the corresponding set of permutations`):
print(`of length n-1 prefixed with the deleted version of`):
print(`pref, it does that by repeatedly trying`):
print(`BdokBeg(n,pref,i,Patterns,J) for n<=L`):
lprint(``):
print(` J is the restriction set `):
fi:
 
 
if nops([args])=1 and op(1,[args])=BdokBegL then
print(`BdokBegL(L,pref,i,Patterns,J): chcekds whetehr it is`):
print(`true or false that BdokBeg(n,pref,i,Patterns,J) is true`):
print(`for all n between nops(pref) and L; J is the restriction set `):
fi:
 
 
if nops([args])=1 and op(1,[args])=BdokBeg then
print(`BdokBeg(n,tau,i,Patterns,J): Checks for all beginings`):
print(`that reduce to tau, whether the set obtained`):
print(`by starting with the set of permutations`):
print(`avoiding the pattern in Patterns , and starting with Beg`):
print(`and then deleting the i^ith letter and reducing, is`):
print(`identical to the corresponding set of n-1 permutations`):
print(`starting with the deleted Beg (reduced)`):
lprint(``):
print(`J is the restriction set`):
fi:
 
 
if nops([args])=1 and op(1,[args])=Bdok1Beg then
print(`Bdok1Beg(n,Beg,i,Patterns): Checks whether the set obtained`):
print(`by starting with the set of permutations`):
print(`avoiding the pattern in Patterns , and starting with Beg`):
print(`and then deleting the i^ith letter and reducing, is`):
print(`identical to the corresponding set of n-1 permutations`):
print(`starting with the deleted Beg (reduced)`):
fi:
 
 
if nops([args])=1 and op(1,[args])=WilfBeg then
print(`WilfBeg(n,Patterns,Beg): The set of permutations`):
print(`of length n that avoid the patterns in Patterns, and`):
print(`that start with Beg`):
fi:
 
 
if nops([args])=1 and op(1,[args])=Bdok then
print(`Bdok(n,tau,i,Patterns): Given an integer n, and a permutation`):
print(`tau of length k, say `):
print(`and an integer 1<=i<=k, finds whether`):
print(`deleting the i-th letter from `):
print(`the members of Wilf(n,Patterns) that start with type tau`):
print(`would give the`):
print(`corresponding class in Wilf(n-1,Patterns)`):
fi:
 
if nops([args])=1 and op(1,[args])=Herb then
print(`Herb(n,k,Patterns): all permutations of length n`):
print(`that avoid the patterns in the set of patterns`):
print(`Patterns broken up as a table by straters`):
print(`of length k`):
fi:
 
if nops([args])=1 and op(1,[args])=Wilf then
print(`Wilf(n,Patterns): all permutations of length n`):
print(`that avoid the patterns in the set of patterns`):
print(` Patterns `):
fi:
 
if nops([args])=1 and op(1,[args])=Insert  then
print(`Insert(pi,i): Given a permutation pi, and an integer`):
print(`i between 1 and nops(pi)+1, constructs the permutation`):
print(`of length nops(pi)+1 whose last entry is i, and such that`):
print(`reduced form of the first nops(pi) letters is pi`):
fi:
 
if nops([args])=1 and op(1,[args])=Insert then
print(`Insert(pi,i): Given a permutation pi, and an integer`):
print(`i between 1 and nops(pi)+1, constructs the permutation`):
print(`of length nops(pi)+1 whose last entry is i, and such that`):
print(`reduced form of the first nops(pi) letters is pi`):
fi:
 
 
if nops([args])=1 and op(1,[args])=good then
print(`good(pi,SetPatterns)`):
print(`Given a permutation pi, and a set of patterns`):
print(`SetPatterns, decides whether`):
print(`pattern1 occurs in pi with the first and last letter of `):
print(`pi  coinciding`):
print(`with the last letter of pattern1. It returns 0 if this is `):
print(`the case, otherwise 1 (0 means bad)`):
fi:
 
if nops([args])=1 and op(1,[args])=good1 then
print(`good1(pi,pattern1)`):
print(`Given a permutation pi, and a pattern pattern1, decides whether`):
print(`pattern1 occurs in pi with the first and last letter of`):
print(` pi  coinciding`):
print(`with the last letter of pattern1. It returns 0 if this is `):
print(`the case, otherwise 1 (0 means bad)`):
fi:
 
 
if nops([args])=1 and op(1,[args])=redu then
print(`redu(perm): Given a permutation on a set of positive integers`):
fi:
 
end:
 
 
ezra1:=proc()
if args=NULL then
 print(`Contains the following procedures:Banim, Bdok, Bdok1Beg, BdokBeg `):
 print(` BdokBegL, BneiWilf `):
 print(`CheckEventj,CheckEventJ, Diffi, dWilf, dWilfRed `):
 print(`EFindi, EFindj, EJulian, EMiklos, EScheme, ETestj, Events, Events1`):
  print(` EventsJ, HaimOkvimMila `):
 print(`good, good1, Herb, HerbP,Insert, perush, perush1 `):
 print(`redu, Refinements, Testi, Scheme, Wilf, WilfBeg, WilfRedBeg `):
fi:
 
end:
 
#IV(n,k) all increasing vectors of length
#k of the form 1<=i_1< ...<i_k <=n 
 
IV:=proc(n,k)
local i,gu,mu:
 
if k=0 then
RETURN({[]}):
fi:
 
if n<k then
RETURN({}):
fi:
 
gu:=IV(n-1,k):
mu:=IV(n-1,k-1):
 
for i from 1 to nops(mu) do
 gu:=gu union {[op(op(i,mu)),n]}:
od:
 
gu:
end:
 
 
#checkJ(w,n,J): checks whether the word w in IV(n,k)
#(k=nops(w))
#obeys the restrictions obeyed by J
 
checkJ:=proc(w,n,J)
local j,k:
 
if J={} then
RETURN(true):
fi:
 
k:=nops(w):
 
if max(op(J))>k or min(op(J))<0 then
ERROR(`Bad input`):
fi:
 
 
if member(0,J) and w[1]<>1 then
 RETURN(false):
fi:
 
 
if member(k,J) and w[k]<>n then
 RETURN(false):
fi:
 
for j from 1 to k-1 do
 
if member(j,J) and w[j+1]-w[j]<>1 then
 RETURN(false):
fi:
 
od:
 
true:
end:
 
 
#IV1(n,k,J) all increasing vectors of length
#k of the form 1<=i_1< ...<i_k <=n , and that
#obey the restrictions imposed by J
 
IV1:=proc(n,k,J)
local gu,i,w,mu:
gu:=IV(n,k):
 
mu:={}:
 
for i from 1 to nops(gu) do
w:=op(i,gu):
 
if checkJ(w,n,J) then
   mu:=mu union {w}:
fi:
 
od:
 
mu:
 
end:
 
 
#redu(perm): Given a permutation on a set of positive integers
#finds its reduced form
 
redu:=proc(perm)
local gu,i,ra,mu:
gu:=sort(perm):
 
for i from 1 to nops(gu) do
ra[gu[i]]:=i:
od:
 
mu:=[]:
 
for i from 1 to nops(perm) do
mu:=[op(mu),ra[perm[i]]]:
od:
mu:
 
 
 
end:
 
 
 
#Redu(Perms): Given a set of permutations on a set of positive integers
#finds the set of reducions
 
Redu:=proc(Perms)
local i,gu:
gu:={}:
for i from 1 to nops(Perms) do
gu:=gu union {redu(op(i,Perms))}:
od:
 
gu:
 
end:
 
#good1(pi,pattern1)
#Given a permutation pi, and a pattern pattern1, decides whether
#pattern1 occurs in pi with the first and last letter of pi  coinciding
#with the last letter of pattern1. It returns 0 if this is 
#the case, otherwise 1 (0 means bad)
 
good1:=proc(pi,pattern1)
local gu,k,n,i,j,subperm,vec:
 
n:=nops(pi):
 
k:=nops(pattern1):
if k>n then
RETURN(1):
fi:
gu:=IV(n,k-2):
 
for i from 1 to nops(gu) do
vec:=op(i,gu):
subperm:=[op(1,pi)]:
for j from 1 to k-2 do
subperm:=[op(subperm),pi[vec[j]]]:
od:
subperm:=[op(subperm),pi[n]]:
if redu(subperm)=pattern1 then
RETURN(0):
fi:
od:
 
1:
 
end:
 
 
 
 
#good(pi,SetPatterns)
#Given a permutation pi, and a set of patterns
#SetPatterns, decides whether
#pattern1 occurs in pi with the first and last letter of 
#pi  coinciding
#with the last letter of pattern1. It returns 0 if this is 
#the case, otherwise 1 (0 means bad)
 
good:=proc(pi,SetPatterns)
local i:
for i from 1 to nops(SetPatterns) do
if good1(pi,op(i,SetPatterns))=0 then
 RETURN(0):
fi:
od:
1:
end:
 
#Insert(pi,i): Given a permutation pi, and an integer
#i between 1 and nops(pi)+1, constructs the permutation
#of length nops(pi)+1 whose last entry is i, and such that
#reduced form of the first nops(pi) letters is pi
 
Insert:=proc(pi,i)
local mu,j:
mu:=[]:
 
for j from 1 to nops(pi) do
if pi[j]<i then
mu:=[op(mu),pi[j]]:
else
mu:=[op(mu),pi[j]+1]:
fi:
od:
mu:=[op(mu),i]:
mu:
end:
 
 
#Wilf(n,Patterns): all permutations of length n
#that avoid the patterns in the set of patterns
#Patterns
 
Wilf:=proc(n,Patterns)
local i,mu,gu,pi,j,muamad:
option remember:
 
 
if n=0 then
RETURN({[]}):
fi:
 
mu:=Wilf(n-1,Patterns):
gu:={}:
 
for i from 1 to nops(mu) do
pi:=op(i,mu):
 
for j from 1 to n do
muamad:=Insert(pi,j):
if member(redu([op(2..n,muamad)]),mu) then
  if good(muamad,Patterns)=1 then
   gu:=gu union {muamad}:
  fi:
fi:
od:
od:
 
gu:
end:
 
 
#Herb(n,k,Patterns): Wilf(n,Patterns) broken up
#into a table with all startes of length k
#Returns the list, followed by the set
#of startes
 
Herb:=proc(n,k,Patterns)
local  gu,A,mu,sta,pi,i:
gu:=Wilf(n,Patterns):
 
 
mu:={}:
 
for i from 1 to nops(gu) do
pi:=op(i,gu):
sta:=[op(1..k,pi)]:
if not member(sta,mu) then
 A[op(sta)]:={}:
 mu:=mu union {sta}:
fi:
A[op(sta)]:=A[op(sta)] union {pi}:
od:
op(A),mu:
 
end:
 
 
 
#HerbP(n,k,Patterns): Wilf(n,Patterns) broken up
#into a table with all reductions of startes of length k
#that avoid the patterns in the set of patterns
#Patterns and whose first nops(tau) elements
#reduce to tau. Returns the list, followed by the set
#of startes
 
HerbP:=proc(n,k,Patterns)
local  gu,A,mu,sta,pi,i:
option remember:
gu:=Wilf(n,Patterns):
 
 
mu:={}:
 
for i from 1 to nops(gu) do
pi:=op(i,gu):
sta:=redu([op(1..k,pi)]):
if not member(sta,mu) then
 A[op(sta)]:={}:
 mu:=mu union {sta}:
fi:
A[op(sta)]:=A[op(sta)] union {[op(1..k,pi)]}:
od:
op(A),mu:
 
end:
 
 
#Bdok1Beg(n,Beg,i,Patterns): Checks whether the set obtained
#by starting with the set of permutations
#avoiding the pattern in Patterns , and starting with Beg
#and then deleting the i^ith letter and reducing, is
#identical to the corresponding set of n-1 permutations
#starting with the deleted Beg (reduced)
 
 
Bdok1Beg:=proc(n,Beg,i,Patterns)
local gu,mu,gu1,pi,Beg1,j:
 
if i>nops(Beg) or i<1 then
ERROR(`i out of range`):
fi:
 
gu1:=WilfBeg(n,Patterns,Beg):
 
gu:={}:
 
for j from 1 to nops(gu1) do
pi:=op(j,gu1):
gu:=gu union {redu([op(1..i-1,pi),op(i+1..nops(pi) ,pi)])}:
od:
Beg1:=[op(1..i-1,Beg),op(i+1..nops(Beg),Beg)]:
Beg1:=redu1(Beg1,Beg[i]):
 
mu:=WilfBeg(n-1,Patterns,Beg1):
 
evalb(mu=gu):
end:
 
 
 
 
#BdokBeg(n,tau,i,Patterns,J): Checks for all beginings
#that reduce to tau, and that obey the restrictions
#imposed by the set J, whether the set obtained
#by starting with the set of permutations
#avoiding the pattern in Patterns , and starting with Beg
#and then deleting the i^ith letter and reducing, is
#identical to the corresponding set of n-1 permutations
#starting with the deleted Beg (reduced)
 
 
BdokBeg:=proc(n,tau,i,Patterns,J)
local gu,k,j,hatkhalot,vec1,j1,vec:
k:=nops(tau):
 
if k>n then
ERROR(`nops(tau)<=n`):
fi:
 
gu:=IV1(n,k,J):
hatkhalot:={}:
 
for j from 1 to nops(gu) do
vec:=op(j,gu):
vec1:=[]:
for j1 from 1 to k do
vec1:=[op(vec1),vec[tau[j1]]]:
od:
hatkhalot:=hatkhalot union {vec1}:
 
od:
 
for j from 1 to nops(hatkhalot) do
if not Bdok1Beg(n,op(j,hatkhalot),i,Patterns) then
RETURN(false):
fi:
od:
true:
end:
 
 
 
 
 
 
 
#Bdok(n,tau,i,Patterns): Given an integer n, and a permutation
#tau of length k, say 
#and an integer 1<=i<=k, finds whether
#deleting the i-th letter from 
#the members of Wilf(n,Patterns) that start with type tau
#would give the
#corresponding class in Wilf(n-1,Patterns)
 
Bdok:=proc(n,tau,i,Patterns)
local i1,  A,gu,mu,B,gu1,pi,j,ele,k, pip, se, se1:
 
k:=nops(tau):
gu:=Herb(n,k,Patterns):
mu:=gu[2]:
A:=gu[1]:
gu1:=Herb(n-1,k-1,Patterns):
B:=gu1[1]:
 
for i1 from 1 to nops(mu) do
pi:=op(i1,mu):
if redu(pi)=tau then
 se:=A[op(pi)]:
 se1:={}:
  for j from 1 to nops(se) do
   ele:=op(j,se):
   se1:=se1 union {redu([op(1..i-1,se),op(i+1..nops(ele),ele)])}:
  od:
fi:
 
 
pip:=B[op(1..k-1,redu([op(1..i-1,se),op(i+1..nops(ele),ele)]) )]:
print(se,pip):
if not se=pip then
RETURN(0):
fi:
 
od:
 
1:
 
end:
 
#WilfBeg(n,Patterns,Beg): The set of permutations
#of length n that avoid the patterns in Patterns, and
#that start with Beg
 
WilfBeg:=proc(n,Patterns,Beg)
local gu,mu,i,muam:
if nops(Beg)>n then
RETURN({}):
fi:
 
mu:=Wilf(n,Patterns):
 
gu:={}:
 
for i from 1 to nops(mu) do
muam:=op(i,mu):
if [op(1..nops(Beg),muam)]=Beg then
 gu:=gu union {muam}:
fi:
od:
gu:
end:
 
 
#redu1(tau,i): Given a partial permutation 
#and an integer i not in tau, keeps all the entries less
#than i intact, but decreases those that are bigger than i
 
redu1:=proc(tau,i)
local j,tau1:
tau1:=[]:
 
if member(i, convert(tau,set)) then
ERROR(`second arg. must be a member of first arg.`):
fi:
 
 
for j from 1 to nops(tau) do
if tau[j]<i then
tau1:=[op(tau1),tau[j]]:
else
tau1:=[op(tau1),tau[j]-1]:
fi:
od:
tau1:
end:
 
 
 
#BdokBegL(L,pref,i,Patterns,J): checks whetehr it is
#true or false that BdokBeg(n,pref,i,Patterns,J) is true
#for all n between nops(pref) and L
 
 
BdokBegL:=proc(L,pref,i,Patterns,J)
local n:
 
for n from nops(pref) to L do
if not BdokBeg(n,pref,i,Patterns,J) then
RETURN(false):
fi:
od:
true:
end:
 
 
#EFindi(pref,Patterns,L,J): Given a permutation prefix
#and a set of patterns, Patterns, finds the set of I, (1<=i<=nops(tau))
#such that the set of permutations of length n
#(for n<=L) that avoid the patterns in Patterns, and
#that start with tau,and obey the resctictions
#imposed by the set J, is identical, after deleting the
#i-th letter to the corresponding set of permutations
#of length n-1 prefixed with the deleted version of
#pref, it does that by repeatedly trying
#BdokBeg(n,pref,i,Patterns,J) for n<=L
 
 
 
EFindi:=proc(pref,Patterns,L,J)
local i,I1:
 
if J<>{} and (max(op(J))>nops(pref) or min(op(J))<0) then
ERROR(`the last arg., J is bad`):
fi:
 
 
I1:={}:
for i from 1 to nops(pref) do
if BdokBegL(L,pref,i,Patterns,J) then
 
I1:=I1 union {i}:
fi:
od:
 
I1:
end:
 
 
#HaimOkvimMila(w,i,j): Given a word w, and two places
#i and j between decides whether the letter in the
#j^th place is one more then the letter at the i^th place
 
HaimOkvimMila:=proc(w,i,j):
if not (i>=1 and i<=nops(w) and j>=1 and j<=nops(w) and i<>j) then
ERROR(`Bad input`):
fi:
if w[j]-w[i]=1 then
RETURN(true):
else
RETURN(false):
fi:
end:
 
#HaimOkvim(S,i,j): Given a set of words S of the same length,
#and two places
#i and j between decides whether all the words in S have
#the property that the letter in the
#j^th place is one more then the letter at the i^th place
 
HaimOkvim:=proc(S,i,j)
local w,r:
 
for r from 1 to nops(S) do
w:=op(r,S):
if not HaimOkvimMila(w,i,j) then
 RETURN(false):
fi:
od:
evalb(true):
end:
 
 
#HaimEkhadMila(w,i,va): Given a word w, and a place
#i, decides whether the letter in the
#i^th place equals va
 
HaimEkhadMila:=proc(w,i,va):
if not (i>=1 and i<=nops(w)) then
ERROR(`Bad input`):
fi:
if w[i]=va then
RETURN(true):
else
RETURN(false):
fi:
end:
 
 
 
#HaimEkhad(S,i,va): Given a set of words S of the same length,
#and a place
#i and a value va , whether whether all the words in S have
#the property that the letter in the
#i^th place equals va
 
HaimEkhad:=proc(S,i,va)
local w,r:
 
for r from 1 to nops(S) do
w:=op(r,S):
if not HaimEkhadMila(w,i,va) then
 RETURN(false):
fi:
od:
evalb(true):
end:
 
 
 
 
#ETestj(tau,Patterns,L,j): Given a permutation, tau,
#and a set of patterns, Patterns,  and a j , (0<=<j<=k (=nops(tau)) )
#Empirically tests whether it is true that 
#the set of k-prefixes of permutations of length n,
#v say
#(for nops(tau)<=n<=L) that reduce to pref has the property that
#that v[tau^(-1)[j+1]]=v[tau^(-1)[j]]+1
#if v[tau^(-1)[1]] is always 1 then j=0, if v[tau^(-1)[k]] is
#always n then j=n, if there is no such j, then j:=-1
 
ETestj:=proc(tau,Patterns,L,j)
local gu,k,n,tauh,mu,Ls,Lt:
 
if tau=[] then
RETURN(false):
fi:
 
Ls:=nops(tau):
Lt:=L:
k:=nops(tau):
 
tauh:=hofkhi(tau):
 
if j>0 and j<k then
for n from Ls to Lt do
mu:=HerbP(n,k,Patterns)[2]:
 
if member(tau,mu) then
gu:=HerbP(n,k,Patterns)[1][op(tau)]:
else
 gu:={}:
fi:
 
if not HaimOkvim(gu,tauh[j],tauh[j+1]) then
 RETURN(false):
fi:
od:
RETURN(true):
elif j=0 then
for n from Ls to Lt do
 
mu:=HerbP(n,k,Patterns)[2]:
 
if member(tau,mu) then
gu:=HerbP(n,k,Patterns)[1][op(tau)]:
else
 gu:={}:
fi:
 
 
 
if not HaimEkhad(gu,tauh[1],1) then
 RETURN(false):
fi:
od:
 RETURN(true):
 
elif j=k then
for n from Ls to Lt do
 
mu:=HerbP(n,k,Patterns)[2]:
 
if member(tau,mu) then
gu:=HerbP(n,k,Patterns)[1][op(tau)]:
else
 gu:={}:
fi:
 
  if not HaimEkhad(gu,tauh[k],n) then
   RETURN(false):
  fi:
 od:
 RETURN(true):
 
else
ERROR(`Bad input`):
fi:
 
end:
 
 
#EFindj(pref,Patterns,L): Given a permutation, pref,
#and a set of patterns, Patterns, 
#Emprically finds a j , (0<=<j<=k (=nops(pref)) )
#[if any]
#such that the set of k-prefixes of permutations of length n,
#v say, that avoid the patterns in Patterns
#(for nops(pref)<=n<=L) that reduce to pref has the property that
#that v[pref^(-1)[j+1]]=v[pref^(-1)[j]]+1
#if v[pref^(-1)[1]] is always 1 then j=0, if v[pref^(-1)[k]] is
#always n then j=n, if there is no such j, then j:=-1
 
 
 
EFindj:=proc(tau,Patterns,L)
local j,k,J:
 
J:={}:
 
k:=nops(tau):
 
for j from 0 to k do
if ETestj(tau,Patterns,L,j) then
J:=J union {j}:
fi:
od:
J:
end:
 
 
 
 
 
#Refinements(permu,Patterns): All the refinements of permu
# (i.e. permutations of length one more, s.t. chopping
#the last letter reduces to permu) that avoid the
#patterns in Patterns
 
Refinements:=proc(permu,Patterns)
local i,j,lu,gu:
 
gu:={}:
 
for i from 1 to nops(permu)+1 do
lu:=[]:
for j from 1 to nops(permu) do
if op(j,permu)<i then
lu:=[op(lu),op(j,permu)]:
else
lu:=[op(lu),op(j,permu)+1]:
fi:
od:
lu:=[op(lu),i]:
 
 
if member(lu,Wilf(nops(lu),Patterns)) then
gu:=gu union {lu}:
fi:
od:
gu:
end:
 
 
 
 
#EScheme(Patterns,GVUL,L): Given a set of permutations (of various lengths)
#Patterns, Emprically finds a scheme [Redu,Expa,A,B,C] where
#Redu is a set of reducible prefix-permutations with respect to
#Patterns, Expa is the set of expandible ones, A is a table 
#where A[tau] is the place (between 1 and nops(tau)) that says
#where to delete, for tau in Redu, 
#and C[tau] is a table that says the Findj of tau
#[i.e. the restriction, if any on the prefixes]
#and B is a table 
#where B[tau] is the set of refinements of tau, of length one
#more. For this to be a scheme, the deleted versions of all
#tau in Redu, and all the all B[tau] must 
#GVUL is the maximal permitted prefix size on either
#Redu or Expa, L is the limit of EFindi
#If unsucessul, it returns 0
 
EScheme:=proc(Patterns,GVUL,L)
local Redu,Expa,A,B,C,i,KVU,hakhi,permu,permud,I1,J:
option remember:
if member([],Patterns) then
ERROR(`[] can't be a member of Patterns`):
fi:
 
hakhi:=0:
 
KVU:={[]}:
 
Redu:={}:
Expa:={}:
 
while KVU<>{} and hakhi<=GVUL do
 permu:=op(1,KVU):
  if nops(permu)>hakhi then
   hakhi:=nops(permu):
  fi:
 
 if hakhi>GVUL then
  RETURN(0):
 fi:
 
  J:=EFindj(permu,Patterns,L):
  I1:=EFindi(permu,Patterns,L,J):
 
if I1={} then
Expa:=Expa union {permu}:
B[permu]:=Refinements(permu,Patterns):
C[permu]:=J:
KVU:=KVU minus {permu}:
 KVU:=KVU union (B[permu] minus (Expa union Redu)):
 
fi:
 
 
 
if I1<>{} then
Redu:=Redu union {permu}:
i:=op(1,I1):
A[permu]:=i:
C[permu]:=J:
permud:=[op(1..i-1,permu),op(i+1..nops(permu),permu)]:
permud:=redu(permud):
KVU:=KVU minus {permu}:
if not member(permud,Redu union Expa) then
 KVU:=KVU union {permud}:
fi:
 
fi:
 
 
od:
 
[Redu,Expa,A,B,C]:
 
end:
 
 
#hofkhi(tau): the inverse of the permutation tau
hofkhi:=proc(tau)
local i,sig1,sig:
 
for i from 1 to nops(tau) do
sig1[tau[i]]:=i:
od:
 
sig:=[]:
 
for i from 1 to nops(tau) do
sig:=[op(sig),sig1[i]]:
od:
sig:
end:
 
 
#EJulian(n,tau,vect,Patterns,GVUL,L): Given an integer n, a
#permutation tau, a vector of distinct integers
#<=n, and a Scheme uses the Scheme
#to compute the number of permutations of
#length n that that with vect and avoid the
#pattern that came from Scheme
 
EJulian:=proc(n,tau,vect,Patterns,GVUL,L)
local gu,Redu,Expa,A,B,C,Sch,i,j,k,vect1,vect1n,vi,j1,Refs,x,tau1,tauh,J:
option remember:
 
k:=nops(tau):
 
tauh:=hofkhi(tau):
 
if nops(tau)<>nops(vect) then
ERROR(`the 2nd and 3rd args must be of same length`):
fi:
 
Sch:=EScheme(Patterns,GVUL,L):
if Sch=0 then
ERROR(`No scheme found, raise GVUL and L`):
fi:
 
if n<=nops(tau) then
 if member(tau,Wilf(n,Patterns)) then
  RETURN(1):
 else
 RETURN(0):
 fi:
fi:
 
if redu(vect)<>tau then
ERROR(`the reductions of the third argument must be the second arg.`):
fi:
 
if vect<>[] then
if min(op(vect))<1 or min(op(vect))>n or nops(vect)<>nops(convert(vect,set))
 then
 ERROR(`The third argument is bad`):
fi:
fi:
 
Redu:=Sch[1]:
Expa:=Sch[2]:
A:=Sch[3]:
B:=Sch[4]:
C:=Sch[5]:
 
if member(tau,Redu) then
i:=A[tau]:
J:=C[tau]:
 
if member(0,J) then
 
if not vect[tauh[1]]=1 then
RETURN(0):
fi:
 
fi:
 
 
if member(k,J) then
 if not vect[tauh[k]]=n then
  RETURN(0):
 fi:
fi:
 
for j from 1 to k do
 if member(j,J) then
  if j>0 and j<k then
   if not vect[tauh[j+1]]-vect[tauh[j]]=1 then
    RETURN(0):
   fi:
  fi:
 fi:
od:
 
 
 
tau1:=[op(1..i-1,tau),op(i+1..nops(tau),tau)]:
tau1:=redu(tau1):
vi:=op(i,vect):
vect1:=[op(1..i-1,vect),op(i+1..nops(vect),vect)]:
vect1n:=[]:
for j1 from 1 to nops(vect1) do
 
 if op(j1,vect1)<vi then
   vect1n:=[op(vect1n),op(j1,vect1)]:
 else
   vect1n:=[op(vect1n),op(j1,vect1)-1]:
 fi:
 
od:
 
vect1:=vect1n:
 
RETURN(EJulian(n-1,tau1,vect1,Patterns,GVUL,L)):
fi:
 
 
if member(tau,Expa) then
Refs:=B[tau]:
 
gu:=0:
 
for j1 from 1 to nops(Refs) do
tau1:=op(j1,Refs):
 
for x from 1 to n do
vect1:=[op(vect),x]:
 
if nops(vect1)=nops(convert(vect1,set)) and redu(vect1)=tau1 then
 gu:=gu+EJulian(n,tau1,vect1,Patterns,GVUL,L):
 fi:
od:
 
od:
RETURN(gu):
fi:
 
end:
 
 
 
 
#EMiklos(n,Patterns,GVUL,L): The number of permutations of length
#n avoiding the permutations in the set Patterns,
#i.e. the cardinality of Wilf(n,Patterns)
 
EMiklos:=proc(n,Patterns,GVUL,L)
 
EJulian(n,[],[],Patterns,GVUL,L):
end:
 
 
 
 
#Test1i(pref,tau,CONN,i): Given a permutation pref and
#pattern tau, and the set of places in pref
#that coincide with members of tau,
#decides whether inserting the
#i^th member of pref can create the first `mistake'
 
Test1i:=proc(pref,tau,CONN,i)
local k:
 
k:=nops(tau):
if not member(i,CONN) then
ERROR(`fourth arg. must be a member of third arg.`):
fi:
 
if nops(CONN)>1 then
print(`don't know yet`):
RETURN(0):
fi:
 
if tau[1]=k and pref[i]<>nops(pref) then
RETURN(true):
fi:
 
if tau[1]=1 and pref[i]<>1 then
RETURN(true):
fi:
 
false:
 
end:
 
 
 
ez:=proc():print(`perush(sigma,x), perush1(tau,x,y,i)`):
print(`NewRelations(kv)`):
print(`Closure(kv)`):
print(`ImpliedRelations(sigma,tau,i)`):
print(`iImpliesi1(sigma,tau,i,i1)`):
print(`Events1(sigma,tau)`):
print(`Events(sigma,Patterns)`):
print(`E1ImpliesE2(sigma,E1,E2)`):
print(`BailOut(sigma,E1,SetE2)`):
print(`Testi(sigma,Patterns,i)`):
end:
 
#perush(sigma,x)
#Given a permutation sigma, and a letter x
#it interprets what it means for x[1],..., x[m]
#to reduce to sigma
 
perush:=proc(sigma,x)
local gu,sigh,i:
sigh:=hofkhi(sigma):
 
gu:=[]:
 
for i from 1 to nops(sigh) do
gu:=[op(gu),x[sigh[i]]]:
od:
 
gu:
end:
 
##perush1(tau,x,y,i)
#Given a permutation tau, two literals, x and y, and
#a list of places i (of length s<nops(tau)=k)
#interprets what it means for 
#x[i[1]],..., x[i[s]],y[1], ...y[k-s] to reduce to tau
 
perush1:=proc(tau,x,y,i)
local k,s,gu,tauh,j:
 
s:=nops(i):
 
k:=nops(tau):
 
tauh:=hofkhi(tau):
 
if not s<k then
ERROR(`The 4th arg. must be shorter than the first arg.`):
fi:
 
gu:=[]:
 
for j from 1 to k do
if tauh[j]<=s then
gu:=[op(gu),x[i[tauh[j]]]]:
else
gu:=[op(gu),y[tauh[j]-nops(i)]]:
fi:
od:
 
gu:
end:
 
#NewRelations(kv)
#Given a set of relations {[x,y]} meaning
#x<y, finds all those that are immediately 
#implied by them using x<y and y<z implies x<z
 
NewRelations:=proc(kv)
local kha,i,j,pair1,pair2,npair:
 
kha:={}:
 
for i from 1 to nops(kv) do
pair1:=op(i,kv):
for j from 1 to nops(kv) do
pair2:=op(j,kv):
 
if pair1[2]=pair2[1] then
npair:=[pair1[1],pair2[2]]:
if not member(npair,kv) then
kha:=kha union {npair}:
fi:
 
fi:
 
od:
od:
kha:
end:
 
 
 
#Closure(kv)
#Given a set of relations {[x,y]} meaning
#x<y, finds all those that are 
#implied by them using x<y and y<z implies x<z repeatedly
 
Closure:=proc(kv)
local kha,KV:
 
KV:=kv:
 
kha:=NewRelations(KV):
 
while kha<>{} do
KV:=KV union kha:
kha:=NewRelations(KV):
od:
 
KV:
 
end:
 
 
#ImpliedRelations(sigma,tau,i): Given a permutation
#sigma( a prefix) of length N, say, and a
#permutation tau (a pattern) of length M, say
#and a set of places i (nops(i)=I<N) such that
#the sub-permutation of sigma: sigma[i[1]], ..., sigma[i[I]]
#reduce to the reduction of tau[1], ..., tau[I],
#outputs all relations implied about x[1], ..., x[N]
#and the hypothetical y[1], .. y[M-N]
 
ImpliedRelations:=proc(sigma,tau,i)
local sigma1,tau1,N,kv,gu1,gu2,i1,j1,k1:
 
N:=nops(sigma):
 
if not ( nops(i)<=N and nops(i)>0) then
ERROR(`Bad input`):
fi:
 
sigma1:=[seq(sigma[i[k1]],k1=1..nops(i))]:
tau1:=[op(1..nops(i),tau)]:
 
if not redu(sigma1)=redu(tau1) then
ERROR(`Bad input for sigma and tau`):
fi:
 
 
gu1:=perush(sigma,x):
gu2:=perush1(tau,x,y,i):
 
kv:={}:
 
for i1 from 1 to nops(gu1) do
for j1 from i1+1 to nops(gu1) do
kv:=kv union {[op(i1,gu1),op(j1,gu1)]}:
od:
od:
 
 
for i1 from 1 to nops(gu2) do
for j1 from i1+1 to nops(gu2) do
kv:=kv union {[op(i1,gu2),op(j1,gu2)]}:
od:
od:
 
Closure(kv):
 
end:
 
 
 
 
 
#iImpliesi1(sigma,tau,i,i1): Given a prefix-permutation
#sigma, and a pattern permutation tau, and
#two set of places i and i1, decides whether
#the existence of the pattern tau where the first
#nops(i) participants of the pattern are at
#the places indicated by i, implies the
#existence of a pattern with the same
#phenomenon with i1
 
iImpliesi1:=proc(sigma,tau,i,i1)
local kv,kv1:
 
 
kv:=ImpliedRelations(sigma,tau,i):
kv1:=ImpliedRelations(sigma,tau,i1):
 
if kv1 minus kv={} then
 RETURN(true):
else
 RETURN(false):
fi:
 
end:
 
####HERE
#CheckEventj(sigma,tau,Event,j): Given a prefix permutation
#sigma and a pattern permutation tau and an event Event
#(a subset of {1, ..., nops(sigma)}) and an integer
#j , 0<=j<=nops(sigma), checks whether the existence of
#the Event contradicts that j is a member of Findj(sigma,tau)
 
CheckEventj:=proc(sigma,tau,Event,j)
local gu,x,y,sigmah,k1,kf,ks:
 
if not (type(Event,set) and min(op(Event))>0 and max(op(Event))<=nops(sigma))
  then
   ERROR(`Bad intput`):
fi:
 
sigmah:=hofkhi(sigma):
 
gu:=perush1(tau,x,y,Event):
 
kf:=-1: ks:=nops(sigma)+1:
 
if j>0 then
for k1 from 1 to nops(gu) do
if op(k1,gu)=x[sigmah[j]] then
  kf:=k1:
  break:
fi:
od:
fi:
 
if j<nops(sigma) then
for k1 from 1 to nops(gu) do
if op(k1,gu)=x[sigmah[j+1]] then
  ks:=k1:
  break:
fi:
od:
fi:
 
if j=0 and ks<=nops(sigma) and ks>1 then
RETURN(false):
fi:
 
 
if j=nops(sigma) and kf>-1 and kf<nops(sigma) then
RETURN(false):
fi:
 
if ks<=nops(sigma) and kf>=0 and ks-kf>1 then
RETURN(false):
fi:
 
true:
end:
 
 
 
 
 
#CheckEventJ(sigma,tau,Event,J): Given a prefix permutation
#sigma and a pattern permutation tau and an event Event
#(a subset of {1, ..., nops(sigma)}) and a set of integers
#J={j} , 0<=j<=nops(sigma), checks whether the existence of
#the Event contradicts that j  is a member of Findj(sigma,tau)
 
CheckEventJ:=proc(sigma,tau,Event,J)
local j:
 
for j from 1 to nops(J) do
if not CheckEventj(sigma,tau,Event,op(j,J)) then 
 RETURN(false):
fi:
od:
true:
end:
 
 
#Events1(sigma,tau): Given a prefix permutation sigma
#and a pattern permutation tau , finds all the subsets
#of places of [1,nops(sigma)] that produce `events's i.e.
#[sigma[i_1], ..., sigma[i_r]] reduces to a prefix of
#tau
 
Events1:=proc(sigma,tau)
local kv,KV,i,j,Pref_tau,kulam,mu:
with(combinat):
Pref_tau:={}:
 
for i from 1 to nops(tau)-1 do
Pref_tau:=Pref_tau union {redu([op(1..i,tau)])}:
od:
 
KV:={}:
kulam:=powerset(nops(sigma)) minus {{}}:
 
for i from 1 to nops(kulam) do
kv:=op(i,kulam):
mu:=sort([op(kv)]):
 
if member(redu([seq(sigma[mu[j]],j=1..nops(mu))]),Pref_tau) then
KV:=KV union {kv}:
fi:
 
od:
 
KV:
 
end:
 
 
 
 
 
#Events(sigma,Patterns):
#Given a prefix permutation sigma, and a set of
#pattern permutation, Patterns, finds all
#possible events , subsets of [1,nops(sigma)] with
#the accompanying tau of Patterns that make it works
#The output is a set of ordered pairs : (recall that a pair
#is a list of two elements), the first member of each such pair
#is the subset of [1,nops(sigma)], the second member is
#the successful permutation tau from Patterns
 
Events:=proc(sigma,Patterns)
local i,tau,kv,KV,j:
option remember:
KV:={}:
 
for i from 1 to nops(Patterns) do
tau:=op(i,Patterns):
 
kv:=Events1(sigma,tau):
 
for j from 1 to nops(kv) do
KV:=KV union {[op(j,kv),tau]}:
od:
 
 
 
od:
 
KV:
 
end:
 
 
 
 
 
#E1ImpliesE2(sigma,E1,E2): Given a prefix-permutation
#sigma, and two events E1 and E2 of the form
#[i1,tau1], [i2, tau2]
#where  i and i1 are sets of places and tau1 and tau2
#are pattern permutations decides whether
#the existence of the pattern tau1 where the first
#nops(i1) participants of the pattern are at
#the places indicated by i1, implies the
#existence of a pattern tau2 with the same
#phenomenon with i2
#At present we assume nops(i1)=nops(i2)
 
E1ImpliesE2:=proc(sigma,E1,E2)
local i1,tau1,i2,tau2,kv1,kv2:
i1:=E1[1]:
tau1:=E1[2]:
i2:=E2[1]:
tau2:=E2[2]:
 
kv1:=ImpliedRelations(sigma,tau1,i1):
kv2:=ImpliedRelations(sigma,tau2,i2):
 
if kv2 minus kv1={} then
 RETURN(true):
else
 RETURN(false):
fi:
 
end:
 
 
 
#BailOut(sigma,E1,SetE2): Given a prefix permutation
#sigma,an event E1, and a set of events SetE2, decides
#whether there exists at least one member of SetE2, let's
#call it E2, such that E1ImpliesE2(sigma,E1,E2) is true
 
BailOut:=proc(sigma,E1,SetE2)
local E2,i:
 
for i from 1 to nops(SetE2) do
E2:=op(i,SetE2):
 
if E1ImpliesE2(sigma,E1,E2) then
RETURN(true):
fi:
od:
false:
end:
 
 
#Given a prefix permutation, sigma, and a set of
#patterns, Patterns, and an integer in the closed
#interval between 1 and nops(sigma), decides whether inserting
#the entry at the i^th place is `harmless', i.e.
#any patterns that it might participate in imply
#previous patterns where he did not participate
 
Testi:=proc(sigma,Patterns,i)
local EventsWithi, EventsWithouti,j,AllEvents,eve:
 
EventsWithi:={}:
EventsWithouti:={}:
 
AllEvents:=Events(sigma,Patterns):
 
for j from 1 to nops(AllEvents) do
eve:=op(j,AllEvents):
 
if member(i,eve[1]) then
EventsWithi:=EventsWithi union {eve}:
else
EventsWithouti:=EventsWithouti union {eve}:
fi:
 
od:
 
for j from 1 to nops(EventsWithi) do
eve:=op(j,EventsWithi):
 
if not BailOut(sigma,eve,EventsWithouti) then
 RETURN(false):
fi:
od:
 
true:
 
end:
 
 
 
Findi:=proc(sigma,Patterns)
local kv,i:
 
kv:={}:
 
for i from 1 to nops(sigma) do
 if Testi(sigma,Patterns,i) then
   kv:=kv union {i}:
 fi:
od:
 
kv:
 
end:
 
 
 
 
 
ez1:=proc():print(`Findj(sigma,Patterns)`):
print(`isgood(sigma,Patterns)`):
end:
 
#isgood(sigma,Patterns): decides whether the permutation
#sigma is good w.r.t. to Patterns, i.e. whether if belongs
#Wilf(nops(sigma),Patterns); So far it is the slow version
#TO BE IMPROVED
 
isgood:=proc(sigma,Patterns)
if member(sigma,Wilf(nops(sigma),Patterns)) then
 RETURN(true):
else
RETURN(false):
fi:
end:
 
 
#Findj(sigma,Patterns): Given a prefix permutation sigma and
#a set of patterns Patterns, finds the members j of sigma
#such that any permutation pi in Wilf(n,Patterns) whose
#first nops(sigma) entries reduce to sigma must be such that
#the entries in the places occupied in sigma by j and j+1
#must be consecutive
#(i.e.  pi[sigma^(-1)[j+1]]-pi[sigma^(-1)[j]]=1)
#if j=0 it means that the entry in the place occupied
#by 1 in sigma must be 1. If j=nops(sigma) it means that
#the entry occupied by nops(sigma) in sigma must be
#n
 
Findj:=proc(sigma,Patterns)
local J,j:
J:={}:
 
for j from 0 to nops(sigma) do
if not isgood(redu([op(sigma),j+1/2]),Patterns) then
J:=J union {j}:
fi:
od:
J:
end:
 
 
#Diffi(n,i,Patterns): The set 
#Wilf(n,Patterns) minus redu(WilfBeg(n+1,Patterns,[i])\i)
#in other words the set of all permutations of length n
#avoiding the patterns in Patterns, such that inserting
#i at the beginning will ruin them
 
Diffi:=proc(n,i,Patterns)
local gu,mu,j,perm:
gu:=WilfBeg(n+1,Patterns,[i]):
 
mu:={}:
for j from 1 to nops(gu) do
perm:=op(j,gu):
mu:=mu union {[op(2..nops(perm),perm)]}:
od:
mu:=Redu(mu):
 
Wilf(n,Patterns) minus mu:
end:
 
 
 
#WilfRedBeg(n,Patterns,Beg): The set of permutations
#of length n+nops(Beg) that avoid the patterns in Patterns, and
#that start with Beg, with Beg chopped, and then reduced
#getting the  set of permutations of [1,n] such that if you
#stick Beg at the beginning, make room for it, by renaming
#the rest, you get a permutation that is free of the
#patterns of Patterns
 
WilfRedBeg:=proc(n,Patterns,Beg)
local gu,mu,i,perm:
 
gu:=WilfBeg(n+nops(Beg),Patterns,Beg):
mu:={}:
for i from 1 to nops(gu) do
perm:=op(i,gu):
perm:=[op(1+nops(Beg)..n+nops(Beg),perm)]:
perm:=redu(perm):
mu:=mu union {perm}:
od:
 
mu:
end:
 
 
#dWilf(n,i,Patterns): Wilf(n-1,i,Patterns)i-Wilf(n,i,Patterns)
 
dWilf:=proc(n,akha,Patterns)
local mu,pi,j,i,muamad,mu1,mu2:
option remember:
 
if n<1 then
ERROR(`n>=1`):
fi:
 
mu:=Wilf(n-1,Patterns):
mu1:=Wilf(n,Patterns):
mu2:={}:
 
for i from 1 to nops(mu) do
pi:=op(i,mu):
 
for j from akha to akha do
muamad:=Insert(pi,j):
if not member(muamad,mu1) then
 mu2:=mu2 union {muamad}:
fi:
od:
od:
 
mu2:
end:
 
 
 
 
#dWilfRed(n,i,Patterns): Wilf(n-1,i,Patterns)i-Wilf(n,i,Patterns),
#i.e. dWilf(n,i,Patterns) with the last element chopped
#and the rest reduced
 
dWilfRed:=proc(n,i,Patterns)
local gu,i1,perm,mu:
 
gu:={}:
mu:=dWilf(n,i,Patterns):
 
for i1 from 1 to nops(mu) do
perm:=op(i1,mu):
perm:=redu([op(1..n-1,perm)]):
gu:=gu union {perm}:
od:
 
gu:
 
end:
 
 
#Banim(per,Patterns): If per is a member of Wilf(n,Patterns)
#output its set of children that belong to Wilf(n+1,Patterns)
 
Banim:=proc(per,Patterns)
local n,gu,i,per1:
 
n:=nops(per):
 
if not member(per,Wilf(n,Patterns)) then
ERROR(` the first argument does not avoid the patterns `):
fi:
 
 
 
gu:={}:
 
for i from 1 to n+1 do
per1:=[op(1..i-1,per),n+1,op(i..n,per)]:
 
if member(per1,Wilf(n+1,Patterns)) then
gu:=gu union {per1}:
fi:
 
od:
 
gu:
end:
 
#BneiWilf(n,Patterns): A breakup of Wilf(n,Patterns)
#according to the number of children
#also returns the cardinalities
 
BneiWilf:=proc(n,Patterns)
local gu,i,mu,per,kama,mu1,MU,MU1:
 
gu:=Wilf(n,Patterns):
 
for i from 0 to n+1 do
mu[i]:={}:
od:
 
for i from 1 to nops(gu) do
per:=op(i,gu):
 
kama:=nops(Banim(per,Patterns)):
mu[kama]:=mu[kama] union {per}:
 
od:
 
for i from 0 to n+1 do
mu1[i]:=nops(mu[i]):
od:
 
mu,mu1:
 
MU:=[]:
MU1:=[]:
 
for i from 0 to n+1 do
MU:=[op(MU),mu[i]]:
MU1:=[op(MU1),mu1[i]]:
od:
MU,MU1:
 
end:
 
 
#Ruth(n,Patterns,tau,resh): Given an integer n
#and a set of patterns Patterns, and a prefix
#permutation of length k, and and increasing
#sequence resh of length nops(tau) between 1
#and n+nops(tau), returns all permutations 
#of length n+nops(tau) that
#start with resh arranged according to tau
#after the prefix is chopped off and
#the rest reduced, getting a certian subset
#of Wilf(n,Patterns)
 
Ruth:=proc(n,Patterns,tau,resh)
local i1, resh1:
 
if nops(resh)<>nops(tau) then
 ERROR(`Bad input`):
fi:
 
if nops(convert(tau,set))<>nops(tau) then
 ERROR(`Bad input`):
fi:
 
if nops(convert(resh,set))<>nops(resh) then
 ERROR(`Bad input`):
fi:
 
resh1:=[seq(resh[tau[i1]],i1=1..nops(tau))]:
WilfRedBeg(n,Patterns,resh1):
end:
 
 
 
tatkv:=proc(A,B):
 
if not (type(A,set) and type(B,set)) then
ERROR(`Bad Input`):
fi:
 
if A intersect B=A then
true:
else
false:
fi:
end:
 
 
#RuthSeriesI(n,Patterns,tau,resh1,r): Given a set
#of patterns Patterns, and a prefix permutation tau
#and a list, resh1, shorter by one than tau
#checks whether the sets Ruth(n,Patterns,tau,resh)
#with the resh ranging over all the ways of literally
#inserting a new element at the r^th place of resh1
#is an Increasing family, and if it is, returns the
#differences. If it fails, it returns 0 followed by the
#series itself
 
RuthSeriesI:=proc(n,Patterns,tau,resh1,r)
local resh,gu,katan,gadol,i,mu,mu1:
 
 
if r=1 then
katan:=1:
 
if nops(resh1)>0 then
 gadol:=op(1,resh1)-1:
else
 gadol:=n+1:
fi:
 
elif r=nops(resh1)+1 then
katan:=op(nops(resh1),resh1)+1:
gadol:=n+nops(tau):
else
katan:=op(r-1,resh1)+1:
gadol:=op(r,resh1)-1:
fi:
 
gu:=[]:
for i from katan to gadol do
resh:=[op(1..r-1,resh1),i,op(r..nops(resh1),resh1)]:
gu:=[op(gu),Ruth(n,Patterns,tau,resh)]:
od:
gu:
 
if gu=[] then
RETURN([]):
fi:
 
mu:=[gu[1]]:
 
for i from 2 to nops(gu) do
if not tatkv(gu[i-1],gu[i]) then
RETURN(0,gu):
fi:
mu:=[op(mu),gu[i] minus gu[i-1]]:
od:
 
 
mu:
 
end:
 
 
#RuthSeriesD(n,Patterns,tau,resh1,r): Given a set
#of patterns Patterns, and a prefix permutation tau
#and a list, resh1, shorter by one than tau
#checks whether the sets Ruth(n,Patterns,tau,resh)
#with the resh ranging over all the ways of literally
#inserting a new element at the r^th place of resh1
#is an Decreasing family, and if it is, returns the
#differences. If it fails, it returns 0 followed by the
#series itself
 
RuthSeriesD:=proc(n,Patterns,tau,resh1,r)
local resh,gu,katan,gadol,i,mu,mu1:
 
 
if r=1 then
katan:=1:
 
if nops(resh1)>0 then
 gadol:=op(1,resh1)-1:
else
 gadol:=n+1:
fi:
 
elif r=nops(resh1)+1 then
katan:=op(nops(resh1),resh1)+1:
gadol:=n+nops(tau):
else
katan:=op(r-1,resh1)+1:
gadol:=op(r,resh1)-1:
fi:
 
gu:=[]:
for i from katan to gadol do
resh:=[op(1..r-1,resh1),i,op(r..nops(resh1),resh1)]:
gu:=[op(gu),Ruth(n,Patterns,tau,resh)]:
od:
gu:
 
if gu=[] then
RETURN([]):
fi:
 
mu:=[]:
 
for i from 1 to nops(gu)-1 do
if not tatkv(gu[i+1],gu[i]) then
RETURN(0,gu):
fi:
mu:=[op(mu),gu[i] minus gu[i+1]]:
od:
 
mu:=[op(mu),gu[nops(gu)]]:
mu:
 
end:
 
 
#IsItDec(n,Patterns,tau,r): Is it true or false that
#the sets obtained from Ruth(n,Patterns,tau,resh), by varying
#the r^th component of resh is always increasing
 
IsItDec:=proc(n,Patterns,tau,r)
local resh1,gu,i,mu:
gu:=IV(n+nops(tau),nops(tau)-1):
 
for i from 1 to nops(gu) do
resh1:=op(i,gu):
mu:=RuthSeriesD(n,Patterns,tau,resh1,r):
if nops([mu])=2 then
RETURN(false):
fi:
od:
true:
end:
 
 
 
#IsItInc(n,Patterns,tau,r): Is it true or false that
#the sets obtained from Ruth(n,Patterns,tau,resh), by varying
#the r^th component of resh is always increasing
 
IsItInc:=proc(n,Patterns,tau,r)
local resh1,gu,i,mu:
gu:=IV(n+nops(tau),nops(tau)-1):
 
for i from 1 to nops(gu) do
resh1:=op(i,gu):
mu:=RuthSeriesI(n,Patterns,tau,resh1,r):
if nops([mu])=2 then
RETURN(false):
fi:
od:
true:
end:
 
 
#Nusins(pi,pattern): The number of occurences of pattern
#in Patterns in the perms pi
 
Nusins:=proc(pi,pattern)
local gu,k,n,per1,vec,i1,i,mu:
n:=nops(pi):
k:=nops(pattern):
 
mu:=IV(n,k):
 
gu:=0:
 
for i from 1 to nops(mu) do
 vec:=op(i,mu):
 per1:=[seq(pi[vec[i1]],i1=1..nops(vec))]:
 
 if redu(per1)=pattern then
  gu:=gu+1:
 fi:
od:
gu:
 
end:
 
 
#NuSins(pi,Patterns): The number of occurences of the patterns
#in the set Patterns in Patterns in the perms pi
NuSins:=proc(pi,Patterns)
local gu,i:
gu:=0:
 
for i from 1 to nops(Patterns) do
gu:=gu+Nusins(pi,op(i,Patterns)):
od:
gu:
end:
 
#SINS(n,Patterns): A breakup of the permutations
#of {1,2,...,n} according to the number of sins
#(i.e. the number of occurrences of the patterns
#in Patterns)
SINS:=proc(n,Patterns)
local gu,mu,i,kama,per,DEJA:
option remember:
with(combinat):
mu:=permute(n):
DEJA:={}:
 
for i from 1 to nops(mu) do
per:=op(i,mu):
kama:=NuSins(per,Patterns):
 
if member(kama,DEJA) then
 gu[kama]:=gu[kama] union {per}:
else
 DEJA:=DEJA union {kama}:
 gu[kama]:={per}:
fi:
 
od:
 
gu:
 
end:
 
 
#GWilf(n,r,Patterns): The set of permutations of [1,n]
#avoiding the patterns in Patterns and having exactly
#r occurrences of the patterns in Patterns
GWilf:=proc(n,r,Patterns):
SINS(n,Patterns)[r]:
end: