## Kristen Lew, Homework 19
## ExpMath, Spring 2012
# Post if you wish

### Problem 1
## By using Wn(A,FP,B,n), with A={0,1}, and appropriate FP, that you have to 
# program yourself, write a procedure NdnC(d,n), that finds, in a clever way, Nd(n). 


### Problem 2
## Modify Wn(A,FP,B,n) to procedure WnX(A,FP,B,n,x) 
# (using an analog/extension of WnG(A,FP,B,n) that you may call 
# WnGX(A,FP,B,n,x)) that outputs not just the number of words of length n 
# avoiding the set of patterns in FP but the weight enumerator where the weight 
# of a word a1 a2 a3 ... an is x[a1]x[a2] ... x[an]
## For example WnX({1,2},{[1,B,1]},B,3,x); 
# should return expand((x[1]+x[2])^3-x[1]*(x[1]+x[2])*x[1]); 
# [Hint: It is a minor pogramming modification in the line: 
# co:=co+WGn(A,FP,B,n-1,BFP1):]
WGnX:=proc(A,FP,B,n,BFP,x) local a, BFP1, co:
option remember:
	co:=0:
	if member([],BFP union FP) then
		RETURN(0):
	fi:
	if n=0 then
		RETURN(1):
	fi:
	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:
			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:
WnX:=proc(A,FP,B,n,x) option remember:
	WGnX(A,FP,B,n,{},x):
end:
		

### Problem 3
## Using your WnX(A,FP,B,n,x) with A={0,1}, write a procedure 
# adnC(d,n) that computes ad(n) cleverly. 
## [Hint: similar to NdnC(d,n), but now you need the degree of x[1] in the 
# weight-enumerator.]


### Problem 4
## [Human Problem]: Using generating functionology and linear algebra, 
# prove that for any finite set of finite patterns, the "infinite sequence" 
# [seq(Wn(A,FP,B,n), n=1..infinity)]: is C-finite.


### Problem 5
## Believing your proof (or believing me), interface Wn(A,FP,B,n) 
# With GuessRec(L) of C6.txt, to write a procedure WnR(A,FP,B,N) 
# that uses the first N terms of Wn(A,FP,B,n) to try and guess a 
# C-finite description of that sequence (or return FAIL). 
WnR:=proc(A,FP,B,N) local L:
	L:=[seq(Wn(A,FP,B,n),n=1..N)]:
	GuessRec(L):
end:
			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:
			GuessRec1:=proc(L,r) local c, i, var, eq:
				if nops(L) <= 2*r+6 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)],L[1..r]]:
			end:
			Wn:=proc(A,FP,B,n) option remember:
				WGn(A,FP,B,n,{}):
			end:
			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:


## What are:
# WnR({1,2},{[1,1]},B,60);
	# [[-1, -1], [2, 3]]
# WnR({1,2},{[1,1,1],[0,0,0]},B,60);
	# [[-1, -1, -1], [2, 4, 7]]
# WnR({1,2},{[1,1,1,1],[0,0,0,0]},B,60);
	# [[-1, -1, -1, -1], [2, 4, 8, 15]]
# 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]]