# Matthew Russell
# Experimental Math
# Homework 18
# I give permission to post this

read `public_html/em12/c18.txt`;

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

# Find as many mathematical mistakes and inaccuracies in this
# nice but mathematically inaccurate Star-Ledger article.

# "Szemerédi’s field is discrete mathematics, specifically combinatorics,
# which is the science of number sequences or arithmetical progressions."
# While combinatorics does include the study of number sequences and arithmetical progressions,
# it is by no means limited to these topics.

# "In 1975, then in his mid-30s, Szemerédi proved that arithmetical
# progressions of any length — five, 10, 10,000, etc. — can be found in any positive sequence of integers."
# It is not clear what the author meant by a "positive sequence of integers". Most likely, it was intended
# to mean any (increasing?) sequence of positive integers. However, the statement then becomes false - 
# the sequence given by the factorial function does not contain a single 3-term progression.
# The statement should have read something along the lines of
# "any increasing sequence of integers with positive upper density".

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

# Write a procedure
# WnS(A,FP,B,n)
# (S is for stupid) that inputs and outputs the same as Wn(A,FP,B,n) but does it by
# brute-force counting, analogously to adnS(d,n). You may follow the following steps.
#    Write a procedure: AllWords(A,n) that inputs an alphabet A,
#    and a pos. integer n, and outputs the set of all nops(A)^n words of length n
#    Write a procedure IsBad1(w,fp1,B) that returns true if and only if
#    the word w contains the single pattern fp1. You are welcome to use a recursion.
#    Write a procedure IsBad(w,FP,B) that returns true if and only if the word
#    w contains at least one of the members of the set of patterns FP.
#    Write a procedure
#    SetWnS(A,FP,B,n)
#    that actually constructs the set of n-letter words in the alphabet A not containing any of the patterns of FP.
#    Finally write the one-line procedure WnS(A,FP,B,n) 

AllWords:=proc(A,n) local A1, a1, a:
option remember:

if n=0 then
	return {[]}:
fi:
A1:=AllWords(A,n-1):
return {seq(seq([op(a1),a],a in A),a1 in A1)}:

end:

IsBadW1:=proc(w,fp1,B) local flag, i:

if nops(w)<nops(fp1) then
	return false:
fi:
# Check the start
flag:=true:
for i from 1 to nops(fp1) while flag do
	if fp1[i]<>B and fp1[i]<>w[i] then
		flag:=false:
	fi:
od:
if flag then
	return true:
fi:
# Else, recurse

return IsBadW1([op(2..nops(w),w)],fp1,B):

end:

IsBadW:=proc(w,FP,B) local fp1:

for fp1 in FP do
	if IsBadW1(w,fp1,B) then
		return true:
	fi:
od:
return false:

end:

SetWnS:=proc(A,FP,B,n) local W,L,w:

W:=AllWords(A,n):
L:={}:
for w in W do
	if not IsBadW(w,FP,B) then
		L:=L union {w}:
	fi:
od:
return L:

end:

WnS:=proc(A,FP,B,n)

return nops(SetWnS(A,FP,B,n)):

end:

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

# Find the first 15 terms of

#    WnS({0,1},{[1,1,1],[1,B,1,B,1],[1,B,B,1,B,B,1],[1,B,B,B,1,B,B,B,1], [1,B$4,1,B$4,1],[1,B$5,1,B$5,1]},B,n);
#    2, 4, 7, 13, 23, 40, 65, 106, 169, 278, 443, 705, 1117, 1760, 2807 (not in OEIS)

#    WnS({0,1}, { [1,1,1],[1,B,1,B,1],[1,B,B,1,B,B,1],[1,B,B,B,1,B,B,B,1], [1,B$4,1,B$4,1],[1,B$5,1,B$5,1],
#		 [0,0,0],[0,B,0,B,0],[0,B,B,0,B,B,0],[0,B,B,B,0,B,B,B,0], [0,B$4,0,B$4,0],[0,B$5,0,B$5,0]}, ,B,n);
#    2, 4, 6, 10, 14, 20, 16, 6, 0, 0, 0, 0, 0, 0, 0

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

# What choice of FP will make the output of WnS({0,1},FP,B,n) the same as Ndn(d,n)?
# Write a program SFP(d,n) that inputs positive integers d and n and outputs such FP.

SFP:=proc(d,n) local FP, j:

FP:={}:
for j from 0 while (d-1)*j+d<=n do
	FP:=FP union {[1,seq(op([B$j,1]),k=2..d)]}:
od:

return FP:

end:

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

# Verify that you indeed get the same thing as the output of Ndn(d,n) for 3 ≤ d ≤ 4 and 1 ≤ n ≤ 15.

NdnSFP:=proc(d,n) local FP:

FP:=SFP(d,n):
return WnS({0,1},FP,B,n):

end:

# NdnSFP(3,n), n=1..15: 2, 4, 7, 13, 23, 40, 65, 106, 169, 278, 443, 705, 1117, 1760, 2692
# NdnSFP(4,n), n=1..15: 2, 4, 8, 15, 29, 56, 103, 192, 364, 668, 1222, 2233, 3987, 7138, 12903
# These both check.

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

# Do the analogous thing for
# WGn(A,FP,B,n,BFP)
# By writing a procedure
# WGnS(A,FP,B,n,BFP)

IsBadWG1:=proc(w,B,fp1) local flag, i:

if nops(w)<nops(fp1) then
	return false:
fi:
# Check the start
flag:=true:
for i from 1 to nops(fp1) while flag do
	if fp1[i]<>B and fp1[i]<>w[i] then
		flag:=false:
	fi:
od:
return flag:

end:

IsBadWG:=proc(w,FP,B,BFP) local fp1:
option remember:

for fp1 in BFP do
	if IsBadWG1(w,B,fp1) then
		return true:
	fi:
od:
for fp1 in FP do
	if IsBadW1(w,fp1,B) then
		return true:
	fi:
od:
return false:

end:

SetWGnS:=proc(A,FP,B,n,BFP) local W,L,w:

W:=AllWords(A,n):
L:={}:
for w in W do
	if not IsBadWG(w,FP,B,BFP) then
		L:=L union {w}:
	fi:
od:
return L:

end:

WGnS:=proc(A,FP,B,n,BFP)

return nops(SetWGnS(A,FP,B,n,BFP)):

end: