######################################################################
##EHRENBORG: Save this file as EHRENBORG. To use it, stay in the     #
##same directory, get into Maple (by typing: maple <Enter> )         #
##and then type:  read EHRENBORG : <Enter>                           #
##Then follow the instructions given there                           #
##                                                                   #
##Written by Doron Zeilberger, Rutgers University ,                  #
#zeilberg@math.Rutgers.edu.                                          # 
######################################################################

#Created: June 28, 2002
#This version: June 28, 2002
#EHRENBORG: A Maple package to study the number of Down-Up Involutions
#Please report bugs to zeilberg@math.Rutgers.edu



print(`Created: June 28, 2002`):
print(`This version: June 28, 2002`):
lprint(``):
print(`This is EHRENBORG, a small Maple package to study`):
print(`the number of Down-Up Involutions (and more general kinds)`):
print(`Inspired by a (false) conjecture of Richard Ehrenborg`):
print(`and Margie Readdy Accompanying the article: `):
print(` I am Sorry, Richard Ehrenborg and Margie Readdy,`):
print(`About Your Two Conjectures:`):
print(`But One is FAMOUS, while the other is FALSE`):
print(`by Doron Zeilberger `):
print(`Published in the Personal Journal of Ekhad and Zeilberger`):
print(`http://www.math.rutgers.edu/~zeilberg/pj.html `):
print(``):

print(`Program Written by Doron Zeilberger, zeilberg@math.rutgers.edu`):
lprint(``):
print(`Please report bugs to zeilberg@math.rutgers.edu`):
lprint(``):
 print(`The most current version of this  package and paper`):
 print(` are  available from`):
 print(`http://www.math.rutgers.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(`Contains the following procedures: DUI, DUIslow, Inv, iRS, `):
 print(` nDUI, nInv, RS `):
fi:

if nops([args])=1 and op(1,[args])=DUI then
print(`DUI(n):The set of Down-Up involutions on {1,2, ...n}`):
print(`For example to get the set of Down-Up involutions of length 6`):
print(` type: DUI(6); `):
fi:

if nops([args])=1 and op(1,[args])=DUIslow then
print(`DUIslow(n): A slow version of DUI(n). Its only purpose is`):
print(`to test DUI(n). Starting at n=11 it is too slow`):
print(`For example to get, slowly,`):
print(` the set of Down-Up involutions of length 10`):
print(` type: DUIslow(10); `):
fi:

if nops([args])=1 and op(1,[args])=Inv then
print(`Inv(w,n): The set of involutions on [1,n] that obey the `):
print(`up(1)-down(-1) `):
print(`and don't care (0) pattern w, for example to get the set of`):
print(`involutions pi on [1,4]  with pi[1]<pi[2], pi[2]>pi[3], and `):
print(`pi[4]<pi[5]  (pi[3] may be larger or smaller than pi[4]) type:`):
print(`Inv([1,-1,0,1],5);`):
fi:

if nops([args])=1 and op(1,[args])=iRS then
print(`iRS(tab1,tab2):The inverse of the Robinson-Schenstead`):
print(` correspondence. For example, try:`):
print(` iRS([[1,3],[2]],[[1,2],[3]]); `):
fi:

if nops([args])=1 and op(1,[args])=nDUI then
print(`nDUI(n):The number of Down-Up involutions on {1,2, ...n}`):
print(`For example to disprove Ehrenborg and Readdy's conjecture`):
print(`that the number of Down-Up involutions of length 2k is k!`):
print(`type: nDUI(12); `):
print(`It is NOT equal to 6! `):
fi:

if nops([args])=1 and op(1,[args])=nInv then
print(`The number of involutions on [1,n] that obey the up(1)-down(-1) `):
print(`and don't care (0) pattern w, for example to get the  number of`):
print(`involutions pi on [1,4]  with pi[1]<pi[2], pi[2]>pi[3], and `):
print(`pi[4]<pi[5]  (pi[3] may be larger or smaller than pi[4]) type:`):
print(`nInv([1,-1,0,1],5);`):
fi:

if nops([args])=1 and op(1,[args])=RS then
print(`RS(perm): The Robinson Schenstead-Correspondence`):
print(`For example, try: RS([4,1,2,3]);`):
fi:
end:



#Adjs(per,i): raises all entries >=i by i
Adjs:=proc(per,i)
local j,per1:
per1:=[]:
for j from 1 to nops(per) do
 if per[j]<i then
  per1:=[op(per1),per[j]]:
 else
  per1:=[op(per1),per[j]+1]:
 fi:
od:
per1:
end:




#All the involutions on [1,n] that obey the up(1)-down(-1) 
#and don't care (0) pattern w
Inv:=proc(w,n)
local gu,i:
gu:={}:
for i from 1 to n do
gu:=gu union Inv1(w,n,i):
od:
gu:
end:

#Inv1(w,n,i): All involutions obeying w of [1,n] ending with i
Inv1:=proc(w,n,i)
local w1,lu,gu,i1,perm,j:
option remember:


if nops(w)<>n-1 then
 ERROR(`Length of first input must be one less than second input`):
fi:

if n=1 then
RETURN({[1]}):
fi:

if n=2 then
 if i=1 then 
    if not w[1]=1 then
     RETURN({[2,1]}):
    else
     RETURN({}):
    fi:
  elif i=2 then
   if not w[1]=-1 then
      RETURN({[1,2]}):
   else
    RETURN({}):
   fi:
else
ERROR(`bad input`):
fi:
fi:
     
if i=n then
if w[n-1]=-1 then
RETURN({}):
else
w1:=[op(1..n-2,w)]:
lu:=Inv(w1,n-1):
gu:={}:
for i1 from 1 to nops(lu) do
 gu:=gu union {[op(lu[i1]),n]}:
od:
RETURN(gu):
fi:
fi:

if i=1 then
if w[n-1]=1 or w[1]=1 then
 RETURN({}):
else
w1:=[op(2..n-2,w)]:
lu:=Inv(w1,n-2):
gu:={}:
  for i1 from 1 to nops(lu) do
    gu:=gu union {[n,op(Adjs(lu[i1],1)),1]}:
  od:
RETURN(gu):
fi:
fi:


if i=n-1 then
 if w[n-1]=1 or w[n-2]=-1 then
   RETURN({}):
 else
  w1:=[op(1..n-3,w)]:
 lu:=Inv(w1,n-2):
   gu:={}:
  for i1 from 1 to nops(lu) do
   gu:=gu union {[op(lu[i1]),n,n-1]}:
  od:
RETURN(gu):
fi:
fi:

if w[i-1]=-1 or w[i]=1 then
 RETURN({}):
fi:

w1:=[op(1..i-2,w),0,op(i+1..n-2,w)]:


if w[n-1]=0 then

 lu:=Inv(w1,n-2):
   gu:={}:
   for i1 from 1 to nops(lu) do
     perm:=Adjs(lu[i1],i):
     gu:=gu union {[op(1..i-1,perm),n,op(i..n-2,perm),i]}:
   od:
RETURN(gu):
fi:


if w[n-1]=1 then
  lu:={}:
    for j from 1 to i-1 do
     lu:=lu union Inv1(w1,n-2,j):
    od:
   gu:={}:
   for i1 from 1 to nops(lu) do
     perm:=Adjs(lu[i1],i):
     gu:=gu union {[op(1..i-1,perm),n,op(i..n-2,perm),i]}:
   od:
RETURN(gu):
fi:


if w[n-1]=-1 then
  lu:={}:
    for j from i to n-2 do
     lu:=lu union Inv1(w1,n-2,j):
    od:
   gu:={}:
   for i1 from 1 to nops(lu) do
     perm:=Adjs(lu[i1],i):
     gu:=gu union {[op(1..i-1,perm),n,op(i..n-2,perm),i]}:
   od:
RETURN(gu):
fi:
 
end:

DUI:=proc(n)
local w,i:
if n mod 2=1 then
w:=[seq(op([-1,1]),i=1..(n-1)/2)]:
else
w:=[seq(op([-1,1]),i=1..n/2-1),-1]:
fi:
Inv(w,n):
end:


##########Enumeration

#Number of involutions on [1,n] that obey the up(1)-down(-1) 
#and don't care (0) pattern w
nInv:=proc(w,n)
local gu,i:
gu:=0:
for i from 1 to n do
gu:=gu + nInv1(w,n,i):
od:
gu:
end:


nDUI:=proc(n)
local w,i:
if n mod 2=1 then
w:=[seq(op([-1,1]),i=1..(n-1)/2)]:
else
w:=[seq(op([-1,1]),i=1..n/2-1),-1]:
fi:
nInv(w,n):
end:


#Inv1(w,n,i): All involutions obeying w of [1,n] ending with i
nInv1:=proc(w,n,i)
local w1,lu,j:
option remember:


if nops(w)<>n-1 then
 ERROR(`Length of first input must be one less than second input`):
fi:

if n=1 then
RETURN(1):
fi:

if n=2 then
 if i=1 then 
    if not w[1]=1 then
     RETURN(1):
    else
     RETURN(0):
    fi:
  elif i=2 then
   if not w[1]=-1 then
      RETURN(1):
   else
    RETURN(0):
   fi:
else
ERROR(`bad input`):
fi:
fi:
     
if i=n then
if w[n-1]=-1 then
RETURN(0):
else
w1:=[op(1..n-2,w)]:
lu:=nInv(w1,n-1):
RETURN(lu):
fi:
fi:

if i=1 then
if w[n-1]=1 or w[1]=1 then
 RETURN(0):
else
w1:=[op(2..n-2,w)]:
lu:=nInv(w1,n-2):
RETURN(lu):
fi:
fi:


if i=n-1 then
 if w[n-1]=1 or w[n-2]=-1 then
   RETURN(0):
 else
  w1:=[op(1..n-3,w)]:
 lu:=nInv(w1,n-2):
RETURN(lu):
fi:
fi:

if w[i-1]=-1 or w[i]=1 then
 RETURN(0):
fi:

w1:=[op(1..i-2,w),0,op(i+1..n-2,w)]:


if w[n-1]=0 then

 lu:=nInv(w1,n-2):
RETURN(lu):
fi:


if w[n-1]=1 then
  lu:=0:
    for j from 1 to i-1 do
     lu:=lu+nInv1(w1,n-2,j):
    od:
RETURN(lu):
fi:


if w[n-1]=-1 then
  lu:=0:
    for j from i to n-2 do
     lu:=lu+nInv1(w1,n-2,j):
    od:
RETURN(lu):
fi:
 
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:



#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:


CycStruc:=proc(perm,x)
local i,gu,T,i0,lu,LU,j0,n,mu:
n:=nops(perm):
for i from 1 to n do
T[i]:=perm[i]:
od:
gu:={seq(i,i=1..n)}:
LU:=[]:

while gu<>{} do
 i0:=min(op(gu)):

 lu:=[i0]:
 j0:=T[i0]:
  gu:=gu minus {i0}:

   while j0<>i0 do
     gu:=gu minus {j0}:
     lu:=[op(lu),j0]:
   j0:=T[j0]:
 od:
 LU:=[op(LU),lu]:
od:
mu:=1:
for i from 1 to nops(LU) do
mu:=mu*x[nops(LU[i])]:
od:
mu:
end:

GF1:=proc(n,x,Patterns)
local gu,mu,i:
mu:=Wilf(n,Patterns):

gu:=0:

for i from 1 to nops(mu) do
 gu:=gu+CycStruc(mu[i],x):
od:

gu:
end:

Adj1:=proc(perm,k)
local mu,i:
mu:=[]:
for i from 1 to nops(perm) do
if perm[i]>=k then
 mu:=[op(mu),perm[i]+1]:
else
 mu:=[op(mu),perm[i]]:
fi:
od:
mu:
end:


#UpDown1(k,n): Up-down permutations on [1,n] that start with k
UpDown1:=proc(k,n)
local i,gu,j,mu:
option remember:
if n=1 then if k=1 then RETURN({[1]}) else RETURN({}) fi: fi:
gu:={}:
for i from k to n-1 do
mu:=DownUp1(i,n-1):

for j from 1 to nops(mu) do
 gu:=gu union {[k,op(Adj1(mu[j],k))]}:
od:
od:
gu:
end:


#DownUp1(k,n): Down-up permutations on [1,n] that start with k
DownUp1:=proc(k,n)
local i,gu,j,mu:
option remember:
if n=1 then if k=1 then RETURN({[1]}) else RETURN({}) fi: fi:
gu:={}:
for i from 1 to k-1 do
mu:=UpDown1(i,n-1):

for j from 1 to nops(mu) do
 gu:=gu union {[k,op(Adj1(mu[j],k))]}:
od:
od:
gu:
end:




UpDown:=proc(n)
local gu,k:
option remember:
gu:={}:
for k from 1 to n do
gu:=gu union UpDown1(k,n):
od:
gu:
end:


DownUp:=proc(n)
local gu,k:
option remember:
gu:={}:
for k from 1 to n do
gu:=gu union DownUp1(k,n):
od:
gu:
end:

#IsInvol(perm): Is the permutation perm an involution
IsInvol:=proc(perm)
local x,mu,i,n:
n:=nops(perm):
mu:=CycStruc(perm,x):
for i from 3 to n do
mu:=subs(x[i]=0,mu):
od:
if mu=0 then
RETURN(false):
else
RETURN(true):
fi:
end:


UDI:=proc(n)
local gu,mu,i:

mu:=UpDown(n):

gu:={}:
for i from 1 to nops(mu) do
if IsInvol(mu[i]) then
gu:=gu union {mu[i]}:
fi:
od:
gu:
end:

DUIslow:=proc(n)
local gu,mu,i:

mu:=DownUp(n):

gu:={}:
for i from 1 to nops(mu) do
if IsInvol(mu[i]) then
gu:=gu union {mu[i]}:
fi:
od:
gu:
end:


DUI1slow:=proc(k,n)
local gu,mu,i:
option remember:
mu:=DownUp1(k,n):

gu:={}:
for i from 1 to nops(mu) do
if IsInvol(mu[i]) then
gu:=gu union {mu[i]}:
fi:
od:
gu:
end:



UDI1slow:=proc(k,n)
local gu,mu,i:
option remember:
mu:=UpDown1(k,n):

gu:={}:
for i from 1 to nops(mu) do
if IsInvol(mu[i]) then
gu:=gu union {mu[i]}:
fi:
od:
gu:
end:




#Robinson-Schenstead Correspondance

ez1:=proc(): print(`RS(perm), iRS(tab1,tab2), checkRS,iRSI(tab) `):
print(`SYT1(lam)`): end:
#Robinson-Schenstead Correspondance



#Ins11(row1,k): Given a list of increasing integers, row1, inserts
#k in the proper place of row1, and returns the bumped
#element, or 0, if it is at the end
Ins11:=proc(row1,k)
local i,m:
m:=nops(row1):
for i from 1 to m while row1[i]<k do
od:

if i=m+1 then
RETURN([op(row1),k],0):
else
RETURN([op(1..i-1,row1),k,op(i+1..m,row1)],row1[i]):
fi:
end:


#Ins1(tab1,k): Given a tableau tab1, inserts the element k
#and returns the modified tableau and the row number
#where it landed
Ins1:=proc(tab1,k)
local j,lu,k1,newrow,tab2:

k1:=k:
tab2:=tab1:
for j from 1 to nops(tab1) while k1<>0 do
lu:=Ins11(tab1[j],k1):
k1:=lu[2]:
newrow:=lu[1]:
tab2:=[op(1..j-1,tab2),newrow,op(j+1..nops(tab2),tab2)]:
k1:=lu[2]:
od:

if k1<>0 then
tab2:=[op(tab2),[k1]]:
RETURN(tab2,nops(tab2)):
else
RETURN(tab2,j-1):
fi:

end:

RS:=proc(perm)
local tab1,tab2,p,i,n,gu:
n:=nops(perm):
tab1:=[]: tab2:=[]:
for i from 1 to n do
gu:=Ins1(tab1,perm[i]):
tab1:=gu[1]:
p:=gu[2]:
if p<=nops(tab2) then
tab2:=[op(1..p-1,tab2),[op(tab2[p]),i],op(p+1..nops(tab2),tab2)]:
else
tab2:=[op(tab2),[i]]:
fi:

od:
tab1,tab2:
end:




#Yafe1(tab): a nice display of a tableau
Yafe1:=proc(tab)
local i:
for i from 1 to nops(tab) do
lprint(op(tab[i])):
od:
end:



#iIns11(row1,k): The inverse of Ins11,
iIns11:=proc(row1,k)
local i,m:
if k=0 then
RETURN([op(1..nops(row1)-1,row1)],row1[nops(row1)]):
fi:

m:=nops(row1):
for i from 1 to m while row1[i]<k do
od:
RETURN([op(1..i-2,row1),k,op(i..m,row1)],row1[i-1]):
end:


#iIns1(tab1,k) : The inverse of Ins1(tab1,k)
iIns1:=proc(tab1,rownum)
local k,tab1a,row1,j,gu:
row1:=tab1[rownum]:

if nops(row1)=1 then
tab1a:=[op(1..nops(tab1)-1,tab1)]:
else
tab1a:=[op(1..rownum-1,tab1),
[op(1..nops(row1)-1,row1)],
op(rownum+1..nops(tab1),tab1)]:
fi:
k:=row1[nops(row1)]:
if rownum=1 then
RETURN(tab1a,k):
fi:

for j from rownum-1 by -1 to 1  do
row1:=tab1a[j]:
gu:=iIns11(row1,k):
tab1a:=[op(1..j-1,tab1a),gu[1],op(j+1..nops(tab1a),tab1a)]:
k:=gu[2]:
od:
tab1a,k:
end:

shape1:=proc(tab) local i:
[seq(nops(tab[i]),i=1..nops(tab))]:end:
size1:=proc(tab): convert(shape1(tab),`+`):end:

#OneiRS(tab1,tab2): One step of
#the inverse of Robinson-Schenstead
OneiRS:=proc(tab1,tab2)
local n,k,i,tab1a,tab2a,gu:
n:=size1(tab2):
for i from 1 to nops(tab2) while tab2[i][nops(tab2[i])]<>n do od:
gu:=iIns1(tab1,i):
tab1a:=gu[1]:
k:=gu[2]:
tab2a:=[op(1..i-1,tab2),[op(1..nops(tab2[i])-1,tab2[i])] ,
op(i+1..nops(tab2),tab2)]:
tab1a,tab2a,k:
end:

#iRS(tab1,tab2):the inverse of Robinson-Schenstead
iRS:=proc(tab1,tab2)
local gu,perm:
perm:=[]:
gu:=tab1,tab2,0:
while gu[1]<>[] do
gu:=OneiRS(gu[1],gu[2]):
perm:=[gu[3],op(perm)]:
od:
perm:
end:

CheckRS:=proc(n)
local gu,i:
with(combinat):
gu:=permute(n):
for i from 1 to nops(gu) do
if iRS(RS(gu[i]))<>gu[i] then
print(gu[i]):
fi:
od:
true:
end:

iRSI:=proc(tab):iRS(tab,tab):end:

#SYT1(lam): The set of standard Young tableaux of shape lam
SYT1:=proc(lam)
local i,gu,mu,n,lam1,j,tab1:
option remember:

n:=convert(lam,`+`):
if lam=[] then
RETURN({[]}):
fi:
if nops(lam)=n then
RETURN({[seq([i],i=1..n)]}):
fi:
gu:={}:



for i from 1 to nops(lam) do


if (i=nops(lam) and lam[i]>1)
or (i<nops(lam) and lam[i]>lam[i+1]) then
lam1:=[op(1..i-1,lam),lam[i]-1,op(i+1..nops(lam),lam)]:


mu:=SYT1(lam1):

for j from 1 to nops(mu) do
tab1:=mu[j]:
tab1:=[op(1..i-1,tab1),[op(tab1[i]),n],op(i+1..nops(tab1),tab1)]:
gu:=gu union {tab1}:
od:

elif i=nops(lam) and lam[i]=1 then
lam1:=[op(1..nops(lam)-1,lam)]:
mu:=SYT1(lam1):

for j from 1 to nops(mu) do
tab1:=mu[j]:
tab1:=[op(1..i-1,tab1),[n]]:
gu:=gu union {tab1}:
od:


fi:


od:

gu:
end:

#Par1(k,n): The set of partitions with largest part equaling k
Par1:=proc(k,n)
local gu,r,mu,j:
if k>n then
RETURN({}):
fi:

if k=n then
RETURN({[n]}):
fi:
gu:={}:
for r from 1 to k do
mu:=Par1(r,n-k):
for j from 1 to nops(mu) do
gu:=gu union {[k,op(mu[j])]}:
od:
od:
gu:
end:




#Par(n): The set of partitions of n
Par:=proc(n)
local gu,k:
gu:={}:
for k from 1 to n do
gu:=gu union Par1(k,n):
od:
gu:
end:


SYT:=proc(n)
local gu,mu,i:
mu:=Par(n):

gu:={}:

for i from 1 to nops(mu) do
gu:=gu union SYT1(mu[i]):
od:
gu:
end:

CheckiRS:=proc(n)
local mu,i,j1,j2,lu,ku:
mu:=Par(n):

for i from 1 to nops(mu) do
lu:=SYT1(mu[i]):
for j1 from 1 to nops(lu) do
for j2 from 1 to nops(lu) do
ku:=lu[j1],lu[j2]:
print(evalb(ku=RS(iRS(ku)))):
od:
od:
od:
end:

#gSYT1(lam): The set of good standard Young tableaux of shape lam
#(i.e. no even integers in first row and no odd inetegers
#in first column)
gSYT1:=proc(lam)
local i,gu,mu,n,lam1,j,tab1:
option remember:

n:=convert(lam,`+`):
if lam=[] then
RETURN({[]}):
fi:
if nops(lam)=n then
if n<=2 then
RETURN({[seq([i],i=1..n)]}):
else
 RETURN({}):
fi:
fi:

if nops(lam)=1 and lam[1]>1 then
RETURN({}):
fi:

gu:={}:



for i from 1 to nops(lam) do


if (i=nops(lam) and lam[i]>1)
or (i>1 and i<nops(lam) and lam[i]>lam[i+1]) 
or (i=1 and 1<nops(lam) and lam[1]>lam[2] and (n mod 2)=1)
then
lam1:=[op(1..i-1,lam),lam[i]-1,op(i+1..nops(lam),lam)]:


mu:=gSYT1(lam1):

for j from 1 to nops(mu) do
tab1:=mu[j]:
tab1:=[op(1..i-1,tab1),[op(tab1[i]),n],op(i+1..nops(tab1),tab1)]:
gu:=gu union {tab1}:
od:

elif i=nops(lam) and lam[i]=1 and (n mod 2)=0 then
lam1:=[op(1..nops(lam)-1,lam)]:
mu:=gSYT1(lam1):

for j from 1 to nops(mu) do
tab1:=mu[j]:
tab1:=[op(1..i-1,tab1),[n]]:
gu:=gu union {tab1}:
od:


fi:


od:

gu:
end:


gSYT:=proc(n)
local gu,mu,i:
mu:=Par(n):

gu:={}:

for i from 1 to nops(mu) do
gu:=gu union gSYT1(mu[i]):
od:
gu:
end:

#pDUI(n): Candidated for being Down-Up perms
pDUI:=proc(n)
local mu,gu,i,lu:
mu:=gSYT(n):
gu:={}:

for i from 1 to nops(mu) do
lu:=iRS(mu[i],mu[i]):
gu:=gu union {lu}:
od:
gu:
end:

#gDUI(n): Another way to get Down-Up Involutions
gDUI:=proc(n)
local mu,gu,i,lu:
mu:=gSYT(n):
gu:={}:

for i from 1 to nops(mu) do
lu:=iRS(mu[i],mu[i]):
if IsDownUp(lu) then
gu:=gu union {lu}:
fi:
od:
gu:
end:


#IsDownUp(perm): Is perm Down-Up
IsDownUp:=proc(perm)
local i:

for i from 1 by 2 to nops(perm)-1 do
if perm[i]<perm[i+1] then
 RETURN(false):
fi:
od:

for i from 2 by 2 to nops(perm)-1 do
if perm[i]>perm[i+1] then
 RETURN(false):
fi:
od:
true:
end: