# John Miller
# hw18.txt - Homework assigned Mon, Mar 26, due Apr 2.
# You are welcome to share this code.

Help:=proc():
print(`WnS(A,FP,B,n), SFP(d,n), WGnS(A,FP,B,n,BFP)`):
print(`AllWords(A,n), IsBad1(w,fp1,B), IsBad(w,FP,B), SetWnS(A,FP,B,n)`):
print(`IsBFPBad(w,FP,B)`):
end:
####################################################################
# Question 2

# WnS(A,FP,B,n): Inputs an alphabet A, a set FP of restricted
# patterns, a blank B, and a positive integer n, and outputs
# the number of words of length n that avoid all the patterns of FP.
WnS := proc(A,FP,B,n):

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

end:  # end of WnS(A,FP,B,n)

####################################################################
# Question 3

# Find the 1st 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);
# We get:
# 2, 4, 7, 13, 23, 40, 65, 106, 169, 278, 443, 705, 1117, 1760, 2807

# Find the 1st 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], [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);
# We get:
# 2, 4, 6, 10, 14, 20, 16, 6, 0, 0, 0, 0, 0, 0, 0

####################################################################
# Question 4

# We d=3, we need FP to be the set:
# {[1,1,1],[1,B,1,B,1],...,[1,B$k,1,B$k,1]}, k = trunc((n-3)/2)

# For general d, we need Fp to be the set:
# {[1$d],[1,B,1,...,1,B,1],...,[1,B$k,1,...,1,B$k,1]},
# k = trunc( (n-d)/(d-1) )

# SFP(d,n):  Input positive integers d and n, and count the number
# of subsets {1,2...,n} that do not contain an arithmetic
# progression of length d.
SFP := proc(d::posint,n::posint)
local FP, k, i, j, fp1:

if d=1 then return(0): fi:

FP := {};
k  := max(trunc((n-d)/(d-1)),0):

for i from 0 to k do:
  fp1 := [seq(op([1,B$i]),j=1..d-1),1]:
  FP  := FP union {fp1}
od:

WnS({0,1},FP,B,n):

end:  # end of SFP(d,n)

####################################################################
# Question 5

# We verify that SFP(d,n) matches Ndn(d,n):

# For d=3, we get for n = 1 to 15:
# SFP:
# 2, 4, 7, 13, 23, 40, 65, 106, 169, 278, 443, 705, 1117, 1760, 2692
# Ndn:
# 2, 4, 7, 13, 23, 40, 65, 106, 169, 278, 443, 705, 1117, 1760, 2692

# For d=4, we get for n = 1 to 15:
# SFP:
# 2, 4, 8, 15, 29, 56, 103, 192, 364, 668, 1222, 2233, 3987, 7138, 12903
# Ndn:
# 2, 4, 8, 15, 29, 56, 103, 192, 364, 668, 1222, 2233, 3987, 7138, 12903

####################################################################
# Question 6

# WGnS(A,FP,B,n,BFP): Inputs the alphabet A, the set of forbidden
# patterns FP, blank B, positive integer n, and another set of
# "beginning forbidden patterns" BFP, and outputs the number
# of words that avoid all patterns of FP and IN ADDITION avoid the
# set of patterns BFP at the beginning.
WGnS := proc(A::set,FP::set,B,n::posint,BFP::set)
local f, NoFPwords, w:

NoFPwords := SetWnS(A,FP,B,n):

f := w -> not IsBFPBad(w,BFP,B):
nops(select(f,NoFPwords)):

end:  # end of WGnS(A,FP,B,n,BFP)

####################################################################
# AllWords(A,n): Inputs an alphabet A, and a positive integer n,
# and outputs a set of all nops(A)^n words of length n.
AllWords := proc(A::set,n::nonnegint)
option remember:
local S, S1, s1, a:

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

S := {}:
S1 := AllWords(A,n-1);

for s1 in S1 do:
  s1 := op(s1):
  S := S union {seq([s1,a], a in A)}:
od:

S:

end:  # end of AllWords(A,n)

####################################################################
# IsBad1(w,fp1,B): Returns true iff the word w contains the single
# pattern fp1.
IsBad1 := proc(w::list, fp1::list, B)
option remember:
local i:

if nops(w) < nops(fp1) then return(false): fi:

if {seq(evalb(w[i]=fp1[i] or fp1[i]=B),i=1..nops(fp1))} = {true} then
  return(true):
fi:

IsBad1(w[2..nops(w)],fp1,B):

end:  # end of IsBad1(w,fp1,B)

####################################################################
# IsBad(w,FP,B): Returns true iff w contains at least one of the
# members of the set of patterns FP.
IsBad := proc(w::list,FP::set,B)
local fp1:

evalb({seq(IsBad1(w,fp1,B),fp1 in FP)}<>{false}):

end:  # end of IsBad(w,FP,B)

####################################################################
# IsBFPBad(w,FP,B): Returns true iff w contains at least one of the
# members of the set of patterns FP.
IsBFPBad := proc(w::list,FP::set,B)
local fp1:

evalb({seq(IsBad1(w[1..nops(fp1)],fp1,B),fp1 in FP)}<>{false}):

end:  # end of IsBFPBad(w,FP,B)

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

# SetWnS(A,FP,B,n): Constucts the set of n-letter words in the
# alphabet A not containing any of the patterns of FP.
SetWnS := proc(A::set,FP::set,B,n::posint)
local f, w:

f := w -> not IsBad(w,FP,B):
select(f,AllWords(A,n)):

end:  # end of SetWnS(A,FP,B,n)