#Homework 19 by Ben Miles for Experimental math OK to post



WnX:=proc(A,FP,B,n,x) 
option remember:

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




WGnX:=proc(A,FP,B,n,BFP,x) local co,a,BFP1:
option remember:
if member([],BFP union  FP) then
  RETURN(0):
fi:

if n=0 then
 RETURN(1):
fi:


co:=0:

for a in A do

BFP1:=AdjustBFP(a,B,FP,BFP):

co:=co+x[a]*WGnX(A,FP,B,n-1,BFP1,x):

od:

co:

end:






























########old stuff
#C19.txt

Help:=proc():  print(`Adn(d,n), IsBad(d,S),adnS(d,n)`): 
print(`NdnS(d,n) , AdnM(d,n), adnM(d,n), NdnM(d,n) `):
print(`AdjustBFP(a,B,FP,BFP) , Wn(A,FP,B,n), WGn(A,FP,B,n,BFP)`):
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:




#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) 
option remember:
WGn(A,FP,B,n,{});
end:


#




#AdnM(d,n): mediocre version of 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
AdnM:=proc(d,n) local S,T,t1,s1:
option remember:

if n=1 then 
RETURN({{},{1}}):
fi:

S:=AdnM(d,n-1):

T:=S:

for t1 in T do 

s1:=t1 union {n}:

if not IsBad(d,s1) then

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

fi:
 
od:

S:


end:

#adnM(d,n): a mediocre way of computing a_d(n) above
adnM:=proc(d,n) local Y,y:
Y:=AdnM(d,n):

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

end:


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

nops(Y):

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
WGn:=proc(A,FP,B,n,BFP) local co,a,BFP1:
option remember:
if member([],BFP union  FP) then
  RETURN(0):
fi:

if n=0 then
 RETURN(1):
fi:


co:=0:

for a in A do

BFP1:=AdjustBFP(a,B,FP,BFP):

co:=co+WGn(A,FP,B,n-1,BFP1):

od:

co:

end:


#AdjustBFP(a,B,FP,BFP): inputs a letter a, a symbol B for
#blank, a set of forbidden patterns FP, and another set
#of forbidden patterns at the beginning
#outputs the new BFP for the chopped word assuming
#it starts with a
AdjustBFP:=proc(a,B,FP,BFP)  local  NBFP,fp:

NBFP:={}:


if member([],BFP) then
 RETURN(FAIL):
fi:

for fp in FP union BFP do

 if fp[1]=a or fp[1]=B then
   NBFP:=NBFP union {fp[2..nops(fp)]}:
  fi:

od:



NBFP:

end: