# OK to post homework
# Lucy Martinez, 02-26-2026, Assignment 10

with(combinat):


# Question 1:
# Using procedure CompsG(n,A), write a procedure CompsMod(n,a,S)
#  that inputs a positive integer n, a positive integer a and
#  a subset S of {0,1,..., a-1} and outputs the set of
#  compositions of n whose entries mod a belong to S. 
#  For example: CompsMod(n,1,{0}) is the same as Comps(n),
#   and Comps(n,2,{1}) gives the set of compositions into odd parts.
#  [Hint: the set of integers of the form s (mod a) is
#   {seq(a*i+s,i=0..infinity)} but you can safely replace it by
#   {seq(a*i+s,i=0..n)} (and even {seq(a*i+s,i=0..trunc(n/a))} (why?)] 
CompsMod:=proc(n,a,S) local S1,s,i,T,s1:
S1:={seq(seq(a*i+s,i=0..trunc(n/a)),s in S)}:
T:= S1 intersect {$1..n}:
CompsG(n,T): #the set of compositions of n whose entries are from the set S1
end:




# Question 2:
# Which of the following sequences are in the OEIS,
#  if there are what are their A numbers. what is the desription?
#  (1) [seq( nops(CompsMod(n,2,{1})),n=1..10)];
#  (2) [seq( nops(CompsMod(n,3,{1})),n=1..10)];
#  (3) [seq( nops(CompsMod(n,5,{1,4})),n=1..10)]; 
# ANSWER:
# (1)  A000045 -Fibonacci numbers: [1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89]

# (2) A078012 - Number of compositions of n into parts >= 3:
#     [1, 1, 1, 2, 3, 4, 6, 9, 13, 19, 28, 41, 60, 88, 129]

# (3) A116975 - Number of compositions of n into parts of sizes == 1 mod 5 or 4 mod 5.
#     [1,1,1,2,3,5,7,10,15,23,35,52,77,115,173,260,389]




# Question 3:
# A partition is odd if all its members are odd. Write a procedure
#  OddParStupid(n) that looks at all the members of Par(n)
#  and selects those that only have odd parts. 
OddParStupid:=proc(n) local S,T,s:
S:=Par(n):
T:={}:
for s in S do
 if {op(s)} mod 2={1} then
  T:=T union {s}:
 fi:
od:
T:
end: 



# Question 4:
# A partition is distinct if all its members are distinct. 
#  Write a procedure DistinctParStupid(n) that looks at all
#  the members of Par(n) and selects those that have distinct parts. 
DistinctParStupid:=proc(n) local S,T,s:
S:=Par(n):
T:={}:
for s in S do
 if nops(s)=nops({op(s)}) then
  T:=T union {s}:
 fi:
od:
T:
end:



# Question 5: 
# Verify that for n up to 15, nops(DistinctParStupid(n))=nops(OddParStupid(n))
# ANSWER:
#  {seq(evalb(nops(DistinctParStupid(n))=nops(OddParStupid(n))),n=1..15)};
#  returns
#  {true}



# Question 7: [Optional Challenge, 5 dollars] 
# Prove the Aurora conjecture that the number of compositions of n equals 2^(n-1)
# Proof:
# Observe that any composition of length n can be represented 
#  with the sequence (a1,a2,a3,...,ak) such that 
#  n=a1+a2+a3+...+ak.
# Now, if we begin with the tuple of all 1s
#  s=(1,1,...,1) of length n so that 1+1+...+1=n,
#  then we have a composition of n. 
# To build the rest of the compositions of n,
#  we can replace the commas with "+" or with ";".
# Notice that there are (n-1) places where the "+" or ";" can go.
# Now, from left to right, for every "+", add
#  the elements immediately before and after the symbol "+".
# Continue adding the elements from left to right until a symbol ";"
#  appears.
# For example, if (1+1;1+1+1;1;1;1;1) then we obtain
#  (2;3;1;1;1;1).
# Observe that placing "+" or ";" in place of the commans in
#  the tuple s=(1,1,...,1) creates a composition of n.
# In fact, this creates all possible compositions of n. 
# Since there are (n-1) places where to place the symbols "+" and ";"
#  then the total number of possible tuples 
#  (after adding the required elements) is 2^(n-1).
# Hence, there are 2^(n-1) compositions of n.



##################################
###########from before
# C10.txt, Feb. 23, 2026
Help10:=proc():
 print(`Comps(n), CompsG(n,A), ParS(n), Park(n,k), Par(n)`):
end:

#Def: A composition of n is a vector of positive integers 
# that add up to n
#Comps(1)={[1]}
#Comps(2)={[1,1],[2]}
#Comps(3)={[1,1,1],[1,2],[2,1],[3]}

#Comps(n): outputs all the compositions of n
Comps:=proc(n) local S,i,s1,S1:
option remember:
if n<0 then
 return({}):
fi:

if n=0 then
 return({[]}):
fi:

S:={}:

for i from 1 to n do
 S1:=Comps(n-i):
 S:=S union {seq([i,op(s1)],s1 in S1)}:
od:
S:
end:


#CompsG(n,A): The set of compositions of n drawn from
# the set A
# CompsG(n,{seq(i,i=1..n)}) is the same as Comps(n)
CompsG:=proc(n,A) local S,i,s1,S1:
option remember:
if n<0 then
 return({}):
fi:

if n=0 then
 return({[]}):
fi:

S:={}:

for i in A do
 S1:=CompsG(n-i,A):
 S:=S union {seq([i,op(s1)],s1 in S1)}:
od:
S:
end:

#Notes:
# CompsG(n,{1,2}) = CompsG(n-1,{1,2}) union CompsG(n-2,{1,2})
# To prove, notice that for CompsG(n-1,{1,2}) you can add a `1` at the end
#  and for CompsG(n-2,{1,2}) you can add a `2` at the end
# Hence, |CompsG(n,{1,2})|=fibonacci(n+1) 

# Number of compositions of n into odd parts is F_n

# Number of compositions of n into odd parts is 
# equals Number of compositions of n-1 into {1,2}

# Integer partitions:
# Def: A partition of n is a composition which is weakly increasing

# ParS(n): The set of (integer) partitions of n
ParS:=proc(n) local S,s:
S:=Comps(n):
{seq(sort(s,`>`),s in S)}:
end:


#Park(n,k): The set of partitions of n into exactly k parts
Park:=proc(n,k) local S,k1,S1,s1:
option remember:

if n<k then
   RETURN({}):
fi:

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

S:={}:
for k1 from 0 to k do
 S1:=Park(n-k,k1):
 S:= S union {seq([op(s1+[1$k1]),1$(k-k1)], s1 in S1)}:
od:
S:
end:


#Par(n): The set of partitions of n, the clever way.
Par:=proc(n) local k:
{seq(op(Park(n,k)), k=1..n)}:
end:


####################################
####################################
# C9.txt, Feb. 19, 2026

Help9:=proc():
 print(`RandL(n,k), PIEd(n,L), IntL(L), PIE(n,L), dn(n) `):
 print(`PIEg(n,L,t), dnt(n,t)`):
end:

#Notes:
# Let X be a universal set
# a finite collection of subsets A1, A2, ..., Ak
# How many members of X belong to none of A1, A2, ..., Ak?
# In computer language:
# Not A1 interset Not A2 intersect Not A3 intersect ... intersect Not Ak
# |X|-|A1|

# First we exclude people that like #1, people that like #2, but we excluded the same
# people that like #1 and #2
# The following is Principle of inclusion/exclusion (PIE) for two subsets
# |X|-|A1|-|A2| + |A1 intersect A2|

# For three subsets: Let "*" mean "intersect"
# |X|-|A1|-|A2|-|A3| + |A1*A2| + |A1*A3| + |A2*A3|-|A1*A2*A3|

# In general: in what follows, "*" means multiplication
# |Not A1 intersect Not 2 ... intersect Not Ak| =
#           Sum((-1)^|S|*|Int(s, s in S), all subsets of {A1,A2,...,Ak}|, S)

#RandL(n,k): A random list of subsets of {1,2,...,n} of length k
RandL:=proc(n,k) local i:
[seq(randcomb(n,rand(2..n-2)()),i=1..k)]:
end:


#PIEd(n,L): What PIE computes but done directly
PIEd:=proc(n,L) local i, s:
nops({seq(i,i=1..n)} minus {seq(op(L[i]),i=1..nops(L))}):
end:


#IntL(L): given a list of sets, outputs the intersection of those sets
IntL:=proc(L) local i:
`intersect`(seq(L[i],i=1..nops(L))):
end:


#PIE(n,L): using the formula PIE
PIE:=proc(n,L) local k,cu,S,s:
cu:=n:
for k from 1 to nops(L) do
 S:=choose(L,k):
 cu:=cu+(-1)^k*add(nops(IntL(s)),s in S):
od:
cu:
end:


#Using PIE, find a formula for the number of derangements
# Def: A derangement is a permutation that has no fixed points
# i.e. pi[1]<>1, pi[2]<>2, ... , pi[n]<>n
#Universal set: all the permutations i.e. n!
# What is a natural choice for A[1]? 
#  A[1]= set of permutations that have a fixed point at the first location:
#  For example: if n=3 then A[1]={[1,2,3], [1,3,2]}
#   A[2]={[1,2,3],[3,2,1]} and A[3]={[1,2,3],[2,1,3]}
# In general:
# A[i]:=set of permutations such that pi[i]=i
# Lemma: for any subset S of k properties
# nops( A[S[1]] intersect A[S[2]] ... intersect A[S[k]] )= (n-k)!
# A[S[1]] intersect A[S[2]] ... intersect A[S[k]] is the number of orderings
#  having k fixed points (k properties in the correct position) so we want
#  to count how many ways are there such there are k places fixed and all others
#  are different? (n-k)! since by fixing k elements, you are left with n-k elements to order 
#  i.e. (n-k)! counts the number of permutations with k fixed pts
# Now, in how many ways can you choose k members of A[1],...,A[n]? 
#  i.e. we need to choose which positions we want to fix
# Sum(binomial(n,k)*(-1)^k*(n-k)!,k=0..n)=Sum( n!/((n-k)!*k!)*(-1)^k*(n-k)!,k=0..n)=
# Sum(n!/k!*(-1)^k,k=0..n)

#dn(n): returns the number of permutations that have no fixed points
# i.e. the number of derangements of length n
dn:=proc(n) local k:
n!*add((-1)^k/k!,k=0..n):
end:


#PIEg(n,L,t): The weight-enumerator of the members of the universal set
# according to t^#NumberOfProperties
PIEg:=proc(n,L,t)local k,cu,S,s:
cu:=n:
for k from 1 to nops(L) do
 S:=choose(L,k):
 cu:=cu+(t-1)^k*add(nops(IntL(s)),s in S):
od:
cu:
end:


#dnt(n,t): returns the weight-enumerator of permutations according to
# t^#NumberOfDerangements
dnt:=proc(n,t) local k:
expand(n!*add((t-1)^k/k!,k=0..n)):
end:


##########################C8.txt:
Help8:=proc():
 print(`xn(n), xnC(n), xnP(n,p)`):
end:

#Gobel's sequence, tricks you to conjecture that
# it is always an integer

#x_n=(1+x_0^2+...+x_(n-1)^2)/n
xn:=proc(n) local i:
option remember:
if n=0 then
 1:
else
 (1+add(xn(i)^2,i=0..n-1))/n:
fi:
end:

#Notice that n*xn(n)=1+x_0^2+...+x_(n-1)^2
# (n-1)*xn(n-1)=1+x_0^2+...+x_(n-2)^2
# n*xn(n)-(n-1)*xn(n-1)=x_(n-1)^2
# so
# n*xn(n)=(n-1)*xn(n-1)+x_(n-1)^2=xn(n-1)(n-1+xn(n-1))
# xn(n)=xn(n-1)(n-1+xn(n-1))/n
#xnC(n): clever version of xn(n)
xnC:=proc(n) local i:
option remember:
if n=1 then
 2:
else
 xnC(n-1)*(n-1+xnC(n-1))*n^(-1):
fi:
end:

#The sequence above is still slow. It will take a long time for n=40
# We have to prove that there is a place p, such that it is
# integers until p-1 but stops being an integer 
#xnP(n,p): clever version mod p
xnP:=proc(n,p) local i:
option remember:
if n=1 then
 2:
else
 xnP(n-1,p)*(n-1+xnP(n-1,p))*n^(-1) mod p:
fi:
end:

#Assume that xn(43) is an integer n*xn(n)=xn(n-1)(n-1+xn(n-1))
# then (xn(42)+42)xn(42) mod 43 =43*xn(43)  mod 43 = 0
# This means (xn(42)+42)xn(42)=0
# (33+42)*42 mod 43;




# The famous Foata bijection "f", inputs a permutation of {1, ...,n} in one-line notation,
#  and outputs another permutation in one-line notation, as follows.
#  (1) Find the cycle decomposition, and convert each of the cycles to canonical form, using CFC.
#  (2) Arrange these cycles in INCREASING order of their first element (which is their largest).
#  (3) Remove the interior brackets.
# For example if pi=[4,3,2,1], the cycle decomposition (in canonical form) is {[4,1],[3,2]}.
#  Now make it into a list of lists with the first elements in increasing order [[3,2],[4,1]],
#  and finally, remove the inside brackets and get f([4,3,2,1])=[3,2,4,1]
Foata:=proc(pi) local cycle, CanForm,C, sig,i,L,s,newsig:
cycle:=CycDec(pi):
CanForm:={}:
for C in cycle do
 CanForm:=CanForm union {CFC(C)}:
od:
L:=[]:
for C in CanForm do
 L:=[op(L),C[1]]:
od:
L:=sort(L):

sig:=[]:

for i from 1 to nops(L) do
 for C in CanForm do
  if L[i]=C[1] then
   sig:=[op(sig), C]:
  fi:
 od:
od:

newsig:=[]:
for s in sig do
 newsig:=[op(newsig),op(s)]:
od:
newsig:
end:



#######From before:
# C6.txt, Feb. 09, 2026

Help6:=proc():
 print(`Games(S,a,b), NuGames(S,a,b), CFC(C), CycToPer(C)`):
end:


#Games(S,a,b): Inputs a finite set of POSITIVE integers
# and pos. integers a, and b, and outputs the set of game histories,
# where Home team scored "a" points and the Visiting teams scored "b" points
# where the "atomic" scoring events belong to S
# In soccer: S={1} (very simple, you can only score 1 pt at a time)
# In basketball: S={1,2,3}
# American football: S={3,6,7,8}
Games:=proc(S,a,b) local G,s,G1,g1: 
option remember:

if a<0 or b<0 then
 return({}):
fi:

if a=0 and b=0 then
 return({[[0,0]]}):
fi:

G:={}:

for s in S do
#Team 1 (Home) scored s points in the previous step
 G1:=Games(S,a-s,b):
 G:=G union {seq([op(g1),[a,b]],g1 in G1)}:

#Team 2 (Visiting) scored s points in the previous step
 G1:=Games(S,a,b-s):
 G:=G union {seq([op(g1),[a,b]],g1 in G1)}:
od:
G:
end:


#NuGames(S,a,b): Inputs a finite set of POSITIVE integers
# and pos. integers a, and b, and outputs the NUMBER game histories,
# where Home team scored "a" points and the Visiting teams scored "b" points
# where the "atomic" scoring events belong to S
# In soccer: S={1} (very simple, you can only score 1 pt at a time)
# In basketball: S={1,2,3}
# American football: S={3,6,7,8}
NuGames:=proc(S,a,b) local G,s,G1,g1: 
option remember:

if a<0 or b<0 then
 return(0):
fi:

if a=0 and b=0 then
 return(1):
fi:

add(NuGames(S,a-s,b),s in S)+ add(NuGames(S,a,b-s),s in S):

end:

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

#added after class: 
#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]:
  od:
   T[C[i][-1]]:=C[i][1]:
  od:

[seq(T[i],i=1..n)]:
end:



########################################
# C5.txt, Feb. 05, 2026

Help5:=proc():
 print(`WtE(S,f,x), RF(x,n), LtoR(pi), inv(pi), maj(pi)`):
end:

#Notes:
# inv(pi): the number of pairs (i,j) for 1<=i<=j<=n such that pi[i]<pi[j]
# Sum(x[1,pi[1]]*x[2,pi[2]]*...*x[n,pi[n]]*(-1)^n) is the definition
#  of the determinant of a matrix

# Weighted counting
# numerical attribute
# Weight enumerator:
#  finite set S, and some weight f, Wt(S,f,a)=Sum(a^f(s),s in S)


#maj(pi): [the major index] the sum of the places/locations where
# pi[i]>pi[i+1]
# maj([4,5,3,2,1])=9 since
#  i=2,i=3,i=4 and 2+3+4=9
maj:=proc(pi) local n,i,co:
n:=nops(pi):
co:=0:
for i from 1 to n-1 do
 if pi[i]>pi[i+1] then
  co:=co+i:
 fi:
od:
co:
end:


#inv(pi): The number of inversions of the permutation pi
# i.e. the number of pairs (i,j) for 1<=i<=j<=n such that pi[i]<pi[j]
# For example: inv([1,2,3])=0, 
#  inv([3,2,1])=3 since the pairs are (1,2),(1,3),(2,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[j]<pi[i] then
   co:=co+1:
  fi:
 od:
od:
co:
end:


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


#RF(x,n): the rising factorial i.e. x*(x+1)*...*(x+n-1)
RF:=proc(x,n) local i:
mul(x+i,i=0..n-1):
end:


#LtoR(pi): The list of places that are larger than anything to the left
# For example: if pi=[2,1,4,3]
#  then LtoR(pi)={1,3}
LtoR:=proc(pi) local i,L,ma,n:
n:=nops(pi):
L:=[1]:
#ma is the current world record (the max)
ma:=pi[1]:
for i from 2 to n do
 if pi[i]>ma then
  L:=[op(L),i]:
  ma:=pi[i]:
 fi:
od:
L:
end:

#########################################
# C4.txt, Feb. 02, 2026

Help4:=proc():
 print(`a(n), b(n), IncSeqs1(n,k,a), IncSeqs(n,k)`):
 print(`Contain1(pi,sig), Contain(pi,S), AvoidPer(n,S)`):
end:


#IncSeqs1(n,k,a): The set of increasing sequences of length k of integers 
# that ends with a
IncSeqs1:=proc(n,k,a) local S,b,S1,s1:
option remember:
if not type(n,integer) and type(k,integer) and k<=n and k>=1 and a<=n and n>=1then
 return(FAIL):
fi:

if k=1 then
 return({[a]}):
fi:
S:={}:

#a-1-(k-1)+1=a-k
for b from k-1 to a-1 do
 S1:=IncSeqs1(n,k-1,b):
 #append a to the list s1: [op(s1),a]
 S:=S union {seq([op(s1),a],s1 in S1)}:
od:
S:
end:


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

#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
 #here we are looking at all the places in pi from each s1
 # for example if s=[1,4,9] and n=10, k=3 then we look at 
 # pi[1]pi[4]pi[9] and see if it reduces to sig then return true
 if redu([seq(pi[s[i1]],i1=1..k)])=sig then
  return(true):
 fi:
od:
false:
end:


#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:
 fi:
od:
false:
end:


#AvoidPer(n,S): the permutations of length n that avoid the patterns in S1
AvoidPer:=proc(n,S) local G, G1,i,pi1,pi:
option remember:
if n=0 then
 return({[]}):
fi:
# G is the set with good permutations (avoiding the patterns in S)
G:={}:
G1:=AvoidPer(n-1,S):

#i is the location of n
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}:
  fi:
 od:
od:
G:
end:



#This is still open: Why is it that it is all integers up to n=17
a:=proc(n) local i: option remember: 
 if  n=1 then
  2:
 else
  add(a(i)^2,i=1..n-1)/(n-1):
 fi:
end:

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):
fi:
end:

##################################
##################################
##################################

# C3.txt, Jan. 29, 2026

Help3:=proc() :
 print(`FP(pi), WtE1(n,x), Der(n), d(n), ExtractCycle(pi,i), CycDec(pi)`):
end:


# FP(pi): inputs a permutation pi of {1,...,n}, where n:=nops(pi) 
#  and outputs the number of places of fixed points of pi
#  For example NuFP([2,1,3,5,4])=1
FP:=proc(pi) local i,n,count:
n:=nops(pi):
count:=0:

if not type(pi,list) then
 print(`The input should be a list`):
 return(FAIL):
fi:

if {seq(type(pi[i],integer),i=1..n)}<>{true} then
 print(`The elements in the list should be integers`):
 return(FAIL):
fi:

for i from 1 to n do 
 if pi[i] = i then 
  count ++:
 fi:
od:
count:
end:


# WtE1(n,x): inputs a non-negative integer and a variable x 
#  and outputs the sum of x^NuFP(pi) summed over all
#  permutations of length n.
WtE1:= proc(n,x) local pi:
add(x^NuFP(pi), pi in permute(n)):
end:


# Der(n): The set of derangements (i.e. permutations without fixed pts)
#  of {1,2,...,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}:
 fi:
od:
DE:
end:


#Linear first order recurrence (homogeneous)
#if a(n):=nops(permute(n))
# then a(n)=n*a(n-1)
# a(n)-n*a(n-1)=0 with a(0)=1

# d(n):=|Der(n)|
# [seq(L[n]-n*L[n-1],n=2..nop(L))]=[1, -1, 1, -1, 1, -1]
# This means Der(n)-n*Der(n-1)-(-1)^n=0
# so Der(n)=n*Der(n-1)+(-1)^n

#d(n): the number of derangements of length n
d:=proc(n) option remember:
if n=1 then
 0:
else
 n*d(n-1)+(-1)^n:
fi:
end:

#limit of d(n)/n! as n goes to infinity is 1/e


# Cycle structure
# [3,1,4,2] ONE-LINE-NOTATION

# Two-Line Notation
# 1 2 3 4
# 3 1 4 2

# 3142=(1342)
# above: 1 goes to 3, 3 goes to 4, 4 goes to 2, 2 goes to 1
# Cycle decomposition of (3,1,4,2) is (1342)


# ExtractCycle(pi,i): The cyle 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]:
od:
C:
end:

# How many cyclic permutations are there of length n?
# (n-1)!
# So the probability of getting a cyclic perm is (n-1)!/n!=1/n


#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)}:
od:
S:
end:

##############################
# C2.txt, Jan. 26, 2026

Help2:=proc() :
 print(`redu(L), SubSeqs3(L,k), Contain3(pi,sig), AvoidPer1(n,sig)`):
end:

#permutations: arranging objects with orders


#if a(n):=number of permutations of {1,2,...,n}
# conjecture: a(n)/a(n-1)=n
# first-order recurrence
# so a(n)=n*a(n-1) where a(0)=1
# 
# A different recurrence: Fibonacci numbers
# F(n)=F(n-1)+F(n-2), second-order linear recurrence
# 
# Back to permutations:
# n!=1*2*3*...*(n-1)*n

#Per(n): the set of permutations of length n
# Per(n)=Union of P(n-1) with n insertd at the first place
# T:=Per(n)->{1,2,...,n} X Per(n-1)
# T(pi)=[i,pi']
#  where i=location of n and
#  pi' is the permutation of {1,2,...,n-1} obtained by deleting n
# Implementation in Maple:
#  B:=proc(pi) : inputs a permutation pi of {1,2,...,n}, outputs [i,pi']

# Pattern avoidance
# 123-avoiding permutation
# i.e. you never have a subsequence of lenght 3 that is increasing


#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([Pi,e])=[2,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 
 #the first number in the sorted version of L1 will be called 1
od:
[seq(T[L[i]],i=1..n)]:
end:


#SubSeqs3(L): The set of subsequences of the list L of length k
# 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]]}:
  od:
 od:
od:
S:
end:


#Contain3(pi,sig): inputs a permutation pi and outputs if pi
# contains 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):
fi:
S:=SubSeqs3(pi):
for s in S do
 if redu(s)=sig then
  return(true):
 fi:
od:
false:
end:


#AvoidPer1(n,sig): inputs a pos. integer n and pattern of length 3
# outpus the subset of permute(n) that avoid the pattern 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}:
 fi:
od:
G:
end: