######################################################################
##FreeSAP: Save this file as SAPf. To use it, stay in the            #
##same directory, get into Maple (by typing: maple <Enter> )         #
##and then type:  read FreeSAP : <Enter>                                 #
##Then follow the instructions given there                           #
##                                                                   #
##Written by Doron Zeilberger, Temple University ,                   #
#zeilberg@math.temple.edu.                                           # 
#######################################################################
 
#Created: June 15, 1999
#This version:June 17, 1999
 
#FreeSAP: A Maple package for enumerating SAPs each of whose
#vertical slices is of bounded height
#
#It 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: June 15, 1999.`):
print(`This version: June 17, 1999`):
print(` FreeSAP: A Maple package to study SAPs `):
print(` each of whose vertical slices is of bounded height`):
print(` It 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`):
print(`Created: June 15, 1999.`):
print(`This version: June 17, 1999`):
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(``):
 
 print(``):
ezra:=proc()
if args=NULL then
print(` FreeSAP, a Maple package to compute generating functions and`):
print(` series expansions for self-avoding polygons each of whose`):
print(`vertical slices are of bounded height`):
print(``):
print(`The MAIN PROCEDURES are: gff, gfSeriesf`):
print(``):
print(`To get help with them do: ezra(gff); or ezra(gfSeriesf); etc.`):
print(`To see a list of the other procedures`):
print(` and  for the procedures for saps bounded in a fixed strip`):
print(` (that are contained in SAP, but are also included here )`):
print(` do ezra1(); and then ezra1(procedure_name); `): 
fi:
 
if nops([args])=1 and op(1,[args])=gfSeriesf then 
print(`gfSeriesf(n,M): The sequence whose i^th term is the`):
print(`number of self-avoiding polygons of length 2i immersed`):
print(`in the strip 0<=y<=n, for 1<=i<=M  `):
fi:
 
if nops([args])=1 and op(1,[args])=gff then 
print(`gff(n,t): The generating function of self-avoiding polygons`):
print(`each of whose vertical slices has height<=n`):
fi:
 
end:
 
 
ezra1:=proc()
if args=NULL then
 print(`Contains the following procedures: Alphabet, DerivedPreLetters,`):
 print(` FillIns1, FindL, FindR , Followers, gf, Gf, GF,gfSeries, GfSeries  `):
 print(` GFSeries, GfSeriesHeight, GFSeriesHeight, IncSeq, `):
 print(` IncSeqSand, IsLeftLetter`):
 print(` IsRightLetter, JoinLL, JoinRL, JoinRR, LebensRaum, LebensRaums`):
 print(` LeftLetters, MarCha, OneStepAll, `):
 print(` OneStepLL, OneStepRL `):
 print(` OneStepRR, Parenths, PlacesToInsert, PreFollowers, PrePreFollowers `):
 print(` RightLetters, SAP,SAPlhw, SAPseries, SeriesMC, SeriesMCLength `):
 print(` SetToUnInt , SolveMC4, SolveMC4series, Stick1 `):
fi:
 
if nops([args])=1 and op(1,[args])=SolveMC4series then 
print(`SolveMC4series(MC,t,M): The  list of length M whose i^th term`):
print(`is the coefficient of t^i in SolveMC4(MC,t)`):
fi:
 
if nops([args])=1 and op(1,[args])=SolveMC4 then 
print(`SolveMC4(MC,t): Given a Markov Chain [LeftLetters,RightLetters,`):
print(` TransMatrix], `):
print(` Let N:=nops(TransMatrix), the vertices are assumed to be labelled`):
print(` by 1, ..., N  `):
print(` The second input is a variable t`):
print(` and the first input, MC is list of length 3`):
print(``):
print(` The 3 components of MC are as follows:`):
print(` LeftLetters is the set of vertices where a path may start`):
print(` RightLetters is the set of vertices where a path may end`):
print(` TransMatrix is a list of sets, where TransMatrix[i] is the`):
print(` set consisting of pairs [j, polyn], where the coeff. of`):
print(` of t^k in polyn is the number of edges from i to j with weight`):
print(``):
print(`The output is the formal power series (necessarily a rational `):
print(` function) whose coeff. of t^i is`):
print(` the number of paths of weight i, that`):
print(` start with a vertex of LeftLetters and ends with a vertex `):
print(` of RightLetters, `):
fi:
 
if nops([args])=1 and op(1,[args])=SAPseries then 
print(`SAPseries(L): The sequence whose i^th term is`):
print(`the number of self-avoiding polygons of length 2i`):
print(`for i=1...L`):
fi:
 
 
if nops([args])=1 and op(1,[args])=SAP then 
print(`SAP(l): The number of self-avoiding polygons of`):
print(`lentgh 2*l`):
fi:
 
if nops([args])=1 and op(1,[args])=SAPlhw then 
print(`SAPlhw(l,h,w): the number of self-avoiding polygons`):
print(`with length 2l, height h, and width w`):
fi:
 
if nops([args])=1 and op(1,[args])=GfSeriesHeight then 
print(`GfSeriesHeight(n,M,s): The sequence whose i^th term is the`):
print(`g.f. of self-avoiding polygons of length 2i of width=n`):
print(`for 1<=i<=M with weigth s^(height)`):
fi:
 
if nops([args])=1 and op(1,[args])=GFSeriesHeight then 
print(`GFSeriesHeight(n,M,s): The sequence whose i^th term is the`):
print(`g.f. of self-avoiding polygons of length 2i of width<=n`):
print(`for 1<=i<=M with weigth s^(height)`):
fi:
 
 
if nops([args])=1 and op(1,[args])=SeriesMCLength then 
print(`SeriesMCLength(MC,s,M): Given a Markov Chain finds the sequence`):
print(`whose i^th member is the generating function  of paths of weight i`):
print(`with weight s^(length)`):
print(`for 0<=i<=M`):
fi:
 
if nops([args])=1 and op(1,[args])=GfSeries then 
print(`GfSeries(n,M): The sequence whose i^th term is the`):
print(`number of self-avoiding polygons of length 2i`):
print(` of width=n `):
fi:
 
if nops([args])=1 and op(1,[args])=GFSeries then 
print(`GFSeries(n,M): The sequence whose i^th term is the`):
print(`number of self-avoiding polygons of length 2i`):
print(` of width<=n `):
fi:
 
if nops([args])=1 and op(1,[args])=gfSeries then 
print(`gfSeries(n,M): The sequence whose i^th term is the`):
print(`number of self-avoiding polygons of length 2i immersed`):
print(`in the strip 0<=y<=n, for 1<=i<=M `):
fi:
 
if nops([args])=1 and op(1,[args])=SeriesMC then 
print(`SeriesMC(MC,M): Given a Markov Chain finds the sequence`):
print(`whose i^th member is the number of paths of weight i`):
print(`for 0<=i<=M`):
fi:
 
if nops([args])=1 and op(1,[args])=gf then 
print(`gf(n,t): The generating function of self-avoiding polygons`):
print(`immersed in a fixed strip`):
fi:
 
 
if nops([args])=1 and op(1,[args])=GF then 
print(`GF(n,t): The generating function of self-avoiding polygons`):
print(`in the variable t, of width<=n`):
fi:
 
 
if nops([args])=1 and op(1,[args])=Gf then 
print(`Gf(n,t): The generating function of self-avoiding polygons`):
print(`in the variable t, of width=n`):
fi:
 
if nops([args])=1 and op(1,[args])=SolveMarCha then 
print(`SolveMarCha(MC,t): Given a Markov Chain [LeftLetters,RightLetters,`):
print(`TransMatrx], finds the sum of the weights of all words that`):
print(`start with a letter of LeftLetters and ends with a letter`):
print(`of RightLetters, as a generating function in the variable t`):
fi:
 
 
if nops([args])=1 and op(1,[args])=MarCha then 
print(`MarCha(n): The Markov chain of self-avoiding polygons`):
print(`that live in the strip [0,n]`):
print(`It is asummed that the vertices (states) are labelled`):
print(`by positive integers. The Markov Chain is given as a`):
print(`list of lengh 3: [LeftLetters,RightLetters,TransitionMatrix]`):
print(`The TransitionMatrix is a list of lists, where the`):
print(` i^th entry is the set of pairs [j,wt(i,j)], where `);
print(` j is the a neighbor and wt(i,j) is the weight of `):
print(` the arc from i to j `):
fi:
 
if nops([args])=1 and op(1,[args])=RightLetters then 
print(`RightLetters(a,b,L,R): All the right`):
print(`letters for a self-avoiding polygon`):
print(`bounded in the strip [a,b], using the letters`):
print(`L and R followed by their finishing-length`):
print(`(i.e. what it takes to close the polygon and`):
print(` terminate the word) `):
fi:
if nops([args])=1 and op(1,[args])=Followers then 
print(`Followers(LET1,a,b,L,R): All the letters that`):
print(`can follow the letter LET1 in the ambient strip, [a,b]`):
print(`where L and R denote ( and ) resp.`):
fi:
 
 
if nops([args])=1 and op(1,[args])=DerivedPreLetters then 
print(` DerivedPreLetters(LET1,L,R): Given a pre-letter, finds `):
print(` all pre-letters obtained from it by inserting any number `):
print(` of eligible intervals `):
fi:
 
if nops([args])=1 and op(1,[args])=FillIns1 then 
print(`FillIns1(LET1,L,R): Given a pre-letter, LET1, where`):
print(`L and R denote ( and ), finds all the possible pre-letters`):
print(`obtained from it by inserting ONE new interval in`):
print(`a legal place`):
fi:
 
if nops([args])=1 and op(1,[args])=Stick1 then 
print(`Stick1(LET1,L,R,a,b): given a pre-letter, and an interval`):
print(`[a,b] finds the resulting pre-letter obtained by inserting`):
print(`[L,R] in the appropirate place in LET1[1][1] and`):
print(`[a,b] in the appropirate place in LET1[1][2]`):
print(`and replacing LET1[2] by LET1[2] minus {a..b}`):
fi:
 
if nops([args])=1 and op(1,[args])=PlacesToInsert then 
print(`PlacesToInsert(UnInts): Given a set of free-space, UnInts`):
print(`in terms of a list of intervals, finds all the`):
print(`intervals [a,b] of length at least 2 that may be`):
print(` inserted `):
fi:
 
if nops([args])=1 and op(1,[args])=SetToUnInt then 
print(`SetToUnInt(kv): Given a set of integers, kv, converts`):
print(`it list-of-intervals notation [[a1,b1],[a2,b2],[a3,b3],...]`):
print(`s.t. kv={a1..b1} union {a2..b2} ....`):
fi:
 
if nops([args])=1 and op(1,[args])=LeftLetters then 
print(`LeftLetters(a,b,L,R): All the left`):
print(`letters for a self-avoiding polygon`):
print(`bounded in the strip [a,b], using the letters`):
print(`L and R`):
fi:
 
if nops([args])=1 and op(1,[args])=PreFollowers then 
print(`PreFollowers(LET1,a,b,L,R): All the pre-letters that`):
print(`can follow the letter LET1 in the ambient strip, [a,b]`):
print(`where L and R denote ( and ) resp.`):
fi:
 
if nops([args])=1 and op(1,[args])=IncSeqSand then 
 
print(`IncSeqSand(BOUNDS,Centers): given a list of pairs`):
print(` [[a1,b1],...,[ak,bk]]`):
print(` and a set of centers, Centers `):
print(` finds the set of increasing sequences x1<=x2<=..<=xk `):
print(` such that ai<=xi<=bi, for i=1...k `):
print(` and the extra teritory taken `):
 
fi:
 
if nops([args])=1 and op(1,[args])=LebensRaums then 
print(`LebensRaums(LET1,FS1): Given a pre-letter LET1, and `):
print(`a free space set FS1, finds the list of pairs`):
print(`indicating the LebensRaum of each component`):
fi:
 
if nops([args])=1 and op(1,[args])=LebensRaum then 
print(` LebensRaum(LET1,FS1,i): Given a Pre-Letter LET1 with its `):
print(` free-space set FS1, and an integer i, finds the set range `):
print(` where the i^th component can roam `):
print(` the output is the lowest and the highest that it can `):
print(` venture to `):
fi:
 
if nops([args])=1 and op(1,[args])=PrePreFollowers then 
print(`PrePreFollowers(LET1,a,b,L,R): All the pre-pre-letters that`):
print(`can follow the letter LET1 in the ambient strip, [a,b]`):
print(`where L and R denote ( and ) resp.`):
fi:
 
if nops([args])=1 and op(1,[args])=OneStepAll then 
print(`OneStepAll(LET1,FS1,L,R): Set of all pairs [LET2,FS2]`):
print(` that can be obtained `):
print(` from the letter LET1, with its accompanying free-space set `):
print(` FS1, by performing either ONE RL-operation or ONE LL- or one RR-`):
print(` operation, L an R denote ( and ) resp. `):
fi:
 
if nops([args])=1 and op(1,[args])=OneStepRL then 
print(`OneStepRL(LET1,FS1,L,R): Set of all pairs [LET2,FS2]`):
print(` that can be obtained `):
print(` from the letter LET1, with its accompanying free-space set `):
print(` FS1, by performing ONE RL-operation `):
print(` L an R denote ( and ) resp. `):
fi:
 
if nops([args])=1 and op(1,[args])=OneStepRR then 
print(`OneStepRR(LET1,FS1,L,R): Set of all pairs [LET2,FS2]`):
print(` that can be obtained `):
print(` from the letter LET1, with its accompanying free-space set `):
print(` FS1, by performing ONE RR-operation `):
print(` L an R denote ( and ) resp. `):
fi:
 
if nops([args])=1 and op(1,[args])=OneStepLL then 
print(`OneStepLL(LET1,FS1,L,R): Set of all pairs [LET2,FS2]`):
print(` that can be obtained `):
print(` from the letter LET1, with its accompanying free-space set `):
print(` FS1, by performing ONE LL-operation `):
print(` L an R denote ( and ) resp. `):
fi:
 
if nops([args])=1 and op(1,[args])=JoinRL then 
print(`JoinRL(LET1,FreeSpace,j,L,R): Given a letter LET1,`):
print(` (phrased in terms of L and R), `):
print(` a set of integers, FreeSpace, and a location j`):
print(` such that LET1[1][j-1]=R, LET1[1][j]=L does the`):
print(` operation pRLq->pq and its corresponding`):
print(` effect on LET1[2] (the list of places with the`):
print(` opening, and  also outputs the new FreeSpace `):
print(` obtained by removing all the points between the two letters of `):
print(` this RL i.e. LET1[2][j-1]+1..LET1[2][j]-1 `):
fi:
 
if nops([args])=1 and op(1,[args])=JoinRR then 
print(` JoinRR(LET1,FreeSpace,j,L,R): Given a letter LET1, `):
print(` (phrased in terms of L and R),  `):
print(` a set of integers, FreeSpace, and a location j `):
print(` such that LET1[1][j]=LET1[1][j-1]=R does the `):
print(` operation LpLqRR->LpRq and its corresponding `):
print(` effect on LET1[2] (the list of places with the `):
print(` opening, and  also outputs the new FreeSpace `):
print(` obtained by removing all the points between these `):
print(` two adjacent Rs i.e. LET1[2][j-1]+1..LET1[2][j]-1 `):
fi:
 
if nops([args])=1 and op(1,[args])=JoinLL then 
print(` JoinLL(LET1,FreeSpace,i,L,R): Given a letter LET1, `):
print(` (phrased in terms of L and R), `):
print(` a set of integers, FreeSpace, and a location i `):
print(` such that LET1[1][i]=LET1[1][i+1]=L does the `):
print(` operation LLpRqR->pLqR and its corresponding `):
print(` effect on LET1[2] (the list of places with the `):
print(` opening, and  also outputs the new FreeSpace `):
print(` obtained by removing all the points between these `):
print(` two adjacent Ls i.e. LET1[2][i]+1..LET1[2][i+1]-1 `):
fi:
 
if nops([args])=1 and op(1,[args])=FindL then 
print(` FindL(w,j,L,R): Given a legal word w (in {L,R}), and `):
print(` a place j  that is an R, find the location of its L-mate`):
fi:
 
if nops([args])=1 and op(1,[args])=FindR then 
print(` FindR(w,i,L,R): Given a legal word w (in {L,R}), and`):
print(` a place i that is an L, find the location of its R-mate`):
fi:
 
if nops([args])=1 and op(1,[args])=IsRightLetter then 
print(`IsRightLetter(LET1,L,R): Decides whether the letter`):
print(`LET1 is a right letter`):
fi:
 
if nops([args])=1 and op(1,[args])=IsLeftLetter then 
print(`IsLeftLetter(LET1,L,R): Decides whether the letter`):
print(`LET1 is a left letter`):
fi:
 
if nops([args])=1 and op(1,[args])=Alphabet then 
print(`Alphabet(n,L,R): All the letters for a self-avoiding polygon`):
print(`bounded in the strip [0,n], using the letters`):
print(` L and R `):
fi:
 
if nops([args])=1 and op(1,[args])=IncSeq then 
print(`IncSeq(m,n,k): The set of inreasing sequences [i1, ..., ik]`):
fi:
 
if nops([args])=1 and op(1,[args])=Parenths then
print(` Parenths(n,L,R): All legal parentheses with n L and n R as  `):
print(` left and right parantheses respectively `):
print(` e.g. Perenths(2,L,R) should give {[L,R,L,R],[L,L,R,R]} `):
fi:
 
end:
 
 
#Parenths(n,L,R): All legal parentheses with n L and n R as 
#left and right parantheses respectively
#e.g. Perenths(2,L,R) should give {[L,R,L,R],[L,L,R,R]}
 
Parenths:=proc(n,L,R)
local gu,gu1,gu2,k,i1,i2:
option remember:
if n=0 then
RETURN({[]}):
fi:
 
gu:={}:
for k from 0 to n-1 do
gu1:=Parenths(k,L,R):
gu2:=Parenths(n-k-1,L,R):
 
for i1 from 1 to nops(gu1) do
for i2 from 1 to nops(gu2) do
gu:=gu union {[L,op(gu1[i1]),R,op(gu2[i2])]}:
od:
od:
od:
gu:
end:
 
 
#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:
 
 
#Alphabet(n,L,R): All the letters for a self-avoiding polygon
#bounded in the strip [0,n], using the letters
#L and R
Alphabet:=proc(n,L,R)
local mu,lu,gu,k,i1,i2:
gu:={}:
 
for k from 1 to (n+1)/2 do
mu:=Parenths(k,L,R):
lu:=IncSeq(0,n,2*k):
 
for i1 from 1 to nops(mu) do
for i2 from 1 to nops(lu) do
gu:=gu union {[mu[i1],lu[i2]]}:
od:
od:
 
od:
 
gu:
 
end:
 
 
 
#IsLeftLetter(LET1,L,R): Decides whether the letter
#LET1 is a left letter
IsLeftLetter:=proc(LET1,L,R)
local mu,k,i:
mu:=LET1[1]:
k:=nops(mu)/2:
 
if mu=[seq(op([L,R]),i=1..k)] then
RETURN(true):
else
RETURN(false):
fi:
 
end:
 
 
 
#IsRightLetter(LET1,L,R): Decides whether the letter
#LET1 is a right letter
IsRightLetter:=proc(LET1,L,R)
local mu,k,i,mu1:
mu:=LET1[1]:
k:=nops(mu)/2:
mu1:=[L,seq(op([L,R]),i=1..k-1),R]:
if mu=mu1 then
RETURN(true):
else
RETURN(false):
fi:
 
end:
 
 
# FindR(w,i,L,R): Given a legal word w (in {L,R}), and
# a place i that is an L, find the location of its R-mate
FindR:=proc(w,i,L,R)
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},w):
 
for j from i+1 while gu>0 do
gu:=gu+w1[j]:
od:
j-1:
end:
 
 
 
# FindL(w,j,L,R): Given a legal word w (in {L,R}), and
# a place j  that is an R, find the location of its L-mate
FindL:=proc(w,j,L,R)
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},w):
 
for i from j-1 by -1 while gu>0 do
gu:=gu+w1[i]:
od:
i+1:
end:
 
 
#JoinLL(LET1,FreeSpace,extw,i,L,R): 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
JoinLL:=proc(LET1,FreeSpace,extw,i,L,R)
local w,v,w1,v1,FreeSpace1,j,j1:
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:=FindR(w,i,L,R):
j1:=FindR(w,i+1,L,R):
 
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)}:
 
[w1,v1],FreeSpace1,extw+v[i+1]-v[i]:
end:
 
 
 
#JoinRR(LET1,FreeSpace,extw,j,L,R): 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
JoinRR:=proc(LET1,FreeSpace,extw,j,L,R)
local w,v,w1,v1,FreeSpace1,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:=FindL(w,j,L,R):
i1:=FindL(w,j-1,L,R):
 
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)}:
 
[w1,v1],FreeSpace1,extw+v[j]-v[j-1]:
end:
 
 
 
 
#JoinRL(LET1,FreeSpace,extw,j,L,R): 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
JoinRL:=proc(LET1,FreeSpace,extw,j,L,R)
local w,v,w1,v1,FreeSpace1,i:
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)}:
 
[w1,v1],FreeSpace1,extw+v[j]-v[j-1]:
end:
 
 
 
#OneStepLL(LET1,FS1,extw,L,R): 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.
#
OneStepLL:=proc(LET1,FS1,extw,L,R)
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 {[JoinLL(LET1,FS1,extw,i,L,R)]}:
fi:
od:
gu:
end:
 
 
 
#OneStepRR(LET1,FS1,extw,L,R): 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.
#
OneStepRR:=proc(LET1,FS1,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]=R and w[j-1]=R and 
  {seq(i1,i1=v[j-1]+1..v[j]-1)} minus FS1={} then
 gu:=gu union {[JoinRR(LET1,FS1,extw,j,L,R)]}:
fi:
od:
gu:
end:
 
 
#OneStepRL(LET1,FS1,extw,L,R): 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.
#
OneStepRL:=proc(LET1,FS1,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 {[JoinRL(LET1,FS1,extw,j,L,R)]}:
fi:
od:
gu:
end:
 
 
 
#OneStepAll(LET1,FS1,extw,L,R): 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'
#L an R denote ( and ) resp.
#
OneStepAll:=proc(LET1,FS1,extw,L,R):
OneStepLL(LET1,FS1,extw,L,R) union
OneStepRR(LET1,FS1,extw,L,R) union
OneStepRL(LET1,FS1,extw,L,R):
end:
 
#PrePreFollowers(LET1,a,b,L,R): All the pre-pre-letters that
#can follow the letter LET1 in the ambient strip, [a,b]
#where L and R denote ( and ) resp.
PrePreFollowers:=proc(LET1,a,b,L,R)
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 OneStepAll(op(mu[i]),L,R):
od:
 
gu:=gu union mu1:
mu:=mu1:
od:
 
gu:
end:
 
 
#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:
 
 
#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 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)},vk-i],i=a..vk)}
union {seq([[i], {seq(j,j=vk..i)},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]+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]+j-vk]}
od:
 
od:
 
gu:
end:
 
 
 
 
#PreFollowers(LET1,a,b,L,R): All the pre-letters that
#can follow the letter LET1 in the ambient strip, [a,b]
#where L and R denote ( and ) resp.
PreFollowers:=proc(LET1,a,b,L,R)
local gu,mu,BOUNDS,lu,i,j:
 
mu:=PrePreFollowers(LET1,a,b,L,R):
 
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]+lu[j][3]+nops(mu[i][1][1])]}:
od:
 
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:
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
lu2:=lu[i2]:
ru:=0:
for i from 1 to k do
ru:=ru+lu2[2*i]-lu2[2*i-1]+2:
od:
 
gu:=gu union {[[mu,lu2],ru] }:
od:
 
od:
 
gu:
 
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:
 
 
 
#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:
 
#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:
 
 
#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[3]+b-a+2
Stick1:=proc(LET1,L,R,a,b)
local w,v,FS,i,ku,extw:
 
 
w:=LET1[1][1]:
v:=LET1[1][2]:
FS:=LET1[2]:
extw:=LET1[3]:
ku:={seq(i,i=a..b)}:
 
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,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,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,extw+b-a+2]:
end:
 
 
#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:
 
#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:
 
#DerivedPreLetters(LET1,L,R): Given a pre-letter, finds
#all pre-letters obtained from it by inserting any number
#of eligible intervals
DerivedPreLetters:=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:
 
 
 
 
#Followers(LET1,a,b,L,R): All the letters that
#can follow the letter LET1 in the ambient strip, [a,b]
#where L and R denote ( and ) resp.
#followed by the extra-weight
Followers:=proc(LET1,a,b,L,R)
local mu,gu1,gu,i:
mu:=PreFollowers(LET1,a,b,L,R):
 
gu1:={}:
 
for i from 1 to nops(mu) do
gu1:=gu1 union DerivedPreLetters(mu[i],L,R):
od:
 
gu:={}:
 
for i from 1 to nops(gu1) do
gu:=gu union {[gu1[i][1],gu1[i][3]]}:
od:
 
gu:
end:
 
 
 
#RightLetters(a,b,L,R): All the right
#letters for a self-avoiding polygon
#bounded in the strip [a,b], using the letters
#L and R followed by their finishing-length
#(i.e. what it takes to close the polygon and
#terminate the word)
#
RightLetters:=proc(a,b,L,R)
local mu,lu,gu,k,i1,i2,ru,lu2,i:
gu:={}:
 
for k from 0 to (b-a-1)/2 do
mu:=[L,seq(op([L,R]),i1=1..k),R]:
lu:=IncSeq(a,b,2*k+2):
 
 
for i2 from 1 to nops(lu) do
lu2:=lu[i2]:
ru:=0:
for i from 1 to k+1 do
ru:=ru+lu2[2*i]-lu2[2*i-1]:
od:
 
gu:=gu union {[[mu,lu2],ru] }:
od:
 
od:
 
gu:
 
end:
 
 
#MarCha(n): The Markov chain of self-avoiding polygons
#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
MarCha:=proc(n)
local Vertices,L,R,T,i,lu,gu,S,mu1,mu1a,j,mu2:
Vertices:=Alphabet(n,L,R):
 
T[L]:=LeftLetters(0,n,L,R):
 
 
for i from 1 to nops(Vertices) do
 T[Vertices[i]]:=Followers(Vertices[i],0,n,L,R):
od:
 
lu:=RightLetters(0,n,L,R):
 
for i from 1 to nops(lu) do
 T[lu[i][1]]:=T[lu[i][1]] union {[R,lu[i][2]]}:
od:
 
T[R]:={}:
 
Vertices:=Vertices union {L,R}:
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:=mu2 union {[S[mu1a[1]],mu1a[2]]}:
od:
 
gu:=[op(gu),mu2]:
od:
 
[{S[L]},{S[R]},gu]:
end:
 
 
 
 
#gf(n,t): The generating function of self-avoiding polygons
#immersed in a fixed strip
gf:=proc(n,t) option remember: SolveMarCha(MarCha(n),t): end:
 
#GF(n,t): The generating function for animals of width<=n
GF:=proc(n,t):normal(gf(n,t)-gf(n-1,t)):end:
 
#Gf(n,t):The generating function for animals of width=n
Gf:=proc(n,t):normal(gf(n,t)-2*gf(n-1,t)+gf(n-2,t)):end:
 
 
 
 
#SeriesMC(MC,M): Given a Markov Chain finds the sequence
#whose i^th member is the number of paths of weight i
#for 0<=i<=M
SeriesMC:=proc(MC,M)
local a,i,SID,gu,gadol,LL1,RL1,TM,mispar,j,lu,i1,m,mu,sakhen,kha:
LL1:=MC[1]:
RL1:=MC[2]:
TM:=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 {lu[j][2]}:
od:
 
od:
 
gadol:=max(op(gu)):
 
for i from 1 to mispar do
if member(i,RL1) then
a[i]:=[seq(0,i1=1..gadol-1),1]:
else
a[i]:=[seq(0,i1=1..gadol)]:
fi:
od:
 
 
SID:=[]:
for m from 1 to M do
 
for i from 1 to mispar do
mu:=TM[i]:
lu:=0:
 
for j from 1 to nops(mu) do
sakhen:=a[mu[j][1]]:
lu:=lu+sakhen[nops(sakhen)-mu[j][2]+1]:
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:
 
 
 
 
#gfSeries(n,M): The sequence whose i^th term is the
#number of self-avoiding polygons of length 2i immersed
#in the strip 0<=y<=n, for 1<=i<=M 
gfSeries:=proc(n,M)
local i,mu:
option remember:
mu:=SeriesMC(MarCha(n),2*M):
[seq(mu[2*i],i=1..M)]:
end:
 
 
#GFSeries(n,M): The sequence whose i^th term is the
#number of self-avoiding polygons of length 2i of width<=n
#for 1<=i<=M 
GFSeries:=proc(n,M)
local i,mu1,mu2:
mu1:=gfSeries(n,M):
 
if n=1 then
RETURN(mu1):
fi:
 
mu2:=gfSeries(n-1,M):
[seq(mu1[i]-mu2[i],i=1..M)]:
end:
 
 
#GfSeries(n,M): The sequence whose i^th term is the
#number of self-avoiding polygons of length 2i of width=n
#for 1<=i<=M 
GfSeries:=proc(n,M)
local i,mu1,mu2:
 
mu1:=GFSeries(n,M):
 
if n=1 then
RETURN(mu1):
fi:
 
 
mu2:=GFSeries(n-1,M):
[seq(mu1[i]-mu2[i],i=1..M)]:
end:
 
 
 
###########
 
#SeriesMCLength(MC,s,M): Given a Markov Chain finds the sequence
#whose i^th member is the generating function  of paths of weight i
#with weight s^(length)
#for 0<=i<=M
SeriesMCLength:=proc(MC,s,M)
local a,i,SID,gu,gadol,LL1,RL1,TM,mispar,j,lu,i1,m,mu,sakhen,kha:
LL1:=MC[1]:
RL1:=MC[2]:
TM:=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 {lu[j][2]}:
od:
 
od:
 
gadol:=max(op(gu)):
 
for i from 1 to mispar do
if member(i,RL1) then
a[i]:=[seq(0,i1=1..gadol-1),1]:
else
a[i]:=[seq(0,i1=1..gadol)]:
fi:
od:
 
 
SID:=[]:
for m from 1 to M do
 
for i from 1 to mispar do
mu:=TM[i]:
lu:=0:
 
for j from 1 to nops(mu) do
sakhen:=a[mu[j][1]]:
lu:=expand(lu+s*sakhen[nops(sakhen)-mu[j][2]+1]):
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:
 
 
 
 
 
#gfSeriesHeight(n,M,s): The sequence whose i^th term is the
#g.f. of self-avoiding polygons of weight 2i 
#with weight=s^(height) immersed
#in the strip 0<=y<=n, for 1<=i<=M and 
gfSeriesHeight:=proc(n,M,s)
local i,mu:
option remember:
mu:=SeriesMCLength(MarCha(n),s,2*M):
[seq(normal(mu[2*i]/s),i=1..M)]:
end:
 
 
#GFSeriesHeight(n,M): The sequence whose i^th term is the
#g.f. of self-avoiding polygons of length 2i of width<=n
#for 1<=i<=M with weigth s^(height)
GFSeriesHeight:=proc(n,M,s)
local i,mu1,mu2:
option remember:
mu1:=gfSeriesHeight(n,M,s):
 
if n=1 then
RETURN(mu1):
fi:
 
mu2:=gfSeriesHeight(n-1,M,s):
[seq(expand(mu1[i]-mu2[i]),i=1..M)]:
end:
 
 
#GfSeriesHeight(n,M,s): The sequence whose i^th term is the
#g.f. of self-avoiding polygons of length 2i of width=n
#with weight s^(height)
#for 1<=i<=M 
GfSeriesHeight:=proc(n,M,s)
local i,mu1,mu2:
option remember:
mu1:=GFSeriesHeight(n,M,s):
 
if n=1 then
RETURN(mu1):
fi:
 
mu2:=GFSeriesHeight(n-1,M,s):
[seq(expand(mu1[i]-mu2[i]),i=1..M)]:
end:
 
 
#SAPlhw(l,h,w): the number of self-avoiding polygons
#with length 2l, height h, and width w
SAPlhw:=proc(l,h,w)
local gu,M,s:
M:=l+h:
gu:=GfSeriesHeight(w,M,s):
coeff(gu[l],s,h):
end:
 
#SAP(l): The number of self-avoiding polygons of
#lentgh 2*l
SAP:=proc(l)
local h,w,gu:
 
gu:=0:
 
 
for w from 1 to l/2 do
for h from w+1 to l-w do
gu:=gu+2*SAPlhw(l,h,w):
od:
od:
 
 
for w from 1 to l/2 do
gu:=gu+SAPlhw(l,w,w):
od:
 
gu:
 
end:
 
#SAPseries(L): The sequence whose i^th term is
#the number of self-avoiding polygons of length 2i
#for i=1...L
SAPseries:=proc(L)
local gu,i:
gu:=[]:
for i from 1 to L do
gu:=[op(gu),SAP(i)]:
print(gu):
od:
gu:
end:
 
 
############End OF Regular stuff
 
###Begin of Free Stuff
 
 
 
 
#Alphabetf(n,L,R): All the letters for a self-avoiding polygon
#that start of width<=n
#L and R
Alphabetf:=proc(n,L,R)
local mu,lu,gu,k,i1,i2:
gu:={}:
 
for k from 1 to (n+1)/2 do
mu:=Parenths(k,L,R):
lu:=IncSeq(0,n,2*k) minus IncSeq(1,n,2*k):
 
for i1 from 1 to nops(mu) do
for i2 from 1 to nops(lu) do
gu:=gu union {[mu[i1],lu[i2]]}:
od:
od:
 
od:
 
gu:
 
end:
 
 
 
gova:=proc(LET1)
 local mu: 
mu:=LET1[2]:
mu[nops(mu)]-mu[1]:
end:
 
 
narmel:=proc(LET1)
 local mu,kat,gu,i: 
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:
 
#FollowersfOld(LET1,n,L,R,t): All the free letters that
#can follow the free-letter LET1 (that starts with 0
#and that have height<=n 
#where L and R denote ( and ) resp.
#followed by generating function in t of  extra-weight: Old version
 
FollowersfOld:=proc(LET1,n,L,R,t)
local gu,i,mu,Otiot,T,lu:
mu:=Followers(LET1,-n,n+gova(LET1)-1,L,R):
 
gu:=[]:
for  i from 1 to nops(mu) do
if gova(mu[i][1])<=n then
gu:=[op(gu),[narmel(mu[i][1]),mu[i][2]]]:
fi:
od:
 
 
Otiot:={}:
 
for i from 1 to nops(gu) do
Otiot:=Otiot union {gu[i][1]}:
od:
 
 
for i from 1 to nops(Otiot) do
T[Otiot[i]]:=0:
od:
 
for i from 1 to nops(gu) do
 T[gu[i][1]]:=T[gu[i][1]]+t^gu[i][2]:
od:
 
lu:=[]:
 
for i from 1 to nops(Otiot) do
lu:=[op(lu),[Otiot[i],T[Otiot[i]]]]:
od:
convert(lu,set):
 
end:
 
 
#SolveMarCha1(MC): 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
#
SolveMarCha1:=proc(MC)
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]]*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:
 
 
 
#LeftLettersf(a,b,L,R,t): All the left
#letters for a self-avoiding polygon
#bounded in the strip [a,b] whose bottom is a
LeftLettersf:=proc(a,b,L,R,t)
local mu,lu,gu,k,i1,i2,ru,lu2,i:
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) minus IncSeq(a+1,b,2*k):
 
 
for i2 from 1 to nops(lu) do
lu2:=lu[i2]:
ru:=0:
for i from 1 to k do
ru:=ru+lu2[2*i]-lu2[2*i-1]+2:
od:
 
gu:=gu union {[[mu,lu2],t^ru] }:
od:
 
od:
 
gu:
 
end:
 
 
 
#RightLettersf(a,b,L,R,t): All the right
#letters for a self-avoiding polygon
#bounded in the strip [a,b], using the letters
#L and R followed by their finishing-length
#with bottom a
#(i.e. what it takes to close the polygon and
#terminate the word)
#
RightLettersf:=proc(a,b,L,R,t)
local mu,lu,gu,k,i1,i2,ru,lu2,i:
gu:={}:
 
for k from 0 to (b-a-1)/2 do
mu:=[L,seq(op([L,R]),i1=1..k),R]:
lu:=IncSeq(a,b,2*k+2) minus IncSeq(a+1,b,2*k+2):
 
 
for i2 from 1 to nops(lu) do
lu2:=lu[i2]:
ru:=0:
for i from 1 to k+1 do
ru:=ru+lu2[2*i]-lu2[2*i-1]:
od:
 
gu:=gu union {[[mu,lu2],t^ru] }:
od:
 
od:
 
gu:
 
end:
 
 
#MarChaf(n): The Markov chain of self-avoiding polygons
#with each vertical slice 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
MarChaf:=proc(n,t)
local Vertices,L,R,T,i,lu,gu,S,mu1,mu1a,j,mu2:
Vertices:=Alphabetf(n,L,R):
 
T[L]:=LeftLettersf(0,n,L,R,t):
 
 
for i from 1 to nops(Vertices) do
 T[Vertices[i]]:=Followersf(Vertices[i],n,L,R,t):
od:
 
lu:=RightLettersf(0,n,L,R,t):
 
for i from 1 to nops(lu) do
 T[lu[i][1]]:=T[lu[i][1]] union {[R,lu[i][2]]}:
od:
 
T[R]:={}:
 
Vertices:=Vertices union {L,R}:
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:=mu2 union {[S[mu1a[1]],mu1a[2]]}:
od:
 
gu:=[op(gu),mu2]:
od:
 
[{S[L]},{S[R]},gu]:
end:
 
 
#gff(n,t): The generating function of self-avoiding polygons
#each vertical strip of  heigth<=n
gff:=proc(n,t) option remember: SolveMC4(MarChaf(n,t),t): end:
 
 
 
#gfSeriesf(n,M): The sequence whose i^th term is the
#number of self-avoiding polygons of length 2i each of
#whose vertical slices is of height <=n
gfSeriesf:=proc(n,M)
local i,mu,t:
option remember:
mu:=SolveMC4series(MarChaf(n,t),t,2*M):
[seq(mu[2*i],i=1..M)]:
end:
 
 
 
 
 
#Followersf(LET1,n,L,R,t): All the free letters that
#can follow the free-letter LET1 (that starts with 0
#and that have height<=n 
#where L and R denote ( and ) resp.
#followed by generating function in t of  extra-weight
 
Followersf:=proc(LET1,n,L,R,t)
local gu,i,mu,Otiot,T,lu,a,b,g:
g:=gova(LET1):
 
mu:=Followers(LET1,0,n+g-1,L,R) union Followers(LET1,-n,g-1,L,R):
 
for a from 1 to n-g-1 do
for b from 0 to n-g-a do
mu:=mu union Followers(LET1,-a,g+b,L,R) :
od:
od:
 
gu:=[]:
for  i from 1 to nops(mu) do
if gova(mu[i][1])<=n then
gu:=[op(gu),[narmel(mu[i][1]),mu[i][2]]]:
fi:
od:
 
 
Otiot:={}:
 
for i from 1 to nops(gu) do
Otiot:=Otiot union {gu[i][1]}:
od:
 
 
for i from 1 to nops(Otiot) do
T[Otiot[i]]:=0:
od:
 
for i from 1 to nops(gu) do
 T[gu[i][1]]:=T[gu[i][1]]+t^gu[i][2]:
od:
 
lu:=[]:
 
for i from 1 to nops(Otiot) do
lu:=[op(lu),[Otiot[i],T[Otiot[i]]]]:
od:
convert(lu,set):
 
end:
 
#SolveMC4(MC,t): Given a Markov Chain [LeftLetters,RightLetters,
#TransMatrix], 
# Let N:=nops(TransMatrix), the vertices are assumed to be labelled
# by 1, ..., N 
# The second input is a variable t
# and the first input, MC is list of length 3
#
# The 3 components of MC are as follows:
#
# LeftLetters is the set of vertices where a path may start
# RightLetters is the set of vertices where a path may end
# TransMatrix is a list of sets, where TransMatrix[i] is the
# set consisting of pairs [j, polyn], where the coeff. of
# of t^k in polyn is the number of edges from i to j with weight
# k
#
#The output is the formal power series (necessarily a rational 
# function) whose coeff. of t^i is
# the number of paths of weight i, that
#start with a vertex of LeftLetters and ends with a vertex
#of RightLetters, 
#
SolveMC4:=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]]*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:
 
#SolveMC4series(MC,t,M): The  list of length M whose i^th term
#is the coefficient of t^i in SolveMC4(MC,t)
SolveMC4series:=proc(MC,t,M)
local a,i,SID,gu,gadol,LL1,RL1,TM,mispar,j,lu,i1,m,mu,sakhen,kha,lu1,j1:
 
 
LL1:=MC[1]:
RL1:=MC[2]:
TM:=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
if member(i,RL1) then
a[i]:=[seq(0,i1=1..gadol-1),1]:
else
a[i]:=[seq(0,i1=1..gadol)]:
fi:
od:
 
 
SID:=[]:
for m from 1 to M do
 
for i from 1 to mispar do
mu:=TM[i]:
lu:=0:
 
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: