# restart; read `d:/Aek/Composition/Composition.txt`;

# Program accompany the paper
# Parts and Subword Pattern
# in Compositions.
# For bijective proof of 
# section 3.1 and 3.2


########################
# Section 1: Basic Functions
########################
# Section 1.1: Set
# Composition(n), SetRun(n), SetPC(i,m,n),
# SetSP(P,n), SubWord(C),
# SetIO(n), SetIE(n), SetIL(n), SetIS(n),
########################
# Section 1.2: Numbers
# PC(i,m,n), Run(n), PC(i,m,n), SP(P,n),
# IO(n), IE(n), IL(n), IS(n),
########################

########################
# Section 2: Bijective Map
########################
# Section 2.1: Theorem 3.2
# Bi32(n), PCtoSP(C,m), SPtoPC(C,m),
########################
# Section 2.2: Theorem 3.3
# Main: Bi33(n), OPtoR(k,C), RtoOP(k,C),
# Step1: OPdown(k,C), OPup(T,case),
# Step2: CN1toIB(C), IBtoCN1(C),
# OP3toR3(k,C), R3toOP3(k,C),
# IEtoIL(C), ILtoIE(C), IO1toIS(C), IStoIO1(C),
# Step3: Rdown(k,C), Rup(T,case)
########################

###########################
# Section1: Basic Functions
###########################

######################
# Section1.1: Set
######################
# Input: positive integer n
# Output: set of composition number of n.
# Try: Composition(3);
Composition:= proc(n) option remember;
local i,C;

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

{seq(seq([i,op(C)],C in Composition(n-i)),i=1..n)};
end:



# Input: positive integers n
# Output: set of runs from the set of 
# composition number of n.
# Try: SetRun(3);
SetRun := proc(n) option remember;
local j,C,SS;

if n<=0 then
	ERROR("BadInput",n);
fi:

SS := {};

for C in Composition(n) do
	SS := SS union {[1,C]}; 
	for j from 2 to nops(C) do
		if C[j] <> C[j-1] then
			SS := SS union {[j,C]};
		fi:
	od:
od:
SS;
end:



# Input: positive integers i, m, n
# Output: set of all comp. of n, [k,C],  
# where part congruent to i mod m 
# at k-th position.
# Try: SetPC(2,2,4);
SetPC := proc(i,m,n) option remember;
local j,s,C,SS;

if i<=0 or m<=0 or n<=0 then
	ERROR("BadInput");
fi:

SS := {};
s := i mod m;
for C in Composition(n) do
	for j from 1 to nops(C) do
		if C[j] mod m = s then
			SS := SS union {[j,C]};
		fi:
	od:
od:
SS;
end:


# Input: positive integer n
# Output: set of composition 
# number of n, [k,C] where
# C has subpattern P at k-th position.
# Try: SetSP([1,1],5);
# SetSP([1,3,2],7);
SetSP := proc(P,n) option remember;
local i,C,SS;

SS := {};
for C in Composition(n) do
	for i from 1 to nops(C)-nops(P)+1 do
		if SubWord([seq(C[j],j=i..i+nops(P)-1)])
			=P then
			SS := SS union {[i,C]};
		fi:
	od:
od:
SS;
end:


# Input: list T
# Output: subword of T
# Try: SubWord([3,5,2,5]); 
SubWord := proc(C) option remember;
local i,N,F;

N := sort([op({op(C)})]);
F := [0$max(op(C))];

for i from 1 to nops(N) do
	F[N[i]] := i;
od:

[seq(F[C[i]],i=1..nops(C))];
end:

# Input: positive integer n
# Output: set of composition 
# of n that starts with odd part.
# Try: [seq(SetIO(i),i=1..10)];
SetIO := proc(n) option remember;
local C,SS;

SS := {};

for C in Composition(n) do
	if C[1] mod 2 = 1 then
		SS := SS union {C};
	fi:
od:
SS;
end:

# Input: positive integer n
# Output: set of composition of n that 
# starts with even part.
# Try: [seq(SetIE(i),i=1..10)];
SetIE := proc(n) option remember;
local C,SS;

SS := {};

for C in Composition(n) do
	if C[1] mod 2 = 0 then
		SS := SS union {C};
	fi:
od:
SS;
end:


# Input: positive integer n
# Output: set of composition of 
# n that the first two parts are equal.
# Try: [seq(SetIL(i),i=1..10)];
SetIL := proc(n) option remember;
local C,SS;

SS := {};

for C in Composition(n) do
	if nops(C)>1 and C[1] = C[2] then
		SS := SS union {C};
	fi:
od:
SS;
end:

# Input: positive integer n
# Output: set of composition of 
# n that first part+1= second part.
# Try: [seq(SetIS(i),i=1..10)];
SetIS := proc(n) option remember;
local C,SS;

SS := {};

for C in Composition(n) do
	if nops(C)>1 and C[2]-C[1] =1 then
		SS := SS union {C};
	fi:
od:
SS;
end:



######################
# Section1.2: Numbers
######################
# Input: positive integers i, m, n
# Output: number of all comp. of n, [k,C],  
# where part congruent to i mod m 
# at k-th position.
# Try: [seq(PC(2,2,n),n=1..10)];
PC := proc(i,m,n) option remember;
nops(SetPC(i,m,n));
end:

# Input: positive integer n
# Output: number of run in
# set of composition number of n.
# Try: [seq(Run(n),n=1..10)];
Run := proc(n) option remember;
nops(SetRun(n));
end:

# Input: positive integer n
# Output: number of comp. where 
# part congruent to i mod m in 
# set of composition number of n.
# Try: [seq(PC(1,2,n),n=1..10)];
PC := proc(i,m,n) option remember;
nops(SetPC(i,m,n));
end:

# Input: positive integer n
# Output: set of composition 
# number of n, [k,C] where C 
# has subpattern P at k-th position.
# Try: [seq(SP([1,1],n),n=1..10)];
# [seq(SP([1,3,2],n),n=1..10)];
SP := proc(P,n) option remember;
nops(SetSP(P,n));
end:

# number of composition of n that 
# starts with odd part.
# Try: [seq(IO(i),i=1..10)];
IO := proc(n) option remember;
nops(SetIO(n));
end:

# number of composition of n that 
# starts with even part.
# Try: [seq(IE(i),i=1..10)];
IE := proc(n) option remember;
nops(SetIE(n));
end:


# number of composition of n that 
# the first two parts are equal.
# Try: [seq(IL(i),i=1..10)];
IL := proc(n) option remember;
nops(SetIL(n));
end:

# number of composition of n that 
# second part - first part = 1.
# Try: [seq(IS(i),i=1..10)];
IS := proc(n) option remember;
nops(SetIS(n));
end:




###############################
# Section2: Bijective Map
###############################

###############################
# Section2.1: 
# To Show: Even(n) = Level(n)
###############################

# Bijective proof of theorem 3.2
# Input: positive integers m,n.
# Check the bijective map. By checking
# the forward map and inverse map
# if both are the same, return map
# else return the different of the maps.
# Try: Example on Table 2 page 5: 
# Bi32(2,4);
# Try: Check for all m and 1<=n<=12
# seq(seq(Bi32(m,n),m=1..n),n=1..12);
Bi32 := proc(m,n) option remember;
local T,map, invmap;

map := {seq(
[T[1],T[2],PCtoSP(T[1],T[2],m)]
,T in SetPC(m,m,n))};

invmap := {seq(
[T[1],SPtoPC(T[1],T[2],m),T[2]]
, T in SetSP([1$m],n))};

if map = invmap then
	map;
else
	[map minus invmap, invmap minus map];
	ERROR("Wrong Bijective");
fi:
end:


# Input: k-th position, C the composition
# and the number m  (C[k]=m)
# Output: SP of (m,C) at k-th position.
# Try: PCtoSP(1,[4],2);
# PCtoSP(3,[2,2,2],2);
PCtoSP := proc(k,C,m)  option remember;

[op(1..k-1,C),(C[k]/m)$m
,op(k+1..nops(C),C)];
end:

# Input: k-th position, C the composition
# and the number m  
# Output: PC of ([1$m],C) at k-th position.
# Try: SPtoPC(2,[1,1,1,1],2);
SPtoPC := proc(k,C,m)  option remember;
[op(1..k-1,C),C[k]*m
,op(k+m..nops(C),C)];
end:


###############################
# Section2.2: 
# To Show: Odd(n) = Run(n)
###############################

############################
# Main Functions:
############################
# Bijective proof of theorem 3.3
# Input: positive integers n.
# Check the bijective map. By checking
# the forward map and inverse map
# if both are the same, return map
# else return the different of the maps.
# Try: Bi33(3);
# Try: seq(Bi33(n),n=1..5);
Bi33 := proc(n) option remember;
local T,map,invmap;

map := {seq([T,OPtoR(T[1],T[2])],T in SetPC(1,2,n))};
invmap := {seq([RtoOP(T[1],T[2]),T],T in SetRun(n))};

if map = invmap then
	map;
else
	[map minus invmap, invmap minus map];
	ERROR("Wrong Bijective");
fi:
end:


# Input: (k,C) where k-th position, 
# C the composition is odd.
# Output: [kp,CP] where CP has run starting 
# at the k-th position.
# Process: 
# Step1: LHS to RHS of (3.2) page6 
# Step2: RHS of (3.2) to RHS of (3.3)
# Step3: RHS to LHS of (3.3)
# Try: OPtoR(1,[3,1]);
OPtoR := proc(k,C) option remember;
local OP,R;

if C=[1] then
	return([1,[1]]);
fi:

#Step1
OP := OPdown(k,C); 

#Step2
if OP[2] = 1 then
	R := OPtoR(OP[1][1],OP[1][2]);
elif OP[2] = 2 then
	R := CN1toIB(OP[1]);
elif OP[2] = 3 then
	R := OP3toR3(OP[1][1],OP[1][2]);
elif OP[2] = 4 then
	R := IEtoIL(OP[1]);
else
	ERROR("NoCase");
fi:

#Step3
Rup(R,OP[2]);
end:


# Input: k-th position, C the composition 
# where C[k] is starting the run.
# Output: [kp,CP] where 
# CP at the k-th position is odd.
# This is the inverse map of OPtoR.
# Try: RtoOP(1,[3,1]);
RtoOP := proc(k,C) option remember;
local OP,R;

if C=[1] then
	return([1,[1]]);
fi:

R := Rdown(k,C); 
if R[2] = 1 then
	OP := RtoOP(R[1][1],R[1][2]);
elif R[2] = 2 then
	OP := IBtoCN1(R[1]);
elif R[2] = 3 then
	OP := R3toOP3(R[1][1],R[1][2]);
elif R[2] = 4 then
	OP := ILtoIE(R[1]);
else
	ERROR("NoCase");
fi:

OPup(OP,R[2]);
end:




##########
# Step1:
##########
# Input: Composition C (of n) with
# the k-th position is odd.
# Output: [[k,C],case] where the k-th 
# position of composition of (n-1) is odd.
# Try: OPdown(3,[2,1,1]);
OPdown := proc(k,C) option remember;

# Check input
if C[k] mod 2 <> 1 then
	ERROR("BadInput");
fi:

if C[1]=1 and nops(C)>=2 and k>=2 then
	[[k-1,[op(2..nops(C),C)]],1];
elif C[1]=1 and k=1 then
	if C[2] >= 2 then
		[[op(2..nops(C),C)],2];
	elif
		C[2]=1 then
		[[1,[op(2..nops(C),C)]],3];
	fi:	
elif C[1]>=2 and nops(C)>=2 and k>=2 then
	[[k,[C[1]-1,op(2..nops(C),C)]],3];
elif C[1]>=2 and k=1 then
	[[C[1]-1,op(2..nops(C),C)],4];
else
	ERROR("NoCase",C);
fi

end:


# Input: Composition T (of n) 
# and case (1,2,3 or 4). 
# Output: [k,C], composition C (of n+1) 
# with the k-th position is odd.
# Try: OPup([3,[1,1,1]],1);
OPup := proc(T,case) option remember;

#check input
if (case=1 or case =3) and
T[2][T[1]] mod 2 <> 1 then
	ERROR("BadInput",T);
elif case = 3 and T[1]=1 and
T[2][1] mod 2 = 1 and T[2][1] > 1 then
	ERROR("BadInput",T);
elif case = 2 and T[1] = 1 then
	ERROR("BadInput",T);
elif case = 4 and T[1] mod 2 <> 0 then
	ERROR("BadInput",T);
fi:


if case=1 then
	[T[1]+1,[1,op(T[2])]];
elif case=2 then
	[1,[1,op(T)]];
elif case=3 then
	if T[1] > 1 then
		[T[1],[T[2][1]+1,op(2..nops(T[2]),T[2])]];
	elif T[1] = 1 then
		[T[1],[1,op(T[2])]];
	fi:
elif case=4 then
	[1,[T[1]+1,op(2..nops(T),T)]];
else
	ERROR("NoCase");
fi:

end:



###########
# Step 2:
###########
# Input: Composition not starting with 1.
# Output: Composition with 
# starting part greater than 1.
# Try: CN1toIB([2,3,6,3,5]);
CN1toIB := proc(C) option remember;
if C[1]=1 then
	ERROR("BadInput",C);
fi:
C;
end:


# Input: Composition with 
# starting part greater than 1.
# Output: Composition not starting with 1.
# Try: CN1toIB([2,3,6,3,5]);
IBtoCN1 := proc(C) option remember;
if C[1]=1 then
	ERROR("BadInput",C);
fi:
C;
end:


# Input: Composition C with 
# the k-th position is odd.
# Output: the corresponding 
# composition where run starting at
# the k-th position.
# Note: this is a little more
# complicated than OPtoR procedure.
# Try: OP3toR3(4,[2,3,6,3,5]);
OP3toR3 := proc(k,C) option remember;
local R,IO1;

R := OPtoR(k,C);
while R[1]=1 and nops(R[2]) >=2 
and R[2][1]+1=R[2][2] do
	IO1 := IStoIO1(R[2]);
	R := OPtoR(1,IO1);
od:
R;
end:


# Input: Composition C where 
# run starting at the k-th position.
# Output: the corresponding 
# composition with the k-th 
# position is odd.
# Note: this is a little more
# complicated than RtoOP procedure.
# Try: R3toOP3(2,[2,3,6,3,5]);
R3toOP3 := proc(k,C) option remember;
local OP,IS;

OP := RtoOP(k,C);
while OP[1]=1 and OP[2][1] >1 
and OP[2][1] mod 2=1 do
	IS := IO1toIS(OP[2]);
	OP := RtoOP(1,IS);
od:
OP;
end:




# Input: Composition with 
# starting part is even.
# Output: Composition with
# the first two parts are the same.
# Try: IEtoIL([4,1,1]);
IEtoIL := proc(C)  option remember;
if C[1] mod 2 <> 0 then
	ERROR("BadInput",C);
fi:
[(C[1]/2)$2,op(2..nops(C),C)];
end:

# Input: Composition with 
# the first two parts are the same.
# Output: Composition with
# starting part is even.
# Try: ILtoIE([2,2,1,1]);
ILtoIE := proc(C)  option remember;
if nops(C) < 2 or C[1] <> C[2] then
	ERROR("BadInput",C);
fi:
[C[1]*2,op(3..nops(C),C)];
end:


# Input: Composition with 
# the first part is odd and greater than 1.
# Output: Composition with
# first part+1 = second part.
# Try: IO1toIS([5,2,3,1]);
IO1toIS := proc(C)  option remember;
if C[1] =1 or C[1] mod 2 <> 1 then
	ERROR("BadInput",C);
fi:
[floor(C[1]/2),ceil(C[1]/2),op(2..nops(C),C)];
end:

# Input: Composition with
# first part+1 = second part.
# Output: Composition with 
# the first part is odd and greater than 1.
# Try: IStoIO1([1,2,3,1]);
IStoIO1 := proc(C)  option remember;
if nops(C) < 2 or C[1]+1 <> C[2] then
	ERROR("BadInput",C);
fi:
[C[1]+C[2],op(3..nops(C),C)];
end:



##########
# Step 3:
##########
# Input: Composition C (of n) with
# starting run at the k-th position.
# Output: [[k,C],case] where 
# starting run is at the k-th position 
# of composition C.
# Try: Rdown(3,[2,1,1]);
Rdown := proc(k,C) option remember;
local NC;

#Check input
if k>1 and C[k] = C[k-1] then
	ERROR("BadInput",[k,C]);
fi:

if C[1]=1 then
	if k>1 then
		[[k-1,[op(2..nops(C),C)]],1];
	elif (k=1 and C[k]=C[k+1]) then
		[[1,[op(2..nops(C),C)]],1];
	else
		[[op(2..nops(C),C)],2];
	fi:
else
	NC := [C[1]-1,op(2..nops(C),C)];
	if nops(C)=1 or (k=2 and C[1]-1=C[2]) then
		[[1,NC],3];
	elif k=1 and C[1]=C[2] then
		[[2,NC],3];
	elif k=1 and C[1]-1=C[2] then
		[NC,4];
	else
		[[k,NC],3];
	fi:	
fi:

end:

# Input: Composition T (of n) 
# and case (1,2,3 or 4). 
# Output: [k,C], composition C (of n+1) 
# with the run starting at k-th position.
# Try: Rup([1,[1,1,1]],1);
Rup := proc(T,case) option remember;
local NC;

#check input
if (case=1 or case =3) and
T[1]>1 and T[2][T[1]] = T[2][T[1]-1] then
	ERROR("BadInput",T);
elif case = 3 and T[1]=1 and
T[2][1]+1 = T[2][1] then
	ERROR("BadInput",T);
elif case = 2 and T[1] = 1 then
	ERROR("BadInput",T);
elif case = 4 and nops(T)>1
and T[1]<>T[2] then
	ERROR("BadInput",T);
fi:

if case=1 then
	if T[1]=1 and T[2][1]=1 then
		[1,[1,op(T[2])]];
	else
		[T[1]+1,[1,op(T[2])]];
	fi:
elif case=2 then
	[1,[1,op(T)]];
elif case=3 then
	NC := [T[2][1]+1,op(2..nops(T[2]),T[2])]; 
	if nops(T[2])=1 or
	(T[1] = 2 and T[2][1]+1=T[2][2]) then
		[1,NC];
	elif T[1] = 1 and T[2][1]=T[2][2]then
		[2,NC];
	else
		[T[1],NC];
	fi:
elif case=4 then
	[1,[T[1]+1,op(2..nops(T),T)]];
else
	ERROR("NoCase");
fi:

end:


######################################
# Testing, for internal use only 
# Try: TestOPdown(2); 
#TestOPdown := proc(n) option remember;
#local T;
#
#for T in SetPC(1,2,n) do
#	OPdown(T[1],T[2]);
#od:
#return();
#end:
#
# Try: TestOPup(2); 
#TestOPup := proc(n) option remember;
#local T,S,R;
#
#for T in SetPC(1,2,n) do
#	S:=OPdown(T[1],T[2]);
#	R := OPup(S[1],S[2]);
#	print(T,R);
#od:
#return();
#end:
#
# Try: TestRdown(2); 
#TestRdown := proc(n) option remember;
#local T;
#
#for T in SetRun(n) do
#	Rdown(T[1],T[2]);
#od:
#return();
#end:
#
# Try: TestRup(2); 
#TestRup := proc(n) option remember;
#local T,S,R;
#
#for T in SetRun(n) do
#	S := Rdown(T[1],T[2]);
#	R := Rup(S[1],S[2]);
#	#print(T,R);
#	if T <> R then
#		ERROR("WrongAlgo");
#	fi:
#od:
#print("Good");
#return();
#end: