#OK to post homework
#Austin DeCicco, 2/13/26, Assignment 6

Help:=proc():
print("FP(pi), Der(n), d(n), ExtractCycle(pi,i), CycDec(pi), IncSeqs1(n,k,a), IncSeqs(n,k), Contain1(pi,sig), Contain(pi,S), AvoidPer(n,S), a(n), b(n), redu(L), 
SubSeqs3(L), Contain3(pi,sig), AvoidPer1(n,sig), Contain3S(pi,S), AvoidPer3(n,S), maj(pi), inv(pi), LtoR(pi), RF(x,n), WtE(S,f,x), Games(S,a,b), NuGames(S,a,b), 
CFC(C), CycToPer(C), BoringGames(S,a,b), NuBoringGames(S,a,b), Foata(pi)"):
end proc:

#BEGIN REFORMATTED C3
############################################################################################################################################################

#FP(pi): The number of fixed points of per. pi

FP:=proc(pi): local n, i, co: n:=nops(pi): co:=0: for i from 1 to n do if pi[i]=i then co:=co+1; end if; end do; co; end proc:

# Der(n): The set of derangements (i.e. permutations w/o fixed points) of {1, ..., n}

Der := proc(n): local S,pi,DE: S:=permute(n): DE:={}: for pi in S do if FP(pi)=0 then  DE:=DE union {pi}; end if; end do; DE; end proc:

#d(n):=|Der(n)|

d:=proc(n) option remember: if n=1 then 0; else n*d(n-1)+(-1)^n; end if; end proc:

#ExtractCycle(pi,i): The cycle corresponding to the member i of the permutation pi For example ExtractCycle([2,1,4,3],1)=[1,2]

ExtractCycle:=proc(pi,i): local C, ng: C:=[i]: ng:=pi[i]: while ng<>i do C:=[op(C),ng]: ng:=pi[ng]: end do; C; end proc:

#CycDec(pi): The full cyclic decomposition of pi

CycDec:=proc(pi): local n, i, StillToDo, S, C, ng: n:=nops(pi): StillToDo:={seq(i,i=1..n)}: S:={}: while StillToDo<>{} do ng:=StillToDo[1]:
C:=ExtractCycle(pi,ng): S:=S union {C}: StillToDo:=StillToDo minus {op(C)}: end do; S; end proc:

############################################################################################################################################################
#END REFORMATTED C3

#BEGIN REFORMATTED C4
############################################################################################################################################################

#IncSeqs1(n,k,a): The set of increasing sequences of length k of integers that ends with a

IncSeqs1:=proc(n,k,a) option remember: local S, b, S1, s1: if not type(n,integer) and type(k,integer) and k<=n and k>=1 and a<=n and n>=1 then return(FAIL); end if;
if k=1 then return({[a]}); end if; S:={}: for b from k-1 to a-1 do S1:=IncSeqs1(n,k-1,b): S:=S union {seq([op(s1),a],s1 in S1)}: end do; S; end proc:

#IncSeqs(n,k): The set of increasing sequences of length k from the integers 1 to n

IncSeqs:=proc(n,k): local a: {seq(op(IncSeqs1(n,k,a)),a=k..n)}; end proc:

#Contain1(pi,sig): Does the permutation pi contain the pattern sig?

Contain1:=proc(pi,sig): local n, k, S, s, i1: n:=nops(pi): k:=nops(sig): S:=IncSeqs(n,k): for s in S do if redu([seq(pi[s[i1]],i1=1..k)])=sig then
return(true); end if; end do; false; end proc:

#Contain(pi,S): does pi contain at least one of the patterns in S?

Contain:=proc(pi,S): local sig: for sig in S do if Contain1(pi,sig) then return true; end if; end do; false; end proc:

#AvoidPer(n,S): the permutations of length n that avoid the patterns in S1

AvoidPer:=proc(n,S) option remember: local G, G1, i, pi1, pi: if n=0 then return({[]}); end if; G:={}: G1:=AvoidPer(n-1,S): for i from 1 to n do
for pi1 in G1 do pi:=[op(1..i-1,pi1),n,op(i..n-1,pi1)]: if not Contain(pi,S) then G:=G union {pi}; end if; end do; end do; G; end proc:

#This is still open: Why is it that it is all integers up to n=17

a:=proc(n) option remember: local i: if n=1 then 2; else add(a(i)^2,i=1..n-1)/(n-1); end if; end proc:

b:=proc(n) option remember: if n>=1 and n<=4 then 1; else (b(n-1)*b(n-3)+b(n-2)^2)/b(n-4); end if; end proc:

#redu(L): inputs a list of distinct numbers and outputs its reduction according to their order For example redu([5,9,1]): [2,3,1]

redu:=proc(L): local n, L1, T, i: n:=nops(L): L1:=sort(L): for i from 1 to n do T[L1[i]]:=i: end do; [seq(T[L[i]],i=1..n)]; end proc:

#SubSeqs3(L): The set of subsequences of the list L of length 3. For example SubSeqs3([1,6,2,4])={[1,6,2],[1,6,4],[1,2,4],[6,2,4]}

SubSeqs3:=proc(L): local n, i1, i2, i3, S: n:=nops(L): S:={}: for i1 from 1 to n do for i2 from i1+1 to n do for i3 from i2+1 to n do
S:=S union {[L[i1],L[i2],L[i3]]}: end do; end do; end do; S; end proc:

#Contain3(pi,sig): does the permutation pi contain the pattern sig? Contain3([2,1,3,4],[1,2,3]) returns true Contain3([4,3,2,1],[1,2,3]) returns false

Contain3:=proc(pi,sig): local n, S, s: n:=nops(pi): if nops(sig)<>3 then RETURN(FAIL); end if; S:=SubSeqs3(pi): for s in S do if redu(s)=sig then
return(true); end if; end do; false; end proc:

#AvoidPer1(n,sig): inputs a pos. integer n and a pattern of length 3 outputs the subset of permute(n) that avoid the parttern sig

AvoidPer1:=proc(n,sig) local A,pi,G: A:=permute(n): G:={}: for pi in A do if not Contain3(pi,sig) then G:=G union {pi}; end if; end do; G; end proc:

Contain3S:=proc(pi,S): local sig: for sig in S do if Contain3(pi,sig) then return true; end if; end do; false; end proc:

AvoidPer3:=proc(n,S): local A, pi: A:={}: for pi in permute(n) do if not Contain3S(pi,S) then A:=A union {pi}; end if; end do; A; end proc:

############################################################################################################################################################
#END REFORMATTED C4

#BEGIN REFORMATTED C5
############################################################################################################################################################

with(combinat):

#maj(pi): The major index : The sum of the places where pi[i]>pi[i+1]

maj:=proc(pi): local n, i, co: co:=0: n:=nops(pi): for i from 1 to n-1 do if pi[i]>pi[i+1] then co:=co+i; end if; end do; co; end proc:

#inv(pi): The number of inversions of the permutation pi. For example inv([1,2,3])=0, inv([3,2,1])=3  

inv:=proc(pi): local n, i, j, co: n:=nops(pi): co:=0: for i from 1 to n do for j from i+1 to n do if pi[i]>pi[j] then co:=co+1; end if; end do; end do; co; end proc:

#LtoR(pi): The list places that are larger than anything to the left pi=[2,1,4,3]

LtoR:=proc(pi): local n, L, i, ma: n:=nops(pi): L:=[1]: ma:=pi[1]: for i from 2 to n do if pi[i]>ma then L:=[op(L), i ]; ma:=pi[i]; end if; end do; L; end proc:

#x*(x+1)*...*(x+n-1)

RF:=proc(x,n): local i: mul(x+i,i=0..n-1); end proc:

#WtE(S,f,x): add(x^f(s), s in S)

WtE:=proc(S,f,x): local s: add(x^(f(s)), s in S); end proc:

############################################################################################################################################################
#END REFORMATTED C5

#BEGIN REFORMATTED C6
############################################################################################################################################################

#Games(S,a,b): Inputs a finite set of POSITIVE integers and pos. integers and outputs the set of game histories, where Home team scored a points
#and the Visiting team scored b points where the "atomic" scoring events belong to S. In Soccer: S={1}; Basketball ={1,2,3}; American football={3,6,7,8}

Games:=proc(S,a,b) option remember: local G, s, G1, g1: if a<0 or b<0 then RETURN({}); end if; if a=0 and b=0 then RETURN({[[0,0]]}); end if; G:={}:
for s in S do G1:=Games(S,a-s,b): G:=G union {seq([op(g1),[a,b]],g1 in G1)}: G1:=Games(S,a,b-s): G:=G union {seq([op(g1),[a,b]],g1 in G1)}: end do; G; end proc:

#NuGames(S,a,b): Inputs a finite set of POSITIVE integers and pos. integers and outputs the NUMBER of game histories, where Home team scored a points
#and the Visiting team scored b points where the "atomic" scoring events belong to S. In Soccer: S={1}; Basketball ={1,2,3}; American football={3,6,7,8}

NuGames:=proc(S,a,b) option remember: local G, s, G1, g1: if a<0 or b<0 then RETURN(0); end if; if a=0 and b=0 then RETURN(1); end if;
add(NuGames(S,a-s,b),s in S)+add(NuGames(S,a,b-s),s in S); end proc:

#CFC(C): inputs a list of numbers coming from a cycle and outputs the equivalent cycle where the largest entry is the first. CFC([4,6,1])= [6,4,1]

CFC:=proc(C): local k: k:=max[index](C): [op(k..nops(C),C),op(1..k-1,C)]; end proc:

#CycToPer(C): The reverse of CycDec(pi). Given a permutation in cycle structure, outputs it in 1-line notation. For example CycToPer({[1,2],[3,4]})=[2,1,4,3]

CycToPer:=proc(C): local n,i,j,T: n:=add(nops(C[i]),i=1..nops(C)): for i from 1 to nops(C) do for j from 1 to nops(C[i])-1 do T[C[i][j]]:=C[i][j+1]:
end do; T[C[i][-1]]:=C[i][1]: end do; [seq(T[i],i=1..n)]; end proc:

############################################################################################################################################################
#END REFORMATTED C6

#1. Read and understand today's Maple code, including procedure CycToPer(C), added after class. Test that CycToPer(CycDec(pi))=pi for every permutation of length 6.

TestCycToPer:=proc():
local S, pi, check:
check:=true:
S:=permute(6):
for pi in S do
if pi<>CycToPer(CycDec(pi)) then
check:=false;
end if;
end do;
check;
end proc:

#TestCycToPer();
#Above command returns true, thus CycToPer(CycDec(pi))=pi for all pi in permute(6).

#2. Assuming that team I (the home team) eventually won, so the final score was [a,b] with with a ≥ b ≥ 0, define a boring game if, throughout the history game team II was never ahead (it is OK if it tied).
#   For example (in basketball) the game history [[0,0],[2,0],[2,2],[3,2]] is boring, but [[0,0],[2,0],[2,2],[3,2],[3,4],[6,4]] is not boring.
#   Write procedures BoringGames(S,a,b) and NuBoringGames(S,a,b) that output the sets, respectively, the number boring games.
#   [Hint: in addition to the condition that a and b are never negative you also need to tell Maple that BoringGames(S,a,b) is the empty set if a < b]

BoringGames:=proc(S,a,b) option remember:
local G, s, G1, g1:
if a<0 or b<0 or a<b then
RETURN({});
end if;
if a=0 and b=0 then
RETURN({[[0,0]]});
end if;
G:={}:
for s in S do
if a-s >= b then
G1:=BoringGames(S,a-s,b);
G:=G union {seq([op(g1),[a,b]],g1 in G1)};
end if;
G1:=BoringGames(S,a,b-s):
G:=G union {seq([op(g1),[a,b]],g1 in G1)}:
end do;
G;
end proc:

NuBoringGames:=proc(S,a,b) option remember:
local G, s, G1, g1, c:
if a<0 or b<0 or a<b then
RETURN(0);
end if;
if a=0 and b=0 then
RETURN(1);
end if;
c:=0:
for s in S do
if a-s >= b then
c:=c + NuBoringGames(S,a-s,b);
end if;
end do;
c + add(NuBoringGames(S,a,b-s),s in S);
end proc:

#BoringGames({3,6,7,8},14,7);
#NuBoringGames({3,6,7,8},14,7);
#Verified to be working

#3. Check whether the following sequences are in the OEIS, and if there are, give their A numbers.

#Seq 1: Soccer
#[seq(NuBoringGames({1},i,i),i=1..20)];
#Output: [1, 2, 5, 14, 42, 132, 429, 1430, 4862, 16796, 58786, 208012, 742900, 2674440, 9694845, 35357670, 129644790, 477638700, 1767263190, 6564120420]
#A number: A000108

#Seq 2: Old-Time Basketball
#[seq(NuBoringGames({1,2},i,i),i=1..20)];
#Output: [1, 5, 22, 117, 654, 3843, 23323, 145172, 921508, 5942737, 38825546, 256431172, 1709356836, 11485249995, 77703736926, 528893901963, 3619228605738, 
#         24884558358426, 171828674445330, 1191050708958096]
#A number: A122951

#Seq 3: Today's Basketball
#[seq(NuBoringGames({1,2,3},i,i),i=1..20)];
#Output: [1, 5, 29, 170, 1093, 7346, 50957, 362476, 2629150, 19371533, 144585146,  1090886362, 8306621114, 63752890716, 492671044866, 3830272606911, 
#         29937476853483, 235104315621495, 1854181694878573, 14679397763545597]
#A number: A175883

#Seq 4: American football
#[seq(NuBoringGames({3,6,7,8},i,i),i=1..20)];
#Output: [0, 0, 1, 0, 0, 5, 1, 1, 22, 7, 7, 117, 71, 91, 737, 658, 908, 4990, 5931, 9108]
#A number: N/A

#4. [A little bit challenging for novices, but try your best]
#   The famous Foata bijection, inputs a permutation of {1, ...,n} in one-line notation, and outputs another permutation in one-line notation, as follows.

#A-set of cycles, B-A after CFC, C-sorted B and transformed to list
Foata:=proc(pi):
local A, B, C, a, b, n, i:
A:=CycDec(pi): B:={}: C:=[]:
n:=nops(pi):

for a in A do
B:= B union {CFC(a)}:
end do;

for i from 1 to n do
for b in B do
if b[1]=i then
C:= [op(C),op(b)];
end if;
end do;
end do;

C;
end proc:

#Foata([8,3,5,6,2,4,7,1]);
#CycDec([8,3,5,6,2,4,7,1]);
#Verified using a random permutation of 8