#John Kim
#Use whatever you like

#read "C:/Users/John Y. Kim/Documents/Maple/hw18.txt":


Help:=proc():  print(`Adn(d,n), IsBad(d,S),adnS(d,n)`): 
print(`NdnS(d,n) `):
end:

#Dedicated to Endre Szemeredi on the occaison of the Abel Prize 2012

with(combinat):
#Let a_d(n) be the largest size of a subset of {1, ...,n}
#avoiding arthmetical pogressions of length d
#(Szemeredi's famous theorem says that a_d(n)/n->0)
#d=3 is it the already deep Roth theorem who proved that
#a_3(n)/n<=C/log(log(n))




#Adn(d,n): Inputs positive integers d and n and outputs
#the set of all subsets of {1, ...,n} that DO NOT have
#an arithmetical progression of length d
Adn:=proc(d,n) local S,s1,i,T:

S:=powerset(n):
T:={}:

for s1 in S do 

if not IsBad(d,s1) then

#T:=T union {s1}:
 
T:={op(T), s1}:

fi:
 
od:

T:


end:




#IsBad(d,S): Does the set of pos. integers  S contain
#an AP of length d?
IsBad:=proc(d,S) local m,S1,dif,PTM,j:
option remember:

if nops(S)<d then
RETURN(false):
fi:

m:=max(S):

S1:=S minus {m}:

if IsBad(d,S1) then
  RETURN(true):
fi:

for dif from 1 to trunc(m/(d-1)) do
PTM:={seq(m-j*dif, j=1..d-1)}:

if PTM minus S1={} then
  RETURN(true):
fi:

od:


false:
end:

#adnS(d,n): a stupid way of computing a_d(n) above
adnS:=proc(d,n) local Y,y:
Y:=Adn(d,n):

max(seq(nops(y),y in Y)):

end:


#NdnS(d,n): a stupid way of computing the number of 
#subsets of {1, ...,n} that do not contain an AP
#of length d
NdnS:=proc(d,n) local Y,y:
Y:=Adn(d,n):

nops(Y):

end:

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

#AllWords(A,n): inputs an alphabet A, and a pos. integer n, 
#and outputs the set of all nops(A)^n words of length n.

AllWords:=proc(A,n) local words,i,j,word:

words:={}:

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

for i in A do
 for j in AllWords(A,n-1) do
  word:=[i,op(j)]:
  words:=words union {word}:
 od:
od:

RETURN(words):

end:


#IsBad1(w,fp1,B): returns true if and only if 
#the word w contains the single pattern fp1. 

IsBad1:=proc(w,fp1,B) local fp2,w1: option remember:

if nops(fp1)>nops(w) then
 RETURN(false):
fi:

if fp1=[] then
 RETURN(true):
fi:

w1:=w[2..nops(w)]:
if IsBad1(w1,fp1,B) then
 RETURN(true):
fi:

fp2:=fp1[2..nops(fp1)]:
if (w[1]=fp1[1] or fp1[1]=B) and IsBad1(w1[1..nops(fp2)],fp2,B) then
 RETURN(true):
fi:

RETURN(false):

end:



#IsBad(w,FP,B): returns true if and only if the word w contains 
#at least one of the members of the set of patterns FP.

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

for fp1 in FP do

if IsBad1(w,fp1,B) then
 RETURN(true):
fi:

od:

RETURN(false):

end:


#SetWnS(A,FP,B,n): contructs the set of n-letter words in the 
#alphabet A not containing any of the patterns of FP.

SetWnS:=proc(A,FP,B,n) local words,goodWords,w:

words:=AllWords(A,n):
goodWords:={}:

for w in words do
 if not IsBad(w,FP,B) then
  goodWords:=goodWords union {w}:
 fi:
od:

goodWords:

end:



#WnS(A,FP,B,n): (S is for stupid) inputs and outputs the same as Wn(A,FP,B,n) 
#but does it by brute-force counting, analogously to adnS(d,n).

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

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

end:


#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

#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


#Every 0-1 sequence of length n is in bijective correspondence with a subset of {1,2,...,n}, 
#if we interpret a 0 in the ith position to indicate i is not in the subset and 1 to indicate i is in the subset.
#So avoiding an arithmetic progression of length d in a subset of {1,2,...,n} is the same as 
#avoiding the patterns [1,B$k,1,B$k,...,1] in 0-1 sequences of length n, where there are d ones.


#SFP(d,n): inputs positive integers d and n and outputs the FP 
#that makes the output of WnS({0,1},FP,B,n) the same as Ndn(d,n).

SFP:=proc(d,n) local k,fp1,FP,i:

k:=0:
FP:={}:

while (d-1)*(k+1)+1<=n do
 fp1:=[]:

 for i from 1 to d-1 do
  fp1:=[op(fp1),1,B$k]:
 od:

 fp1:=[op(fp1),1]:
 FP:=FP union {fp1}:
 k:=k+1:
od:

FP:

end:



#BFPIsBad1(w,B,bfp1): returns true if and only if 
#the word w contains the single pattern fp1 or starts 
#with bfp1. 

BFPIsBad1:=proc(w,B,bfp1) option remember:
 IsBad1(w[1..nops(bfp1)],bfp1,B):
end:



#WGIsBad(w,FP,B,BFP): returns true if and only if the word w contains 
#at least one of the members of the set of patterns FP or begins with 
#one of the members of the set of patterns BFP.

WGIsBad:=proc(w,FP,B,BFP) local fp1,bfp1:

if IsBad(w,FP,B) then
 RETURN(true):
fi:

for bfp1 in BFP do
 if BFPIsBad1(w,B,bfp1) then
  RETURN(true):
 fi:
od:

RETURN(false):

end:


#SetWGnS(A,FP,B,n,BFP): contructs the set of n-letter words in the 
#alphabet A not containing any of the patterns of FP and not beginning 
#with any of the patterns of BFP.

SetWGnS:=proc(A,FP,B,n,BFP) local words,goodWords,w:

words:=AllWords(A,n):
goodWords:={}:

for w in words do
 if not WGIsBad(w,FP,B,BFP) then
  goodWords:=goodWords union {w}:
 fi:
od:

goodWords:

end:



#WGnS(A,FP,B,n,BFP): (S is for stupid) inputs and outputs the same as WGn(A,FP,B,n) 
#but does it by brute-force counting, analogously to adnS(d,n).

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

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

end: