######################################################################
##FreeSAW: Save this file as FreeSAW. To use it, stay in the         #
##same directory, get into Maple (by typing: maple <Enter> )         #
##and then type:  read FreeSAW : <Enter>                             #
##Then follow the instructions given there                           #
##                                                                   #
##Written by Doron Zeilberger, Temple University ,                   #
#zeilberg@math.temple.edu.                                           # 
#######################################################################
 
#Created: Nov. 30, 1999
#This version: Nov. 30, 1999
#FreeSAW: A Maple package to study 2D FREE SAWs on the square-lattice
#It is one of the packages that accompanies Doron Zeilberger's
#article: "Symbol-Crunching with the Transfer-Matrix Method with 
#Applications to the Enumeration of Skinny Physical Creatures"
#Please report bugs to zeilberg@math.temple.edu
print(`Created: Nov. 30, 1999.`):
print(`This version: Nov. 30, 1999`):
print(` FreeSAW: A Maple package to study 2D Self Avoiding Walks, where `):
print(` each of whose vertical cross-sections has bounded width,`):
print(` but the gloabl width is unbounded. `).
print(``):
print(` It is one of the packages that accompany Doron Zeilberger's `):
print(`article: "Symbol-Crunching with the Transfer-Matrix Method with `):
print(`Applications to the Enumeration of Skinny Physical Creatures"`):
lprint(``):
print(`Written by Doron Zeilberger, zeilberg@math.temple.edu .`):
lprint(``):
print(`Please report bugs to zeilberg@math.temple.edu .`):
lprint(``):
 print(`The most current version of this  package and paper`):
 print(` are  available from`):
 print(`http://www.math.temple.edu/~zeilberg/`):
 print(`For a list of the procedures type ezra(), for help with`):
 print(`a specific procedure, type ezra(procedure_name)`):
 print(``): 
 
ezra:=proc()
if args=NULL then
 
 print(`Contains the following procedures:  `):
 print(`   gfSeriesWf,gfWf   `):
fi:
 
if nops([args])=1 and op(1,[args])=gfSeriesWf then 
print(`gfSeriesW(n,M): The sequence whose i^th term is the`):
print(`number of self-avoiding walks length i with every `):
print(` vertical cross-section of width<=n`):
print(`for 1<=i<=M `):
fi:
 
if nops([args])=1 and op(1,[args])=GFSeriesW then 
print(`GFSeriesW(n,M): The sequence whose i^th term is the`):
print(`number of self-avoiding walks length i of width<=n`):
print(`for 1<=i<=M `):
fi:
 
if nops([args])=1 and op(1,[args])=GFW then 
print(`GFW(n,t): The generating function for SAWs of width<=n`):
fi:
 
if nops([args])=1 and op(1,[args])=gfWf then 
print(`gfWf(n,t): The generating function for SAWs with `):
print(`each vertical cross-section of width<=n`):
fi:
 
if nops([args])=1 and op(1,[args])=SAWseries then 
print(`SAWseries(L): The sequence whose i^th term is`):
print(`the number of self-avoiding walks of length i`):
print(`for i=1...L`):
fi:
 
if nops([args])=1 and op(1,[args])=Wordsnw2 then 
print(`Wordsnw2(n,w,L,R,A): the list (with repetitions) of`):
print(`SAW words of weight n in [0,w] `):
fi:
 
end:
 
##A
#Ancestors of procedures
ABBA[GfW]:={gfW}:
ABBA[GFW]:={gfW}:
ABBA[gfW]:={SolveMarCha,MarChaW}:
ABBA[SolveMarCha]:={}:
ABBA[MarChaW]:={AlphabetW,FollowersW}:
ABBA[AlphabetW]:={Okvim}:
ABBA[Okvim1]:={FollowersW}:
ABBA[Okvim]:={Okvim1}:
ABBA[FollowersW]:={LeftLettersW,PreFollowersW,DerivedPreLettersW,
FillInsOneStepA,InterfacesWithRight}:
ABBA[FollowersWf]:={LeftLettersWf,FollowersW1}:
ABBA[LeftLettersW]:={LeftLetters,Insert1AL,Insert2AL,OneStepChopL,
OneStepChopR}:
ABBA[LeftLettersWf]:={LeftLettersW,Support}:
ABBA[PreFollowersW]:={PrePreFollowersW,LebensRaums,IncSeqSand}:
ABBA[DerivedPreLettersW]:={FillInsOneStep}:
ABBA[FillInsOneStepA]:={FillIns1A}:
ABBA[InterfacesWithRight]:={PreFollowersWR,PrePreFollowersWR}:
ABBA[LeftLetters]:={IncSeq}:
ABBA[Insert1AL]:={PlacesForLeftA}:
ABBA[Insert2AL]:={PlacesForLeftA}:
ABBA[OneStepChopL]:={FindRW}:
ABBA[OneStepChopR]:={FindLW}:
ABBA[PrePreFollowersW]:={OneStepAllW,OneStepAbortL,OneStepAbortR}:
ABBA[LebensRaums]:={LebensRaum}:
ABBA[IncSeqSand]:={}:
ABBA[FillInsOneStep]:={FillIns1}:
ABBA[FillIns1A]:={PlacesToInsertA,SetToUnInt,Stick1AL,Stick1AR}:
ABBA[PreFollowersWR]:={PrePreFollowersWR,LebensRaums,IncSeqSand}:
ABBA[PrePreFollowersWR]:={OneStepAllW}:
ABBA[IncSeq]:={}:
ABBA[PlacesForLeftA]:={}:
ABBA[FindRW]:={}:
ABBA[FindLW]:={}:
ABBA[OneStepAllW]:=
{OneStepLLW,OneStepRRW,OneStepRLW,OneStepAL,OneStepLA,OneStepAR,OneStepRA}:
ABBA[OneStepAbortL]:={FindRW,LebensRaum, GoodA}:
ABBA[OneStepAbortR]:={FindLW,LebensRaum,GoodA}:
ABBA[LebensRaum]:={}:
ABBA[FillIns1]:={PlacesToInsert,SetToUnInt,Stick1}:
ABBA[PlacesToInsertA]:={PlacesToInsert1A}:
ABBA[SetToUnInt]:={}:
ABBA[Stick1AL]:={}:
ABBA[Stick1AR]:={}:
ABBA[OneStepLLW]:={JoinLLW}:
ABBA[OneStepRRW]:={JoinRRW}:
ABBA[OneStepRLW]:={JoinRLW}:
ABBA[OneStepAL]:={JoinAL}:
ABBA[OneStepLA]:={JoinLA}:
ABBA[OneStepAR]:={JoinAR}:
ABBA[OneStepRA]:={JoinRA}:
ABBA[GoodA]:={}:
ABBA[PlacesToInsert]:={PlacesToInsert1}:
ABBA[PlacesToInsert1]:={}:
ABBA[Stick1]:={}:
ABBA[PlacesToInsert1A]:={}:
ABBA[JoinLLW]:={FindRW}:
ABBA[JoinRRW]:={FindLW}:
ABBA[JoinRLW]:={}:
ABBA[JoinAL]:={FindRW}:
ABBA[JoinLA]:={FindRW}:
ABBA[JoinAR]:={FindLW}:
ABBA[JoinRA]:={FindLW}:
ABBA[GFSeriesW]:={gfSeriesW}:
ABBA[GfSeriesW]:={GFSeriesW}:
ABBA[gfSeriesW]:={SeriesMC1,MCtoGMC,Hafokh,MarChaW}:
ABBA[SeriesMC1]:={}:
ABBA[MCtoGMC]:={paleg}:
ABBA[Hafokh]:={hafokh}:
ABBA[hafokh]:={}:
ABBA[paleg]:={}:
ABBA[Wordsnw2]:={Wordsnw1}:
ABBA[Wordsnw1]:={FollowersW}:
ABBA[EdgesW]:={AlphabetW,FollowersW}:
ABBA[Support]:={}:
ABBA[gova]:={Support}:
ABBA[narmel]:={}:
##End Ancestors
 
#AlphabetW(a,b,L,R,A): The SAW alphabet in a strip
AlphabetW:=proc(a,b,L,R,A)
local gu,mu,guo:
mu:={L}:
gu:=mu union Okvim(mu,a,b,L,R,A):
 
while mu<>gu do
guo:=gu:
gu:=gu union Okvim(gu,a,b,L,R,A):
mu:=guo:
od:
 
gu:
 
end:
 
#AlphabetWf(n,L,R,A): The SAW alphabet for SAWs
#with vertical cross-section <=n
AlphabetWf:=proc(n,L,R,A)
local gu,mu,guo:
mu:={L}:
gu:=mu union Okvimf(mu,n,L,R,A):
 
while mu<>gu do
guo:=gu:
gu:=gu union Okvimf(gu,n,L,R,A):
mu:=guo:
od:
 
gu:
 
end:
 
 
#ANCESTORS(Set1): the set of all ancestors of the
#definitions in the set Set1, including themselves
ANCESTORS:=proc(Set1)
local gu,mu,mun:
gu:=Set1:
mu:=IterAbba(gu):
 
while mu<>gu do
mun:=IterAbba(mu):
gu:=mu:
mu:=mun:
od:
 
mu:
end:
##B
##C
##D
#DerivedPreLettersW(LET1,L,R): Given a pre-letter, finds
#all pre-letters obtained from it by inserting any number
#of eligible intervals
DerivedPreLettersW:=proc(LET1,L,R)
local mu,gu:
mu:={LET1}:
gu:={}:
 
 
while mu<>{} do
gu:=gu union mu:
mu:=FillInsOneStep(mu,L,R):
od:
 
gu:
 
end:
##E
#EdgesW(a,b,L,R,A): all the edges in the SAWs in a strip [a,b]
# langaue 
EdgesW:=proc(a,b,L,R,A)
local gu,mu,i,mu1,lu,j,lu1:
mu:=AlphabetW(a,b,L,R,A):
gu:={}:
 
for i from 1 to nops(mu) do
mu1:=op(i,mu):
lu:=FollowersW(mu1,a,b,L,R,A):
for j from 1 to nops(lu) do
lu1:=lu[j]:
gu:=gu union {[mu1,lu1[2],lu1[1]]}:
od:
od:
gu:
end:
 
##F
#FillIns1(LET1,L,R): Given a pre-letter, LET1, where
#L and R denote ( and ), finds all the possible pre-letters
#obtained from it by inserting ONE new interval in
#a legal place
FillIns1:=proc(LET1,L,R)
local gu,mu,i:
gu:={}:
mu:=PlacesToInsert(SetToUnInt(LET1[2])):
 
for i from 1 to nops(mu) do
gu:=gu union {Stick1(LET1,L,R,mu[i][1],mu[i][2])}:
 
od:
gu:
end:
 
#FillIns1A(LET1,A): Given a pre-letter, LET1, where
#L and R denote ( and ), finds all the possible pre-letters
#obtained from it by inserting ONE new interval in
#a legal place
FillIns1A:=proc(LET1,A)
local gu,mu,i:
gu:={}:
mu:=PlacesToInsertA(SetToUnInt(LET1[2])):
 
for i from 1 to nops(mu) do
 
if mu[i][1]<>mu[i][2] then
gu:=gu union {Stick1AL(LET1,A,mu[i][1],mu[i][2])} union
{Stick1AR(LET1,A,mu[i][1],mu[i][2])}:
else
gu:=gu union {Stick1AL(LET1,A,mu[i][1],mu[i][2])}:
fi:
od:
gu:
end:
 
 
#FillInsOneStep(SetLET1,L,R): given a set of pre-letters
#finds all the pre-letters obtained from their members
#by inserting ONE interval
FillInsOneStep:=proc(SetLET1,L,R)
local gu,i:
gu:={}:
 
for i from 1 to nops(SetLET1) do
gu:=gu union FillIns1(SetLET1[i],L,R):
od:
gu:
end:
 
 
#FillInsOneStepA(SetLET1,A): given a list of pre-letters
#finds all the pre-letters obtained from their members
#by inserting ONE A 
FillInsOneStepA:=proc(SetLET1,A)
local gu,i:
gu:={}:
 
for i from 1 to nops(SetLET1) do
gu:=gu union FillIns1A(SetLET1[i],A):
od:
gu:
end:
 
 
# FindLW(w,j,L,R,A): Given a legal word w (in {L,R}), and
# a place j  that is an R, find the location of its L-mate
FindLW:=proc(w,j,L,R,A)
local w1,i,gu:
 
if w[j]<>R then
ERROR(` The `, i, `place of`, w, `should have been an `, L):
fi:
 
gu:=1:
w1:=subs({L=-1,R=1,A=0},w):
 
for i from j-1 by -1 while gu>0 do
gu:=gu+w1[i]:
od:
i+1:
end:
 
# FindRW(w,i,L,R,A): Given a legal word w (in {L,R}), and
# a place i that is an L, find the location of its R-mate
FindRW:=proc(w,i,L,R,A)
local w1,j,gu:
 
if w[i]<>L then
ERROR(` The `, i, `place of`, w, `should have been an `, L):
fi:
 
gu:=1:
w1:=subs({L=1,R=-1,A=0},w):
 
for j from i+1 while gu>0 do
gu:=gu+w1[j]:
od:
j-1:
end:
 
 
#FollowersW(LET1,a,b,L,R,A): In the language of SAWs,
#all the letters that
#can follow the letter LET1 in the ambient strip, [a,b]
#where L and R denote ( and ) resp., and A denotes a loose end
#followed by the extra-weight
FollowersW:=proc(LET1,a,b,L,R,A)
local mu,gu1,gu,i,guA0,guA1,guA2,lu,GU,GU0,GU01:
 
if LET1=R then
RETURN([]):
fi:
 
 
if LET1=L then
GU:=LeftLettersW(a,b,L,R,A):
gu:=[]:
for i from 1 to nops(GU) do
gu:=[op(gu), [GU[i][1],GU[i][4]]]:
od:
 RETURN(gu):
fi:
 
mu:=PreFollowersW(LET1,a,b,L,R,A):
 
gu1:={}:
 
for i from 1 to nops(mu) do
gu1:=gu1 union DerivedPreLettersW(mu[i],L,R):
od:
 
 
 
guA0:={}:guA1:={}:guA2:={}:
 
for i from 1 to nops(gu1) do
lu:=gu1[i][1][1]:
lu:=subs({A=1,L=0,R=0},lu):
lu:=convert(lu,`+`):
 
if lu=0 then
guA0:=guA0 union {gu1[i]}:
elif lu=1 then
guA1:=guA1 union {gu1[i]}:
elif lu=2 then
guA2:=guA2 union {gu1[i]}:
else
ERROR(gu1[i], `has too many As`):
fi:
 
od:
 
GU:=guA2 union guA1 union FillInsOneStepA(guA1,A) union guA0:
GU0:=FillInsOneStepA(guA0,A);
GU01:=FillInsOneStepA(GU0,A);
GU:=GU union GU0 union GU01:
 
GU:=GU union InterfacesWithRight(LET1,a,b,L,R,A):
 
gu:=[]:
for i from 1 to nops(GU) do
gu:=[op(gu), [GU[i][1],GU[i][4]]]:
od:
 
gu:
 
end:
 
#FollowersW1(LET1,a,b,L,R,A): In the language of SAWs,
#all the pseudo-letters that
#can follow the letter LET1 in the ambient strip, [a,b]
#where L and R denote ( and ) resp., and A denotes a loose end
#followed by the extra-weight
FollowersW1:=proc(LET1,a,b,L,R,A)
local mu,gu1,gu,i,guA0,guA1,guA2,lu,GU,GU0,GU01:
 
if LET1=R then
RETURN([]):
fi:
 
 
if LET1=L then
GU:=LeftLettersW(a,b,L,R,A):
gu:={}:
for i from 1 to nops(GU) do
gu:=gu union  {[GU[i][1],GU[i][3],GU[i][4]]}:
od:
 RETURN(gu):
fi:
 
mu:=PreFollowersW(LET1,a,b,L,R,A):
 
gu1:={}:
 
for i from 1 to nops(mu) do
gu1:=gu1 union DerivedPreLettersW(mu[i],L,R):
od:
 
 
 
guA0:={}:guA1:={}:guA2:={}:
 
for i from 1 to nops(gu1) do
lu:=gu1[i][1][1]:
lu:=subs({A=1,L=0,R=0},lu):
lu:=convert(lu,`+`):
 
if lu=0 then
guA0:=guA0 union {gu1[i]}:
elif lu=1 then
guA1:=guA1 union {gu1[i]}:
elif lu=2 then
guA2:=guA2 union {gu1[i]}:
else
ERROR(gu1[i], `has too many As`):
fi:
 
od:
 
GU:=guA2 union guA1 union FillInsOneStepA(guA1,A) union guA0:
GU0:=FillInsOneStepA(guA0,A);
GU01:=FillInsOneStepA(GU0,A);
GU:=GU union GU0 union GU01:
 
GU:=GU union InterfacesWithRight(LET1,a,b,L,R,A):
 
gu:={}:
for i from 1 to nops(GU) do
gu:=gu union { [GU[i][1],GU[i][3],GU[i][4]]}:
od:
 
gu:
 
end:
 
 
#FollowersWf(LET1,n,L,R,A): In the language of SAWs,
#with each vertical cross-section of length<=n
#all the letters that
#can follow the letter LET1 in the ambient strip, [a,b]
#where L and R denote ( and ) resp., and A denotes a loose end
#followed by the extra-weight
FollowersWf:=proc(LET1,n,L,R,A)
local gu,GU,i,g,LET1b:
 
if LET1=R then
RETURN([]):
fi:
 
 
if LET1=L then
GU:=LeftLettersWf(n,L,R,A):
gu:=[]:
for i from 1 to nops(GU) do
gu:=[op(gu), [narmel(GU[i][1],L,R),GU[i][4]]]:
od:
 RETURN(gu):
fi:
 
LET1b:=LET1[2]:
g:=LET1b[nops(LET1b)]-LET1b[1]:
GU:=FollowersW1(LET1,0,g+n,L,R,A) union FollowersW1(LET1,-n,g,L,R,A):
for a from 1 to n do
GU:=GU union FollowersW1(LET1,-a,max(n-a,g),L,R,A): 
od:
 
gu:=[]:
for i from 1 to nops(GU) do
 
if gova1(GU[i])<=n then
 gu:=[op(gu), [narmel(GU[i][1],L,R),GU[i][3]]]:
fi:
 
od:
 
gu:
 
end:
 
##G
 
#gfSeriesW(n,M): The sequence whose i^th term is the
#number of self-avoiding walks of length i immersed
#in the strip 0<=y<=n, for 1<=i<=M 
gfSeriesW:=proc(n,M) 
local t:
option remember: 
SeriesMC1(MCtoGMC(Hafokh(MarChaW(n),t)),M,t):
end:
 
#gfSeriesWf(n,M): The sequence whose i^th term is the
#number of self-avoiding walks of length i with each vertical
#cross-section of height<=n
gfSeriesWf:=proc(n,M) 
local t:
option remember: 
SeriesMC1(MCtoGMC(Hafokh(MarChaWf(n),t)),M,t):
end:
 
#gfSeriesWs(n,M,s): The sequence whose i^th term is the
#weight-enumerator (according to the weight s^(number of letters)
#number of self-avoiding walks of length i immersed
#in the strip 0<=y<=n, for 1<=i<=M 
gfSeriesWs:=proc(n,M,s) 
local t:
option remember: 
SeriesMC1s(MCtoGMC(Hafokh(MarChaW(n),t)),M,t,s):
end:
 
#GfSeriesW(n,M): The sequence whose i^th term is the
#number of self-avoiding walks of length i of width=n
#for 1<=i<=M 
GfSeriesW:=proc(n,M)
local i,mu1,mu2:
 
mu1:=GFSeriesW(n,M):
 
if n=0 then
RETURN(mu1):
fi:
 
 
mu2:=GFSeriesW(n-1,M):
[seq(mu1[i]-mu2[i],i=1..M)]:
end:
 
 
#GfSeriesWs(n,M,s): The sequence whose i^th term is the
#weight-enumerator (according to the weight s^(number of letters)
#number of self-avoiding walks of length i of width=n
#for 1<=i<=M 
GfSeriesWs:=proc(n,M,s)
local i,mu1,mu2:
 
mu1:=GFSeriesWs(n,M,s):
 
if n=0 then
RETURN(mu1):
fi:
 
 
mu2:=GFSeriesWs(n-1,M,s):
[seq(mu1[i]-mu2[i],i=1..M)]:
end:
 
#GFSeriesW(n,M): The sequence whose i^th term is the
#number of self-avoiding walks length i of width<=n
#for 1<=i<=M 
GFSeriesW:=proc(n,M)
local i,mu1,mu2:
option remember:
mu1:=gfSeriesW(n,M):
 
if n=0 then
RETURN(mu1):
fi:
 
mu2:=gfSeriesW(n-1,M):
[seq(mu1[i]-mu2[i],i=1..M)]:
end:
 
 
#GFSeriesWs(n,M,s): The sequence whose i^th term is the
##weight-enumerator (according to the weight s^(number of letters)
#number of self-avoiding walks length i of width<=n
#for 1<=i<=M 
GFSeriesWs:=proc(n,M,s)
local i,mu1,mu2:
option remember:
mu1:=gfSeriesWs(n,M,s):
 
if n=0 then
RETURN(mu1):
fi:
 
mu2:=gfSeriesWs(n-1,M,s):
[seq(mu1[i]-mu2[i],i=1..M)]:
end:
 
 
 
#gfW(n,t): The generating function of self-avoiding walks
#immersed in a fixed strip [0,n]
gfW:=proc(n,t) option remember: SolveMarCha(MarChaW(n),t): end:
 
#gfWf(n,t): The generating function of self-avoiding walks
#with each vertical cross section of length<=n
gfWf:=proc(n,t) option remember: sort(factor(SolveMarCha(MarChaWf(n),t))): 
end:
 
#GFW(n,t): The generating function for SAWs of width<=n
GFW:=proc(n,t):factor(normal(gfW(n,t)-gfW(n-1,t))):end:
 
#GfW(n,t):The generating function for saws of width=n
GfW:=proc(n,t):normal(gfW(n,t)-2*gfW(n-1,t)+gfW(n-2,t)):end:
 
#GoodA(LET,L,R,A): decides whether it has at most two A's
GoodA:=proc(LET,L,R,A) local lu:
lu:=LET[1]:
lu:=subs({A=1,L=0,R=0},lu):
lu:=convert(lu,`+`):
if lu<=2 then
RETURN(true):
else
RETURN(false):
fi:
end:
 
#gova(PRELET): The height of a preletter PRELET
gova:=proc(PRELET) local gu:gu:=Support(PRELET):
if gu={} then
0:
else
max(op(gu))-min(op(gu)):
fi:
end:
 
#gova1(PRELET): The height of a pseudo-letter PRELET
gova1:=proc(PRELET) local gu:gu:=Support1(PRELET):
if gu={} then
0:
else
max(op(gu))-min(op(gu)):
fi:
end:
 
##H
 
#hafokh(li): Given a list of outgoing neighbors, with weights
#[[a1,b1],[a2,b2]..] returns a list in which the neighbors are
#only listed once and [a,b1],[a,b2],... get condensed to
#[a,t^b1+t^b2+...]
hafokh:=proc(li,t)
local sakhen,i,T,ru:
sakhen:={seq(li[i][1],i=1..nops(li))}:
 
for i from 1 to nops(sakhen) do
T[sakhen[i]]:=0:
od:
 
for i from 1 to nops(li) do
 T[li[i][1]]:=T[li[i][1]]+t^li[i][2]:
od:
ru:=[]:
 
for i from 1 to nops(sakhen) do
ru:=[op(ru),[sakhen[i],T[sakhen[i]]] ]:
od:
ru:
end:
 
#Hafokh(MC,t): Given a Markov Chain MC, translates
#it to t-format
Hafokh:=proc(MC,t)
local mat,mat1,i:
mat:=MC[3]:
mat1:=[]:
 
for i from 1 to nops(mat) do
 mat1:=[op(mat1),hafokh(mat[i],t)]:
od:
 
[MC[1],MC[2],mat1]:
end:
 
##I
 
#IncSeq(m,n,k): The set of inreasing sequences [i1, ..., ik]
#of k integers, such that m<=i1< ...<ik<=n
IncSeq:=proc(m,n,k)
local gu,mu,i:
option remember:
if k<0 or m>n then
RETURN({}):
fi:
 
if k=0 then
RETURN({[]}):
fi:
 
if m=n then
if k=1 then
 RETURN({[m]}):
else
 RETURN({}):
fi:
fi:
 
 
gu:=IncSeq(m,n-1,k):
mu:=IncSeq(m,n-1,k-1):
 
for i from 1 to nops(mu) do
gu:=gu union {[op(mu[i]),n]}:
od:
 
gu:
end:
 
#IncSeqSand(BOUNDS,Centers): given a list of pairs [[a1,b1],...,[ak,bk]]
#and a set of centers, Centers
#finds the set of increasing sequences x1<=x2<=..<=xk
#such that ai<=xi<=bi, for i=1...k
#followed by the set of edges covered
#followed the extra teritory taken
IncSeqSand:=proc(BOUNDS,Centers)
local k,mu,gu,a,b,i,j,j1,BOUNDS1,Centers1,vec,vk:
option remember:
k:=nops(BOUNDS):
 
if k=0 then
RETURN({[]}):
fi:
 
a:=BOUNDS[k][1]:
b:=BOUNDS[k][2]:
vk:=Centers[k]:
if k=1 then
if not (a<=vk and vk<=b) then
 ERROR(`Bad input`):
fi:
 
RETURN({seq([[i], {seq(j,j=i..vk)},   {seq([j,j+1],j=i..vk-1)},
vk-i],i=a..vk)}
union {seq([[i], {seq(j,j=vk..i)},{seq([j,j+1],j=vk..i-1)},
i-vk],i=vk+1..b)}):
fi:
 
BOUNDS1:=[op(1..k-1,BOUNDS)]:
Centers1:=[op(1..k-1,Centers)]:
a:=BOUNDS[k][1]:
b:=BOUNDS[k][2]:
mu:=IncSeqSand(BOUNDS1,Centers1):
gu:={}:
for i from 1 to nops(mu) do
vec:=mu[i][1]:
 
for j from max(vec[k-1]+1,a) to vk do
gu:=gu union {[[op(vec),j],mu[i][2] union  {seq(j1,j1=j..vk)},
mu[i][3] union  {seq([j1,j1+1],j1=j..vk-1)},
mu[i][4]+vk-j]}
od:
 
for j from vk+1 to b do
gu:=gu union {[[op(vec),j],mu[i][2] union  {seq(j1,j1=vk..j)},
mu[i][3] union  {seq([j1,j1+1],j1=vk..j-1)},
mu[i][4]+j-vk]}
od:
 
od:
 
gu:
end:
 
#Insert1AL(LET,a,b,A): Given a pre-letter LET [LET,FS,OCU,wt]
#finds the set of pre-letters obtained from it by inserting
#ONE A in LET[1] and the corresponding place in LET[2]
Insert1AL:=proc(LET,a,b,A)
local LET1,LET2,wt,gu,mu,ru,i,k,FS,OCU:
LET1:=LET[1][1]:
LET2:=LET[1][2]:
FS:=LET[2]:
OCU:=LET[3]:
wt:=LET[4]:
k:=nops(LET2)/2:
 
mu:=PlacesForLeftA(LET[1],a,b):
 
gu:={}:
 
for i from 1 to nops(mu) do
ru:=mu[i]:
gu:=gu union
{[[[op(1..ru[1]-1,LET1),A,op(ru[1]..2*k,LET1)],
              [op(1..ru[1]-1,LET2),ru[2],op(ru[1]..2*k,LET2)]],
FS minus {ru[2]},OCU,wt+1]}:
od:
gu:
end:
 
 
 
#Insert2AL(LET,a,b,A): Given a letter LET followed by its weight
#finds the set of letters obtained from it by inserting
#TWO As in LET[1] and the corresponding place in LET[2]
Insert2AL:=proc(LET,a,b,A)
local LET1,LET2,wt,gu,mu,ru1,ru2,i,j,k,FS,OCU:
LET1:=LET[1][1]:
LET2:=LET[1][2]:
FS:=LET[2]:
OCU:=LET[3]:
wt:=LET[4]:
 
k:=nops(LET2)/2:
 
mu:=PlacesForLeftA(LET[1],a,b):
 
gu:={}:
 
for i from 1 to nops(mu) do
ru1:=mu[i]:
for j from i+1 to nops(mu) do
ru2:=mu[j]:
gu:=gu union
{[[[op(1..ru1[1]-1,LET1),A,op(ru1[1]..ru2[1]-1,LET1),A,
                                             op(ru2[1]..2*k,LET1)],
   [op(1..ru1[1]-1,LET2),ru1[2],op(ru1[1]..ru2[1]-1,LET2),ru2[2],
                                             op(ru2[1]..2*k,LET2)] ],
FS minus {ru1[2],ru2[2]},OCU,
         wt+2]}:
od:
od:
gu:
end:
 
 
#InterfacesWithRight(LET1,a,b,L,R,A): In the SAW
#language, given a letter LET1 that lives in the
#interval [a,b], finds the list of intefaces 
#with the Terminating letter R
InterfacesWithRight:=proc(LET1,a,b,L,R,A)
local mu,i,j,mu1,ru,i1,i2,k,ka,jh:
mu:=PreFollowersWR(LET1,a,b,L,R,A):
 
 
ru:={}:
for i from 1 to nops(mu) do
mu1:=mu[i]:
 
if convert(subs({L=1,A=0,R=0},mu1[1][1]),`+`)=1 and
convert(subs({L=0,A=0,R=1},mu1[1][1]),`+`)=1 
and convert(subs({L=0,A=1,R=0},mu1[1][1]),`+`)=0 
then
ru:=ru union {[R,mu1[2],mu1[3],mu1[4]-2]}:
fi:
 
if convert(subs({L=1,A=0,R=0},mu1[1][1]),`+`)=0 and
convert(subs({L=0,A=0,R=1},mu1[1][1]),`+`)=0 
and convert(subs({L=0,A=1,R=0},mu1[1][1]),`+`)=1 
then
ru:=ru union {[R,mu1[2],mu1[3],mu1[4]-1]}:
fi:
 
od:
 
mu:=PrePreFollowersWR(LET1,a,b,L,R,A):
for i from 1 to nops(mu) do
mu1:=mu[i]:
if convert(subs({L=1,A=0,R=0},mu1[1][1]),`+`)=0 and
convert(subs({L=0,A=0,R=1},mu1[1][1]),`+`)=0 
and convert(subs({L=0,A=1,R=0},mu1[1][1]),`+`)=2 
then
 for j from 1 to nops(mu1[1][1]) do
    if mu1[1][1][j]=A then 
         i1:=mu1[1][2][j]:
     break:
    fi:
 od:
 
ka:=j:
 for j from ka+1 to nops(mu1[1][1]) do
   if mu1[1][1][j]=A then 
         i2:=mu1[1][2][j]:
     break:
    fi:
 od:
 
 if {seq(k,k=i1+1..i2-1)} minus mu1[2]={} then
  ru:=ru union {[R,mu1[2] minus {seq(jh,jh=i1..i2)},
mu1[3] union {seq([jh,jh+1],jh=i1..i2-1)},
mu1[4]+i2-i1]}:
  fi:
fi:
od:
 
ru:
 
end:
 
 
#IterAbba(Set1): Given a set of definitions
#joins to them the definitions that depend on
#them
IterAbba:=proc(Set1)
local i,gu,bu:
gu:={}:
for i from 1 to nops(Set1) do
bu:=ABBA[op(i,Set1)]:
if not type(bu,set) then
ERROR(bu,`is not a set`):
fi:
gu:=gu union bu:
od:
gu union Set1:
end:
 
##J
 
#JoinAL(LET1,FreeSpace,OCCUPIED,extw,i,L,R,A): In the langauge of
#SAWs, given a letter LET1,
# (phrased in terms of L and R), 
# a set of integers, FreeSpace, and a location i
# such that LET1[1][i-1]=A, LET1[1][i]=L does the
# operation ALpR->pA and its corresponding
# effect on LET1[2] (the list of places with the
# opening, and  also outputs the new FreeSpace
# obtained by removing all the points between these
# two adjacent Ls i.e. LET1[2][i-1]+1..LET1[2][i]-1
JoinAL:=proc(LET1,FreeSpace,OCCUPIED,extw,i,L,R,A)
local w,v,w1,v1,FreeSpace1,OCCUPIED1,j:
w:=LET1[1]:
v:=LET1[2]:
 
if not (w[i-1]=A and w[i]=L) then
ERROR(` The locations `, i , ` and `, i+1, `should be `, L):
fi:
 
j:=FindRW(w,i,L,R,A):
 
w1:=[op(1..i-2,w),op(i+1..j-1,w),A,op(j+1..nops(w),w)]:
v1:=[op(1..i-2,v),op(i+1..nops(v),v)]:
 
FreeSpace1:=FreeSpace minus {seq(j,j=v[i-1]+1..v[i]-1)}:
OCCUPIED1:=OCCUPIED union {seq([j,j+1],j=v[i-1]..v[i]-1)}:
[w1,v1],FreeSpace1,OCCUPIED1,extw+v[i]-v[i-1]:
end:
 
#JoinAR(LET1,FreeSpace,OCCUPIED,extw,j,L,R,A): In the langauge of
#SAWs, given a letter LET1,
# (phrased in terms of L and R), 
# a set of integers, FreeSpace, and a location i
# such that LET1[1][j-1]=A, LET1[1][j]=R does the
# operation LpAR->Ap and its corresponding
# effect on LET1[2] (the list of places with the
# opening, and  also outputs the new FreeSpace
# obtained by removing all the points between these
# two adjacent Ls i.e. LET1[2][j-1]+1..LET1[2][j]-1
JoinAR:=proc(LET1,FreeSpace,OCCUPIED,extw,j,L,R,A)
local w,v,w1,v1,FreeSpace1,OCCUPIED1,i,i1:
w:=LET1[1]:
v:=LET1[2]:
 
if not (w[j-1]=A and w[j]=R ) then
ERROR(` The locations `, j-1 , ` and `, j, `should be `, A,R):
fi:
 
i:=FindLW(w,j,L,R,A):
 
w1:=[op(1..i-1,w),A,op(i+1..j-2,w),op(j+1..nops(w),w)]:
v1:=[op(1..j-2,v),op(j+1..nops(v),v)]:
 
 
 
FreeSpace1:=FreeSpace minus {seq(i1,i1=v[j-1]+1..v[j]-1)}:
OCCUPIED1:=OCCUPIED union {seq([i1,i1+1],i1=v[j-1]..v[j]-1)}:
[w1,v1],FreeSpace1,OCCUPIED1,extw+v[j]-v[j-1]:
end:
 
#JoinLA(LET1,FreeSpace,OCCUPIED,extw,i,L,R,A): In the langauge of
#SAWs, given a letter LET1,
# (phrased in terms of L and R), 
# a set of integers, FreeSpace, and a location i
# such that LET1[1][i-1]=A, LET1[1][i]=L does the
# operation LApR->pA and its corresponding
# effect on LET1[2] (the list of places with the
# opening, and  also outputs the new FreeSpace
# obtained by removing all the points between these
# two adjacent Ls i.e. LET1[2][i]+1..LET1[2][i+1]-1
JoinLA:=proc(LET1,FreeSpace,OCCUPIED,extw,i,L,R,A)
local w,v,w1,v1,FreeSpace1,OCCUPIED1,j:
w:=LET1[1]:
v:=LET1[2]:
 
if not (w[i]=L and w[i+1]=A) then
ERROR(` The locations `, i , ` and `, i+1, `should be `, L):
fi:
 
j:=FindRW(w,i,L,R,A):
 
w1:=[op(1..i-1,w),op(i+2..j-1,w),A,op(j+1..nops(w),w)]:
 
v1:=[op(1..i-1,v),op(i+2..nops(v),v)]:
 
FreeSpace1:=FreeSpace minus {seq(j,j=v[i]+1..v[i+1]-1)}:
OCCUPIED1:=OCCUPIED union {seq([j,j+1],j=v[i]..v[i+1]-1)}:
[w1,v1],FreeSpace1,OCCUPIED1,extw+v[i+1]-v[i]:
end:
 
#JoinLLW(LET1,FreeSpace,extw,i,L,R,A): In the langauge of
#SAWs, given a letter LET1,
# (phrased in terms of L and R), 
# a set of integers, FreeSpace, and a location i
# such that LET1[1][i]=LET1[1][i+1]=L does the
# operation LLpRqR->pLqR and its corresponding
# effect on LET1[2] (the list of places with the
# opening, and  also outputs the new FreeSpace
# obtained by removing all the points between these
# two adjacent Ls i.e. LET1[2][i]+1..LET1[2][i+1]-1
#It also outputs a new occupied edges
JoinLLW:=proc(LET1,FreeSpace,OCCUPIED,extw,i,L,R,A)
local w,v,w1,v1,FreeSpace1,j,j1,OCCUPIED1:
w:=LET1[1]:
v:=LET1[2]:
 
if not (w[i]=L and w[i+1]=L) then
ERROR(` The locations `, i , ` and `, i+1, `should be `, L):
fi:
 
j:=FindRW(w,i,L,R,A):
j1:=FindRW(w,i+1,L,R,A):
 
w1:=[op(1..i-1,w),op(i+2..j1-1,w),L,op(j1+1..j-1,w),op(j..nops(w),w)]:
v1:=[op(1..i-1,v),op(i+2..nops(v),v)]:
 
FreeSpace1:=FreeSpace minus {seq(j,j=v[i]+1..v[i+1]-1)}:
OCCUPIED1:=OCCUPIED union {seq([j,j+1],j=v[i]..v[i+1]-1)}:
 
[w1,v1],FreeSpace1,OCCUPIED1,extw+v[i+1]-v[i]:
end:
 
#JoinRA(LET1,FreeSpace,OCCUPIED,extw,j,L,R,A): In the langauge of
#SAWs, given a letter LET1,
# (phrased in terms of L and R), 
# a set of integers, FreeSpace, and a location i
# such that LET1[1][j]=A, LET1[1][j+1]=A does the
# operation LpRA->Ap and its corresponding
# effect on LET1[2] (the list of places with the
# opening, and  also outputs the new FreeSpace
# obtained by removing all the points between these
# two adjacent Ls i.e. LET1[2][j]+1..LET1[2][j+1]-1
JoinRA:=proc(LET1,FreeSpace,OCCUPIED,extw,j,L,R,A)
local w,v,w1,v1,FreeSpace1,OCCUPIED1,i,i1:
w:=LET1[1]:
v:=LET1[2]:
 
if not (w[j]=R and w[j+1]=A) then
ERROR(` The locations `, j , ` and `, j+1, `should be `, R,A):
fi:
 
i:=FindLW(w,j,L,R,A):
 
w1:=[op(1..i-1,w),A,op(i+1..j-1,w),op(j+2..nops(w),w)]:
v1:=[op(1..j-1,v),op(j+2..nops(v),v)]:
 
 
 
FreeSpace1:=FreeSpace minus {seq(i1,i1=v[j]+1..v[j+1]-1)}:
OCCUPIED1:=OCCUPIED union {seq([i1,i1+1],i1=v[j]..v[j+1]-1)}:
 
[w1,v1],FreeSpace1,OCCUPIED1,extw+v[j+1]-v[j]:
end:
 
#JoinRLW(LET1,FreeSpace,OCCUPIED,extw,j,L,R):  In the SAW langauge,
#Given a letter LET1,
# (phrased in terms of L and R), 
# a set of integers, FreeSpace, and a location j
# such that LET1[1][j-1]=R, LET1[1][j]=L does the
# operation pRLq->pq and its corresponding
# effect on LET1[2] (the list of places with the
# opening, and  also outputs the new FreeSpace
# obtained by removing all the points between these
# the R and the L of the deleted RL
# i.e. LET1[2][j-1]+1..LET1[2][j]-1
JoinRLW:=proc(LET1,FreeSpace,OCCUPIED,extw,j,L,R)
local w,v,w1,v1,FreeSpace1,i,OCCUPIED1:
w:=LET1[1]:
v:=LET1[2]:
 
if not (w[j-1]=R and w[j]=L) then
ERROR(` The locations `, j-1 , ` and `, j, `should be `, R, L):
fi:
w1:=[op(1..j-2,w),op(j+1..nops(w),w)]:
v1:=[op(1..j-2,v),op(j+1..nops(v),v)]:
 
FreeSpace1:=FreeSpace minus {seq(i,i=v[j-1]+1..v[j]-1)}:
OCCUPIED1:=OCCUPIED union {seq([i,i+1],i=v[j-1]..v[j]-1)}:
[w1,v1],FreeSpace1,OCCUPIED1,extw+v[j]-v[j-1]:
end:
 
#JoinRRW(LET1,FreeSpace,OCCUPIED,extw,j,L,R,A): In the language of
#SAWs, Given a letter LET1,
# (phrased in terms of L and R), 
# a set of integers, FreeSpace, and a location j
# such that LET1[1][j]=LET1[1][j-1]=R does the
# operation LpLqRR->LpRq and its corresponding
# effect on LET1[2] (the list of places with the
# opening, and  also outputs the new FreeSpace
# obtained by removing all the points between these
# two adjacent Rs i.e. LET1[2][j-1]+1..LET1[2][j]-1
JoinRRW:=proc(LET1,FreeSpace,OCCUPIED,extw,j,L,R,A)
local w,v,w1,v1,FreeSpace1,OCCUPIED1,i,i1:
w:=LET1[1]:
v:=LET1[2]:
 
if not (w[j]=R and w[j-1]=R) then
ERROR(` The locations `, j , ` and `, j-1, `should be `, R):
fi:
 
i:=FindLW(w,j,L,R,A):
i1:=FindLW(w,j-1,L,R,A):
 
w1:=[op(1..i1-1,w),R,op(i1+1..j-2,w),op(j+1..nops(w),w)]:
v1:=[op(1..j-2,v),op(j+1..nops(v),v)]:
 
FreeSpace1:=FreeSpace minus {seq(i,i=v[j-1]+1..v[j]-1)}:
OCCUPIED1:=OCCUPIED union {seq([i,i+1],i=v[j-1]..v[j]-1)}:
[w1,v1],FreeSpace1,OCCUPIED1,extw+v[j]-v[j-1]:
end:
##K
##L
 
#LebensRaum(LET1,FS1,i): Given a Pre-Letter LET1 with its
#free-space set FS1, and an integer i, finds the set range
#where the i^th component can roam
#the output is the lowest and the highest that it can
#venture to
LebensRaum:=proc(LET1,FS1,i)
local v,mina,maxa,i1:
v:=LET1[2]:
 
for i1 from v[i] while member(i1,FS1 union {v[i]}) do
od:
maxa:=i1-1:
 
for i1 from v[i] by -1 while member(i1,FS1 union {v[i]}) do
od:
mina:=i1+1:
 
mina,maxa:
end:
 
 
 
#LebensRaums(LET1,FS1): Given a pre-letter LET1, and 
#a free space set FS1, finds the list of pairs
#indicating the LebensRaum of each component
LebensRaums:=proc(LET1,FS1)
local i,gu:
gu:=[]:
 
for i from 1 to nops(LET1[1]) do
 gu:=[op(gu),[LebensRaum(LET1,FS1,i)]]:
od:
gu:
end:
 
 
 
 
#LeftLetters(a,b,L,R): All the left
#letters for a self-avoiding polygon
#bounded in the strip [a,b], using the letters
#L and R followed by their length
LeftLetters:=proc(a,b,L,R)
local mu,lu,gu,k,i1,i2,ru,lu2,i,FS,OCU,jh:
gu:={}:
 
for k from 1 to (b-a+1)/2 do
mu:=[seq(op([L,R]),i1=1..k)]:
lu:=IncSeq(a,b,2*k):
 
for i2 from 1 to nops(lu) do
FS:={seq(jh,jh=a..b)}:
OCU:={}:
 
lu2:=lu[i2]:
ru:=0:
for i from 1 to k do
ru:=ru+lu2[2*i]-lu2[2*i-1]+2:
FS:=FS minus {seq(jh,jh=lu2[2*i-1]..lu2[2*i])}:
OCU:=OCU union {seq([jh,jh+1],jh=lu2[2*i-1]..lu2[2*i]-1)}:
od:
 
gu:=gu union {[[mu,lu2],FS,OCU,ru] }:
od:
 
od:
 
gu:
 
end:
 
 
#LeftLettersW(a,b,L,R,A): All the left
#letters for a self-avoiding walk
#bounded in the strip [a,b], using the letters
#L and R and A followed by their length
#L denotes the left of a pair , R denotes the right
#and A denotes a horizonal unit-segment all Alone,
#with no companion reachable from the left
LeftLettersW:=proc(a,b,L,R,A)
local mu,gu,i,j,LET,guA0,guA1,guA2,lu,ku,FS,OCU,i1:
 
FS:={seq(i,i=a..b)}:
OCU:={}:
gu:={}:
for i from a to b do
 FS:=FS minus {i}:
 gu:=gu union {[[[A],[i]],FS,OCU,1]}:
od:
 
for i from a to b do
 for j from i+1 to b do
 FS:=FS minus {i,j}:
 
  gu:=gu union {[[[A,A],[i,j]],FS,OCU,2]}:
od:
od:
 
mu:=LeftLetters(a,b,L,R):
 
gu:=gu union mu:
 
for i from 1 to nops(mu) do
LET:=op(i,mu):
gu:=gu union Insert1AL(LET,a,b,A) union Insert2AL(LET,a,b,A):
od:
 
guA0:={}:guA1:={}:guA2:={}:
for i from 1 to nops(gu) do
lu:=gu[i][1][1]:
lu:=subs({A=1,L=0,R=0},lu):
lu:=convert(lu,`+`):
 
if lu=0 then
guA0:=guA0 union {gu[i]}:
elif lu=1 then
guA1:=guA1 union {gu[i]}:
elif lu=2 then
guA2:=guA2 union {gu[i]}:
else
ERROR(gu[i], `has too many As`):
fi:
od:
 
for i from 1 to nops(guA1) do
gu:=gu union OneStepChopL(op(guA1[i]),L,R,A) union
OneStepChopR(op(guA1[i]),L,R,A):
od:
 
ku:={}:
 
for i from 1 to nops(guA0) do
ku:=ku union OneStepChopL(op(guA0[i]),L,R,A) union
OneStepChopR(op(guA0[i]),L,R,A):
od:
 
gu:=gu union ku:
 
 
for i from 1 to nops(ku) do
gu:=gu union OneStepChopL(op(ku[i]),L,R,A) union
OneStepChopR(op(ku[i]),L,R,A):
od:
for i from a to b do
for j from i+1 to b do
gu:=gu union {[R,{seq(i1,i1=a..i-1), seq(i1,i1=j+1..b)},
{seq([i1,i1+1],i1=i..j-1)}, j-i]}:
od:
od:
gu:
 
end:
 
 
#LeftLettersWf(n,L,R,A): All the left
#letters for a self-avoiding walk
#with vertical slice of height<=n
#L and R and A followed by their length
#L denotes the left of a pair , R denotes the right
#and A denotes a horizonal unit-segment all Alone,
#with no companion reachable from the left
LeftLettersWf:=proc(n,L,R,A)
local mu,gu,i:
mu:=LeftLettersW(0,n,L,R,A):
gu:={}:
 
for i from 1 to nops(mu) do
 
if min(op(Support(mu[i])))=0 then
 gu:=gu union {mu[i]}:
fi:
 
od:
gu:
 
end:
 
##M
 
#MarChaW(n): The Markov chain of self-avoiding walks
#that live in the strip [0,n] 
#It is asummed that the vertices (states) are labelled
#by positive integers. The Markov Chain is given as a
#list of lengh 3: [LeftLetters,RightLetters,TransitionMatrix]
#The TransitionMatrix is a list of lists, where the
#i^th entry is the set of pairs [j,wt(i,j)], where
#j is the a neighbor and wt(i,j) is the weight of
#the arc from i to j
MarChaW:=proc(n)
local Vertices,L,R,A,T,i,gu,S,mu1,mu1a,j,mu2:
Vertices:=AlphabetW(0,n,L,R,A):
 
for i from 1 to nops(Vertices) do
 T[Vertices[i]]:=FollowersW(Vertices[i],0,n,L,R,A):
od:
 
 
Vertices:=convert(Vertices,list):
 
for j from 1 to nops(Vertices) do
S[Vertices[j]]:=j:
od:
 
gu:=[]:
 
for i from 1 to nops(Vertices) do
 
mu1:=T[Vertices[i]]:
mu2:=[]:
 
for j from 1 to nops(mu1) do
 mu1a:=op(j,mu1):
 mu2:=[op(mu2),[S[mu1a[1]],mu1a[2]]]:
od:
 
gu:=[op(gu),mu2]:
od:
 
[{S[L]},{S[R]},gu]:
end:
 
 
#MarChaWf(n): The Markov chain of self-avoiding walks
#each of whose vertical cross-sections are of height<=n
#It is asummed that the vertices (states) are labelled
#by positive integers. The Markov Chain is given as a
#list of lengh 3: [LeftLetters,RightLetters,TransitionMatrix]
#The TransitionMatrix is a list of lists, where the
#i^th entry is the set of pairs [j,wt(i,j)], where
#j is the a neighbor and wt(i,j) is the weight of
#the arc from i to j
MarChaWf:=proc(n)
local Vertices,L,R,A,T,i,gu,S,mu1,mu1a,j,mu2:
Vertices:=AlphabetWf(n,L,R,A):
 
for i from 1 to nops(Vertices) do
 T[Vertices[i]]:=FollowersWf(Vertices[i],n,L,R,A):
od:
 
 
Vertices:=convert(Vertices,list):
 
for j from 1 to nops(Vertices) do
S[Vertices[j]]:=j:
od:
 
gu:=[]:
 
for i from 1 to nops(Vertices) do
 
mu1:=T[Vertices[i]]:
mu2:=[]:
 
for j from 1 to nops(mu1) do
 mu1a:=op(j,mu1):
 mu2:=[op(mu2),[S[mu1a[1]],mu1a[2]]]:
od:
 
gu:=[op(gu),mu2]:
od:
 
[{S[L]},{S[R]},gu]:
end:
 
MCtoGMC:=proc(MC)
local RL1,TM,akha,resh,TM1,i,lu:
RL1:=MC[2]:TM:=MC[3]:
if nops(RL1)<>1 then
ERROR(`The input Markov Chain should have only one terminal vertex`):
fi:
akha:=RL1[1]:
 
TM1:=[]:
resh:=[]:
 
for i from 1 to nops(TM) do
lu:=paleg(TM[i],akha):
TM1:=[op(TM1),lu[1]]: resh:=[op(resh),lu[2]]:
od:
[MC[1],TM1,resh]:
end:
 
##N
#normalizes the letter LET1 to be a free letter
narmel:=proc(LET1,L,R)
 local mu,kat,gu,i: 
 
if LET1=L or LET1=R then
 RETURN(LET1):
fi:
 
mu:=LET1[2]:
kat:=mu[1]:
gu:=[]:
 
for i from 1 to nops(mu) do
gu:=[op(gu),mu[i]-kat]:
od:
[LET1[1],gu]:
end:
 
##O
 
Okvim:=proc(SetLET1,a,b,L,R,A)
local gu,i:
 
gu:={}:
 
for i from 1 to nops(SetLET1) do
gu:=gu union Okvim1(SetLET1[i],a,b,L,R,A):
od:
 
gu:
end:
 
Okvimf:=proc(SetLET1,n,L,R,A)
local gu,i:
 
gu:={}:
 
for i from 1 to nops(SetLET1) do
gu:=gu union Okvim1f(SetLET1[i],n,L,R,A):
od:
 
gu:
end:
 
#Okvim1(LET1,a,b,L,R,A): all the letters that may follow LET1
Okvim1:=proc(LET1,a,b,L,R,A)
local mu,gu,i:
if LET1=R then
RETURN({}):
fi:
mu:=FollowersW(LET1,a,b,L,R,A):
gu:={}:
 
for i from 1 to nops(mu) do
gu:=gu union {mu[i][1]}:
od:
gu:
end:
 
#Okvim1f(LET1,n,L,R,A): all the letters that may follow LET1
Okvim1f:=proc(LET1,n,L,R,A)
local mu,gu,i:
if LET1=R then
RETURN({}):
fi:
mu:=FollowersWf(LET1,n,L,R,A):
gu:={}:
 
for i from 1 to nops(mu) do
gu:=gu union {mu[i][1]}:
od:
gu:
end:
 
#OneStepAbortL(LET1,FS1,OCU1,extw,L,R,A): In the langauge of SAWs
#Set of all quadruples [LET2,FS2,OCU1,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, and extra-weight, extw, by performing ONE Abort-L 
#(i.e. LpR ->pA )
#operation L an R denote ( and ) resp. A denotes a loose end
#
OneStepAbortL:=proc(LET1,FS1,OCU1,extw,L,R,A)
local i,j,w,v,gu,w1,v1,ka,m,j1,mu:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for i from 1 to nops(w)-1 do
if  w[i]=L then
 j:=FindRW(w,i,L,R,A):
 w1:=[op(1..i-1,w),op(i+1..j-1,w),A,op(j+1..nops(w),w)]:
 v1:=[op(1..i-1,v),op(i+1..nops(v),v)]:
 ka:=[LebensRaum(LET1,FS1,i)]:
 
 for m from ka[1] to v[i] do
 gu:=gu union {[[w1,v1],FS1 minus {seq(j1,j1=m..v[i])},
OCU1 union {seq([j1,j1+1],j1=m..v[i]-1)},extw+v[i]-m]}:
 od:
 
 
 for m from v[i]+1 to ka[2] do
 gu:=gu union {[[w1,v1],FS1 minus {seq(j1,j1=v[i]..m)},
OCU1 union {seq([j1,j1+1],j1=v[i]..m-1)},
extw+m-v[i]]}:
 od:
 
fi:
od:
 
 
mu:=gu:
gu:={}:
for i from 1 to nops(mu) do
if GoodA(mu[i][1],L,R,A) then
gu:=gu union {mu[i]}:
fi:
od:
gu:
 
end:
 
#OneStepAbortR(LET1,FS1,OCU1,extw,L,R,A): In the langauge of SAWs
#Set of all triples [LET2,FS2,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, and extra-weight, extw, by performing ONE Abort-R
#(i.e. LpR ->Ap )
#operation L an R denote ( and ) resp. A denotes a loose end
#
OneStepAbortR:=proc(LET1,FS1,OCU1,extw,L,R,A)
local i,j,w,v,gu,w1,v1,ka,j1,m,mu:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for j from 2 to nops(w) do
if  w[j]=R then
 i:=FindLW(w,j,L,R,A):
 w1:=[op(1..i-1,w),A,op(i+1..j-1,w),op(j+1..nops(w),w)]:
 v1:=[op(1..j-1,v),op(j+1..nops(v),v)]:
 
 
 ka:=[LebensRaum(LET1,FS1,j)]:
 
 for m from ka[1] to v[j] do
 gu:=gu union {[[w1,v1],FS1 minus {seq(j1,j1=m..v[j])},
OCU1 union {seq([j1,j1+1],j1=m..v[j]-1)},
extw+v[j]-m]}:
 od:
 
 
 for m from v[j]+1 to ka[2] do
 gu:=gu union {[[w1,v1],FS1 minus {seq(j1,j1=v[j]..m)},
OCU1 union {seq([j1,j1+1],j1=v[j]..m-1)},extw+m-v[j]]}:
 od:
 
fi:
od:
gu:
 
mu:=gu:
gu:={}:
for i from 1 to nops(mu) do
if GoodA(mu[i][1],L,R,A) then
gu:=gu union {mu[i]}:
fi:
od:
gu:
end:
 
 
#OneStepAL(LET1,FS1,OCU1,extw,L,R,A): In the langauge of SAWs
#Set of all triples [LET2,FS2,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, and extra-weight, extw, by performing ONE `LL-operation'
#L an R denote ( and ) resp. A denotes a loose end
#
OneStepAL:=proc(LET1,FS1,OCU1,extw,L,R,A)
local i,i1,w,v,gu:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for i from 2 to nops(w) do
if  w[i]=L and w[i-1]=A and 
  {seq(i1,i1=v[i-1]+1..v[i]-1)} minus FS1={} then
 gu:=gu union {[JoinAL(LET1,FS1,OCU1,extw,i,L,R,A)]}:
fi:
od:
gu:
end:
 
#OneStepAllW(LET1,FS1,OCU1,extw,L,R,A): In the language of SAWs,
#Set of all pairs [LET2,FS2,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, by performing ONE `RL, or RR- or LL-operation'
#or AL or LA or AR or RA operation, where
#L an R denote ( and ) resp., and A denotes a loose end
#
OneStepAllW:=proc(LET1,FS1,OCU1,extw,L,R,A) local gu,i,mu:
mu:=OneStepLLW(LET1,FS1,OCU1,extw,L,R,A) union
OneStepRRW(LET1,FS1,OCU1,extw,L,R,A) union
OneStepRLW(LET1,FS1,OCU1,extw,L,R) union
OneStepAL(LET1,FS1,OCU1,extw,L,R,A) union
OneStepLA(LET1,FS1,OCU1,extw,L,R,A) union
OneStepAR(LET1,FS1,OCU1,extw,L,R,A) union
OneStepRA(LET1,FS1,OCU1,extw,L,R,A):
gu:={}:
for i from 1 to nops(mu) do
if GoodA(mu[i][1],L,R,A) then
gu:=gu union {mu[i]}:
fi:
od:
gu:
end:
 
#OneStepAR(LET1,FS1,OCU1,extw,L,R,A): In the langauge of SAWs
#Set of all triples [LET2,FS2,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, and extra-weight, extw, by performing ONE RA-operation
#L an R denote ( and ) resp. A denotes a loose end
#
OneStepAR:=proc(LET1,FS1,OCU1,extw,L,R,A)
local j,i1,w,v,gu:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for j from 2 to nops(w) do
if  w[j-1]=A and w[j]=R and 
  {seq(i1,i1=v[j-1]+1..v[j]-1)} minus FS1={} then
 gu:=gu union {[JoinAR(LET1,FS1,OCU1,extw,j,L,R,A)]}:
fi:
od:
gu:
end:
 
 
#OneStepChopL(LET1,FS,OCU,extw,L,R,A): In the langauge of SAWs
#Set of all quadruples [LET2,FS2,OCU,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, and extra-weight, extw, by performing ONE Chop-L 
#in a left letter
#(i.e. LpR ->pA )
#operation L an R denote ( and ) resp. A denotes a loose end
#
OneStepChopL:=proc(LET1,FS,OCU,extw,L,R,A)
local i,j,w,v,gu,w1,v1:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for i from 1 to nops(w)-1 do
if  w[i]=L then
 j:=FindRW(w,i,L,R,A):
 w1:=[op(1..i-1,w),op(i+1..j-1,w),A,op(j+1..nops(w),w)]:
 v1:=[op(1..i-1,v),op(i+1..nops(v),v)]:
 gu:=gu union {[[w1,v1],FS,OCU,extw-1] }:
fi:
od:
gu:
end:
 
 
#OneStepChopR(LET1,FS,OCU,extw,L,R,A): In the langauge of SAWs
#Set of all quadruples [LET2,FS2,OCU,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, and extra-weight, extw, by performing ONE Chop-R
#(i.e. LpR ->Ap )
#operation L an R denote ( and ) resp. A denotes a loose end
#
OneStepChopR:=proc(LET1,FS,OCU,extw,L,R,A)
local i,j,w,v,gu,w1,v1:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for j from 2 to nops(w) do
if  w[j]=R then
 i:=FindLW(w,j,L,R,A):
 w1:=[op(1..i-1,w),A,op(i+1..j-1,w),op(j+1..nops(w),w)]:
 v1:=[op(1..j-1,v),op(j+1..nops(v),v)]:
 gu:=gu union {[[w1,v1],FS,OCU,extw-1]}:
fi:
od:
gu:
end:
 
 
#OneStepLA(LET1,FS1,OCU1,extw,L,R,A): In the langauge of SAWs
#Set of all triples [LET2,FS2,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, and extra-weight, extw, by performing ONE LA-operation
#L an R denote ( and ) resp. A denotes a loose end
#
OneStepLA:=proc(LET1,FS1,OCU1,extw,L,R,A)
local i,i1,w,v,gu:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for i from 1 to nops(w)-1 do
if  w[i]=L and w[i+1]=A and 
  {seq(i1,i1=v[i]+1..v[i+1]-1)} minus FS1={} then
 gu:=gu union {[JoinLA(LET1,FS1,OCU1,extw,i,L,R,A)]}:
fi:
od:
gu:
end:
 
#OneStepLLW(LET1,FS1,OCU1,extw,L,R,A): In the langauge of SAWs
#Set of all quadruples [LET2,FS2,OCU1,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, and and extra-weight, extw, by performing ONE `LL-operation'
#L an R denote ( and ) resp. A denotes a loose end
#
OneStepLLW:=proc(LET1,FS1,OCU1,extw,L,R,A)
local i,i1,w,v,gu:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for i from 1 to nops(w)-1 do
if  w[i]=L and w[i+1]=L and 
  {seq(i1,i1=v[i]+1..v[i+1]-1)} minus FS1={} then
 gu:=gu union {[JoinLLW(LET1,FS1,OCU1,extw,i,L,R,A)]}:
fi:
od:
gu:
end:
 
 
#OneStepRA(LET1,FS1,OCU1,extw,L,R,A): In the langauge of SAWs
#Set of all triples [LET2,FS2,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, and extra-weight, extw, by performing ONE RA-operation
#L an R denote ( and ) resp. A denotes a loose end
#
OneStepRA:=proc(LET1,FS1,OCU1,extw,L,R,A)
local j,i1,w,v,gu:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for j from 1 to nops(w)-1 do
if  w[j]=R and w[j+1]=A and 
  {seq(i1,i1=v[j]+1..v[j+1]-1)} minus FS1={} then
 gu:=gu union {[JoinRA(LET1,FS1,OCU1,extw,j,L,R,A)]}:
fi:
od:
gu:
end:
 
#OneStepRLW(LET1,FS1,OCU1,extw,L,R): 
#In the langaue if SAWs:
#Set of all pairs [LET2,FS2,extw]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, by performing ONE `RL-operation'
#L an R denote ( and ) resp.
#
OneStepRLW:=proc(LET1,FS1,OCU1,extw,L,R)
local j,i1,w,v,gu:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for j from 2 to nops(w) do
if  w[j-1]=R and w[j]=L and 
  {seq(i1,i1=v[j-1]+1..v[j]-1)} minus FS1={} then
 gu:=gu union {[JoinRLW(LET1,FS1,OCU1,extw,j,L,R)]}:
fi:
od:
gu:
end:
 
 
#OneStepRRW(LET1,FS1,OCU1,extw,L,R,A): In the SAW language
#Set of all triples [LET2,FS2,exwt]
# that can be obtained
#from the letter LET1, with its accompanying free-space set
#FS1, by performing ONE `RR-operation'
#L an R denote ( and ) resp.
#
OneStepRRW:=proc(LET1,FS1,OCU1,extw,L,R,A)
local j,i1,w,v,gu:
w:=LET1[1]:
v:=LET1[2]:
gu:={}:
 
for j from 2 to nops(w) do
if  w[j]=R and w[j-1]=R and 
  {seq(i1,i1=v[j-1]+1..v[j]-1)} minus FS1={} then
 gu:=gu union {[JoinRRW(LET1,FS1,OCU1,extw,j,L,R,A)]}:
fi:
od:
gu:
end:
 
##P
 
#paleg(li,i) given a list of pairs kicks out the one that starts with [i,
paleg:=proc(li,i)
local li1,i1:
for i1 from 1 to nops(li) do
if li[i1][1]=i then
li1:=[op(1..i1-1,li),op(i1+1..nops(li),li)]:
RETURN(li1,li[i1][2]):
fi:
od:
li,0:
end:
 
#PlacesForLeftA(LET,a,b): Given a SAP left letter
#finds the LIST of the places where an A can be inserted
#the output is a set of pairs [i,place] where
#which means that the A may be inserted 
#BEFORE the i^th place of LET[1] and it is placed
#in place place, i,e. LET2 should be modified by inserting
#place between the (i-1)^th and i^th place
PlacesForLeftA:=proc(LET,a,b)
local gu,i,j,k,LET2:
LET2:=LET[2]:
k:=nops(LET2)/2:
gu:=[seq([1,i],i=a..LET2[1]-1)]:
 
for j from 1 to k-1 do
gu:=[op(gu),seq([2*j+1,i],i=LET2[2*j]+1..LET2[2*j+1]-1)]:
od:
 
gu:=[op(gu),seq([2*k+1,i],i=LET2[2*k]+1..b)]:
 
gu:
end:
 
#PlacesToInsert(UnInts): Given a set of free-space, UnInts
#in terms of a list of intervals, finds all the
#intervals [a,b] of length at least 2 that may be
#inserted
PlacesToInsert:=proc(UnInts)
local k,ak,bk:
k:=nops(UnInts):
 
if k=0 then
 RETURN({}):
fi:
 
ak:=UnInts[k][1]:
bk:=UnInts[k][2]:
 
PlacesToInsert([op(1..k-1,UnInts)]) union PlacesToInsert1(ak,bk):
 
end:
 
#PlacesToInsert1(a,b): Given two integers
#finds all the intervals [i,j] such that a<=i<j<=b
PlacesToInsert1:=proc(a,b)
local gu,i,j:
gu:={}:
for i from a to b-1 do
for j from i+1 to b do
gu:=gu union {[i,j]}:
od:
od:
gu:
end:
 
 
#PlacesToInsert1A(a,b): Given two integers
#finds all the intervals [i,j] such that a<=i<j<=b
PlacesToInsert1A:=proc(a,b)
local gu,i,j:
gu:={}:
for i from a to b do
for j from i to b do
gu:=gu union {[i,j]}:
od:
od:
gu:
end:
 
#PlacesToInsertA(UnInts): Given a set of free-space, UnInts
#in terms of a list of intervals, finds all the
#intervals [a,b] of length at least 2 that may be
#inserted
PlacesToInsertA:=proc(UnInts)
local k,ak,bk:
k:=nops(UnInts):
 
if k=0 then
 RETURN({}):
fi:
 
ak:=UnInts[k][1]:
bk:=UnInts[k][2]:
 
PlacesToInsertA([op(1..k-1,UnInts)]) union PlacesToInsert1A(ak,bk):
 
 
end:
 
 
#PreFollowersW(LET1,a,b,L,R,A): In the SAW language,
#All the pre-letters that
#can follow the letter LET1 in the ambient strip, [a,b]
#where L and R denote ( and ) resp. and A denotes a loose end
PreFollowersW:=proc(LET1,a,b,L,R,A)
local gu,mu,BOUNDS,lu,i,j:
 
mu:=PrePreFollowersW(LET1,a,b,L,R,A):
 
gu:={}:
 
for i from 1 to nops(mu) do
BOUNDS:=LebensRaums(mu[i][1],mu[i][2],mu[i][4]):
lu:=IncSeqSand(BOUNDS,mu[i][1][2]):
for j from 1 to nops(lu) do
 gu:=gu union 
{[ [mu[i][1][1],lu[j][1]],mu[i][2] minus lu[j][2],
mu[i][3] union lu[j][3],
   mu[i][4]+lu[j][4]+nops(mu[i][1][1])]}:
od:
 
od:
 
gu:
 
end:
 
#PreFollowersWR(LET1,a,b,L,R,A): In the SAW language,
#All the pre-letters that
#can follow the letter LET1 in the ambient strip, [a,b]
#where L and R denote ( and ) resp. and A denotes a loose end
#no abortions
PreFollowersWR:=proc(LET1,a,b,L,R,A)
local gu,mu,BOUNDS,lu,i,j:
mu:=PrePreFollowersWR(LET1,a,b,L,R,A):
 
gu:={}:
 
for i from 1 to nops(mu) do
BOUNDS:=LebensRaums(op(mu[i])):
lu:=IncSeqSand(BOUNDS,mu[i][1][2]):
 
for j from 1 to nops(lu) do
 gu:=gu union {[[mu[i][1][1],lu[j][1]],mu[i][2] minus lu[j][2],
mu[i][3] union lu[j][3],
   mu[i][4]+lu[j][4]+nops(mu[i][1][1])]}:
od:
 
od:
 
gu:
 
end:
 
#PrePreFollowersW(LET1,a,b,L,R,A): All the pre-pre-letters that
#can follow the SAW letter LET1 in the ambient strip, [a,b]
#where L and R denote ( and ) resp. and A denotes a loose-end
#A pre-pre-letter is a 4-tuple (list of size 4) [LET,FS,OCU,wt] 
# where LET is a letter, FS is the set of free nodes, OCU 
#is the set of edges [a,a+1] occupied, and wt is the new wt gained
# A pre-pre-letter follows a letter if it can be obtained by one
#or more application of JoinLL, JoinRR, JoinLA etc. as well as
#AbandonL etc.
 
PrePreFollowersW:=proc(LET1,a,b,L,R,A)
local gu,mu,mu1,i,lu,guA0,guA1,guA2,ku:
 
gu:={[LET1,{seq(i,i=a..b)} minus convert(LET1[2],set),{},0]}:
mu:={[LET1,{seq(i,i=a..b)} minus convert(LET1[2],set),{}, 0]}:
 
while mu<>{} do
mu1:={}:
for i from 1 to nops(mu) do
mu1:=mu1 union OneStepAllW(op(mu[i]),L,R,A):
od:
 
gu:=gu union mu1:
mu:=mu1:
od:
 
 
guA0:={}:guA1:={}:guA2:={}:
 
for i from 1 to nops(gu) do
lu:=gu[i][1][1][1]:
lu:=subs({A=1,L=0,R=0},lu):
lu:=convert(lu,`+`):
 
if lu=0 then
guA0:=guA0 union {gu[i]}:
elif lu=1 then
guA1:=guA1 union {gu[i]}:
elif lu=2 then
guA2:=guA2 union {gu[i]}:
else
ERROR(gu[i], `has too many As`):
fi:
 
od:
 
for i from 1 to nops(guA1) do
gu:=gu union OneStepAbortL(op(guA1[i]),L,R,A) union
OneStepAbortR(op(guA1[i]),L,R,A):
od:
 
ku:={}:
 
for i from 1 to nops(guA0) do
ku:=ku union OneStepAbortL(op(guA0[i]),L,R,A) union
OneStepAbortR(op(guA0[i]),L,R,A):
od:
 
gu:=gu union ku:
 
 
for i from 1 to nops(ku) do
gu:=gu union OneStepAbortL(op(ku[i]),L,R,A)
union OneStepAbortR(op(ku[i]),L,R,A):
od:
 
gu:
 
end:
 
#PrePreFollowersWR(LET1,a,b,L,R,A): All the pre-pre-letters that
#can follow the SAW letter LET1 in the ambient strip, [a,b]
#where L and R denote ( and ) resp. and A denotes a loose-end
#excpet abortions 
PrePreFollowersWR:=proc(LET1,a,b,L,R,A)
local gu,mu,mu1,i:
 
 
gu:={[LET1,{seq(i,i=a..b)} minus convert(LET1[2],set),{},0]}:
mu:={[LET1,{seq(i,i=a..b)} minus convert(LET1[2],set),{},0]}:
 
while mu<>{} do
mu1:={}:
 
for i from 1 to nops(mu) do
mu1:=mu1 union OneStepAllW(op(mu[i]),L,R,A):
od:
 
gu:=gu union mu1:
mu:=mu1:
od:
 
gu:
 
end:
 
##Q
##R
##S
 
#SAW(l): The number of self-avoiding walks of
#lentgh l
SAW:=proc(l)
local h,w,gu:
option remember:
gu:=0:
 
if l=0 then
 RETURN(1):
fi:
 
for w from 0 to l/2 do
for h from w+1 to l-w do
gu:=gu+4*SAWlhw(l,h,w):
od:
od:
 
 
for w from 0 to l/2 do
gu:=gu+2*SAWlhw(l,w,w):
od:
 
gu:
 
end:
 
#SAWlhw(l,h,w): the number of self-avoiding walks
#with length l, height h, and width w
SAWlhw:=proc(l,h,w)
local gu,M,s:
option remember:
M:=l+h:
gu:=GfSeriesWs(w,M,s):
coeff(gu[l+1],s,h):
end:
 
#SAWseries(L): The sequence whose i^th term is
#the number of self-avoiding polygons of length 2i
#for i=1...L
SAWseries:=proc(L)
local gu,i:
gu:=[]:
for i from 0 to L do
gu:=[op(gu),SAW(i)]:
print(gu):
od:
gu:
end:
 
#SeriesMC1(MC,M,t): Given a General Markov Chain, where the 
#tranition-weights, are given in terms of a polynomial in 
#the variable t,  finds the sequencwhose i^th member is 
#the number of paths of weight i for 0<=i<=M
SeriesMC1:=proc(MC,M,t)
local a,i,SID,gu,gadol,LL1,TM,resh,mispar,j,lu,i1,m,mu,sakhen,kha,lu1,j1:
LL1:=MC[1]:
TM:=MC[2]:
resh:=MC[3]:
mispar:=nops(TM):
 
gu:={}:
for i from 1 to mispar do
lu:=TM[i]:
 
for j from 1 to nops(lu) do
gu:=gu union {degree(lu[j][2],t)}:
od:
 
od:
 
gadol:=max(op(gu)):
 
for i from 1 to mispar do
a[i]:=[seq(0,i1=1..gadol)]:
od:
 
 
SID:=[]:
for m from 0 to M do
 
for i from 1 to mispar do
mu:=TM[i]:
lu:=coeff(resh[i],t,m):
 
for j from 1 to nops(mu) do
sakhen:=a[mu[j][1]]:
lu1:=mu[j][2]:
for j1 from 1 to degree(lu1,t) do
lu:=lu+coeff(lu1,t,j1)*sakhen[nops(sakhen)-j1+1]:
od:
od:
 
kha[i]:=lu:
od:
 
gu:=0:
 
for i from 1 to nops(LL1) do
gu:=gu+kha[LL1[i]]:
od:
 
SID:=[op(SID),gu]:
 
for i from 1 to mispar do
a[i]:=[op(2..nops(a[i]),a[i]),kha[i]]:
od:
 
od:
SID:
end:
 
 
#SeriesMC1s(MC,M,t,s): Given a General Markov Chain, where the 
#tranition-weights, are given in terms of a polynomial in 
#the variable t,  finds the sequencwhose i^th member is 
#the weight-enumerator of paths of t^i for 0<=i<=M
#according to the weight (s^(letters))
SeriesMC1s:=proc(MC,M,t,s)
local a,i,SID,gu,gadol,LL1,TM,resh,mispar,j,lu,i1,m,mu,sakhen,kha,lu1,j1:
LL1:=MC[1]:
TM:=MC[2]:
resh:=MC[3]:
mispar:=nops(TM):
 
gu:={}:
for i from 1 to mispar do
lu:=TM[i]:
 
for j from 1 to nops(lu) do
gu:=gu union {degree(lu[j][2],t)}:
od:
 
od:
 
gadol:=max(op(gu)):
 
for i from 1 to mispar do
a[i]:=[seq(0,i1=1..gadol)]:
od:
 
 
SID:=[]:
for m from 0 to M do
 
for i from 1 to mispar do
mu:=TM[i]:
lu:=coeff(resh[i],t,m):
 
for j from 1 to nops(mu) do
sakhen:=a[mu[j][1]]:
lu1:=mu[j][2]:
for j1 from 1 to degree(lu1,t) do
lu:=expand(lu+s*coeff(lu1,t,j1)*sakhen[nops(sakhen)-j1+1]):
od:
od:
 
kha[i]:=lu:
od:
 
gu:=0:
 
for i from 1 to nops(LL1) do
gu:=gu+kha[LL1[i]]:
od:
 
SID:=[op(SID),gu]:
 
for i from 1 to mispar do
a[i]:=[op(2..nops(a[i]),a[i]),kha[i]]:
od:
 
od:
SID:
end:
 
#SetToUnInt(kv): Given a set of integers, kv, converts
#it list-of-intervals notation [[a1,b1],[a2,b2],[a3,b3],...]
#s.t. kv={a1..b1} union {a2..b2} ....
SetToUnInt:=proc(kv)
local a1,b1,i,gu:
if kv={} then
RETURN([]):
fi:
 
a1:=min(op(kv)):
 
for i from a1 while member(i,kv) do
od:
b1:=i-1:
gu:=SetToUnInt(kv minus {seq(i,i=a1..b1)}):
[[a1,b1],op(gu)]:
end:
 
 
#SolveMarCha(MC,t): Given a Markov Chain [LeftLetters,RightLetters,
#TransMatrx], finds the sum of the weights of all words that
#start with a letter of LeftLetters and ends with a letter
#of RightLetters, as a generating function in the variable t
#
SolveMarCha:=proc(MC,t)
local eq,var,a,gu,LL1,RL1,TM,eq1,lu,i,j:
 
LL1:=MC[1]:
RL1:=MC[2]:
TM:=MC[3]:
eq:={}:
var:={}:
 
for i from 1 to nops(TM) do
var:=var union {a[i]}:
 
if member(i,RL1) then
eq1:=a[i]-1:
else
eq1:=a[i]:
fi:
 
lu:=TM[i]:
 
for j from 1 to nops(lu) do
 eq1:=eq1-a[lu[j][1]]*t^lu[j][2]:
od:
 
eq:=eq union {eq1}:
od:
 
var:=solve(eq,var):
 
if var=NULL then
RETURN(0):
fi:
 
gu:=0:
 
for i from 1 to nops(LL1) do
gu:=normal(gu+subs(var,a[LL1[i]])):
od:
 
gu:
 
end:
 
 
#Stick1(LET1,L,R,a,b): given a pre-letter, and an interval
#[a,b] finds the resulting pre-letter obtained by inserting
#[L,R] in the appropirate place in LET1[1][1] and
#[a,b] in the appropirate place in LET1[1][2]
#and replacing LET1[2] by LET1[2] minus {a..b}
#and replacing LET1[3] by LET1[2] union {[a,a+1],...[b-1,b]}
#and replacing LET1[4] by LET1[4]+b-a+2
Stick1:=proc(LET1,L,R,a,b)
local w,v,FS,i,ku,extw,OCU,ku1:
 
 
w:=LET1[1][1]:
v:=LET1[1][2]:
FS:=LET1[2]:
OCU:=LET1[3]:
extw:=LET1[4]:
ku:={seq(i,i=a..b)}:
ku1:={seq([i,i+1],i=a..b-1)}:
 
if ku minus FS<>{} then
ERROR(`something is wrong`):
fi:
 
 
 
if a>v[nops(v)] then
w:=[op(w),L,R]:
v:=[op(v),a,b]:
RETURN([[w,v],FS minus ku,OCU union ku1, extw+b-a+2]):
fi:
 
 
if b<v[1] then
w:=[L,R,op(w)]:
v:=[a,b,op(v)]:
RETURN([[w,v],FS minus ku,OCU union ku1,extw+b-a+2]):
fi:
 
 
 
for i from 1 while v[i]<a do
od:
i:=i-1:
 
w:=[op(1..i,w),L,R,op(i+1..nops(w),w)]:
v:=[op(1..i,v),a,b,op(i+1..nops(v),v)]:
[[w,v],FS minus ku,OCU union ku1,extw+b-a+2]:
end:
 
 
#Stick1AL(LET1,A,a,b): In the SAW language,
#given a pre-letter, and an interval
#[a,b] finds the resulting pre-letter obtained by inserting
#A in the appropirate place in LET1[1][1] and
#a in the appropirate place in LET1[1][2]
#and replacing LET1[2] by LET1[2] minus {a..b}
#and replacing LET1[3] by LET1[3] union {[a,a+1], ..., [b-1,b]}
#and replacing LET1[4] by LET1[4]+b-a+1
Stick1AL:=proc(LET1,A,a,b)
local w,v,FS,i,ku,OCU,ku1,extw:
 
 
w:=LET1[1][1]:
v:=LET1[1][2]:
FS:=LET1[2]:
OCU:=LET1[3]:
extw:=LET1[4]:
ku:={seq(i,i=a..b)}:
ku1:={seq([i,i+1],i=a..b-1)}:
 
if ku minus FS<>{} then
ERROR(`something is wrong`):
fi:
 
 
 
if a>v[nops(v)] then
w:=[op(w),A]:
v:=[op(v),a]:
RETURN([[w,v],FS minus ku,OCU union ku1,extw+b-a+1]):
fi:
 
 
if b<v[1] then
w:=[A,op(w)]:
v:=[a,op(v)]:
RETURN([[w,v],FS minus ku,OCU union ku1,extw+b-a+1]):
fi:
 
 
 
for i from 1 while v[i]<a do
od:
i:=i-1:
 
w:=[op(1..i,w),A,op(i+1..nops(w),w)]:
v:=[op(1..i,v),a,op(i+1..nops(v),v)]:
[[w,v],FS minus ku,OCU union ku1,extw+b-a+1]:
end:
 
#Stick1AR(LET1,A,a,b): In the SAW language,
#given a pre-letter, and an interval
#[a,b] finds the resulting pre-letter obtained by inserting
#A in the appropirate place in LET1[1][1] and
#b in the appropirate place in LET1[1][2]
#and replacing LET1[2] by LET1[2] minus {a..b}
##and replacing LET1[3] by LET1[3] union {[a,a+1],... [b-1,b]}
#and replacing LET1[4] by LET1[4]+b-a+1
Stick1AR:=proc(LET1,A,a,b)
local w,v,FS,i,ku,ku1,extw,OCU:
 
 
w:=LET1[1][1]:
v:=LET1[1][2]:
FS:=LET1[2]:
OCU:=LET1[3]:
extw:=LET1[4]:
ku:={seq(i,i=a..b)}:
ku1:={seq([i,i+1],i=a..b-1)}:
 
if ku minus FS<>{} then
ERROR(`something is wrong`):
fi:
 
 
 
if a>v[nops(v)] then
w:=[op(w),A]:
v:=[op(v),b]:
RETURN([[w,v],FS minus ku,OCU union ku1,extw+b-a+1]):
fi:
 
 
if b<v[1] then
w:=[A,op(w)]:
v:=[b,op(v)]:
RETURN([[w,v],FS minus ku,OCU union ku1,extw+b-a+1]):
fi:
 
 
 
for i from 1 while v[i]<a do
od:
i:=i-1:
 
w:=[op(1..i,w),A,op(i+1..nops(w),w)]:
v:=[op(1..i,v),b,op(i+1..nops(v),v)]:
[[w,v],FS minus ku,OCU union ku1,extw+b-a+1]:
end:
 
#Support(PRELET): The set of points on a the left vertical line
#that belong to the PRELETTER [LET,FS,OCU,wt]
Support:=proc(PRELET)
local i,OCU,LET:
LET:=PRELET[1]:
OCU:=PRELET[3]:
if type(LET,list) then
convert(LET[2],set) union {seq(op(OCU[i]),i=1..nops(OCU))}:
else
{seq(op(OCU[i]),i=1..nops(OCU))}:
fi:
 
end:
 
 
#Support1(PSEULET): The set of points on a the left vertical line
#that belong to the pseudo-letter [LET,OCU,wt]
Support1:=proc(PRELET)
local i,OCU,LET:
LET:=PRELET[1]:
OCU:=PRELET[2]:
if type(LET,list) then
convert(LET[2],set) union {seq(op(OCU[i]),i=1..nops(OCU))}:
else
{seq(op(OCU[i]),i=1..nops(OCU))}:
fi:
end:
 
##T
##U
##V
##W
 
#Wordsnw1(a,b,L,R,A,n,MATKHIL): the list (with repetitions) of
#SAW words of weight n that start with MATKHIL
Wordsnw1:=proc(a,b,L,R,A,n,MATKHIL)
local gu,mu,i,j,lu:
if n<0 then
RETURN([]):
fi:
 
mu:=FollowersW(MATKHIL,a,b,L,R,A):
 
if n=0 then
if member([R,0],mu) then
RETURN([[MATKHIL],[MATKHIL,0,R]]):
else
RETURN([[MATKHIL]]):
fi:
fi:
gu:=[]:
 
 
for i from 1 to nops(mu) do
lu:=Wordsnw1(a,b,L,R,A,n-mu[i][2],mu[i][1]):
 
 for j from 1 to nops(lu) do
   gu:=[op(gu),[MATKHIL,mu[i][2],op(lu[j])]]:
 od:
od:
 
gu:
 
end:
 
 
#Wordsnw2(n,w,L,R,A): the list (with repetitions) of
#SAW words of weight n and in [0,w]
Wordsnw2:=proc(n,w,L,R,A)
local mu,gu,i,a,b:
a:=0:b:=w:
mu:=Wordsnw1(a,b,L,R,A,n,L):
 
gu:=[]:
 
for i from 1 to nops(mu) do
if mu[i][nops(mu[i])]=R then
 gu:=[op(gu),mu[i]]:
fi:
od:
gu:
 
end:
 
##X
##Y
##Z