######################################################################
##AVOID: Save this file as  AVOID                                    #
## To use it, stay in the                                            #
##same directory, get into Maple (by typing: maple <Enter> )         #
##and then type:  read REK<Enter>                                    #
##Then follow the instructions given there                           #
##                                                                   #
##Written by Doron Zeilberger, Rutgers University ,                  #
#zeilberg at math dot rutgers dot edu                                #
######################################################################
 
#Created: April 2015
 
print(`Created:  April 2015`):
print(` This is AVOID `):
print(` A maple package for generating and counting permutations that avoid a specified subset of permutations`):
print(`It is one of the packages that accompany the article `):
print(`Y`):
print(`by Shalosh B. Ekhad, Nathaniel Shar, and Doron Zeilberger`):

print(`and also available from Zeilberger's website`):
print(``):
print(`Please report bugs to zeilberg at math dot rutgers dot edu`):
print(``):
 print(`The most current version of this  package and paper`):
 print(` are  available from`):
 print(`http://www.math.rutgers.edu/~zeilberg/  .`):

print(`---------------------------------------`):
 print(`For a list of the Supporting procedures type ezra1();, for help with`):
 print(`a specific procedure, type ezra(procedure_name);   .`):
 print(``):
print(`---------------------------------------`):

print(`---------------------------------------`):
 print(`For a list of the MAIN procedures type ezra();, for help with`):
 print(`a specific procedure, type ezra(procedure_name);   .`):
 print(``):
print(`---------------------------------------`):



with(combinat):

ezra1:=proc()

if args=NULL then
 print(` The supporting procedures are: CleanUp, CleanUp1, ImplliedM , IsSubWord, IV, Nake, Pats, SpellOut, SubWords  `):
 print(``):

else
ezra(args):
fi:

end:

ezra:=proc()

if args=NULL then
 print(`The main procedures are:  Kids, KidsP, Kitot, NuP, NuW, Perms, Pranks, PranksV RNuP, RPerms,SeqW, WC `):
 print(` `):


elif nops([args])=1 and op(1,[args])=CleanUp then
print(`CleanUp(S): simplifies S such that no word is a subword of another one`):
print(`Try: `):
print(`CleanUp({[1,2],[1,3,2],[1,2,4]}); `):

elif nops([args])=1 and op(1,[args])=CleanUp1 then
print(`CleanUp1(S): finds whether one of the members of S can be kicked out`):
print(`and kicks it out, if it exists`):

elif nops([args])=1 and op(1,[args])=ImpliedM then
print(`ImplliedM(i,S,n): Given a set of mistakes , S, that permutations of {1, ...,n}, may not contain, outputs the set of mistakes`):
print(`that the the permutations obtained by chopping the first entry, if it is i, and then reducing every`):
print(`entry larger than i by 1. Try: `):
print(` ImpliedM(2,{[1,2,4],[2,3,4]},n); `):

elif nops([args])=1 and op(1,[args])=IsSubWord then
print(`IsSubWord(w1,w1): Is w1 a subsword of w2? Try: `):
print(` IsSubWord([1,3],[1,2,3]); `):

elif nops([args])=1 and op(1,[args])=IV then
print(`IV(n,k): The set of all  increasing sequences [i1,...,ik] such that 1<=i1<i2<...<ik<=n, Try: `):
print(` IV(5,3); `):


elif nops([args])=1 and op(1,[args])=Kids then
print(`Kids(T): Inputs a state T=[n,S] where S is a set of actual patterns and we are interested`):
print(`in permutations of {1,...,n} avoiding the patterns in S, outputs its children state`):
print(`fulfillied by chopping the first letter (and reducing) if it is i=1, ...,n, so the`):
print(`output is a list of states of length n whose first component is n-1. Try:`):
print(`Kids([4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]}]);`):

elif nops([args])=1 and op(1,[args])=KidsP then
print(`KidsP(T): Inputs a state T=[n,S] where S is a set of actual patterns and we are interested`):
print(`in permutations of {1,...,n} avoiding the patterns in S, outputs its children state`):
print(`fulfillied by chopping the first letter (and reducing) if it is i=1, ...,n, so the`):
print(`output is a list of pairs [coeff, state], states of length n whose first component is n-1. and the coeff is the`):
print(`multiplicity Try:`):
print(`KidsP([4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]}]);`):

elif nops([args])=1 and op(1,[args])=Kitot then
print(`Kitot(k,d): All the classes that give the same enumeration for patterns of length k up to k+d`):
print(`Try: `):
print(`Kitot(5,2);`):


elif nops([args])=1 and op(1,[args])=Nake then
print(`Nake(n,S): inputs a positive integer n, and a set of words in {1,...,n}`):
print(`outputs a pair`):
print(` [coeff,[k,S1]] where k<=n and S1 is hopefully simpler than S and such that `):
print(`  NuP(n,S)=coeff*NuP(k,S1). Try `):
print(` Nake(3,{[2,3]}); `):

elif nops([args])=1 and op(1,[args])=NuP then
print(`NuP(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,`):
print(`outputs the NUMBER of n-permutations that do not contain, as subwords the members of S. Try:`):
print(`NuP(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});`):


elif nops([args])=1 and op(1,[args])=NuW then
print(`NuW(n,tau): The NUMBER of permutations of length n avoiding the pattern tau. Try:`):
print(`NuW(5,[1,2,3]);`):


elif nops([args])=1 and op(1,[args])=Pats then
print(`Pats(k): a set of representaives from each trivial Wilf-equivalence class`):

elif nops([args])=1 and op(1,[args])=Perms then
print(`Perms(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,`):
print(`outputs the set of n-permutations that do not contain, as subwords the members of S. Try:`):
print(`Perms(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});`):

elif nops([args])=1 and op(1,[args])=Pranks then
print(`Pranks(k,N): inputs a positive integer, outputs the list of pairs [S,ListOfFirstNtermsWilfClassAvoidingS]`):
print(`arranged lexicographically, for all single patterns of size k, For example try:`):
print(`Pranks(3,7);`):

elif nops([args])=1 and op(1,[args])=PranksV then
print(`PranksV(k,N): verbose form  of Pranks(k,N) (q.v.). Try: `):
print(`PranksV(3,7);`):

elif nops([args])=1 and op(1,[args])=RNuP then
print(`RNuP(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,`):
print(`outputs the NUMBER of n-permutations that DO contain, as subwords one the members of S. Try:`):
print(`RNuP(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});`):

elif nops([args])=1 and op(1,[args])=RPerms then
print(`RPerms(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,`):
print(`outputs the set of n-permutations that DO CONTAION, as subwords, one of the members of S. Try:`):
print(`RPerms(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});`):

elif nops([args])=1 and op(1,[args])=SeqW then
print(`SeqW(N,tau): The sequence, from n=nops(tau) to n=N, for number of permutations of length n avoiding the pattern tau. Try:`):
print(`SeqW(8,[1,2,3]);`):

elif nops([args])=1 and op(1,[args])=SpellOut then
print(`SpellOut(tau,n): inputs a pattern tau  and a positive integer n outputs the set of all manifestations of tau.`):
print(` Try: `):
print(` SpellOut([2,1,3],4); `):

elif nops([args])=1 and op(1,[args])=SubWords then
print(`SubWords(w,k): all the subwords of w of length k. Try:`):
print(`SubWords([1,4,3],2);`):

elif nops([args])=1 and op(1,[args])=WC then
print(`WC(n,tau): The set of permutations of length n avoiding the pattern tau. Try:`):
print(`WC(5,[1,2,3]);`):

else
print(`There is no ezra for`,args):
fi:
 
end:

#####################from VATTER#############

hofkhi:=proc(pi)  local i, T:
for  i from 1 to nops(pi) do
T[pi[i]]:=i:
od:
[seq(T[i],i=1..nops(pi))]:
end:

Hofkhi:=proc(S)  local i:
 {seq(hofkhi(S[i]),i=1..nops(S))}:
end:

#revers(perm): The reverse of a permutation
revers:=proc(perm)
local i:
[seq(perm[nops(perm)-i+1],i=1..nops(perm))]:
end:
 

#khaverim(pat): Given a  pattern  outputs
#all the images under the trivial-Wilf-equivalence group
#For example, try: khaverim([1,2,3]);
khaverim:=proc(pat):
{pat, revers(pat),hofkhi(pat),
revers(hofkhi(pat)),hofkhi(revers(pat)),
hofkhi(revers(hofkhi(pat))),
revers(hofkhi(revers(pat))),
hofkhi(revers(hofkhi(revers(pat))))}:
end:

#Pats(k): a set of representaives from each trivial Wilf-equivalence class
Pats:=proc(k) local mu,gu:
mu:=convert(permute(k),set):
gu:={}:

while mu<>{} do
 gu:=gu union {mu[1]}:
mu:=mu minus khaverim(mu[1]):
od:
gu:


end:

#####################End from VATTER#############


#ImplliedM(i,S,n): Given a set of mistakes that permutations of length n may not contain, outputs the set of mistakes
#that the the permutations obtained by chopping the first entry, i, and then reducing it to from {1,..,i-1,i+1, ..n}
#to {1, ..., n-1}. Try:
#ImpliedM(2,{[1,2,4],[2,3,4]},4);

ImpliedM:=proc(i,S,n) local S1,w,j:

S1:={}:

for w in S do

 if not member(i,w) then
   S1:= S1 union {w}:
 elif w[1]=i then
   S1:=S1 union {[op(2..nops(w),w)]}:
 fi:
od:

subs({seq(j=j-1,j=i+1..n)},S1):

end:

   
#Perms(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,
#outputs the set of n-permutations that do not contain, as subwords the members of S. Try:
#Perms(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});
Perms:=proc(n,S) local gu,i,mu,S1,j,mu1:
option remember:

if n=0 then
 if member([],S) then
   RETURN({}):
 else
  RETURN({[]}):
fi:
fi:

gu:={}:

for i from 1 to n do

 S1:=ImpliedM(i,S,n):

  mu:=Perms(n-1,S1):

  mu:=subs({seq(j=j+1,j=i..n-1)},mu):
  mu:={seq([i,op(mu1)],mu1 in mu)}:
  gu:=gu union mu:

od:

gu:

end:



#IV(n,k): The set of all  increasing sequences [i1,...,ik] such that 1<=i1<i2<...<ik<=n, Try:
#IV(5,3);
IV:=proc(n,k) local lu,j,lu1:
option remember:
if k=0 then
 RETURN({[]}):
fi:

if k=1 then
 RETURN({seq([j],j=1..n)}):
fi:

lu:=IV(n,k-1):


{seq(seq([op(lu1),j],j=lu1[k-1]+1..n),lu1 in lu)}:


end:


#SpellOut(tau,n): inputs a pattern tau  and a positive integer n outputs the set of all manifestations of tau.
#Try:
#SpellOut([2,1,3],4);
SpellOut:=proc(tau,n) local k,gu,i,gu1:

k:=nops(tau):
if k>n then
 RETURN({}):
fi:

gu:=IV(n,k):

{seq(subs({seq(i=gu1[i], i=1..k)},tau),gu1 in gu)}:

end:


#WC(n,tau): The set of permutations of length n avoiding the pattern tau. Try:
#WC(5,[1,2,3]);
WC:=proc(n,tau) 
option remember:
Perms(n,SpellOut(tau,n)):
end:


#NuPold(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,
#outputs the number of n-permutations that do not contain, as subwords the members of S. Try:
#NuPold(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});
NuPold:=proc(n,S) local i:
option remember:

if n=0 then
 if member([],S) then
   RETURN(0):
 else
  RETURN(1):
fi:
fi:



add(NuPold(n-1, ImpliedM(i,S,n)),i=1..n):

end:

#NuPold(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,
#outputs the number of n-permutations that do not contain, as subwords the members of S. Try:
#NuPold(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});
NuPold:=proc(n,S) local i:
option remember:

if n=0 then
 if member([],S) then
   RETURN(0):
 else
  RETURN(1):
fi:
fi:



add(NuPold(n-1, CleanUp(ImpliedM(i,S,n))),i=1..n):

end:

#NuWold(n,tau): The number of permutations of length n avoiding the pattern tau. Try:
#NuWold(5,[1,2,3]);
NuWold:=proc(n,tau) 
option remember:
NuPold(n,SpellOut(tau,n)):
end:

#NuWold(n,tau): The number of permutations of length n avoiding the pattern tau. Try:
#NuWold(5,[1,2,3]);
NuWold:=proc(n,tau) 
option remember:
NuPold(n,SpellOut(tau,n)):
end:

#NuW(n,tau): The number of permutations of length n avoiding the pattern tau. Try:
#NuW(5,[1,2,3]);
NuW:=proc(n,tau) 
option remember:
NuP(n,SpellOut(tau,n)):
end:


#Kids(T): Inputs a state T=[n,S] where S is a set of actual patterns and we are interested
#in permutations of {1,...,n} avoiding the patterns in S, outputs its children state
#fulfillied by chopping the first letter (and reducing) if it is i=1, ...,n, so the
#output is a list of states of length n whose first component is n-1. Try:
#Kids([4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]}]);
Kids:=proc(T) local i,n,S:
option remember:

n:=T[1]:
S:=T[2]:

[seq([n-1,CleanUp(ImpliedM(i,S,n))],i=1..n)]:

end:


#IsSubWord(w1,w1): Is w1 a subsword of w2? Try
#IsSubWord([1,3],[1,2,3]);
IsSubWord:=proc(w1,w2) local k,n,gu,gu1,i1:
k:=nops(w1):
n:=nops(w2):

if k>n then
 RETURN(false):
fi:

gu:=IV(n,k):

for gu1 in gu do

 if [seq(w2[gu1[i1]],i1=1..k)]=w1 then
   RETURN(true):
 fi:

od:

false:

end:


#CleanUp1(S): finds whether one of the members of S can be kicked out
#and kicks it out, if it exists
CleanUp1:=proc(S) local w1,w2:

for w1 in S do
 for w2 in S minus {w1} do
  if  IsSubWord(w1,w2)  then
     RETURN(S minus {w2}):
  fi:
od:
od:

S:

end:

#CleanUpOld(S): cleans up the set of words S such that none is a subword of another word
CleanUpOld:=proc(S) local S1,S2:

S1:=S:

S2:=CleanUp1(S1):

while S1<>S2 do
S1:=S2:
S2:=CleanUp1(S1):
od:
S1:
end:

#CleanUp(S): cleans up the set of words S such that none is a subword of another word
CleanUp:=proc(S) local S1,T,ma,i,w,j:

if nops({seq(nops(w), w in S)})=1 then
  RETURN(S):
fi:

ma:=max(seq(nops(w), w in S)):

for i from 1 to ma do
 T[i]:={}:
od:

for w in S do
 T[nops(w)]:=T[nops(w)] union {w}:
od:

S1:=S:
for i from 1 to ma do
 for w in T[i] do
   for j from 1 to i-1 do
     if SubWords(w,j) intersect T[j]<>{} then
       S1:=S1 minus {w}:
     fi:
   od:
 od:
od:
S1:

end:


#Kitot(k,d): All the classes that give the same enumeration for patterns of length k up to k+d
#Try:
#Kitot(5,2);
Kitot:=proc(k,d) local gu,tau,T,mu,S,mu1,i:
gu:=permute(k):

for tau in gu do
T[tau]:=[seq(NuW(i,tau) ,i=k..k+d)]:
od:

mu:={seq(T[tau],tau in gu)}:

for mu1 in mu do

 S[mu1]:={}:

od:

for tau in gu do
 S[T[tau]]:=S[T[tau]] union {tau}:
od:

[seq([mu1,S[mu1]],mu1 in mu)]:

end:



#SeqWold(N,tau): The sequence, from n=nops(tau) to n=N, for number of permutations of length n avoiding the pattern tau. Try:
#SeqWold(8,[1,2,3]);
SeqWold:=proc(N,tau)  local n:
[seq(NuWold(n,tau),n=nops(tau)..N)]:
end:


#SeqW(N,tau): The sequence, from n=nops(tau) to n=N, for number of permutations of length n avoiding the pattern tau. Try:
#SeqW(8,[1,2,3]);
SeqW:=proc(N,tau)  local n:
[seq(NuW(n,tau),n=nops(tau)..N)]:
end:







####from NewWilf
#IsLexBigger(L1,L2): Is list L2 lex. bigger than list L1? Try
#IsLexBigger([3,4,6],[3,4,7]);
IsLexBigger:=proc(L1,L2) local i,k:

k:=min(nops(L1),nops(L2)):

if L1=L2 then
 RETURN(true):
fi:

for i from 1 to k while L1[i]=L2[i] do od:

evalb(L1[i]-L2[i]>0):

end:

#Pranks(k,N): inputs a positive integer, outputs the list of pairs [S,ListOfFirstNtermsWilfClassAvoidingS]
#arranged lexicographically, for all single patterns of size k, For example try:
#Pranks(3,7);
Pranks:=proc(k,N) local mu,gu,lu,i,i1:
mu:=Pats(k):

lu:=SeqW(N,mu[1]):

gu:=[[mu[1],lu]]:

for i from 2 to nops(mu) do


 lu:=SeqW(N,mu[i]):



for i1 from 1 to nops(gu) while IsLexBigger(lu,gu[i1][2]) do od:

gu:=[op(1..i1-1,gu),[mu[i],lu],op(i1..nops(gu),gu)]:

od:

gu:

end:


#PranksV(k,N): Verbose form of  Pranks(L,N) (q.v.) 
#Try:
#PranksV(3,7);
PranksV:=proc(k,N) local t0, gu,mu,i:
t0:=time():
gu:=Pranks(k,N):
mu:={seq(gu[i][2],i=1..nops(gu))}:
print(`The first`, N, `terms of all Wilf classes avoiding a single pattern of length`, k):
print(``):
print(`Up to trivial symmetry, there are `, nops(gu), `distinct patterns of length`, k):
print(`but judging from the first`, N, `terms, there are  only`, nops(mu), `of them. Here there are, arranged in lexicographic order `):

lprint(gu[1]):

for i from 2 to nops(gu) do
 if gu[i][2]=gu[i-1][2] then
  lprint(gu[i][1], ` " `):
 else
  lprint(gu[i]):
 fi:
od:

print(`This took`, time()-t0, `seconds. `):

end:

####End from NewWilf



#SubWords(w,k): all the subwords of w of length k. Try:
#SubWords([1,4,3],2);
SubWords:=proc(w,k) local gu,gu1,i1:
option remember:

if k>nops(w) then
 RETURN({});
 
elif k=nops(w) then

 RETURN({w});

else
gu:=IV(nops(w),k):

RETURN({seq([seq(w[gu1[i1]],i1=1..k)],gu1 in gu)}):

fi:
end:





#PranksOld(k,N): inputs a positive integer, outputs the list of pairs [S,ListOfFirstNtermsWilfClassAvoidingS]
#arranged lexicographically, for all single patterns of size k, For example try:
#PranksOld(3,7);
PranksOld:=proc(k,N) local mu,gu,lu,i,i1:
mu:=Pats(k):

lu:=SeqWold(N,mu[1]):

gu:=[[mu[1],lu]]:

for i from 2 to nops(mu) do


 lu:=SeqWold(N,mu[i]):



for i1 from 1 to nops(gu) while IsLexBigger(lu,gu[i1][2]) do od:

gu:=[op(1..i1-1,gu),[mu[i],lu],op(i1..nops(gu),gu)]:

od:

gu:

end:


#Nake(n,S): inputs a positive integer n, and a set of words in {1,...,n}
#outputs a pair
#[coeff,[k,S1]] where k<=n and S1 is hopefully simpler than S and such that
# NuP(n,S)=coeff*NuP(k,S1). Try
#Nake(3,{[2,3]});
Nake:=proc(n,S) local Mish,i,k,s1,T:
Mish:={seq(op(s1),s1 in S)}:
if nops(Mish)=n then
 RETURN([1,[n,S]]):
fi:

k:=nops(Mish):
Mish:=sort(convert(Mish,list)):
T:=subs({seq(Mish[i]=i,i=1..k)},S):
[binomial(n,k)*(n-k)!,[k,T]]:
end:

#NuPyashan(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,
#outputs the number of n-permutations that do not contain, as subwords the members of S. Try:
#NuPuashan(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});
NuPyashan:=proc(n,S) local i,lu,T,ka:
option remember:

if n=0 then
 if member([],S) then
   RETURN(0):
 else
  RETURN(1):
fi:
fi:



lu:=0:

for i from 1 to n do
 T:=CleanUp(ImpliedM(i,S,n)):
 ka:=Nake(n-1,T):
 lu:=lu+ka[1]*NuPyashan(op(ka[2])):
od:

lu:


end:


#CleanUpP(n,S): cleans up the set of words S such that none is a subword of another word
CleanUpP:=proc(n,S) local S1,T,ma,i,w,j:

if nops({seq(nops(w), w in S)})=1 then
  RETURN([1,[n,S]]):
fi:

ma:=max(seq(nops(w), w in S)):

for i from 1 to ma do
 T[i]:={}:
od:

for w in S do
 T[nops(w)]:=T[nops(w)] union {w}:
od:

S1:=S:
for i from 1 to ma do
 for w in T[i] do
   for j from 1 to i-1 do
     if SubWords(w,j) intersect T[j]<>{} then
       S1:=S1 minus {w}:
     fi:
   od:
 od:
od:

Nake(n,S1):

end:

#NuPdep(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,
#outputs the number of n-permutations that do not contain, as subwords the members of S. Try:
#NuPdep(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});
NuPdep:=proc(n,S) local i,lu,ka:
option remember:

if n=0 then
 if member([],S) then
   RETURN(0):
 else
  RETURN(1):
fi:
fi:



lu:=0:

for i from 1 to n do
 ka:=CleanUpP(n-1,ImpliedM(i,S,n)):
 lu:=lu+ka[1]*NuPdep(op(ka[2])):
od:

lu:


end:




#KidsP(T): Inputs a state T=[n,S] where S is a set of actual patterns and we are interested
#in permutations of {1,...,n} avoiding the patterns in S, outputs its children state
#fulfillied by chopping the first letter (and reducing) if it is i=1, ...,n, so the
#output is a list of states of length n whose first component is n-1. Try:
#KidsP([4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]}]);
KidsP:=proc(T) local i,n,S:
option remember:

n:=T[1]:
S:=T[2]:

[seq(CleanUpP(n-1,ImpliedM(i,S,n)),i=1..n)]:

end:


#NuP(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,
#outputs the number of n-permutations that do not contain, as subwords the members of S. Try:
#NuP(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});
NuP:=proc(n,S) local Y,i:
option remember:

if n=0 then
 if member([],S) then
   RETURN(0):
 else
  RETURN(1):
fi:
fi:


Y:=KidsP([n,S]):

add(Y[i][1]*NuP(op(Y[i][2])),i=1..nops(Y)):

end:



###start bad guys



#RPerms(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,
#outputs the set of n-permutations that DO Contain, as subwords the members of S. Try:
#RPerms(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});
RPerms:=proc(n,S) local gu,i,mu,S1,j,mu1:
option remember:

if n=0 then
 if member([],S) then
   RETURN({[]}):
 else
  RETURN({}):
fi:
fi:

gu:={}:

for i from 1 to n do

 S1:=ImpliedM(i,S,n):

  mu:=RPerms(n-1,S1):

  mu:=subs({seq(j=j+1,j=i..n-1)},mu):
  mu:={seq([i,op(mu1)],mu1 in mu)}:
  gu:=gu union mu:

od:

gu:

end:


#RNuP(n,S): Inputs a positive inetger n, and a set of words in {1,..n} with distinct letters,
#outputs the number of n-permutations that do not contain, as subwords the members of S. Try:
#RNuP(4,{[1,2,3],[1,2,4],[1,3,4],[2,3,4]});
RNuP:=proc(n,S) local Y,i:
option remember:

if n=0 then
 if member([],S) then
   RETURN(1):
 else
  RETURN(0):
fi:
fi:


Y:=KidsP([n,S]):

add(Y[i][1]*RNuP(op(Y[i][2])),i=1..nops(Y)):

end: