## Homework 18.  April-2-2012.  Pat Devlin ##
# I have no preferrences about keeping my work private #


Help:=proc():
  print(`AllWords(A,n), IsBadBeginning(w, fp, B), PatIsBad1(w,fp1,B), PatIsBad(w, FP, B), SetWnS(A, FP, B, n), WnS(A, FP, B, n)`):

  print(`PatIsBadIncludingBeginning(w, FP, B, n, BFP), SetWGnS(A, FP, B, n, BFP), WGnS(A, FP, B, n, BFP)`):
  print(`Type HelpAll() for a list of all functions`):
end proc:

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


#############
# Problem 1 #
#############

# See my earlier comment on the Star-Ledger article, which I posted earlier. #


#############
# Problem 2 #
#############

AllWords:=proc(A,n) option remember: local a, w, shorterWords, allTheWords:
  if (n <= 0) then return {[]}: fi:
  shorterWords:=AllWords(A, n-1):
  allTheWords:={}:

  for w in shorterWords do
    for a in A do
      allTheWords:=allTheWords union {[op(w), a]}:
    od:
  od:

  return allTheWords:
end proc:


IsBadBeginning:=proc(w, fp, B) local i:
  if(nops(fp) > nops(w)) then return false: fi:
  for i from 1 to nops(fp) do
    if( not (fp[i] = B)) then
      if( not (fp[i] = w[i])) then return false: fi:
    fi:
  od:
  return true:
end proc:

PatIsBad1:=proc(w, fp1, B) local i, subWord:
  if(nops(fp1) > nops(w)) then return false: fi:
  if(IsBadBeginning(w, fp1, B)) then return true: fi:
  subWord:=[seq(w[i], i=2..nops(w))]:
  return PatIsBad1(subWord, fp1, B):
end proc:


PatIsBad:=proc(w, FP, B) local fp:
  for fp in FP do
    if(PatIsBad1(w, fp, B)) then return true: fi:
  od:
  return false:
end proc:


SetWnS:=proc(A, FP, B, n) local allTheWords, w, goodWords:
  goodWords:={}:
  allTheWords:=AllWords(A,n):
  for w in allTheWords do
    if( not (PatIsBad(w, FP, B))) then goodWords:=goodWords union {w}: fi:
  od:
  
  return goodWords:
end proc:


WnS:=proc(A, FP, B, n):
  return nops(SetWnS(A, FP, B, n)):
end proc:

#############
# Problem 3 #
#############

# The first 13 terms of both sequences are [the first 15 took too long]
# 
# 2, 4, 7, 13, 23, 40, 65, 106, 169, 278, 443, 705, 1117
# 
# and
# 
# 2, 4, 6, 10, 14, 20, 16, 6, 0, 0, 0, 0, 0
# 
# respectively.


#############
# Problem 4 #
#############

# The choice of FP to make it so that WnS({0,1}, FP, B, n) is the same as
# Ndn(d,n)  is just avoiding all patterns of the form
# [1, B$k, 1, B$k, 1, B$k, ... , B$k, 1]  (a total of d 1's), where k ranges
# from 0 to infinity.
# To make this finite, note that we actually only need to go until d +
# k*(d-1) [which is the length of this forbidden string] is greater than n.
# So we just need k > (n-d) / (d-1).

SFP:=proc(d,n, blank:=B) local k, i:
  return {[1$d], seq([op([1, seq(op([blank$k, 1]), i=1..d-1)])], k=0..((n-d)/(d-1)+1))}:
end proc:


#############
# Problem 5 #
#############

# The output in problem 4 does in fact work for 3 <= d <= 4 and for 1 <= n <= 13 [checking up to 15 took too long]

#############
# Problem 6 #
#############

PatIsBadIncludingBeginning:=proc(w, FP, B, BFP) local bfp:
  for bfp in BFP do
    if(IsBadBeginning(w, B, bfp)) then return true: fi:
  od:

  return PatIsBad(w, FP, B):
end proc:


SetWGnS:=proc(A, FP, B, n, BFP) local allTheWords, w, goodWords:
  goodWords:={}:
  allTheWords:=AllWords(A,n):
  for w in allTheWords do
    if( not (PatIsBadIncludingBeginning(w, FP, B, BFP))) then goodWords:=goodWords union {w}: fi:
  od:

  return goodWords:
end proc:


WGnS:=proc(A, FP, B, n, BFP):
  return nops(SetWGnS(A, FP, B, n, BFP)):
end proc:



#################
# From Class 18 #
#################

#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:




#Wn(A,FP,B,n): inputs
#(i) A: a set of symbols (the alphabet)
#(ii) FP: a set of forbidden patterns, given as a list
#where B denotes Blank. For example, if FP contains
#[1,B,1,B,1] then our words may not contain
#10101, 10111, 11101, 11111
#(iii) A letter B
#n a pos. integer
#Outputs:
#The number of words in the alphabet A of length n that
#AVOID all the patterns of FP.
#For example, 
#Wn({0,1},{[1,B,1]},B,3); should return
#6
Wn:=proc(A,FP,B,n) 

WGn(A,FP,B,n,{});
end:


#WGn(A,FP,B,n,BFP): inputs
#(i) A: a set of symbols (the alphabet)
#(ii) FP: a set of forbidden patterns, given as a list
#where B denotes Blank. For example, if FP contains
#[1,B,1,B,1] then our words may not contain
#10101, 10111, 11101, 11111
#(iii) A letter B
#(iv) n a pos. integer
#(v): Another set of patterns (same format at for FP)
#Outputs:
#The number of words in the alphabet A of length n that
#AVOID all the patterns of FP and IN ADDITION AVOID
#the set of patterns BFP at the beginning
#For example, 
#Wn({0,1},{[1,B,1]},B,3); should return
#6
Wn:=proc(A,FP,B,n) 

WGn(A,FP,B,n,{});
end: