#C27.txt,  Dec. 8, 2016 Pattern Avoiding Permutations
Help:=proc(): print(` redu(L), IV(n,k) , IsBad(pi,P) , GG(n,P) , SeqGG(P,N), GP1(L.n,d), GP(L,n) `): end:

with(combinat):

#inputs a list of numbers, and outputs the reduction as a permutation of nops(L)
#redu([e,pi,gamma,phi, h])=[ 4, 5 , 2 , 3    ,1]
redu:=proc(L) local L1,T,k,i:
L1:=sort(sort(L,'output'='permutation'),'output'='permutation'):

end:

#IV(n,k): the set of increasing vectors of length k in {1, ...,n} ending in n
IV:=proc(n,k) local S,i,s:
S:=choose([seq(i,i=1..n-1)],k-1):
{seq([op(s), n], s in S)}:
end:

 #IsBad1(pi,p): inputs a perm. pi and a pattern p outputs true iff pi contains the pattern p
 #where the last entry of pi participates
 IsBad1:=proc(pi,p) local S,n,k,s:
  n:=nops(pi):
  k:=nops(p):
  S:=IV(n,k):
  for s in S do
   if redu(pi[s])=p then
      RETURN(true):
   fi:
  od:

 false: 
   end:
 #inputs a permutation pi and a set of patterns P and outputs true if
 #it contains at least one member of P
 IsBad:=proc(pi,P) local p:
 for p in P do
  if IsBad1(pi,p) then
     RETURN(true):
   fi:
 od:
  false:
 end:
   
   #inputs a non-neg. integer n and a set of patterns P and outputs the
   #set of permutations avoiding the patterns of P 
   GG:=proc(n,P) local Sold,S, i,cand,pi:
   option remember:
    if n=0 then
       RETURN({[]}):
    fi:
    Sold:=GG(n-1,P):
    S:={}:

    for pi in Sold do
     for i from 0 to n-1 do
     cand:=redu([op(pi),i+1/2]):
     if not IsBad(cand,P) then
        S:=S union {cand}:
     fi:
     od:
   od:
    S:
     end:
  
   #SeqGG(P,N): inputs a set of patterns P, and a positive integer N
    #returns the list of length N whose i-th entry is the NUMBER of permutations
    #of length i NOT containing any of the patterns in P
   SeqGG:=proc(P,N) local i:
    [seq( nops(GG(i,P)),i=1..N)]:
   end:


#GP1(L,n,d): inputs a list of pairs [input,output], and a variable n
#and outputs a polynomial of degree d such P(input)=output
GP1:=proc(L,n,d) local P,i,a,var,eq:
if d>=nops(L)-2 then
 RETURN(FAIL):
fi:
P:=add(a[i]*n^i,i=0..d):
var:={seq(a[i],i=0..d)}:
eq:={seq(subs(n=L[i][1],P)=L[i][2],i=1..d+2)}:
var:=solve(eq,var):

if var=NULL then
  RETURN(FAIL):
fi:

P:=subs(var,P):

if {seq(subs(n=L[i][1],P)-L[i][2],i=d+3..nops(L))}<>{0} then

  RETURN(FAIL):
else
 RETURN(P):
fi:

end:




#GP(L,n): inputs a list of pairs [input,output], and a variable n
#and outputs a polynomial of degree <=nops(L) such P(input)=output
GP:=proc(L,n) local d,hope:
for d from 0 to nops(L)-2 do
 hope:=GP1(L,n,d):
 if hope<>FAIL then
   RETURN(hope):
 fi:
od:
FAIL:
end: