# OK to post homework
# Lucy Martinez, 02-27-2026, Assignment 11

with(combinat):


# Question 1:
# Using procedure GenCompsGF(a,b,A,B,x), write a procedure
#  CountNuCompsClever(a,b,A,B,N) that inputs the positive integers a and b
#  and a subset A of {1, ..., a} and a subset B of {0,...,b-1}
#  and outputs the first N terms of the sequence enumerating
#  compositions all whose parts have the property that i mod a belongs to A
#  and the number of parts mod b belongs to B.
#  In other words, a composition L qualifies if member(nops(L) mod b,B) is true
#  and {seq(L[i] mod a, i=1..nops(L))} minus A={}
#  Hint: To get the first N+1 coefficients, starting at n=0 of the Taylor coefficients around x=0,
#  you use the Maple command [seq(coeff( taylor(f,x=0,N+3),x,i),i=0..N)]: 
CountNuCompsClever:=proc(a,b,A,B,N) local f,i:
f:=GenCompsGF(a,b,A,B,x):
[seq(coeff( taylor(f,x=0,N+3),x,i),i=1..N)]: 
end:



#Question 2:
# Write a procedure CountNuCompsStupid(a,b,A,B,N) that does the same thing but as follows:
#  Write a procedure CountNuCompsStupid1(a,b,A,B,n), that finds the number
#  of compositions of n that obeys the stated condition,
#  but first using Comps(n) (there are 2^(n-1) of them, so you can go to n=16 easily),
#  and for each of them, L, checks whether nops(L) mod b belongs to B,
#  and all the members of L mod a belongs to A and collects them into a set and does nops.
# Check that CountNuCompsClever(a,b,A,B,15)= CountNuCompsStupid(a,b,A,B,15) for
#  a=3, b=4, A={1,2}, B={0,3}
#  a=2, b=3, A={1}, B={2} 
# ANSWER: YES! Both of them agree:
# CountNuCompsStupid(3,4,{1,2},{0,3},15) and 
#  CountNuCompsClever(3,4,{1,2},{0,3},15) both return
#  [0, 0, 1, 4, 7, 10, 18, 34, 62, 114, 211, 390, 717, 1316, 2420]
# Also,
# CountNuCompsStupid(2,3,{1},{2},15) and
#  CountNuCompsClever(2,3,{1},{2},15) both return
#  [0, 1, 0, 2, 1, 3, 5, 5, 15, 13, 36, 42, 81, 128, 192]


CountNuCompsStupid1:=proc(a,b,A,B,n) local S,S1,s,S2,S3,i:
S:=Comps(n):
S1:={}:
for s in S do
 S2:={seq(s[i] mod a, i=1..nops(s))}:
 S3:=S2 minus A:
 if member(nops(s) mod b,B) and S3={} then
  S1:=S1 union {s}:
 fi:
od:
nops(S1):
end:

CountNuCompsStupid:=proc(a,b,A,B,N) local i:
[seq(CountNuCompsStupid1(a,b,A,B,i),i=1..N)]:
end:



##################################From previous classes:
# C11.txt, Feb. 26, 2026


Help11:=proc():
 print(`CP(A,B), WtE(A,x), PowA(A,n), GenCompsGF(a,b,A,B,x)`):
end:

#|A union B|=|A| + |B| - |A intersect B|

#Def: Given two sets A and B, the cartesian product is given by
# {[a,b] : a in A and b in B}
# CP({[1,2],[4,5]},{[5,6],[6,7]})={[[1,2],[4,5]]},..

#CP(A,B): the Cartesian product of two sets (possibly given as lists)
CP:=proc(A,B) local a,b:
{seq(seq([op(a),op(b)],a in A),b in B)}:
end:

#The number of elements in the Cartesian product:
# |AxB|=|A|x|B|
# Wt([a,b])=Wt(a) + Wt(b)

# WtE(CP(A,B),x)=WtE(A,x)*WtE(B,x)
# Corollary: WtE(A^n,x)=Wt(A,x)^n

# Wt Enumerator of the set of all positive integers:
#  x+x^2+x^3+...=x(1+x+x^2+...)=x/(1-x)

# The weight enumerator of the compositions with exactly k parts 
# is given by
# ( x/(1-x) )^k
# Now, consider:
# add( (x/(1-x))^k, k=0..infinity)
# Let A=x/(1-x) then 
#  add( A^k, k=0..infinity) = 1/(1-A), A=x/(1-x)

#Wt of all compositions of n is given by
# 1/(1- T) where T=x/(1-x)

#if we dont believe in calculus, then 
# pretend infinity

# Weight enumerator of odd integers:
#  x+x^3+x^5+... = x(1+x^2+x^4+...)=x/(1-x^2)
# S=1+x^2+x^4+... and x^2*S=x^2+x^4+... so (1-x^2)*S=1 and so S=1/(1-x^2)
# So, the generating function of all compositions into odd parts :
# odd compositions is 
# 1/(1-T) where T=x/(1-x^2)

#Let A be a finite set, then the weight enumerator of all compositions
# with members in A is
# 1/(1-Wt(A,x))

# For {1,2}, Wt({1,2})=x+x^2
# WtE. of all {1,2} compositions is 1/(1-Wt({1,2}))=1/(1-x-x^2)


# Inputs an integer a and a subset A of {0,1,...,a-1}
# and an integer b with a subset B of {0,1,...,b-1}
# find the generating function (aka weight enumerator)
# for the compositions in which each part is such that i mod a belongs to A
# Number of parts k is such that k mod b is in B
#
# All compositions a=1,b=1, A={0} and B={0}
# For the odd compositions: a=2, A={1} and b=1, B={0}


#GenCompsGF(a,b,A,B,x): The rational function whose Taylor series is such that
# the coeff. of x^n is the EXACT number of compositions whose
# parts all obey i mod a belongs to A AND
# number of parts k obey k mod b belongs to B
# GF of i mod a: x^i + x^(i+a) + x^(i+2a) + x^(i+3a) + ... = x^i/(1-x^a)
GenCompsGF:=proc(a,b,A,B,x) local f,i,j:
f:=add(x^i,i in A)/(1-x^a):
normal(add(f^j, j in B)/(1-f^b)):
end:


#WtE(A,x): The sum of x^a in A1 (weight enumerator)
WtE:=proc(A,x) local a:
add(x^convert(a,`+`), a in A):
end:


#PowA(A,n): The cartesian product of A with itself n times
PowA:=proc(A,n) local S:
if n=1 then
 return(A):
fi:
CP(PowA(A,n-1),A):
end:



####################################
# 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(`WtE2(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:


#WtE2(S,f,x): Sum(x^f(s), s in S)
WtE2:=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: