print(` Version of April 18, 1997`):
print(`This is GJsqfree A Maple package`):
print(`that applies the Goulden-Jackson Cluster method,`):
print(`as extended and modified by John Noonan and Doron Zeilberger,`):
print(`to deal with the enumeration of Square-Free Words.`):
lprint(``):
print(`Written by John Noonan and Doron Zeilberger.`):
lprint(``):
print(`It is one of the packages accompanying Noonan and Zeilberger's `):
print(`article: "The Goulden-Jackson Cluster Method: Extensions,`):
print(`Applications, and Implementations", where the method`):
print(`is explained in detail, and then extended and generalized in`):
print(`various directions. `):
lprint(``):
print(`The paper, and the packages, including the present one`):
print(`is available from http://www.math.temple.edu/~zeilberg/gj.html`):
lprint(``):
print(`For general help, and a list of the available functions,`):
print(` type "ezra();". For specific help type "ezra(procedure_name)" `):
lprint(``):
lprint(`Warning: t,s,C,x are global variables, do not use them!`):
 
 
 
ezra:=proc()
if args=NULL then
 
print(`This is GJsqfree`):
print(`A Maple package that applies the Noonan-Zeilberger `):
print(`implementation of the Goulden-Jackson Cluster method`):
print(` to find series expansions for Square-Free Words`):
print(` and pseudo-square-free (i.e. finite-memory)`):
print(`For help, and list of procedures type " ezra();" `):
lprint(``):
print(`Written by John Noonan and Doron Zeilberger`):
lprint(``):
print(` Contains Procedures `):
print(` Series , Zinn `):
print(`The main procedure is Series`):
print(` For specific help type "ezra(procedure_name)" `):
fi:
 
 
 
 
if nops([args])=1 and op(1,[args])=`Zinn` then
 print(` Zinn's method `):
 print(`Given an increasing sequence a(n) of positive integers , expressed`):
 print(`in terms of a list, estimates the theta and mu such that `):
 print(` a(n) is asympt. to n^(theta)*mu^n. The output is `):
 print(` theta, mu `):
fi:
 
if nops([args])=1 and op(1,[args])=`Series` then
print(`Series(MEMO,DIM,NUTERMS): Given the memory, MEMO (a positive `):
print(`integer), the number of letters`):
print(` DIM, and the number of terms NUTERMS,`):
print(`finds the list whose (n+1)^(th) member is the number of words`):
print(` of length n, that do not have squares uu, where length(u)<=MEMO`):
print(`NUTERMS is the desired number of terms in the list`):
fi:
 
 
if nops([args])=1 and op(1,[args])=`GJ1` then
print(`GJ1(DIM,MISTAKES,L) finds the first L terms `):
print(`of the sequence: number of words of length 2*DIM,  in the alphabet`):
print(`\pmDIM, \pm(DIM-1), \pm1 , that avoid`):
print(`as factors,`):
print(`( i.e. subsequences of consecutive letters) the members of the `):
print(`set of lists MISTAKES and its images.`):
print(` For example to find the sequence a_n (0<=n<=15)`):
print(`where a_n:= wt. numbers of words in {-1,-2,1,2,3} without factors in `):
print(` MISTAKES={[1,1],[2,2],[-1,-1],[-2,-2]}. type GJ1(2,{[1,1]},15)`):
fi:
 
 
if nops([args])=1 and op(1,[args])=`Lclust1` then
 print(`Lclust1(MISTAKES,NUTERMS,DIM): computes the first NUTERMS terms of`):
 print(`the L-cluster expansion of the g.f. if the set of mistakes is`):
 print(` MISTAKES where MISTAKES is a set of canonical representatives`):
 print(`and the actual set of mistakes is the set of all images under`):
 print(` all signed permutations. For example Lclust1({[1,2]},10,2) `):
fi:
 
 
end:
 
 
 
with(combinat):
 
 
#canon(mila):Given a word in an alphabet of integers, in terms of a list
#finds an image under the action of the symmetric group that
#is least lexicographically
 
canon:=proc(mila)
local i,gu,mu,lu,n:
lu:=[1]:
mu:=op(1,mila):
gu[mu]:=1:
n:=2:
for i from 2 to nops(mila) do
 mu:=op(i,mila):
 if not type(gu[mu],integer) then 
  gu[mu]:=n: n:=n+1:
 fi:
 lu:=[op(lu),gu[mu]]:
od:
lu:
end:
 
 
 
 
#khaverim(mila,n):Given a word mila finds the set of all its 
#images under the action of the group of permutations
 
khaverim:=proc(mila1,n)
local i,gu,r,lu,mila,mila2:
 
mila:=canon(mila1):
 
mila2:=[]:
 
for i from 1 to nops(mila) do
 mila2:=[op(mila2),op(i,mila)]:
od:
 
r:=nops(convert(mila2,set)):
if n<r then
 ERROR(`Not enough letters`):
fi:
 
 
gu:=permute(n,r):
 
lu:={}:
 
for i from 1 to nops(gu) do
lu:=lu union {peula(mila,op(i,gu))}:
od:
 
lu:
 
end:
 
 
#peula(mila,perm): Given a word in the alphabet {1,2,..,r} applies
#to it the (partial) permutation perm i.e. i is replaced by perm[i]
 
peula:=proc(mila,perm)
local gu,i:
gu:=[]:
 
 
for i from 1 to nops(mila) do
gu:=[op(gu), 
op(op(i,mila),perm)]:
od:
 
gu:
end:
 
 
mist:=proc(memo,dim)
SHEGIOTAD(memo,dim):
end:
 
 
Mist:=proc(memo,dim) 
local gu,gu1,i:
 
gu:=mist(memo,dim) :
gu1:={}:
 
for i from 1 to nops(gu) do
gu1:=gu1 union khaverim(op(i,gu),dim):
od:
 
gu1:
 
end:
 
 
 
 
 
#bdok(MISTAKES) checks that the set of Mistakes is minimal with 
#respect to containment
 
bdok:=proc(MISTAKES)
local mila,i,j,k,mila1:
 
for i from 1 to nops(MISTAKES) do
mila:=op(i,MISTAKES):
 
for j from 1 to nops(mila) do
 for k from j to nops(mila) do
  mila1:=[op(j..k,mila)]:
  if k-j<nops(mila)-1 and member(mila1,MISTAKES) then
   RETURN(0):
  fi:
 od:
od:
od:
1:
end:
 
 
 
 
hafukh:=proc(mila)
local i,mila1:
mila1:=[]:
 
for i from   nops(mila) by -1  to 1  do
mila1:=[op(mila1),op(i,mila)]:
od:
mila1:
end:
 
 
 
canon1:=proc(mila)
hafukh(canon(hafukh(mila))): 
end:
 
 
 
Lclust1:=proc(MISTAKES1,NUTERMS,DIM)
local LEN,SUFFI,i,j,x,Lt,LIS,mila,I1,r,pref,tot,gu,resh,i1,suffi,
MISTAKES,kapi1,kapi2,mila1:
 
MISTAKES:={}:
for i from 1 to nops(MISTAKES1) do
 mila:=canon1(op(i,MISTAKES1)):
kapi1[op(mila)]:=kama(mila,DIM):
MISTAKES:=MISTAKES union {mila}:
od:
 
 
LIS:=[]:
 
SUFFI:={[]}:
 
for i from 1 to nops(MISTAKES) do
 mila:=op(i,MISTAKES):
 
 for j from 2 to nops(mila) do
 mila1:=[op(j..nops(mila),mila)]:
kapi2[op(mila1)]:=kama(mila1,DIM):
  SUFFI:=SUFFI union {mila1}:
 od:
od:
 
LEN:=0:
 
for i from 1 to nops(MISTAKES) do
  mila:=op(i,MISTAKES):
  if nops(mila)>LEN then
    LEN:=nops(mila):
  fi:
od:
 
 
for i from 1 to nops(SUFFI) do
mila:=op(i,SUFFI):
Lt[op(mila)]:=[seq(0,j=1..LEN-nops(mila))]:
od:
 
 
for I1 from 0 to NUTERMS do
 
tot:=0:
 
for i from 1 to nops(SUFFI) do
mila:=op(i,SUFFI):
x[op(mila)]:=0:
od:
 
for i from 1 to nops(MISTAKES) do
 
  mila:=op(i,MISTAKES):
 
  gu:=0:
 
  if nops(mila)=I1 then
   gu:=-1:
  fi:
 
  for r from 1 to nops(mila)-1 do
    pref:=canon1([op(1..nops(mila)-r,mila)]):
     
     if member(pref,SUFFI) then
      gu:=gu-op(nops(Lt[op(pref)])-r+1,Lt[op(pref)]):
     fi:
 
  od:
 
 
  for j from 2 to nops(mila) do
   suffi:=[op(j..nops(mila),mila)]:
   x[op(suffi)]:=x[op(suffi)]+kapi1[op(mila)]
/kapi2[op(suffi)]*gu:
  od:
 
 
tot:=tot+kapi1[op(mila)]*gu:
 
od:
 
 
 
LIS:=[op(LIS),tot]:
 
for i1 from 1 to nops(SUFFI) do
mila:=op(i1,SUFFI):
resh:=Lt[op(mila)]:
Lt[op(mila)]:=[op(2..nops(resh),resh),x[op(mila)]]:
od:
 
od:
 
LIS:
 
end:
 
 
GJ1:=proc(DIM,MISTAKES,L)
local NUMLETTERS,lu,resh,i,gu,t,resh1:
 
NUMLETTERS:=DIM:
 
resh:=Lclust1(MISTAKES,L+2,DIM):
 
lu:=0:
 
for i from 0 to L+1 do
lu:=lu+op(i+1,resh)*t^i:
od:
 
 
gu:=1/(1-NUMLETTERS*t-lu):
 
gu:=taylor(gu,t=0,L+1):
 
resh1:=[]:
 
for i from 0 to L do
resh1:=[op(resh1),coeff(gu,t,i)]:
od:
 
resh1:
end:
 
 
 
#Series(MEMO,DIM,NUTERMS): Given the memory, MEMO (a positive even 
#integer), the dimension, DIM, and the number of terms NUTERMS,
#finds the list whose (n+1)^(th) member is the number of memory-MEMO
#(pseudo-)SAWs in the DIM-dimensional hypercubic lattice .
#NUTERMS is the desired number of terms in the list
 
Series:=proc(MEMO,DIM,NUTERMS)
local MISTAKES:
MISTAKES:=mist(MEMO,DIM) :
GJ1(DIM,MISTAKES,NUTERMS):
end:
 
 
kama:=proc(mila,n)
local i,r,mila2:
 
 
mila2:=[]:
 
for i from 1 to nops(mila) do
 mila2:=[op(mila2),op(i,mila)]:
od:
 
r:=nops(convert(mila2,set)):
if n<r then
 ERROR(`Not enough letters`):
fi:
 
n!/(n-r)!:
 
end:
 
 
 
 
 
 
 
#Circular Square Free
 
detectsq:=proc(w)
local i,wLast,wBef:
 
for i from 1 to trunc(nops(w)/2) do
 
wBef:=[op(nops(w)-2*i+1..nops(w)-i,w) ]:
 
wLast:=[op(nops(w)-i+1..nops(w),w) ]:
 
if wBef=wLast then
 RETURN(1):
fi:
 
od:
 
0:
 
end:
 
 
TOV:=proc(n,DIM)
local w,w1,i,yashan,khadas,j,ku:
 
if n=1 then
ku:=[]:
for j from 1 to DIM do
ku:=[op(ku),[j]]:
od:
RETURN(ku):
fi:
 
khadas:=[]:
yashan:=TOV(n-1,DIM):
 
for i from 1 to nops(yashan) do
 w:=op(i,yashan):
 
for j from 1 to DIM do
 w1:=[op(w),j]:
 
if  detectsq(w1)=0 then
  khadas:=[op(khadas),w1]:
fi:
od:
 
od:
 
khadas:
 
end:
 
mispar:=proc(n,DIM):
nops(TOV(n,DIM)):
end:
 
detectsqall:=proc(w)
local i,j,lu1,lu2,n:
 
n:=nops(w):
 
for i from 1 to n-1 do
 for j from i to trunc((i+n-1)/2) do
   lu1:=op(i..j,w):
   lu2:=op(j+1..2*j-i+1,w):
 
   if lu1=lu2 then
     RETURN(1):
   fi:
 
 od:
od:
 
0:
 
end:
 
 
 
 
 
detectscirc:=proc(w)
local w1,i,n1:
 
n1:=nops(w):
 
if detectsqall(w)=1 then
  RETURN(1):
fi:
 
for i from 2 to n1 do
 
 w1:=[op(i..n1,w),op(1..i-1,w)]:
 
 if detectsqall(w1)=1 then
  RETURN(1):
 fi:
 
od:
 
0:
 
end:
 
 
TOVCIRC:=proc(n,DIM)
local i,w,gu,guc:
 
gu:=TOV(n,DIM):
 
guc:=[]:
 
for i from 1 to nops(gu) do
 w:=op(i,gu):
 
 if detectscirc(w)=0 then
   guc:=[op(guc),w]:
 fi:
 
od:
 
guc:
 
end:
 
 
SHEGIOT:=proc(n,DIM)
local gu,guk,w,i:
 
guk:=[]:
 
gu:=TOVCIRC(n,DIM):
 
for i from 1 to nops(gu) do
 w:=op(i,gu):
 
 guk:=[op(guk),[op(w),op(w)]]:
od:
 
guk:
 
end:
 
 
 
 
 
 
 
SHEGIOTAD:=proc(n,DIM)
local i,gu:
 
gu:=[]:
 
for i from 1 to n do
 gu:=[op(gu),op(SHEGIOT(i,DIM))]:
od:
 
gu:
 
end:
 
 
 
 
Zinn:=proc(resh,n)
local s1,s2:
s1:=sn(resh,n):
s2:=sn(resh,n-1):
evalf(2*(s1+s2)/(s1-s2)^2),
evalf(sqrt(op(n+1,resh)/op(n-1,resh))*exp(-(s1+s2)/((s1-s2)*s1))):
end:
 
 
sn:=proc(resh,n):
-1/log(op(n+1,resh)*op(n-1,resh)/op(n,resh)^2):
evalf(%):
end: