# restart; 
# read`\c:/Users/Asus/Google Drive/Aek/RadoEq/Schaal.txt`;

# Accompanying my own paper:
# Rado Numbers of Nonhomogeneous 
# Regular Equations

# First version: July 19, 2019

with(ListTools):


#################################
# Section 1.1: 
# New program to compute 
# Rado numbers. This is an 
# improvement to my old 
# program, "RamseyIntegers". 
#
# Functions:
# Rado1(C,b,k), SubRado1(C,b,chi,nn),
# TupN(C,b,S,nn), TupSol(C,b,S),
# Len1(chi), NotEmp(LS), 
#
# GoodCol(chi,C,b),
#
#################################

# The main program to compute 
# the "good" coloring
# Input: the list C of coeffs and
# constant b for equation CX=b 
# and constant k for k colors.
# Output: the set of the longest
# "good" coloring
# Try: 
# Rado1([-1,1,1],0,2);
# Rado1([[-2,1,1],0,2);
Rado1 := proc(C,b,k) option remember;
local i;

if add(i,i in C)=b then
	return({[]});
fi:

SubRado1(sort(C),b,[{1},{}$(k-1)],2);
end:


# Subfunction of Rado1
# Input: List of coeffs C, constant b,
# the current good coloring chi and
# the new position n
# Output: the set of longest possible 
# intervals that not contain mono-chromatic 
# solution of CX=b with k colors.
# Try: SubRado1([1,1,-1],0,[{1},{}$(2)],2);
SubRado1 := proc(C,b,chi,nn) option remember;
local i,MS,nchi,champ,XX,YY;

XX := {};
champ := 0;

for i from 1 to min(nops(chi),NotEmp(chi)+1) do
	MS := chi[i] union {nn};
	
	if TupN(C,b,MS,nn)=false then
		nchi := chi;
		nchi[i] := MS;
		YY := SubRado1(C,b,nchi,nn+1);
		if YY <> {} and Len1(YY[1]) = champ then
			XX := XX union YY;
		elif YY <> {} and Len1(YY[1]) > champ then
			XX := YY;
			champ := Len1(YY[1]);
		fi:
	fi:
od:

if XX = {} then
	return({chi});
else
	return(XX);
fi:
end:



# Solve for tuple solution of
# sum_i c_i*x_i=b where x_i is in S
# with at least one co-or equals 
# the biggest element in S
# Input: List of coeffs C, constant b,
# the set of position S and
# the current position nn
# Output: list of "good" tuple 
# if there is one and false otherwise 
# Try: 
# TupN([-1,1,1,1],3,{1,4,5},5);
TupN := proc(C,b,S,nn) option remember;
local i,t,nC,nb;

for i from 1 to nops(C) do
	nC := [op(1..i-1,C),op(i+1..nops(C),C)];
	nb := b-C[i]*nn;
	t := TupSol(nC,nb,S);
	if t <> false then
		return([op(1..i-1,t),nn,op(i..nops(t),t)]);
	fi:
od:

return(false)
end:


# Solve for tuple solution of
# sum_i c_i*x_i=b where x_i is in S
# Input: List of coeffs C, constant b,
# the set of position S 
# Output: list of "good" tuple 
# if there is one and false otherwise 
# Try: TupSol([-1,1,1],4,{1,4,5});
# TupSol([-1,1,1,2],0,{1,3,5});
TupSol := proc(C,b,S) 
#option remember;
local i,c,t,nC,nb;

if C = [] then
	if b=0 then
		return([]);
	else
		return(false);
	fi:
fi:
	
if min(op(C)) >= 1 and b < nops(C) then	
	return(false);
fi:

nC := sort(C);
c := nC[1];
nC := [op(2..nops(nC),nC)];

for i in S do
	nb := b-c*i;
	t := TupSol(nC,nb,S);
	if t <> false then
		return( [i,op(t)] );
	fi:
od:

return(false);
end:


# Helper function
# Input: The coloring, Col
# Output: the length of the 
# interval from the coloring
# Try: Len1([{1,3},{2}]);
Len1 := proc(Col) option remember;
local S,T;

T := `union`(seq(S, S in Col));
nops(T);
end:


# Helper function
# Input: The coloring, Col
# Output: number of non-empty set in LS
# Try: NotEmp([{1},{}$4]);
NotEmp := proc(Col) option remember;
local i,a;

a := 0;
for i from 1 to nops(Col) do
	if Col[i] <> {} then
		a := a+1;
	fi:
od:
a;	
end:


#############################################
# Check whether the giving coloring is good
# Input: the coloring interval chi, 
# the list of coeffs C and constant b 
# for the equation CX=b.
# Output: true if chi has no mono. solution in
# E: c1*x1+c2*x2+...+c{k-1}*x{k-1}+c{k}*x{k}=b,
# return false otherwise.
# Try: GoodCol([{1,3,4},{2}],[-1,1,1,2],2);
# GoodCol([{1,4},{2,3}],[-1,1,1,2],2);
GoodCol := proc(chi,C,b) option remember;
local S;

for S in chi do
	if TupSol(C,b,S) <> false then
		return(false);
	fi:	
od:

return(true);
end:



#################################
# Section 1.2: 
# Find all symmetric good colorings
# 
# Functions:
# SymRado(C,b,k,N), 
# SubSymRado(C,b,N,chi,nn), 
#
#################################

# Compute the symmetric only 
# "good" coloring
# Input: the list C of coeffs and
# constant b for equation CX=b 
# and constant k for k colors along
# witht the length of the interval N
# Output: the set of the longest
# symmetric "good" coloring

# Try: 
# SymRado([-1,1,1],0,2,4);
# SymRado([-1,1,2],0,2,10);
# SymRado([-1,1,1],0,3,13);
# SymRado([-1,1,1],0,4,43); #the correct number is 44
SymRado := proc(C,b,k,N) option remember;
local i;
if add(i,i in C)=b then
	return({[]});
fi:

SubSymRado(sort(C),b,N,[{1,N},{}$(k-1)],2);
end:

# Subfunction of SymRado
# Input: the list C of coeffs and
# constant b for equation CX=b 
# and constant k for k colors along
# with the length of the interval N,
# coloring chi and the new position nn.
# Output: the set of the longest
# symmetric "good" coloring

# Output: the set of longest possible 
# symmetric intervals that not contain 
# mono-chromatic solution of CX=b 
# with k colors.
# Try: 
# SubSymRado([-1,1,1],0,4,[{1,4},{}],2);
# SubSymRado([-1,1,1],0,13,[{1,4},{},{}],2);
SubSymRado := proc(C,b,N,chi,nn) option remember;
local i,nchi,MS,XX;

if nn > ceil(N/2) then
	return({chi});
fi:

XX := {};

for i from 1 to min(nops(chi),NotEmp(chi)+1) do
	MS := chi[i] union {nn, N+1-nn}; 
	if TupN(C,b,MS,nn)=false 
	and TupN(C,b,MS,N+1-nn)=false then
		nchi := chi;
		nchi[i] := MS;
		XX := XX union SubSymRado(C,b,N,nchi,nn+1);
	fi:
od:

return(XX);
end:



#################################
# Section 2: 
# Verify some lower bounds to 
# the main theorem in my paper.
# 
# Functions:
# LowThm4(C,k), ValLow8(C,w,k),
# LowThm8(C,k), NewInt(chi,w), 
# CheckEx(Col,C),
#
# MyLib(C,k), SetToInt(chi), 
# IntToSet(T),
#
#################################


# Test the lower bound of theorem 4.
# Only test for b=-s*m of equation 
# in the form -1,+,+,...
# Input: the list C of coeffs 
# for equation CX=0 
# and constant k for k colors
# Output: print out some information
# of lower bounds for various b.
# Try: LowThm4([-1,1,1],2);
# LowThm4([-1,1,1],3);
# LowThm4([-1,1,2],2);
# LowThm4([-1,1,1,1],2);
# LowThm4([-1,1,1,1],3);
# LowThm4([-1,1,1,1,1],2);

LowThm4 := proc(C,k) option remember;
local c,A,s,R,b,m,T,M,chi;

s := add(c, c in C);
A := {};

for chi in MyLib(C,k) do
	if CheckEx(chi,C) then
		A := A union {chi};
	fi:	
od:

print("s=",s,"Number of Good Coloring=", nops(A));

R := Len1(A[1])+1; 

for chi in A do 
	M := SetToInt(chi);
	print("Col is", M);
	for m from 1 to 5 do
		T := [seq((M[i])$m,i=1..nops(M))];
		print("b=",-s*m,"r-1=",(R-1)*m,nops(T),
		GoodCol(IntToSet(T),C,-s*m));
	od:
od:

return();
end:



# Compute the actual lower bound of theorem 8.
# Only test for b=s*w.
# Try: ValLow8([-1,1,2],16,2);
ValLow8 := proc(C,w,k) option remember;
local c,s,A,R,M,B;

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

s := add(c, c in C);
A := MyLib(C,k);
R := Len1(A[1])+1;

print("s=",s,"nops(A)=", nops(A)); 
print(R,A);

for M in Rado1(C,s*w,k) do
	B := SetToInt(M);
	print(s*w,B,nops(B),"Theory value",w-ceil(w/R));
od:	

return();
end:


# Test the lower bound of theorem 8.
# Only test for b=s*w of equation 
# in the form -1,+,+,...
# Input: the list C of coeffs 
# for equation CX=0 
# and constant k for k colors
# Output: print out some information
# of lower bounds for various b.
# Try: LowThm8([-1,1,1],3);
LowThm8 := proc(C,k) option remember;
local c,w,chi,s,A,R,M,T,S;

s := add(c, c in C);
A := {};

for chi in MyLib(C,k) do
	if CheckEx(chi,C) then
		A := A union {chi};
	fi:	
od:

print("s=",s,"Number of Good Coloring=", nops(A));

R := Len1(A[1])+1; 

for chi in A do 
	M := SetToInt(chi);
	print("Col is",M);
	S := {}:
	for w from 2 to R+4 do
		T := NewInt(M,w);
		if GoodCol(IntToSet(T),C,s*w)=false then
			print("false",w);
		fi:	
			
		S := S union {GoodCol(IntToSet(T),C,s*w)};
	od:
	print(S);	
od:

return();
end:



# Input: chi= good coloring for E(0), w=b/s
# Output: the supposely good coloring for E(b).
# Try: chi :=[1,2,2,1,3,3,3,3,3,1,2,2,1];
# NewInt(chi,12);
# NewInt([1,2,2,1],12);
NewInt := proc(chi,w) option remember;
local i,R,m,L,T;

R := nops(chi)+1;
m := ceil(w/R);
L := w-m;

T := [seq(chi[i]$m,i=1..nops(chi))];

[seq(T[L+1-i],i=1..L)];
end:




# Check the excellent condition 
# for the coloring
# Input: the coloring Col,
# list C of coeffs for equation CX=0. 
# Output: true if Col satisfy excellent
# condition and false otherwise.
# Try:
# CheckEx([{1,4,10,13},{2,3,7,11,12},{5,6,8,9}],[-1,1,1]);
CheckEx := proc(Col,C) option remember;
local i,c,s;

s := add(c, c in C);

for i from 0 to s do
	if GoodCol(Col,C,-i) = false then
		return(false);
	fi:
od:

true:
end:


###############################################
# Input: the list C of coeffs 
# for equation CX=0 
# and constant k for k colors
# Output: the set of the longest
# "good" colorings, some of 
# which I did not compute
# Try: MyLib([-1,1,1,1],3);
MyLib := proc(C,k) option remember;
local A;

if C = [-1,1,1,1] and k=3 then
	A := {[{1,2,9,10,33,34,41,42},
	{3,4,5,6,7,8,35,36,37,38,39,40},{seq(11+i,i=0..21)}]};
elif C = [-1,1,1,1,1] and k=3 then
	A := {[{1,2,3,16,17,18,31,32,33,46,47,48,61,
	62,63,76,77,78,91,92,93},{seq(4+i,i=0..11)
	,seq(79+i,i=0..11)},{seq(19+i,i=0..11)
	,seq(34+i,i=0..11),seq(49+i,i=0..11),seq(64+i,i=0..11)}]};
elif C = [-1,1,1,1,1,1] and k=3 then
	A := {[{seq(1+i,i=0..3),seq(25+i,i=0..3),seq(49+i,i=0..3)
	,seq(73+i,i=0..3),seq(97+i,i=0..3),seq(121+i,i=0..3)
	,seq(145+i,i=0..3),seq(169+i,i=0..3)},
	{seq(5+i,i=0..19),seq(149+i,i=0..19)},
	{seq(29+i,i=0..19),seq(53+i,i=0..19),seq(77+i,i=0..19)
	,seq(101+i,i=0..19),seq(125+i,i=0..19)}]};
elif C = [-1,1,1] and k=4 then
	#A := SymRado(C,0,k,43);	#the correct number is 44
	A := {[{1, 3, 5, 15, 17, 19, 26, 28, 40, 42, 44}
		,{2, 7, 8, 18, 21, 24, 27, 37, 38, 43}
		,{4, 6, 13, 20, 22, 23, 25, 30, 32, 39, 41}
		,{9, 10, 11, 12, 14, 16, 29, 31, 33, 34, 35, 36}]};
else
	A := Rado1(C,0,k);
fi:

return(A);	
end:


# Helper function
# Turns the coloring in the set
# form to the interval form
# Input: coloring chi in the set form
# Output: coloring in the interval form
# Try: SetToInt([{1,4},{2,3}]);
# SetToInt([{1,4,10,13},{2,3,11,12},{5,6,7,8,9}]);
SetToInt := proc(chi) option remember;
local i,j,T;

T := [0$Len1(chi)];

for i from 1 to nops(chi) do
	for j in chi[i] do
		T[j] := i;
	od:
od:
T;	
end:


# Helper function
# Turns the coloring in the 
# interval form to the set form
# Input: coloring chi in the interval form
# Output: coloring in the set form
# Try: IntToSet([1,2,2,1]);
# IntToSet([1,2,2,1,3,3,3,3,3,1,2,2,1]);
IntToSet := proc(T) option remember;
local i,col,chi;

col := max(op(T));
chi := [{}$col];

for i from 1 to nops(T) do
	chi[T[i]] := chi[T[i]] union {i};
od:

chi	
end:


#################################
# Section 3: 
# Future work: test for values
# of E(b) with different coeffs
# than -1,+,+,...
#
# Functions:
# TestB(C,k), 
# 
#################################

# Test Rado numbers of the given 
# coeffs with various values of b
# Try: 
# TestB([-1,1,1],2);
TestB := proc(C,k) option remember;
local c,b,s,t,A,R,a,m,Pos,Neg;

s := add(c,c in C);
A := Rado1(C,0,k);
R := Len1(A[1])+1;
print("s=",s,"Number of Good Coloring=", nops(A));

Neg :=[R];

for m from 1 to 4 do
	b := -s*m;
	A := Rado1(C,b,k);
	print("b=",b,"r=",Len1(A[1])+1,
	seq(SetToInt(a), a in A));
	Neg := [op(Neg),Len1(A[1])+1];
od:


Pos :=[R];

for m from 1 to (R+2) do
	b := s*m;
	A := Rado1(C,b,k);
	print("b=",b,"r=",Len1(A[1])+1,
	seq(SetToInt(a), a in A));
	Pos := [op(Pos),Len1(A[1])+1];	
od:

return(Neg,Pos);
end: