print(` Version of Feb. 18 , 2000 `):
print(` First Version : Feb. 18 , 2000 `):
print(` This is CGJ- Goulden-Jackson for Cyclic Words`):
print(` It solves the problem of counting cyclic words`):
print(` with a fixed beginning `):
print(` not containing any factors that belong to a finite set of`):
print(` of words called MISTAKES `):
print(` It implements the Edlin-Zeilberger extension of the `):
print(` Goulden-Jackson Cluster method, contained in the article:`):
print(` "The Goulden-Jackons Cluster Method For Cyclic Words " `):
print(` by Anne Edlin and Doron Zeilberger `):
print(``):
print(` This Maple package was written by `):
print(` Anne Edlin and Doron Zeilberger `):
print(` exteding the original version (for linear words,) `):
print(` that was written by John Noonan and Doron Zeilberger`):
lprint(``):
print(`The paper, and this package `):
print(`is available from http://www.math.temple.edu/~zeilberg/`):
print(` or http://www.math.temple.edu/~anne/`):
lprint(``):
print(`For general help, and a list of the available functions,`):
print(` type "ezra();". For specific help type "ezra(procedure_name)" `):
lprint(``):
 
 
ezra:=proc()
if args=NULL then
print(`CGJ`):
 
print(` Contains Procedures: `):
print(` bdokC, CGJs , ProveBW, SetOfCorrectWordsC,WrapAround `):
print(``):
print(` For specific help type "ezra(procedure_name)" `):
fi:
 
 
if nops([args])=1 and op(1,[args])=bdokC then
print(`bdokC(alphabet,MISTAKES,L): checks the validity `):
print(`of the Edlin-Zeilberger method for the given alphabet`):
print(` and set of MISTAKES up to words of length L`):
print(` For example bdokC({1,2},{[1,1],[2,2]},10); `):
fi:
 
if nops([args])=1 and op(1,[args])=ProveBW then
print(`ProveBW(): proves the Burstein-Wilf formula`):
fi:
 
if nops([args])=1 and op(1,[args])=WrapAround then
print(`WrapAround(MISTAKES,s): The contibution from Case III clusters`):
print(`in the Edlin-Zeilberger cyclic words analog of Goulden-Jackosn`):
print(`index by the LIST of MISTAKES, and whose entries give all possible`):
print(`overlaps, phrased in terms  of the variable s`):
fi:
 
 
if nops([args])=1 and op(1,[args])=`CGJs` then
print(`CGJs(alphabet,MISTAKES,s) finds the generating function`):
print(`g(s), is the g.f. sum(a[i]*s^i,i=0..infty)  `):
print(`where a[i]:=number of cyclic words of length i without any mistakes`):
print(`from MISTAKES`):
print(`For example to get the g.f. for a_n:=number of cyclic `):
print(` words of length n`):
print(`in the alphabet {1,2,3}, avoiding 123,231,312, type`):
print(` type GJs({1,2,3},{[1,2,3],[2,3,1],[3,1,2]},s)`):
fi:
 
 
 
end:
 
with(linalg):
CGJs:=proc(alphabet,MISTAKES1,s)
local v,eq, var,i,lu,C,MISTAKES,mu:
 
MISTAKES:=Hakten(MISTAKES1):
eq:={}:
var:={}:
 
for i from 1 to nops(MISTAKES) do
 v:=op(i,MISTAKES):
 eq:= eq union {findeqz(v,MISTAKES,C,s)}:
 var:=var union {C[op(v)]}:
od:
 
var:=solve(eq,var):
 
lu:=1:
 mu:=0:
for i from 1 to nops(alphabet) do
 lu:=lu-s:
od:
 
for i from 1 to nops(MISTAKES) do
 v:=op(i,MISTAKES):
 lu:=lu-subs(var,C[op(v)]):
 mu:=mu+subs(var,C[op(v)]):
od:
 
normal((1/lu)*(1+s*diff(mu,s)-mu)+WrapAround(convert(MISTAKES,list),s)):
 
end:
 
 
#findeqz sets up the equ C[v]= s+t*Sum_u overlap(u,v,x) *C[u]
 
findeqz:=proc(v,MISTAKES,C,s)
local eq,i,u:
eq:=-1:
 
for i from 1 to nops(v) do
 eq:=eq*s:
od:
 
for i from 1 to nops(MISTAKES) do
 u:=op(i,MISTAKES):
 eq:=eq-overlapz(u,v,s)*C[op(u)]:
od:
 
C[op(v)]-eq=0:
 
end:
 
 
 
#overlapz is a procedure that given two words u and v, and a variable s
#computes the weight-enumerator of all v\suffix(u),
#for all suffixes of u that are prefixes of v, but with uniform weight s
overlapz:=proc(u,v,s)
local i,j,lu,gug:
 
lu:=0:
 
for i from 2 to nops(u) do
  for j from i to nops(u) while (j-i+1<=nops(v) and op(j,u)=op(j-i+1,v))
         do
   :
  od:   
 
if j-i=nops(v) and u<>v then
 ERROR(v,`is a subword of`,u,`illegal input`):
 fi:
 
 
 
 if j=nops(u)+1 and (i>1 or j>2) then
  gug:=1:
 
   gug:=gug*s^(nops(v)-(j-i)):
 
  lu:=lu+gug:
 
fi:
 
od:
 
lu:
 
end:
 
 
 
#WrapAround(MISTAKES,s): The contibution from Case I clusters
#in the Edlin-Zeilberger cyclic words analog of Goulden-Jackosn
#index by the LIST of MISTAKES, and whose entries give all possible
#overlaps, phrased in terms  of the variable s
WrapAround:=proc(MISTAKES,s)
local n,A,B,C,i,j,D1,lu,gu,gu1,r:
with(linalg):
n:=nops(MISTAKES):
A:=matrix(n,n):
B:=matrix(n,n):
C:=matrix(n,n):
n:=nops(MISTAKES):
for i from 1 to n do
for j from 1 to n do
A[i,j]:=-overlapz(MISTAKES[i],MISTAKES[j],s):
B[i,j]:=s*diff(A[i,j],s):
if i=j then
C[i,j]:=1-A[i,j]:
else
C[i,j]:=-A[i,j]:
fi:
od:
od:
D1:=multiply(multiply(A,inverse(C)),B):
gu:=0:
for i from 1 to n do
gu1:=D1[i,i]:
lu:=taylor(gu1,s=0,nops(MISTAKES[i])+1):
for r from 0 to nops(MISTAKES[i])-1 do
gu1:=gu1-coeff(lu,s,r)*s^r:
od:
gu:=normal(gu+gu1):
od:
gu:
end:
 
 
 
 
 
hakten:=proc(B)
local w,i:
 
for i from 1 to nops(B) do
w:=op(i,B):
 
if superflous(B,w)=1 then
 RETURN(B minus {w}):
fi:
od:
B:
end:
 
#Hakten(B) removes all superflous words
 
Hakten:=proc(B)
local B1,B2:
 
B1:=B:
 
B2:=hakten(B1):
 
while B1<>B2 do
B1:=B2:
B2:=hakten(B2):
od:
 
B2:
end:
 
 
#BW(k,w,x): The Burstein-Wilf generating function
BW:=proc(k,w,x)
normal(1+
(1-x^w)/(1-x)*
(k*x+(k-1)*x*(
                 (w+1-w*k*x)/(1-k*x+(k-1)*x^(w+1))- (w+1)/(1-x^(w+1))
             )
)):
end:
 
 
#BWb(k,w): Checking the Edlin-Zeilberger Analog of Goulden-Jackson
#for cyclic words against the Burstein-Wilf generating function
BWb:=proc(k,w)
local al,MI,i,j,x,gu:
al:={seq(i,i=1..k)}:
 
MI:={seq([seq(j,i=1..w+1)],j=1..k)}:
 
gu:=CGJs(al,MI,x):
gu:=gu-BW(k,w,x):
normal(gu):
 
end:
 
#bdokC(alphabet,MISTAKES,L): checks the validity of
#of the Edlin-Zeilberger method
bdokC:=proc(alphabet,MISTAKES,L)
local lu,gu,s,i:
 
lu:=EmpiricalGJseriesC(alphabet,MISTAKES,L):
gu:=taylor(CGJs(alphabet,MISTAKES,s),s=0,L+1):
gu:=[seq(coeff(gu,s,i),i=0..L)]:
evalb(lu=gu):
end:
 
#EmpiricalGJSeriesC(alphabet,MISTAKES1,L): Does what
#GJseriesC(nops(alphabet),MISTAKES,L) does, but
#empirically. Don't make L too large, unless there 
#are lots of mistakes. It is meant to be a check
#on the validity of the (usually) much much faster
#and should not be used except for curiosity
EmpiricalGJseriesC:=proc(alphabet,MISTAKES,L)
local n,gu:
gu:=[]:
 
for n from 0 to L do
gu:=[op(gu),nops(SetOfCorrectWordsC(alphabet,MISTAKES,n))]:
od:
gu:
end:
 
 
#SetOfCorrectWords(Alphabet,MISTAKES,n): given an alphabet, Alphabet
#and a set of mistakes, MISTAKES, finds, empirically, the
#set of words that that do not have factors that belong to MISTAKES
SetOfCorrectWords:=proc(Alphabet,MISTAKES,n)
local MISTAKES1,gu,mu,i,j,cand:
option remember:
MISTAKES1:=Hakten(MISTAKES):
 
if n=0 then
RETURN({[]}):
fi:
 
mu:=SetOfCorrectWords(Alphabet,MISTAKES,n-1):
 
gu:={}:
 
for i from 1 to nops(mu) do
 for j from 1 to nops(Alphabet) do
   cand:=[op(op(i,mu)),op(j,Alphabet)]:
 
     if not isbad(cand,MISTAKES1) then
          gu:=gu union {cand}:
     fi:
 od:
od:
 
gu:
 
end:
 
 
#SetOfCorrectWordsC(Alphabet,MISTAKES,n): given an alphabet, Alphabet
#and a set of mistakes, MISTAKES, finds, empirically, the
#set of CYCLIC words (with a marked beginning)
#that that do not have factors that belong to MISTAKES
SetOfCorrectWordsC:=proc(Alphabet,MISTAKES,n)
local gu,mila,mu,i:
mu:=SetOfCorrectWords(Alphabet,MISTAKES,n):
gu:={}:
 
for i from 1 to nops(mu) do
mila:=op(i,mu):
if not isbadC(mila,MISTAKES) then
 gu:=gu union {mila}:
fi:
od:
gu:
end:
 
 
 
#isbadC(mila,MISTAKES): returns true if one of the suffices of
#one of the CYCLIC shifts of mila belongs to the set of MISTAKES
isbadC:=proc(mila,MISTAKES)
local i,mila1,n:
n:=nops(mila):
for i from 1 to n do
mila1:=[op(i..n,mila),op(1..i-1,mila)]:
 
if isbad(mila1,MISTAKES) then
RETURN(true):
fi:
od:
 
false:
end:
 
 
#isbad(mila,MISTAKES): returns true if one of the suffices of
#mila belongs to the set of MISTAKES
isbad:=proc(mila,MISTAKES)
local i,shegi:
 
for i from 1 to nops(MISTAKES) do
shegi:=op(i,MISTAKES):
 
if nops(mila)>=nops(shegi) and 
 [op(nops(mila)-nops(shegi)+1..nops(mila),mila)]=shegi then
 RETURN(true):
fi:
 
od:
 
false:
 
end:
 
 
SBW:=proc(k,w,s)
local i,L,gu,mu,A,matkhil:
A:=-sum(s^i,i=1..w):
L:=-k*s^(w+1)/(1-A):
matkhil:=sum((i-1)*s^i,i=1..w):
gu:=k*normal(s*diff(A,s)*A/(1-A))-k*matkhil:
mu:=normal(1/(1-k*s-L)):
normal((s*diff(L,s)-L+1)*mu+gu):
end:
 
#ProveBW(): proves the Burstein-Wilf formula
ProveBW:=proc()
local i,L,gu,mu,A,matkhil,k,w,s:
A:=-sum(s^i,i=1..w):
L:=-k*s^(w+1)/(1-A):
matkhil:=sum((i-1)*s^i,i=1..w):
gu:=k*normal(s*diff(A,s)*A/(1-A))-k*matkhil:
mu:=normal(1/(1-k*s-L)):
evalb(simplify(normal((s*diff(L,s)-L+1)*mu+gu-BW(k,w,s)))=0):
end: