#Yusra Naqvi
#HW 19

#OK to post

################################################################################
###Stuff from C19.txt###
################################################################################

#Wn(A,FP,B,n): 
#Inputs:
#i) an alphabet A
#ii) a set of forbidden patterns FP, with patterns given as lists
#iii) a symbol indicating a blank space B
#iv) a positive integer n
#Outputs:
#the number of words in A of length n that avoid all the patterns in FP
#For example:
#Wn({0,1},{[1,B,1]},B,3);
#should give:
#6

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

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

end:

###

#WGn(A,FP,B,n,BFP): 
#Inputs:
#i) an alphabet A
#ii) a set of forbidden patterns FP, with patterns given as lists
#iii) a symbol indicating a blank space B
#iv) a positive integer n
#v) a set of patterns BFP to be avoided at the beginning of the word
#Outputs:
#the number of words in A of length n that avoid all the patterns in FP,
#and avoiding patterns in BFP at the beginning.

WGn:=proc(A,FP,B,n,BFP) local co,a,BFP1:
option remember:

if member([],FP union BFP) 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 a blank, a set of
#forbidden patterns FP, and a set of patterns BFP forbidden at the beginning
#and outputs a new set of forbidden beginning patterns for a chopped word
#that starts with a

AdjustBFP:=proc(a,B,FP,BFP) local NBFP,fp:

NBFP:={}:

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:

################################################################################
###End of stuff from C19.txt###
################################################################################

################################################################################
###Stuff from hw18.txt###
################################################################################

#SFP(d,n):

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

FP:={}:

if n<d then
 return(FP):
fi:

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

end:

################################################################################
###End of stuff from hw18.txt###
################################################################################

################################################################################
###Stuff from C6.txt###
################################################################################

#GuessRec1(L,r): inputs a sequence of numbers L and a positive integer r
#and tries to guess a linear recurrence equation of order r satisfied by L.
#L(n)+c1*L(n-1)+...+cr*L(n-r)=0 for all n within range
#The output is given as 2 lists of r numbers
#[[c1,c2,...,cr],InitialConditions]
#For example, the Fibonacci sequence is
#[[-1,-1],[1,1]]

GuessRec1:=proc(L,r) local c,i,var,eq:

if nops(L)<2*r+7 then
 return(FAIL):
fi:

var:={seq(c[i],i=1..r)}:

eq:={seq(L[n]+add(c[i]*L[n-i],i=1..r)=0,n=r+1..nops(L))}:

var:=solve(eq,var):

if var=NULL then
 return(FAIL):
fi:

[[seq(subs(var,c[i]),i=1..r)],[seq(L[i],i=1..r)]]:

end:

###

#GuessRec(L): inputs a sequence of numbers L and tries to guess 
#a linear recurrence equation of minimum order r satisfied by L.
#L(n)+c1*L(n-1)+...+cr*L(n-r)=0 for all n within range
#The out is given as 2 lists of r numbers
#[[c1,c2,...,cr],InitialConditions]
#For example, the Fibonacci sequence is
#[[-1,-1],[1,1]]

GuessRec:=proc(L) local r, ans:

for r from 1 to (nops(L)-6)/2 do
 ans:=GuessRec1(L,r):
 
 if ans<>FAIL then
  return(ans):
 fi:
 
od:

FAIL:

end:

################################################################################
###End of stuff from C6.txt###
################################################################################

################################################################################
###New stuff for hw19.txt###
################################################################################

#1
#NdnC(d,n): a clever way of computing the number of subsets of {1, ...,n} 
#that do not contain an AP of length d

NdnC:=proc(d,n):

Wn({0,1},SFP(d,n),B,n):

end:

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

#2
#WnX(A,FP,B,n,x): extension of Wn(A,FP,B,n) that outputs the weight enumerator 
#of words of length n avoiding the set of patterns in FP, where the weight of a
#word
#a1 a2 a3 ... an
#is
#x[a1]x[a2] ... x[an]  

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

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

end:

###

#WGnX(A,FP,B,n,BFP,x): extension of WGn(A,FP,B,n,BFP) that outputs the weight 
#enumerator of words of length n avoiding the set of patterns in FP and avoiding
#beginning patterns in BFP

WGnX:=proc(A,FP,B,n,BFP,x) local co,a,BFP1:
option remember:

if member([],FP union BFP) 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:

expand(co):

end:

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

#3
#adnC(d,n): a clever way of computing a_d(n) (i.e. the largest size of a subset 
#of {1,..,n} avoiding arithmetic progressions of length d)

adnC:=proc(d,n):

degree(WnX({0,1},SFP(d,n),B,n,x),x[1]);

end:

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

#5
#WnR(A,FP,B,N): uses the first N terms of Wn(A,FP,B,n) to try and guess a 
#C-finite description of that sequence

WnR:=proc(A,FP,B,N) local L:

L:=[seq(Wn(A,FP,B,n),n=1..N)]:

GuessRec(L):

end:

###

#We find that:

#WnR({1,2},{[1,1]},B,60); 
#[[-1, -1], [2, 3]]

#WnR({0,1},{[1,1,1],[0,0,0]},B,60);
#[[-1, -1], [2, 4]]

#WnR({0,1},{[1,1,1,1],[0,0,0,0]},B,60); 
#[[-1, -1, -1], [2, 4, 8]]

#WnR({a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,w,x,y,z},
#{[d,o,r,o,n],[d,B,o,B,r,B,o,B,n]},B,100);
#[[-25, 0, 0, 0, 2, -25, 625, -15625, 390625, -1, 25, 0, 0, 0, -3, 25, -1250, 0, 
#0, 0, 0, 0, 0, 0, 1], [25, 625, 15625, 390625, 9765624, 244140575, 6103513750, 
#152587828125, 3814694921875, 95367353515627, 2384183349609500, 
#59604571533209375, 1490113983154546875, 37252841949473046875,
#931320858002089843747, 23283016681684814452875, 582075297832952880844375,
#14551879465595245360609375, 363796912134181976284375000,
#9094920940712451933369140630, 227372976951768398226562500500,
#5684323259643375871356201207500, 142108052387319505134277345703125,
#3552700582089014348545074564453125, 88817496362379752003192906376953117]]

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