#Maple Code for Dr. Z.'s Combinatorics Lecture 25

Help25:=proc(): print(` Glashier1(L), Glashier(L) , Syl(L), BZset(n), BZ(L,j)  `): end:


##STAFF FROM M24.txt
print(`For a list of the SET procedures, type: Help24s();`):

print(`For a list of the ENUMERATION procedures (via Dynamic programming), type: Help24e();`):

print(`For a list of the GENERATING functions procedures  type: Help24g();`):

#Help24s() lists the Maple procedures that outout the SETS themselves (and hence take exponential time and memory)
Help24s:=proc():print(`Pnk(n,k), Pn(n) , Ferr(p), PnkD(n,k,d), PnD(n,d), PnkC(n,k,C,m), PnC(n,C,m) `): end:

#Help24e() lists the Maple procedures that outout the CARDINATLIES (alias "number of elements) and hence take POLYNOMIAL time and memory
Help24e:=proc():print(`pnk(n,k), pn(n), pnkD(n,k,d), pnD(n,d), pnkC(n,k,C,m), pnC(n,C,m) `): end:

#Help24g() lists the Maple procedures that uses generating functions for enumeration
Help24g:=proc():print(` pnSeq(N), pnOddSeq(N), pnDistinctSeq(N), pnFast(n) `): end:



###START FUNCTIONS THAT OUTPUT ACTUAL SETS
#Pnk(n,k): The set of (integer) partitions of n whose largest part is exactly k
Pnk:=proc(n,k) local k1,s,S:
option remember:
if k>n then
 RETURN({}):
fi:

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

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

S:={seq(op(Pnk(n-k,k1)),k1=1..k)}:
{seq([k,op(s)], s in S)}:
end:

#Pn(n): The set of (integer) partitions of n. Try:
#Pn(10);
Pn:=proc(n) local k:
if n=0 then
{[]}:
else
{seq(op(Pnk(n,k)),k=1..n)}:
fi:
end:


#Ferr(p): The Ferrer diagram of the partiton p
Ferr:=proc(p) local i:

for i from 1 to nops(p) do
lprint(1$p[i]):
od:
end:



#PnkD(n,k,d): The set of (integer) partitions of n whose largest part is exactly k and the difference between two consecutive terms
#is at least d. For exapmple the set of distinct partitions of n with largest part k is PnkD(n,k,1);
PnkD:=proc(n,k,d) local k1,s,S:
option remember:
if k>n then
 RETURN({}):
fi:

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

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

S:={seq(op(PnkD(n-k,k1,d)),k1=1..k-d)}:
{seq([k,op(s)], s in S)}:
end:


#PnD(n,d): The set of (integer) partitions of n such that the difference between consecutive terms is at least d. Try:
#PnD(10,1);
PnD:=proc(n,d) local k:
{seq(op(PnkD(n,k,d)),k=1..n)}:
end:


#PnkC(n,k,C,m): The set of (integer) partitions of n whose largest part is exactly k and the members mod m are in C
#For exapmple the set of set of  partions of n into odd parts with largest part k is
#PnkC(n,k,{1,4},5);
PnkC:=proc(n,k,C,m) local k1,s,S:
option remember:
if k>n then
 RETURN({}):
fi:

if k=n then
 if member(k mod m, C) then
 RETURN({[n]}):
 else
 RETURN({}):
 fi:
fi:

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

if not member(k mod m, C) then
 RETURN({}):
fi:


S:={}:
for k1 from 1 to k do

if member(k1 mod m,C) then
 S:=S union PnkC(n-k,k1,C,m):
fi:

od:

{seq([k,op(s)], s in S)}:
end:

#PnC(n,C,m): The set of (integer) partitions of n such its components mod m are in C. For example for the set of odd partitions of 10, try:
#PnC(10,{1},2);
PnC:=proc(n,C,m) local k:
{seq(op(PnkC(n,k,C,m)),k=1..n)}:
end:
###END FUNCTIONS THAT OUTPUT ACTUAL SETS



###START FUNCTIONS THAT OUTPUT  NUMBER OF ELEMENTS OF SETS
#pnk(n,k): The NUMBER of partitions of n whose largest part is exactly k
pnk:=proc(n,k) local k1:
option remember:

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

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

if n=1 then  if k=1 then   RETURN(1):  else  RETURN(0): fi:fi:

add(pnk(n-k,k1),k1=1..k):

end:

#pn(n): The NUMBER of partitions of n. Try:
#pn(10);
pn:=proc(n) local k: add(pnk(n,k),k=1..n): end:


#pnkD(n,k,d): The NUMBER of partitions of n whose largest part is exactly k and the difference between two consecutive terms
#is at least d. For exapmple the set of distinct partions of n with largest part k is PnkD(n,k,1);
pnkD:=proc(n,k,d) local k1:
option remember:

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

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

if n=1 then  if k=1 then    RETURN(1):  else   RETURN(0):  fi:fi:

add(pnkD(n-k,k1,d),k1=1..k-d):

end:


#pnD(n,d): The NUMBER of partitions of n such that the difference between consecutive terms is at least d. Try:
#pnD(10,1);
pnD:=proc(n,d) local k:
add(pnkD(n,k,d),k=1..n):
end:


#pnkC(n,k,C,m): The NUMBER of (inteter) partitions of n whose largest part is exactly k and the members mod m are in C
#For exapmple the number of  integer partitions of n into odd parts with largest part k is
#pnkC(n,k,{1,4},5);
pnkC:=proc(n,k,C,m) local k1,S:
option remember:
if k>n then
 RETURN(0):
fi:

if k=n then
 if member(k mod m, C) then
 RETURN(1):
 else
 RETURN(0):
 fi:
fi:

if n=1 then
 if member(1,C) then
   RETURN(1):
 else
  RETURN(0):
 fi:
fi:

if not member(k mod m, C) then
 RETURN(0):
fi:


S:=0:
for k1 from 1 to k do

if member(k1 mod m,C) then
 S:=S+ pnkC(n-k,k1,C,m):
fi:

od:
S:
end:

#pnC(n,C,m): The NUMBER of partitions of n such its components mod m are in C. For example for the number of odd partitions of 10, try:
#pnC(10,{1},2);
pnC:=proc(n,C,m) local k:
add(pnkC(n,k,C,m),k=1..n):
end:
###END FUNCTIONS THAT NUMBER OF ELEMENTS OF SETS


#START PROCEDURES THAT USE GENERATING FUNCTIONS
# pnSeq(N): Same output as [seq(pn(i),i=1..N)] but using Euler's generating function 1/((1-q)*(1-q^2)*(1-q^3)*...)
pnSeq:=proc(N) local f,q,i:
f:=mul(1/(1-q^i),i=1..N):
f:=taylor(f,q=0,N+1):
[seq(coeff(f,q,i),i=1..N)]:
end:



# pnOddSeq(N): Same output as [seq(pnC(i,{1},2),i=1..N)] but using Euler's generating function 1/((1-q)*(1-q^3)*(1-q^5)*...)
pnOddSeq:=proc(N) local f,q,i:
f:=mul(1/(1-q^(2*i+1)),i=0..trunc(N/2)):
f:=taylor(f,q=0,N+1):
[seq(coeff(f,q,i),i=1..N)]:
end:


# pnDistinctSeq(N): Same output as [seq(pnC(i,{1},2),i=1..N)] but using Euler's generating function (1+q)*(1+q^2)*(1+q^3)...)
pnDistinctSeq:=proc(N) local f,q,i:
f:=mul(1+q^i,i=1..N):
f:=taylor(f,q=0,N+1):
[seq(coeff(f,q,i),i=1..N)]:
end:


#pnFast(n): Same as pn(n) but using Euler's recurrence  Sum((-1)^j*p(n-(3*j-1)*j/2)+(-1)^j*p(n-(3*j+1)*j/2),j=0..infinity)=0 if n>0
pnFast:=proc(n) local j,su:
option remember:
if n<0 then
RETURN(0):
elif n=0 then
RETURN(1):
else
su:=0:
for j from 1 while j*(3*j+1)/2<=n do
 su:=su-(-1)^j*pnFast(n- j*(3*j+1)/2):
od:


for j from 1 while j*(3*j-1)/2<=n do
 su:=su-(-1)^j*pnFast(n- j*(3*j-1)/2):
od:

RETURN(su):
fi:


end:
###END STUFF FROM M24.txt


#Glashier1(L) one step in Glashier's bijection Distinct-To-Odd
Glashier1:=proc(L) local i:
#We look at the first even entry

for i from 1 to nops(L) while L[i] mod 2=1 do od:


#if none are found, we are done

if i=nops(L)+1 then

#if none are found, we are done
 RETURN(L):

else
#otherwise we break the even part into two halves and sort it
RETURN(sort([op(1..i-1,L),L[i]/2,L[i]/2,op(i+1..nops(L),L)],`>`)):
fi:

end:


#Glashier(L) Glashier's bijection from Distinct partitions to odd partitions
Glashier:=proc(L) local L1,L2,L3:
L1:=L:
L2:=Glashier1(L1):

while L1<>L2 do
 L3:=Glashier1(L2):
 L1:=L2:
 L2:=L3:
od:

L2:

end:

#Syl(L): Sylvester's bijection from odd partitions to distinct partitions
Syl:=proc(L) local i,r,m,L1,M1,a1:
option remember:

#If L is the empty partition, we return the empty partition

if L=[] then
 RETURN([]):
fi:

#If L only consists of 1s we return the distinct partition consisting of one part equal to that number
if L=[1$nops(L)] then
 RETURN([nops(L)]):
fi:



#We find r (the number of parts larger than 1) and m (the number of 1's)

for i from 1 to nops(L) while L[i]>1 do od:


r:=i-1:
m:=nops(L)-r:



#Calling the largest part 2*a1+1 (like in the paper) we find a1

a1:=(L[1]-1)/2:


#We construct the smaller odd partition obtained by removing the first part and the 1's and subtracting 2 from the other parts
L1:=[seq(L[i]-2,i=2..r)]:

#We call the procedure recursivel
M1:=Syl(L1):

#We restor the stuff that we lost by putting at the front [a1+r+m , a1+r-1]

[a1+r+m,a1+r-1,op(M1)]:

end:


#RemZ(L): Removes the 0's from L
RemZ:=proc(L) local i:
for i from 1 to nops(L) while L[i]>0 do od:
[op(1..i-1,L)]:
end:

#BZset(n): The set of pairs [L,j] such that (3*j+1)*j/2+sum(L)=n. Try
#BZset(11);
BZset:=proc(n) local L,S,S1,j:

S:={}:

for j from 0 while (3*j+1)*j/2<=n do
 S1:=Pn(n-(3*j+1)*j/2):
 S:=S union {seq([L,j],L in S1)}:
od:


for j from 1 while (3*j-1)*j/2<=n do
 S1:=Pn(n-(3*j-1)*j/2):
 S:=S union {seq([L,-j],L in S1)}:
od:

S:

end:



#BZ(P): The Bressoud-Zeilberger involution proving Euler's recurrence P=[L,j]
BZ:=proc(P) local L,j,t,i:
L:=P[1]:
j:=P[2]:

if L=[] and j=0 then
 RETURN(FAIL):
fi:

if L=[] then
 if j>0 then
  RETURN([[3*j-1],j-1]):
 else
  RETURN([[-3*j-2],j+1]):
fi:
fi:

t:=nops(L):

if t+3*j>=L[1] then

 RETURN([RemZ([t+3*j-1,seq(L[i]-1,i=1..t)]),j-1]):
else
 RETURN([RemZ([seq(L[i]+1,i=2..t),1$(L[1]-3*j-t-1)]),j+1]):
fi:


end: