#Yusra Naqvi
#HW 20

#OK to post

################################################################################
###Stuff from C20.txt###
################################################################################

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

###

#GFun(A,B,FP,x): inputs an alphabet A ( a set of symbols or numbers)
#and a letter B (NOT in A) and a set of forbidden  patterns
#FP, and another symbol x (not in A union {B}) and outputs
#a rational function in x[A[1]], ..., x[A[nops(A)]] such
#the if you mtaylor it the coeff. of
#x[A1]^a1*x[A2]^a2*... is the EXACT number of words in
#the alphabet A, avoiding the patterns in FP with
#a1 occurrences of A1, 
#a2 occurrences of A2, ....
#For example
#GFun({1},B,{},x); should output:
#1/(1-x[1]);
#GFun({1},B,{[1,1]},x); should output:
#1+X[1]
#weight([1,2,1,1])=x[1]*x[2]*x[1]*x[1]

GFun:=proc(A,B,FP,x) local eq,var, F,S, ToDo,BFP,eq1,ABFP,a:

#F[BFP]=generating function of all words in the alphabet A
#that avoid FP and in addition avoid BFP
#S, the set of BFPs that show up
#f=1+x[1]*f+x[2]*f+...+x[n]*f
#(1-x[1]-...-x[n])*f=1
#f=1/(1-x[1]-...-x[n])
#f=1/(1-n*t) (if x[1]=...=x[n]=t)

eq:={}:
S:={{}}:
var:={}:

ToDo:={{}}:

while ToDo<>{} do 
 BFP:=ToDo[1]:
 S:=S union {BFP}:
 
 eq1:=F[BFP]-1:
 var:=var union {F[BFP]}:

 for a in A do
  ABFP:=AdjustBFP(a,B,FP,BFP):
 
  if not member([],ABFP) then
   eq1:=eq1-x[a]*F[ABFP]:
   ToDo:=ToDo union {ABFP}:
  fi:
 
 od:

 ToDo:=ToDo minus S:
 eq:=eq union {eq1}:

od:

var:=solve(eq,var):
subs(var,F[{}]):

end:

###
  
 #GFunT(A,B,FP,T): inputs an alphabet A ( a set of symbols or numbers)
#and a letter B (NOT in A) and a set of forbidden  patterns
#FP, and another symbol x (not in A union {B}) and outputs
#a rational function in x[A[1]], ..., x[A[nops(A)]] such
#the if you mtaylor it the coeff. of
#T^(length)

#For example
#GFunT({1},B,{},T); should output:
#1/(1-T);
#GFun({1},B,{[1,1]},T); should output:
#1+T

GFunT:=proc(A,B,FP,T) local eq,var, F,S, ToDo,BFP,eq1,ABFP,a:

#F[BFP]=generating function of all words in the alphabet A
#that avoid FP and in addition avoid BFP
#S, the set of BFPs that show up
#f=1+x[1]*f+x[2]*f+...+x[n]*f
#(1-x[1]-...-x[n])*f=1
#f=1/(1-x[1]-...-x[n])
#f=1/(1-n*t) (if x[1]=...=x[n]=t)

eq:={}:
S:={{}}:
var:={}:

ToDo:={{}}:

while ToDo<>{} do 
 BFP:=ToDo[1]:
 S:=S union {BFP}:

 eq1:=F[BFP]-1:
 var:=var union {F[BFP]}:

 for a in A do
  ABFP:=AdjustBFP(a,B,FP,BFP):

  if not member([],ABFP) then
   eq1:=eq1-T*F[ABFP]:
   ToDo:=ToDo union {ABFP}:
  fi:

 od:

 ToDo:=ToDo minus S:
 eq:=eq union {eq1}:

od:

var:=solve(eq,var):
subs(var,F[{}]):

end:

################################################################################
###End of stuff from C20.txt###
################################################################################

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

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

AllWords:=proc(A,n) local S,i,v:

S[0]:={[]}:

for i from 1 to n do
 S[i]:=`union`(seq({seq([A[j], op(v)], v in S[i-1])},j=1..nops(A))):
od:

S[n]:

end:

###

#IsBad2(w,fp1,B): returns true iff the word w is equal to a pattern fp1.
#It assumes that nops(w)=nops(fp1), which is fine because this is how it is 
#used in the procedure `IsBad1` below.

IsBad2:=proc(w,fp1,B) local i:   

for i from 1 to nops(fp1) do
 if w[i]<>fp1[i] and fp1[i]<>B then
  return(false):
 fi:
od:

true:

end:

###

#IsBad1(w,fp1,B): returns true iff the word w contains the pattern fp1.

IsBad1:=proc(w,fp1,B) local i:   

if fp1=[] then
 return(true):
elif nops(fp1)>nops(w) then
 return(false):
fi:

for i from 1 to nops(w)-nops(fp1)+1 do
 if IsBad2(w[i..i+nops(fp1)-1],fp1,B) then
  return(true):
 fi:
od:

false: 

end:

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

with(combinat):

################################################################################
###New stuff for hw20.txt###
################################################################################

#1
#UA(k): inputs a positive integer k, and outputs the set of sets of 
#unavoidable length-k-patterns

UA:=proc(k) local S,PS,U,FP,T:

U:={}:
S:=AllWords({0,1},k):
PS:=powerset(S):

for FP in PS do
 if type(GFunT({0,1},B,FP,T),polynom(anything,T)) then
  U:={op(U),FP}:
 fi:
od: 
 
U:

end:

###

#We find:

#UA(2);
#{{[0, 0], [0, 1], [1, 1]}, {[0, 0], [1, 0], [1, 1]}, 
#{[0, 0], [0, 1], [1, 0], [1, 1]}}

#UA(3);
#{{[0, 0, 0], [0, 0, 1], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [0, 1, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [1, 0, 0], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [0, 1, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 1], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [1, 0, 0], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [1, 0, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [0, 1, 1], [1, 0, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [0, 1, 1], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [0, 1, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [1, 0, 0], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [1, 0, 0], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [1, 0, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 1], [1, 0, 0], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [1, 0, 0], [1, 0, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [0, 1, 1], [1, 0, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [0, 1, 1], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [0, 1, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [1, 0, 0], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [1, 0, 0], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [1, 0, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 1], [1, 0, 0], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 1], [1, 0, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [1, 0, 0], [1, 0, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [0, 1, 1], [1, 0, 0], [1, 0, 1], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [0, 1, 1], [1, 0, 0], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [0, 1, 1], [1, 0, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 0], [1, 0, 0], [1, 0, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 1, 1], [1, 0, 0], [1, 0, 1], [1, 1, 0], [1, 1, 1]}, 
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [0, 1, 1], [1, 0, 0], [1, 0, 1], [1, 1, 1]},
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [0, 1, 1], [1, 0, 0], [1, 1, 0], [1, 1, 1]},
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [0, 1, 1], [1, 0, 1], [1, 1, 0], [1, 1, 1]},
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [1, 0, 0], [1, 0, 1], [1, 1, 0], [1, 1, 1]},
#{[0, 0, 0], [0, 0, 1], [0, 1, 1], [1, 0, 0], [1, 0, 1], [1, 1, 0], [1, 1, 1]},
#{[0, 0, 0], [0, 1, 0], [0, 1, 1], [1, 0, 0], [1, 0, 1], [1, 1, 0], [1, 1, 1]},
#{[0, 0, 0], [0, 0, 1], [0, 1, 0], [0, 1, 1], [1, 0, 0], [1, 0, 1], [1, 1, 0],
#[1, 1, 1]}}

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

#2
#AUA(k): inputs a positive integer k, and outputs the set of sets of almost
#unavoidable length-k-patterns

AUA:=proc(k) local S,PS,U,FP,T,d,rts,abrts,r:

U:={}:
S:=AllWords({0,1},k):
PS:=powerset(S):

for FP in PS do
 d:=denom(GFunT({0,1},B,FP,T)):
 rts:={solve(d,T)}:
 abrts:={seq(abs(r),r in rts)}:
 
 if evalf(min(abrts))>=1 then
  U:={op(U),FP}:
 fi:
 
od: 
 
U:

end:

###

#We find:

#AUA(2);
#{{[0, 1]}, {[1, 0]}, {[0, 0], [0, 1]}, {[0, 0], [1, 0]}, {[0, 0], [1, 1]}, 
#{[0, 1], [1, 0]}, {[0, 1], [1, 1]}, {[1, 0], [1, 1]}, {[0, 0], [0, 1], [1, 0]}, 
#{[0, 0], [0, 1], [1, 1]}, {[0, 0], [1, 0], [1, 1]}, {[0, 1], [1, 0], [1, 1]}, 
#{[0, 0], [0, 1], [1, 0], [1, 1]}}

#AUA(3);
#The output is too long for this file, but here are the sets containing 2 lists:
#{[0, 0, 1], [0, 1, 1]}, {[0, 0, 1], [1, 0, 1]}, {[0, 0, 1], [1, 1, 0]}, 
#{[0, 1, 0], [0, 1, 1]}, {[0, 1, 0], [1, 1, 0]}, {[0, 1, 1], [1, 0, 0]}, 
#{[1, 0, 0], [1, 0, 1]}, {[1, 0, 0], [1, 1, 0]}

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

#3
#IsSubPattern(pat1,pat2,B): inputs two patterns, and outputs true if and only if
#any occurrence of pat1 implies an occurence of pat2 
#This is functionally the same as the procedure IsBad1(w,fp,B) from hw18.txt

IsSubPattern:=proc(pat1,pat2,B):

IsBad1(pat1,pat2,B):

end:

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

#4
#MinimalFP(B,FP): inputs a symbol for blank, B, and a set of patterns 
#(expressed as lists), and returns a subset of FP, whose avoidance implies 
#the avoidance of all the other patterns.
#For example,
#MinimalFP(B,{[1,1,1],[1,1,1,1],[1,B,1],[1,2,1]});
#should return
#{[1,B,1]} 

MinimalFP:=proc(B,FP) local S,fp1,fp2:

S:=FP:

for fp1 in S do
 for fp2 in S minus {fp1} do
  if IsSubPattern(fp2,fp1,B) then 
   S:=S minus {fp2}:
  fi:
 od:
od: 
 
S:

end:

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

#5
#SAW(n): outputs the set of all self-avoiding walks of length n

SAW:=proc(n) local m,S,s,a,s2,i:
option remember:

if n=0 then
 {[]}:
elif n=1 then
 {[1],[2],[-1],[-2]}:
else
 m:=trunc(n/2):
 S:={}:
 
 for s in SAW(n-1) do
  for a in {1,2,-1,-2} do
   s2:=[op(s),a]:
   
   for i from 1 to m do
   
   if numboccur(s2[n-i*2+1..n],1)=numboccur(s2[n-i*2+1..n],-1) and
      numboccur(s2[n-i*2+1..n],2)=numboccur(s2[n-i*2+1..n],-2) then
    break:
   fi: 
   
   if i=m then
    S:=S union {s2}:
   fi: 
   
   od:

  od:
 od:

 S:

fi:
 
end:

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

#6
#seq(nops(SAW(n)),n=1..10);
#4, 12, 36, 100, 284, 780, 2172, 5916, 16268, 44100

#This is sequence A001411 in OEIS.

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

#7
#SAP(n) that inputs a non-negative integer n, and outputs the set of all 
#self-avoiding polygons of length 2n

SAP:=proc(n) local S,T,s,t,a:

S:={}:
T:=SAW(2*n-1):
   
for t in T do
 for a in {1,2,-1,-2} do
  s:=[op(t),a]:   
  
  if numboccur(s,1)=numboccur(s,-1) and numboccur(s,2)=numboccur(s,-2) 
     and not member(s[2..n],T) then
   S:=S union {s}:
  fi:
  
 od:
od:

S:

end:

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

#8
#GFsawd(d,T): inputs a pos. integer d, and a variable T, and outputs the 
#rational function in T whose Maclaurin coefficient of T^n would give 
#the number of memory-d-self-avoiding walks of length n

GFsawd:=proc(d,T) local FP,i,B:

FP:={}:
for i from 1 to d do
 FP:=FP union SAP(i):
od: 

GFunT({1,-1,2,-2},B,FP,T);

end:

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

#9
#GFsawd(1,T); 

#-(T+1)/(3*T-1)

#4, 12, 36, 108, 324, 972, 2916, 8748, 26244, 78732, 236196, 708588, 2125764, 
#6377292, 19131876, 57395628, 172186884, 516560652, 1549681956, 4649045868,
#13947137604, 41841412812, 125524238436, 376572715308, 1129718145924, 
#3389154437772, 10167463313316, 30502389939948, 91507169819844, 274521509459532

#A003946 in OEIS

###

#GFsawd(2,T); 

#-(2*T^2+3*T^3+2*T+1)/(T^3+2*T^2+2*T-1)

#4, 12, 36, 100, 284, 804, 2276, 6444, 18244, 51652, 146236, 414020, 1172164, 
#3318604, 9395556, 26600484, 75310684, 213217892, 603657636, 1709061740,
#4838656644, 13699094404, 38784563836, 109805973124, 310880168324, 880156846732,
#2491880003236, 7054953868260, 19973824589724, 56549436919204

#Not in OEIS

###

#GFsawd(3,T); 

#-(8*T^8+3*T^7-T^6+8*T^5+3*T^4+4*T^3+2*T^2+2*T+1)/((T+1)*(T^6+T^3-T^2+3*T-1))

#4, 12, 36, 100, 284, 780, 2172, 6028, 16732, 46436, 128892, 357748, 992964, 
#2756060, 7649700, 21232436, 58932564, 163572700, 454010940, 1260148740,
#3497657684, 9708067684, 26945626676, 74790042724, 207586580124, 576175473060,
#1599227539468, 4438801793148, 12320298939716, 34196112608188

#Not in OEIS

###

#GFsawd(4,T); 

#-(1+41*T^7+2*T+6*T^3+50*T^23-82*T^24+24*T^25+16*T^27+61*T^29+2*T^26+47*T^28-117
#*T^30-94*T^31+101*T^36+52*T^37-16*T^38-72*T^39+14*T^5-54*T^33+49*T^34+84*T^20-
#18*T^8+9*T^6-153*T^17+141*T^35+3*T^2-117*T^32+6*T^4+5*T^10+22*T^11-61*T^18-117*
#T^16-33*T^41+74*T^21+141*T^22-36*T^14-132*T^15+24*T^43+11*T^42+32*T^44+24*T^45+
#8*T^46-21*T^12-T^13+28*T^9-4*T^19-80*T^40)/(-1-5*T^7+2*T+2*T^3+2*T^23-2*T^24+4*
#T^25+4*T^27-5*T^29+2*T^26-3*T^28-7*T^30-2*T^31-T^36-4*T^37+2*T^5+2*T^33+3*T^34+
#4*T^20+2*T^8-T^6+9*T^17+3*T^35+T^2+5*T^32+2*T^4+3*T^10-2*T^11+T^18-7*T^16+T^41+
#6*T^21-13*T^22-8*T^14-8*T^15+T^42+T^12-7*T^13-4*T^9+12*T^19)

#4, 12, 36, 100, 284, 780, 2172, 5916, 16268, 44660, 122596, 336428, 923316,
#2533924, 6954340, 19085796, 52380228, 143755252, 394530428, 1082772220,
#2971623276, 8155495676, 22382417316, 61427608676, 168585505252, 462675873540,
#1269794600060, 3484898215012, 9564157518364, 26248430624188

#Not in OEIS

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