###################################################################### ##LOU: Save this file as LOU. To use it, stay in the # ##same directory, get into Maple (by typing: maple ) # ##and then type: read LOU : # ##Then follow the instructions given there # ## # #Written by Doron Zeilberger, Rutgers University , # #zeilberg@math.rutgers.edu. # ###################################################################### #Created: Nov. 24, 1998 #This version: June 7, 2010 #LOU: A Maple package to study Lou Kauffman's #equivalent statement of the Four Color Thm #Please report bugs to zeilberg@math.rutgers.edu with(plots): print(`Created: Nov. 24, 1998.`): print(`This version: Nov. 34, 1998`): print(`LOU, a Maple package to study Lou Kauffman's linguistic`): print(`approach to the Four Color Theorem.`): print(`Written by Doron Zeilberger, zeilberg@math.Rutgers.edu`): print(``): print(`It is one of the two packages accompanying the article`): print(`Toward a Language Theoretic Proof of the Four Color`): print(`Theorem, by Bobbe J. Cooper, Eric Rowland, and Doron Zeilberger. `): print(`(The other package is a Mathematica package, ParseWords, available`): print(`from Eric Rowland's website.) `): lprint(``): print(`Please report bugs to zeilberg@math.rutgers.edu`): lprint(``): print(`The most current version of this package and paper`): print(` are available from`): print(`http://www.math.rutgers.edu/~zeilberg/`): print(`For a list of the procedures type ezra(), for help with`): print(` For a list of the main procedures type ezraM()`): print(` For a list of conjecturing procedures type ezraC()`): print(`a specific procedure, type ezra(procedure_name)`): print(``): ezraM:=proc() if args=NULL then print(`The Main are procedures: `): print(` AllDerTrees1, AllWords,`): print(` BT, BTP, IrredP, MinLou `): else ezra(args): fi: end: ezraC:=proc() if args=NULL then print(`The conjecturing procedures are : `): print( ` LefComb, PairsFromWords , RigComb, RL, RLw,RLRL, RLRLw`): print(`RRLL, RRLLw, RRRL, RRRLw, RRR1, RRR1w, Tik1, Tovim, Zug1LL `): else ezra(args): fi: end: ezra:=proc() if args=NULL then print(`Contains the following procedures: AllDerTrees1, `): print(` AllDerTrees1, AllWords,`): print(` BT, BTn1n2,BTP, BTPn1n2,Check2Conj`): print(`DrawMinLou, DrawPair, DrawPair2, DrawT, DrawTw`): print(`Etsim, ExploreRule2a,`): print(`ExploreRule2aa, Find2Conj, FindOneP, FindOnePw,`): print(`GPair, Graft, GraftP, GraftedPairs`): print(` Height, IrredP, IrredPn1n2a,IsIrredP, LefComb, ListToRE ,LL1, LL1w`): print(`LR1, LRw, MaxLou, Milim, MilimI,MilimP, MinLou , MinLouw`): print( ` PairsFromWords , RigComb, RL, RLw,RLRL, RLRLw`): print(`RRLL, RRLLw, RRRL, RRRLw, RRR1, RRR1w, Rule1, Rule2a,Tik1, Tovim, `): print(`VerifyRule1, VerifyRule1a, Zug1LL `): fi: if nops([args])=1 and op(1,[args])=AllDerTrees1 then print(`AllDerTrees1(n): all derivation trees first way`): fi: if nops([args])=1 and op(1,[args])=AllDerTrees2 then print(`AllDerTrees1(n): all derivation trees second way`): fi: if nops([args])=1 and op(1,[args])=AllWords then print(`AllWords(n): All words of length n`): fi: if nops([args])=1 and op(1,[args])=BT then print(` BT(n): the set of complete binary trees on n leaves`): fi: if nops([args])=1 and op(1,[args])=BTn1n2 then print(`BTn1n2(n1,n2): the set of binary trees on n1+n2 leaves`): print(`with the left-tree with n1 leaves and the right tree with`): print(`n2 leaves`): fi: if nops([args])=1 and op(1,[args])=BTP then print(` BTP(n): the set of pairs of complete binary trees on n leaves`): fi: if nops([args])=1 and op(1,[args])=BTPn1n2 then print(`BTPn1n2(n1,n2): All pairs [T1,T2] of complete binary trees `): print(`where T1 has type(n1,n2) and T2 has type (n2,n1)`): fi: if nops([args])=1 and op(1,[args])=Check2Conj then print(`Check2Conj(n): checks the move-2 from beginning to end`): print(`conjecture for all binary trees of n leaves`): fi: if nops([args])=1 and op(1,[args])=DrawMinLou then print(`DrawMinLou(n,X,Y,Z,E): draws all minimal pairs`): fi: if nops([args])=1 and op(1,[args])=DrawPair then print(`DrawPair(T): Draws the pair of (complete) binary trees T`): print(`facing each other and in a balanced way`): print(`For example, try: DrawP([[],[]]);`): fi: if nops([args])=1 and op(1,[args])=DrawPairw then print(`DrawPairw(Zug,w,X,Y,Z,E): Given a pair of trees, Zug`): print(` a word w, and symbols X,Y,Z,E, draws the labelled diagram`): fi: if nops([args])=1 and op(1,[args])=DrawT then print(`DrawT(T): Draws the (complete) binary tree T`): print(`For example, try: DrawT([[],[]]);`): fi: if nops([args])=1 and op(1,[args])=DrawTa then print(`DrawTa(P): Draws the pair of (complete) binary trees P`): print(` with the same orientation `): print(`For example, try: DrawTa([[],[]]);`): fi: if nops([args])=1 and op(1,[args])=DrawTw then print(`DrawTw(T,w,X,Y,Z,E): Draws the (complete) binary tree T`): print(`with labelled induced by w`): print(`For example, try: DrawTw([[],[]],[X,Y],X,Y,Z,E);`): fi: if nops([args])=1 and op(1,[args])=Etsim then print(`Etsim(w): All the derivation trees for the word w`): fi: if nops([args])=1 and op(1,[args])=ExploreRule2a then print(`ExploreRule2a(L): Explores Rule2a for all pairs of type`): print(` (n1+2,n2),(n1,n2+2) for n1,n2 <=L`): fi: if nops([args])=1 and op(1,[args])=ExploreRule2aa then print(`ExploreRule2aa(n1,n2): Explores Ruled2a and checks`): print(`the succesful ones for pairs of type`): print(`(n1+2,n2) and the second (n1,n2+2)`): print(`the output is {true} (hopefully) followed by the number of succesful`): print(`ones followed by the number of failures`): fi: if nops([args])=1 and op(1,[args])=Find2Conj then print(`Find2Conj(T): Given a complete binary tree, T,`): print(`finds all words in Milim(T) of the form 2w such that`): print(`w2 is also there `): fi: if nops([args])=1 and op(1,[args])=FindOneP then print(`FindOneP(N): Finds all one-parameter pairs of the form`): print(`[P,i,j,a,b]: where P is the pair, i,j are the leaves (numbered`): print(`form the left) where to stick either LefComb (0) or RigComb(1)`): print(`resp. where {a,b} are 0 or 1`): print(`For example, try FindOneP(1);`): fi: if nops([args])=1 and op(1,[args])=FindOnePw then print(`FindOnePw(N,c): Finds all one-parameter pairs of the form`): print(`[P,i,j,a,b,mu1,mu2]: where P is the pair, `): print(` i,j are the leaves (numbered`): print(`form the left) where to stick either LefComb (0) or RigComb(1)`): print(`resp. where {a,b} are 0 or 1, followed by the regular expression`): print(`mu1,mu2 for even and odd number of leaves in terms of the symbol c`): print(`For example, try FindOnePw(1,c);`): fi: if nops([args])=1 and op(1,[args])=GPair then print(`GPair(P,i,j,a,b,n): Given a pair P, and integers i,j between`): print(`1 and the number of leaves and Boolean variables 0(L) and 1(R)`): print(`and an integer n, constructs the pair obtained by grafting`): print(`LefComb(n) (a,b=0) and/or RigComb(n) (a,b=1) in the i^th and`): print(`j^th leaf respectively`): fi: if nops([args])=1 and op(1,[args])=Graft then print(`Graft(T1,T2,r): Grafts the tree T2 to the r^th leaf of tree T1`): fi: if nops([args])=1 and op(1,[args])=GraftP then print(`GraftP(Pair1,Pair2,r): Grafts the pair Pair2 into`): print(` the r^th leaves of pair Pair1 `): fi: if nops([args])=1 and op(1,[args])=GraftedPairs then print(`GraftedPairs(n): All the pairs of trees obtained`): print(`by grafting smaller pairs `): fi: if nops([args])=1 and op(1,[args])=Height then print(`Height(T): The height of a binary tree T`): fi: if nops([args])=1 and op(1,[args])=IrredP then print(`IrredP(n): all the irreducible pairs of trees`): fi: if nops([args])=1 and op(1,[args])=IrredPn1n2a then print(`IrredPn1n2a(n1,n2,a): all the irreducible pairs of trees`): print(`where the first is of type (n1+a,n2) and the second of type`): print(`n1,n2+a`): fi: if nops([args])=1 and op(1,[args])=IsIrredP then print(`IsIrredP(Pair): Is the pair Pair irreducuble?`): fi: if nops([args])=1 and op(1,[args])=LefComb then print(`LefComb(n): The left-comb with n leaves`): fi: if nops([args])=1 and op(1,[args])=ListToRE then print(`ListToRE(Resh,b): Given a list of words Resh, and a symbol b`): print(` converts it to a regular`): print(`expression in the form [Prefix, [Period,b], Suffix],`): print(`such that Resh[b+1] is `): print(`Prefix(Period)^bSuffix `): print(`ListToRE([[1,2,3],[1,2,2,2,3],[1,2,2,2,2,2,3]],b);`): fi: if nops([args])=1 and op(1,[args])=ListToRE2 then print(`ListToRE2(Resh,a,b): Given a list of lists of`): print(`Resh, finds a regular expression`): print(`[w1,[w2,a],w3,[w4,b],w5] such that`): print(`Resh[a][b] equals w1 (w2^a) w3 (w4)^b w5`): fi: if nops([args])=1 and op(1,[args])=LL1 then print(`LL1(a,b): the pair ([[],LefComb(a+b-1)],`): print(`and [LefComb(a),LefComb(b)]:`): fi: if nops([args])=1 and op(1,[args])=LL1w then print(`LL1w(a,b,p1,p2): The word for `): print(`the pair ([[],LefComb(2*a+p1+2*b+p2-1)], and `): print(` [LefComb(2*a+p1),LefComb(2*b+p2)]: `): print(` For example, try: LL1w(a,b,0,0); `): fi: if nops([args])=1 and op(1,[args])=LR1 then print(`LR1(a,b): the pair `): print(`([RigComb(a+b-1),[]], and [LefComb(a),RigComb(b)]:`): fi: if nops([args])=1 and op(1,[args])=LR1w then print(`LR1w(a,b,p1,p2): The word for the pair `): print(`([RigComb(a+b-1),[]], and [LefComb(a),RigComb(b)]:`): print(`with a->2*a+p1, b->2*b+p2 `): print(` For example, try: LR1w(a,b,0,0); `): fi: if nops([args])=1 and op(1,[args])=MaxLou then print(`MaxLou(n): the largest cardinality of words that a pair `): print(`of trees can have in common`): print(`and a corresponding pair-of-trees`): fi: if nops([args])=1 and op(1,[args])=Milim then print(`Milim(tree1): all words on the leaves for tree1`): fi: if nops([args])=1 and op(1,[args])=MilimI then print(`MilimI(n,i): all words on n letters that give exactly i trees`): fi: if nops([args])=1 and op(1,[args])=MilimP then print(`MilimP(treePair): all the common words on the leaves for the trees`): print(`in the pair treePair`): fi: if nops([args])=1 and op(1,[args])=MinLou then print(`MinLou(n): the smallest cardinality of words that a pair `): print(`of trees can have in common`): print(`and a corresponding pair-of-trees`): print(`According to Lou Kauffman, 4CT is equivalemt to statement that MinLou(n) is always positive`): fi: if nops([args])=1 and op(1,[args])=PairsFromWords then print(`PairsFromWords(n): all pairs of words that come from good words`): print(`of length n`): fi: if nops([args])=1 and op(1,[args])=RigComb then print(`RigComb(n): The right-comb with n leaves`): fi: if nops([args])=1 and op(1,[args])=RL then print(`RL(n): the pair (LeftComb(n),RightComb(n)) and their common words`): fi: if nops([args])=1 and op(1,[args])=RLw then print(`RLw(n,p): Given a symbol n and a parity p (0 or 1)`): print(`guesses automatically the good work for the pair`): print(`[RigComb(2*n+p),LefComb(2*n+p)]. For example, try`): print(`RLw(n,0); and : RLw(n,1); `): fi: if nops([args])=1 and op(1,[args])=RLRL then print(`RLRL(a,b): The pair consisting of [RigComb(a),LefComb(b)]`): print(`and [RigComb(a-1),LefComb(b+1)], with a>=2,b>=1 `): fi: if nops([args])=1 and op(1,[args])=RLRLw then print(`RLRLw(a,b,p1,p2): The formal word for the`): print(`pair consisting of [RigComb(a),LefComb(b)]`): print(`and [RigComb(a-1),LefComb(b+1)], with a>=2, b>=1 a=2*a+p1, b=2*b+p2`): fi: if nops([args])=1 and op(1,[args])=RRLL then print(`RRLL(a,b): The pair consisting of [RigComb(a),RigComb(b)]`): print(`and [LefComb(a-1),LefComb(b+1)], with a>=2,b>=1 `): fi: if nops([args])=1 and op(1,[args])=RRLLw then print(`RRLLw(a,b,p1,p2): The formal word for the`): print(`pair consisting of [RigComb(a),RigComb(b)]`): print(`and [LefComb(a-1),LefComb(b+1)], with a>=2, b>=1 a=2*a+p1, b=2*b+p2`): fi: if nops([args])=1 and op(1,[args])=RRRL then print(`RRRL(a,b): The pair consisting of [RigComb(a),RigComb(b)]`): print(`and [RigComb(a-1),LefComb(b+1)], with a>=2,b>=1 `): fi: if nops([args])=1 and op(1,[args])=RRRLw then print(`RRRLw(a,b,p1,p2): The formal word for the`): print(`pair consisting of [RigComb(a),RigComb(b)]`): print(`and [RigComb(a-1),LefComb(b+1)], with a>=2, b>=1 a=2*a+p1, b=2*b+p2`): fi: if nops([args])=1 and op(1,[args])=RRR1 then print(`RRR1(a,b): The `): print(`pair consisting of `): print(`RigComb(a+b+1) and [[RigComb(a),RigComb(b)],[]]`): fi: if nops([args])=1 and op(1,[args])=RRR1w then print(`RRR1w(a,b,p1,p2): The formal word for the`): print(`pair consisting of `): print(`RigComb(a+b+1) and [[RigComb(a),RigComb(b)],[]]`): fi: if nops([args])=1 and op(1,[args])=Rule1 then print(`Rule1(zug): Applies Rule1 to the pair zug`): fi: if nops([args])=1 and op(1,[args])=Rule2a then print(`Rule2a(zug): Applies Rule2a to the pair zug`): fi: if nops([args])=1 and op(1,[args])=Tik1 then print(`Tik1(T1,T2,i1,i2,N): Finds which of the eight`): print(` possibilities of grafting combs `): print(` implanting even(0) or odd(1) `): print(`left(-1) or right(1) `): print(`to the i1^th leaf of T1 and i2^th leaf of T2 resp. up to N.`): print(`If succesful,`): print(`For example, try Tik1([[[],[]],[]],[[],[[[],[]]],2,3,6);`): fi: if nops([args])=1 and op(1,[args])=Tovim then print(`Tovim(n,N): all hopeful grafting of combs (up to N leaves)`): print(`on pairs of trees with n leaves `): print(`Given as triplets: [T1,T2,i1,i2,Parity,LeftOrRigtonT1,`): print(` LeftOrRightT2,lu], where i1 and i2 are the leaves on T1 and `): print(`T2 to be grafted, Parity is the parity of the number of leaves of`): print(`of the grafted combs (even=0, odd=1), LeftOrRightT1 is -1 (left)`): print(`or +1 (right) indicationg whether the grafted comb is left or right`): print(`Similary for LeftOrRightT2, and lu is the regular expression giving`): print(`the common legal labelling, or the sequence, if it is not unique`): print(`For example, try Tovim(2,6); `): fi: if nops([args])=1 and op(1,[args])=VerifyRule1 then print(`VerifyRule1(L): verifies Rule1 for all pairs of type `): print(`(n1+1,n2),(n1,n2+1) for n1,n2 <=L`): fi: if nops([args])=1 and op(1,[args])=VerifyRule1a then print(`VerifyRule1a(n1,n2): verifies Rule1 for all pairs of type`): print(`(n1+1,n2) and the second (n1,n2+1)`): fi: if nops([args])=1 and op(1,[args])=Zug1LL then print(`Zug1LL(T1,T2,i1,i2,n): The pair of trees obtained`): print(`by grafting a left Combs with n leaves on the i1-th`): print(`leaf of T1 and i2-th leaf of T2`); fi: end: #BT(n): the set of binary trees on n vertices BT:=proc(n) local gu,k,gu1,gu2,i,j: option remember: if not type(n,integer) then ERROR(`input should be an integer`): fi: if n<=0 then RETURN({}): fi: if n=1 then RETURN({[]}): fi: gu:={}: for k from 1 to n-1 do gu1:=BT(k):gu2:=BT(n-k): for i from 1 to nops(gu1) do for j from 1 to nops(gu2) do gu:=gu union {[gu1[i],gu2[j]]}: od: od: gu: od: gu: end: #Milim(tree1): all words on the leaves of tree1 Milim:=proc(tree1) local son1,son2,gu1,gu2,gu: option remember: if tree1=[] then RETURN({[0]}): fi: gu:={}: son1:=tree1[1]:son2:=tree1[2]: gu1:=Milim(son1):gu2:=Milim(son2): gu:=gu union Cat(Add1(gu1),Add2(gu2)) union Cat(Add2(gu1),Add1(gu2)): end: #MinLou(n): the smallest cardinality of words that a pair #of trees can have in common, and a corresponding pair-of-trees MinLou:=proc(n) local gu,i1,j1,ka,mu,aluf,AlufSet: gu:=BT(n): if n=1 or n=2 then RETURN(nops(A1(gu[1]))): fi: aluf:={gu[1],gu[2]}: AlufSet:={aluf}: ka:=nops(Milim(gu[1]) intersect Milim(gu[2])): for i1 from 1 to nops(gu) do for j1 from i1+1 to nops(gu) do mu:=nops(Milim(gu[i1]) intersect Milim(gu[j1])): if muka then aluf:={gu[i1],gu[j1]}: AlufSet:={aluf}: ka:=mu: elif mu=ka then aluf:={gu[i1],gu[j1]}: AlufSet:=AlufSet union {aluf}: fi: od: od: ka,AlufSet: end: #ComLou(n): the set of cardinalities of words that a pair #of trees can have in common, and a corresponding pair-of-trees ComLou:=proc(n) local gu,i1,j1,ku: gu:=BT(n): if n=1 or n=2 then RETURN({nops(A1(gu[1]))}): fi: ku:={}: for i1 from 1 to nops(gu) do for j1 from i1+1 to nops(gu) do ku:= ku union {nops(Milim(gu[i1]) intersect Milim(gu[j1]))}: od: od: ku: end: add1:=proc(gu) local i: [seq(gu[i]+1 mod 3,i=1..nops(gu))]: end: add2:=proc(gu) local i: [seq(gu[i]+2 mod 3,i=1..nops(gu))]: end: Add1:=proc(Setw) local i: {seq(add1(Setw[i]),i=1..nops(Setw))}: end: Add2:=proc(Setw) local i: {seq(add2(Setw[i]),i=1..nops(Setw))}: end: #AllWords(n): all words that evaluate to 1 AllWords:=proc(n) local gu,mu,i: option remember: mu:=BT(n): gu:={}: for i from 1 to nops(mu) do gu:=gu union Milim(mu[i]): od: gu: end: Cat:=proc(gu1,gu2) local i1,j1,gu: gu:={}: for i1 from 1 to nops(gu1) do for j1 from 1 to nops(gu2) do gu:=gu union {[op(gu1[i1]),op(gu2[j1])]}: od: od: gu: end: #Etsim(w): All the derivation trees for the word w Etsim:=proc(w) local w1,w2,i,n,T1,T2,gu,i1,j1: n:=nops(w): if n=1 then if w[1]=0 then RETURN({[]}): else RETURN({}): fi: fi: gu:={}: for i from 1 to n-1 do w1:=[op(1..i,w)]: w2:=[op(i+1..n,w)]: T1:=Etsim(add2(w1)):T2:=Etsim(add1(w2)): for i1 from 1 to nops(T1) do for j1 from 1 to nops(T2) do gu:=gu union {[T1[i1],T2[j1]]}: od: od: T1:=Etsim(add1(w1)):T2:=Etsim(add2(w2)): for i1 from 1 to nops(T1) do for j1 from 1 to nops(T2) do gu:=gu union {[T1[i1],T2[j1]]}: od: od: od: gu: end: #AllDerTrees1(n): all derivation trees first way AllDerTrees1:=proc(n) local mu,gu,i,j,mu1,lu: mu:=BT(n): gu:={}: for i from 1 to nops(mu) do mu1:=mu[i]: lu:=Milim(mu1): for j from 1 to nops(lu) do gu:=gu union {[mu1,lu[j]]}: od: od: gu: end: #AllDerTrees2(n): all derivation trees second way AllDerTrees2:=proc(n) local mu,gu,i,j,mu1,lu: mu:=AllWords(n): gu:={}: for i from 1 to nops(mu) do mu1:=mu[i]: lu:=Etsim(mu1): for j from 1 to nops(lu) do gu:=gu union {[lu[j],mu1]}: od: od: gu: end: Size1:=proc(tree): if tree=[] then 1 else Size1(tree[1])+Size1(tree[2]) fi: end: addk:=proc(pair,k):[pair[1]+k,pair[2]+k]:end: Addk:=proc(Setp,k) local i:{seq(addk(Setp[i],k),i=1..nops(Setp))}:end: #Intervals1(tree): all the Intervals1 of a tree tree Intervals1:=proc(tree) local tree1,tree2,gu1,gu2,k,n: if tree=[] then RETURN({}): fi: n:=Size1(tree): tree1:=tree[1];tree2:=tree[2]; gu1:=Intervals1(tree1): k:=Size1(tree1): gu2:=Intervals1(tree2): gu2:=Addk(gu2,k): {[1,n]} union gu1 union gu2: end: #Intervals(tree): all the proper Intervals1 of a tree tree Intervals:=proc(tree) local n: n:=Size1(tree): Intervals1(tree) minus {[1,n]}: end: #IrredP(n): all the irreducible pairs of trees IrredP:=proc(n) local mu,gu,i,j,mu1,mu2,lu1,lu2: mu:=BT(n): gu:={}: for i from 1 to nops(mu) do mu1:=mu[i]: lu1:=Intervals(mu1): for j from i+1 to nops(mu) do mu2:=mu[j]: lu2:=Intervals(mu2): if lu1 intersect lu2={} then gu:=gu union {{mu1,mu2}}: fi: od: od: gu: end: #MinLou(n)F: the smallest cardinality of words that a pair #of trees can have in common, and a corresponding pair-of-trees #Fast version MinLouF:=proc(n) local gu,aluf,AlufSet,i1,ka,shi: gu:=IrredP(n): if n=1 then RETURN(1) fi: if n=2 then RETURN(2) fi: aluf:=gu[1]: AlufSet:={aluf}: ka:=nops(Milim(gu[1][1]) intersect Milim(gu[1][2])): shi:=ka: for i1 from 2 to nops(gu) do ka:=nops(Milim(gu[i1][1]) intersect Milim(gu[i1][2])): if kan then ERROR(`the third output must be between 1 and the size of the first tree`): fi: if T1=[] then RETURN(T2): fi: T1L:=T1[1]:T1R:=T1[2]: n1:=Size1(T1L): if r<=n1 then S1L:=Graft(T1L,T2,r): RETURN([S1L,T1R]): else S1R:=Graft(T1R,T2,r-n1): RETURN([T1L,S1R]): fi: end: #GraftP(Pair1,Pair2,r): Grafts the pair Pair2 into the Pair1 GraftP:=proc(Pair1,Pair2,r) [Graft(Pair1[1],Pair2[1],r),Graft(Pair1[2],Pair2[2],r)]: end: #BTP(n): All the pairs of trees with n leaves BTP:=proc(n) local gu,mu,i,j: mu:=BT(n): gu:={}: for i from 1 to nops(mu) do for j from i+1 to nops(mu) do gu:=gu union {{mu[i],mu[j]}}: od: od: gu: end: #BTP(n): All the pairs of trees with n leaves BTPOld:=proc(n) local gu,mu,i,j: mu:=BT(n): gu:={}: for i from 1 to nops(mu) do for j from 1 to nops(mu) do gu:=gu union {[mu[i],mu[j]]}: od: od: gu: end: #GraftedPairs(n): All the pairs of trees obtained #by grafting smaller pairs GraftedPairs:=proc(n) local gu,mu1,mu2,r,i,j,r1: gu:={}: for r from 2 to n-1 do mu1:=BTP(r): mu2:=BTP(n+1-r): for i from 1 to nops(mu1) do for j from 1 to nops(mu2) do for r1 from 1 to r do gu:=gu union {GraftP(mu1[i],mu2[j],r1)}: od: od: od: od: gu: end: #IrredP1(n): all the irreducible pairs of trees (by lists) IrredP1:=proc(n) local mu,gu,i,j,mu1,mu2,lu1,lu2: mu:=BT(n): gu:={}: for i from 1 to nops(mu) do mu1:=mu[i]: lu1:=Intervals(mu1): for j from 1 to nops(mu) do mu2:=mu[j]: lu2:=Intervals(mu2): if lu1 intersect lu2={} then gu:=gu union {[mu1,mu2]}: fi: od: od: gu: end: #Find2Conj(T): Given a complete binary tree, T, #finds all words in Milim(T) of the form 2w such that #w2 is also there Find2Conj:=proc(T) local i1,lu,mila,gu,mila1: lu:=Milim(T): gu:={}: for i1 from 1 to nops(lu) do mila:=lu[i1]: if mila[1]=2 then mila1:=[op(2..nops(mila),mila),2]: if member(mila1,lu) then gu:=gu union {mila}: fi: fi: od: gu: end: #Check2Conj(n): checks the 2-conj for trees with n leaves Check2Conj:=proc(n) local gu,i1: gu:=BT(n): for i1 from 1 to nops(gu) do if Find2Conj(gu[i1])={} then RETURN(gu[i1]): fi: od: true: end: #Height(T): The height of a binary tree T Height:=proc(T): if T=[] then RETURN(0): else 1+max(Height(T[1]),Height(T[2])): fi: end: #DrawT1(T,Leav): Draws the (complete) binary tree T #with prescribed places for the leaves #For example, try: DrawT1([[],[]],[[-1,0],[1,0]]); DrawT1:=proc(T,Leav) local gu,gu1,gu2,T1,T2,Root1L,Root1R,Leav1,Leav2,Root1: if T=[] then gu:=plot([Leav[1]],style=point,axes=none,scaling=unconstrained): RETURN(gu): fi: T1:=T[1]: T2:=T[2]: Leav1:=[op(1..Size1(T1),Leav)]: Leav2:=[op(Size1(T1)+1..Size1(T),Leav)]: gu1:=DrawT1(T1,Leav1): gu2:=DrawT1(T2,Leav2): Root1L:=Shoresh(T1,Leav1): Root1R:=Shoresh(T2,Leav2): Root1:=Shoresh(T,Leav): gu:= plot([Root1,Root1L],thickness=3,axes=none),plot([Root1,Root1R],thickness=3), gu1,gu2: end: DrawT:=proc(T) local i: display(DrawT1(T,[seq([i,0],i=1..Size1(T))])):end: #Shoresh(T,Leav): the root of the tree with Leaves at Leav Shoresh:=proc(T,Leav) local root1,root2,T1,T2,Leav1,Leav2: if Size1(T)<>nops(Leav) then ERROR(`Bad output`): fi: if T=[] then RETURN(Leav[1]): fi: T1:=T[1]: T2:=T[2]: Leav1:=[op(1..Size1(T1),Leav)]: Leav2:=[op(Size1(T1)+1..Size1(T),Leav)]: root1:=Shoresh(T1,Leav1): root2:=Shoresh(T2,Leav2): [(root1[1]+root2[1])/2,max(root1[2],root2[2])+1]: end: #ShoreshU(T,Leav): the root of the tree with Leaves at Leav ShoreshU:=proc(T,Leav) local root1,root2,T1,T2,Leav1,Leav2: if Size1(T)<>nops(Leav) then ERROR(`Bad output`): fi: if T=[] then RETURN(Leav[1]): fi: T1:=T[1]: T2:=T[2]: Leav1:=[op(1..Size1(T1),Leav)]: Leav2:=[op(Size1(T1)+1..Size1(T),Leav)]: root1:=ShoreshU(T1,Leav1): root2:=ShoreshU(T2,Leav2): [(root1[1]+root2[1])/2,min(root1[2],root2[2])-1]: end: #DrawTup1(T,Leav): Draws the (complete) binary tree T #with prescribed places for the leaves #For example, try: DrawTup1([[],[]],[[-1,0],[1,0]]); but going up DrawTup1:=proc(T,Leav) local gu,gu1,gu2,T1,T2,Root1L,Root1R,Leav1,Leav2,Root1: if T=[] then gu:=plot([Leav[1]],style=point,axes=none,scaling=unconstrained): RETURN(gu): fi: T1:=T[1]: T2:=T[2]: Leav1:=[op(1..Size1(T1),Leav)]: Leav2:=[op(Size1(T1)+1..Size1(T),Leav)]: gu1:=DrawTup1(T1,Leav1): gu2:=DrawTup1(T2,Leav2): Root1L:=ShoreshU(T1,Leav1): Root1R:=ShoreshU(T2,Leav2): Root1:=ShoreshU(T,Leav): gu:= plot([Root1,Root1L],thickness=3,axes=none),plot([Root1,Root1R],thickness=3), gu1,gu2: end: DrawTup:=proc(T) local i: display(DrawTup1(T,[seq([i,0],i=1..Size1(T))])):end: DrawPair:=proc(Zug) local T1,T2,i: T1:=Zug[1]: T2:=Zug[2]: display(DrawTup1(T1,[seq([i,0],i=1..Size1(T1))]), DrawT1(T2,[seq([i,1],i=1..Size1(T2))])): end: #DrawTw1(T,w,Leav,X,Y,Z,E): Draws the (complete) binary tree T #with prescribed places for the leaves #For example, try: DrawT1([[],[]],[[-1,0],[1,0]],X,Y,Z); DrawTw1:=proc(T,w,Leav,X,Y,Z) local gu,gu1,gu2,T1,T2,Root1L,Root1R,Leav1,Leav2,Root1,w1,w2: if T=[] then gu:=textplot([op(Leav[1]),convert(w[1],string)], style=point,axes=none,scaling=unconstrained): RETURN(gu): fi: T1:=T[1]: T2:=T[2]: Leav1:=[op(1..Size1(T1),Leav)]: Leav2:=[op(Size1(T1)+1..Size1(T),Leav)]: w1:=[op(1..Size1(T1),w)]: w2:=[op(Size1(T1)+1..Size1(T),w)]: gu1:=DrawTw1(T1,w1,Leav1,X,Y,Z,E): gu2:=DrawTw1(T2,w2,Leav2,X,Y,Z,E): Root1L:=Shoresh(T1,Leav1): Root1R:=Shoresh(T2,Leav2): Root1:=Shoresh(T,Leav): gu:= plot([Root1,Root1L],thickness=3,axes=none), plot([Root1,Root1R],thickness=3), gu1,gu2,textplot([Root1[1],Root1[2], convert(Label1(T,w,X,Y,Z,E),string)]): end: DrawTw:=proc(T,w,X,Y,Z,E) local i: display(DrawTw1(T,w,[seq([i,0],i=1..Size1(T))],X,Y,Z,E)):end: #Label1(T,Leav,X,Y,Z,E): the label of the root of the tree with #leaves labelled by Leav Label1:=proc(T,Leav,X,Y,Z,E) local root1,root2,T1,T2,Leav1,Leav2,gu: if Size1(T)<>nops(Leav) then ERROR(`Bad output`): fi: if T=[] then RETURN(Leav[1]): fi: T1:=T[1]: T2:=T[2]: Leav1:=[op(1..Size1(T1),Leav)]: Leav2:=[op(Size1(T1)+1..Size1(T),Leav)]: root1:=Label1(T1,Leav1,X,Y,Z,E): root2:=Label1(T2,Leav2,X,Y,Z,E): gu:={X,Y,Z} minus {root1,root2}: if nops(gu)<>1 then E: else gu[1]: fi: end: #DrawTwUp1(T,w,Leav,X,Y,Z,E): Draws the (complete) binary tree T #with prescribed places for the leaves #For example, try: DrawT1([[],[]],[[-1,0],[1,0]],X,Y,Z); DrawTwUp1:=proc(T,w,Leav,X,Y,Z) local gu,gu1,gu2,T1,T2,Root1L,Root1R,Leav1,Leav2,Root1,w1,w2: if T=[] then gu:=textplot([op(Leav[1]), convert(w[1],string)],style=point,axes=none,scaling=unconstrained): RETURN(gu): fi: T1:=T[1]: T2:=T[2]: Leav1:=[op(1..Size1(T1),Leav)]: Leav2:=[op(Size1(T1)+1..Size1(T),Leav)]: w1:=[op(1..Size1(T1),w)]: w2:=[op(Size1(T1)+1..Size1(T),w)]: gu1:=DrawTwUp1(T1,w1,Leav1,X,Y,Z,E): gu2:=DrawTwUp1(T2,w2,Leav2,X,Y,Z,E): Root1L:=ShoreshU(T1,Leav1): Root1R:=ShoreshU(T2,Leav2): Root1:=ShoreshU(T,Leav): gu:= plot([Root1,Root1L],thickness=3,axes=none), plot([Root1,Root1R],thickness=3), gu1,gu2,textplot([Root1[1],Root1[2],Label1(T,w,X,Y,Z,E)]): end: DrawTwUp:=proc(T,w,X,Y,Z,E) local i: display(DrawTwUp1(T,w,[seq([i,0],i=1..Size1(T))],X,Y,Z,E)):end: DrawPairw:=proc(Zug,w,X,Y,Z,E) local T1,T2,i: T1:=Zug[1]: T2:=Zug[2]: display(DrawTwUp1(T1,w,[seq([i,0],i=1..Size1(T1))],X,Y,Z,E), DrawTw1(T2,w,[seq([i,.5],i=1..Size1(T2))],X,Y,Z,E)): end: Targem:=proc(w,X,Y,Z) local gu,i: gu:=[]: for i from 1 to nops(w) do if w[i]=0 then gu:=[op(gu),X]: elif w[i]=1 then gu:=[op(gu),Y]: elif w[i]=2 then gu:=[op(gu),Z]: fi: od: gu: end: DrawMinLou:=proc(n,X,Y,Z,E) local gu,i,j,T,mu: gu:=MinLou(n)[2]: for i from 1 to nops(gu) do T:=gu[i]: mu:=Milim(T[1]) intersect Milim(T[2]): display(DrawPairw(T,Targem(mu[1],X,Y,Z),X,Y,Z,E)): od: end: MinLouw:=proc(n) local gu,mu,ku,i: mu:=MinLou(n)[2]: gu:={}: for i from 1 to nops(mu) do ku:=Milim(mu[i][1]) intersect Milim(mu[i][2]): gu:=gu union {[mu[i],ku[1]]}: od: gu: end: RightRec:=proc(): end: #PairsFromWords(n): all pairs of words that come from good words #of length n PairsFromWords:=proc(n) local gu,mu,i,i1,i2,lu: mu:=AllWords(n): gu:={}: for i from 1 to nops(mu) do lu:=Etsim(mu[i]): for i1 from 1 to nops(lu) do for i2 from i1+1 to nops(lu) do gu:=gu union {{lu[i1],lu[i2]}}: od: od: od: gu: end: #MilimI(n,i): all the words of length n that produce exactly i trees MilimI:=proc(n,i) local gu,i1,lu: gu:=AllWords(n): lu:={}: for i1 from 1 to nops(gu) do if nops(Etsim(gu[i1]))=i then lu:=lu union {gu[i1]}: fi: od: Shrink(lu): end: Sw:=proc(w) local X,Y,Z,w1: w1:=Targem(w,X,Y,Z): w1:=subs({X=0,Y=2,Z=1},w1): end: Shrink:=proc(SetW) local gu,u,v,u1,v1,i1,mu: gu:=SetW: mu:={}: while gu<>{} do u:=gu[1]: v:=Sw(u): u1:=[seq(u[nops(u)-i1+1],i1=1..nops(u))]: v1:=[seq(v[nops(v)-i1+1],i1=1..nops(v))]: gu:=gu minus {u,v,u1,v1}: mu:=mu union {u}: od: mu: end: #LeafCliques1(T): All the consective leaf-cliques LeafCliques1:=proc(T) local gu,mu,n,n1,i: n:=Size1(T): if T=[] then RETURN({}): fi: gu:={[1,n]}: gu:=gu union LeafCliques1(T[1]): n1:=Size1(T[1]): mu:=LeafCliques1(T[2]): mu:={seq([mu[i][1]+n1,mu[i][2]+n1],i=1..nops(mu))}: gu union mu: end: #LeafCliques(T): All proper consective leaf-cliques LeafCliques:=proc(T): if not type(T,list) then RETURN(FAIL): fi: LeafCliques1(T) minus {[1,Size1(T)]}: end: #IsIrredP(Pair): Is the pair Pair=[T1,T2] irreducible? IsIrredP:=proc(T): evalb(LeafCliques(T[1]) intersect LeafCliques(T[2])={}): end: #LefComb(n): The left-comb with n leaves LefComb:=proc(n) option remember: if n<=0 then RETURN(FAIL): fi: if n=1 then []: else [LefComb(n-1),[]]: fi: end: #RigComb(n): The right-comb with n leaves RigComb:=proc(n) option remember: if n<=0 then RETURN(FAIL): fi: if n=1 then []: else [[],RigComb(n-1)]: fi: end: #Canon1(SetW): Given a set of words only retains those #that start with a 1 Canon1:=proc(SetW) local gu,i,w,j: gu:={}: for i from 1 to nops(SetW) do w:=SetW[i]: for j from 1 to nops(w) while w[j]=0 do od: if w[j]=1 then gu:=gu union {w}: fi: od: gu: end: ######### begin LL #Zug1LL(T1,T2,i1,i2,n): The pair of trees obtained #by grafting a left Combs with n leaves on the i1-th #leaf of T1 and i2-th leaf of T2 Zug1LL:=proc(T1,T2,i1,i2,n) local gu,S1,S2: gu:=LefComb(n): S1:=Graft(T1,gu,i1): S2:=Graft(T2,gu,i2): if not IsIrredP([S1,S2]) then RETURN(FAIL): fi: [S1,S2]: end: #Tik1LLe(T1,T2,i1,i2,N): Finds whether there is hope for #the infinite family obtained by attaching even left-combs #to the i1^th leaf of T1 and i2^th leaf of T2 up to N #If succesful, returms the sequence of good common words #For example, try Tik1LLe([[[],[]],[]],[[],[[[],[]]],2,3,6); Tik1LLe:=proc(T1,T2,i1,i2,N) local gu,n,lu,i: gu:=[]: for n from 2 by 2 to N do lu:=Zug1LL(T1,T2,i1,i2,n): if lu=FAIL then RETURN(FAIL): else gu:=[op(gu), Canon1(Milim(lu[1]) intersect Milim(lu[2]))]: fi: od: gu: if {seq(nops(gu[i]),i=1..nops(gu))}={1} then gu:=ListToRE([seq(gu[i][1],i=1..nops(gu))]): fi: gu: end: #Tik1LLo(T1,T2,i1,i2,N): Finds whether there is hope for #the infinite family obtained by attaching odd left-combs #to the i1^th leaf of T1 and i2^th leaf of T2 up to N #If succesful, returms the sequence of good common words #For example, try Tik1LLe([[[],[]],[]],[[],[[[],[]]],2,3,6); Tik1LLo:=proc(T1,T2,i1,i2,N) local gu,n,lu,i: gu:=[]: for n from 3 by 2 to N do lu:=Zug1LL(T1,T2,i1,i2,n): if lu=FAIL then RETURN(FAIL): else gu:=[op(gu), Canon1(Milim(lu[1]) intersect Milim(lu[2]))]: fi: od: gu: if {seq(nops(gu[i]),i=1..nops(gu))}={1} then gu:=[seq(gu[i][1],i=1..nops(gu))]: gu:=ListToRE(gu): fi: gu: end: ############## End LL####### ######### begin LR #Zug1LR(T1,T2,i1,i2,n): The pair of trees obtained #by grafting a left Combs with n leaves on the i1-th #leaf of T1 and i2-th leaf of T2 Zug1LR:=proc(T1,T2,i1,i2,n) local S1,S2,gu1,gu2: gu1:=LefComb(n): gu2:=RigComb(n): S1:=Graft(T1,gu1,i1): S2:=Graft(T2,gu2,i2): if not IsIrredP([S1,S2]) then RETURN(FAIL): fi: [S1,S2]: end: #Tik1LRe(T1,T2,i1,i2,N): Finds whether there is hope for #the infinite family obtained by attaching even left-combs #to the i1^th leaf of T1 and i2^th leaf of T2 up to N #If succesful, returms the sequence of good common words #For example, try Tik1LRe([[[],[]],[]],[[],[[[],[]]],2,3,6); Tik1LRe:=proc(T1,T2,i1,i2,N) local gu,n,lu,i: gu:=[]: for n from 2 by 2 to N do lu:=Zug1LR(T1,T2,i1,i2,n): if lu=FAIL then RETURN(FAIL): else gu:=[op(gu), Canon1(Milim(lu[1]) intersect Milim(lu[2]))]: fi: od: gu: if {seq(nops(gu[i]),i=1..nops(gu))}={1} then gu:=[seq(gu[i][1],i=1..nops(gu))]: gu:=ListToRE(gu): fi: gu: end: #Tik1LRo(T1,T2,i1,i2,N): Finds whether there is hope for #the infinite family obtained by attaching odd left-combs #to the i1^th leaf of T1 and i2^th leaf of T2 up to N #If succesful, returms the sequence of good common words #For example, try Tik1LRe([[[],[]],[]],[[],[[[],[]]],2,3,6); Tik1LRo:=proc(T1,T2,i1,i2,N) local gu,n,lu,i: gu:=[]: for n from 3 by 2 to N do lu:=Zug1LR(T1,T2,i1,i2,n): if lu=FAIL then RETURN(FAIL): else gu:=[op(gu), Canon1(Milim(lu[1]) intersect Milim(lu[2]))]: fi: od: gu: if {seq(nops(gu[i]),i=1..nops(gu))}={1} then gu:=[seq(gu[i][1],i=1..nops(gu))]: gu:=ListToRE(gu): fi: gu: end: ############## End LR####### ######### begin RL #Zug1RL(T1,T2,i1,i2,n): The pair of trees obtained #by grafting a left Combs with n leaves on the i1-th #leaf of T1 and i2-th leaf of T2 Zug1RL:=proc(T1,T2,i1,i2,n) local S1,S2,gu1,gu2: gu1:=RigComb(n): gu2:=LefComb(n): S1:=Graft(T1,gu1,i1): S2:=Graft(T2,gu2,i2): if not IsIrredP([S1,S2]) then RETURN(FAIL): fi: [S1,S2]: end: #Tik1RLe(T1,T2,i1,i2,N): Finds whether there is hope for #the infinite family obtained by attaching even left-combs #to the i1^th leaf of T1 and i2^th leaf of T2 up to N #If succesful, returms the sequence of good common words #For example, try Tik1RLe([[[],[]],[]],[[],[[[],[]]],2,3,6); Tik1RLe:=proc(T1,T2,i1,i2,N) local gu,n,lu,i: gu:=[]: for n from 2 by 2 to N do lu:=Zug1RL(T1,T2,i1,i2,n): if lu=FAIL then RETURN(FAIL): else gu:=[op(gu), Canon1(Milim(lu[1]) intersect Milim(lu[2]))]: fi: od: gu: if {seq(nops(gu[i]),i=1..nops(gu))}={1} then gu:=[seq(gu[i][1],i=1..nops(gu))]: gu:=ListToRE(gu): fi: gu: end: #Tik1RLo(T1,T2,i1,i2,N): Finds whether there is hope for #the infinite family obtained by attaching odd left-combs #to the i1^th leaf of T1 and i2^th leaf of T2 up to N #If succesful, returms the sequence of good common words #For example, try Tik1RLe([[[],[]],[]],[[],[[[],[]]],2,3,6); Tik1RLo:=proc(T1,T2,i1,i2,N) local gu,n,lu,i: gu:=[]: for n from 3 by 2 to N do lu:=Zug1RL(T1,T2,i1,i2,n): if lu=FAIL then RETURN(FAIL): else gu:=[op(gu), Canon1(Milim(lu[1]) intersect Milim(lu[2]))]: fi: od: gu: if {seq(nops(gu[i]),i=1..nops(gu))}={1} then gu:=[seq(gu[i][1],i=1..nops(gu))]: gu:=ListToRE(gu): fi: gu: end: ############## End RL ####### ######### begin RR #Zug1RR(T1,T2,i1,i2,n): The pair of trees obtained #by grafting a left Combs with n leaves on the i1-th #leaf of T1 and i2-th leaf of T2 Zug1RR:=proc(T1,T2,i1,i2,n) local S1,S2,gu1,gu2: gu1:=RigComb(n): gu2:=RigComb(n): S1:=Graft(T1,gu1,i1): S2:=Graft(T2,gu2,i2): if not IsIrredP([S1,S2]) then RETURN(FAIL): fi: [S1,S2]: end: #Tik1RRe(T1,T2,i1,i2,N): Finds whether there is hope for #the infinite family obtained by attaching even left-combs #to the i1^th leaf of T1 and i2^th leaf of T2 up to N #If succesful, returms the sequence of good common words #For example, try Tik1RRe([[[],[]],[]],[[],[[[],[]]],2,3,6); Tik1RRe:=proc(T1,T2,i1,i2,N) local gu,n,lu,i: gu:=[]: for n from 2 by 2 to N do lu:=Zug1RR(T1,T2,i1,i2,n): if lu=FAIL then RETURN(FAIL): else gu:=[op(gu), Canon1(Milim(lu[1]) intersect Milim(lu[2]))]: fi: od: gu: if {seq(nops(gu[i]),i=1..nops(gu))}={1} then gu:=[seq(gu[i][1],i=1..nops(gu))]: gu:=ListToRE(gu): fi: gu: end: #Tik1RRo(T1,T2,i1,i2,N): Finds whether there is hope for #the infinite family obtained by attaching odd left-combs #to the i1^th leaf of T1 and i2^th leaf of T2 up to N #If succesful, returms the sequence of good common words #For example, try Tik1RRe([[[],[]],[]],[[],[[[],[]]],2,3,6); Tik1RRo:=proc(T1,T2,i1,i2,N) local gu,n,lu,i: gu:=[]: for n from 3 by 2 to N do lu:=Zug1RR(T1,T2,i1,i2,n): if lu=FAIL then RETURN(FAIL): else gu:=[op(gu), Canon1(Milim(lu[1]) intersect Milim(lu[2]))]: fi: od: gu: if {seq(nops(gu[i]),i=1..nops(gu))}={1} then gu:=[seq(gu[i][1],i=1..nops(gu))]: gu:=ListToRE(gu): fi: gu: end: ############## End RL ####### #Tik1(T1,T2,i1,i2,N): Finds out, which if, any of the #eight possibilities of implanting even(0) or odd(1) #(left(-1) or right(1)) #combs on T1, T2, at the i1-th and i2-th leaves resp. #gives good pairs #For example, try Tik1([[[],[]],[]],[[],[[[],[]]]); Tik1:=proc(T1,T2,i1,i2,N) local gu,lu: gu:={}: lu:=Tik1LLe(T1,T2,i1,i2,N): if lu<>FAIL then gu:=gu union {[T1,T2,i1,i2,0,-1,-1,lu]}: fi: lu:=Tik1LLo(T1,T2,i1,i2,N): if lu<>FAIL then gu:=gu union {[T1,T2,i1,i2,1,-1,-1,lu]}: fi: lu:=Tik1LRe(T1,T2,i1,i2,N): if lu<>FAIL then gu:=gu union {[T1,T2,i1,i2,0,-1,1,lu]}: fi: lu:=Tik1LRo(T1,T2,i1,i2,N): if lu<>FAIL then gu:=gu union {[T1,T2,i1,i2,1,-1,1,lu]}: fi: lu:=Tik1RLe(T1,T2,i1,i2,N): if lu<>FAIL then gu:=gu union {[T1,T2,i1,i2,0,1,-1,lu]}: fi: lu:=Tik1RLo(T1,T2,i1,i2,N): if lu<>FAIL then gu:=gu union {[T1,T2,i1,i2,1,1,-1,lu]}: fi: lu:=Tik1RRe(T1,T2,i1,i2,N): if lu<>FAIL then gu:=gu union {[T1,T2,i1,i2,0,1,1,lu]}: fi: lu:=Tik1RRo(T1,T2,i1,i2,N): if lu<>FAIL then gu:=gu union {[T1,T2,i1,i2,1,1,1,lu]}: fi: gu: end: #Tovim(n,N): all hopeful grafting of combs (up to N leaves) #on pairs of trees #with n leaves Tovim:=proc(n,N) local gu,mu,i,i1,i2: gu:={}: mu:=BT(n): for i from 1 to nops(mu) do for i1 from 1 to N do for i2 from i1+1 to n do gu:=gu union Tik1(mu[i],mu[i],i1,i2,N): od: od: od: mu:=BTP(n): for i from 1 to nops(mu) do for i1 from 1 to N do for i2 from i1+1 to n do gu:=gu union Tik1(op(mu[i]),i1,i2,N): od: od: for i1 from 1 to N do for i2 from i1+1 to n do gu:=gu union Tik1(op(mu[i]),i2,i1,N): od: od: od: gu: end: #GCP(w1,w2): The greatest common prefix of word w1 and word w2 GCP:=proc(w1,w2) local i: for i from 1 to min(nops(w1),nops(w2)) while w1[i]=w2[i] do od: [op(1..i-1,w1)]: end: #GCS(w1,w2): The greatest common suffix of word w1 and word w2 GCS:=proc(w1,w2) local i: for i from 1 to min(nops(w1),nops(w2)) while w1[nops(w1)-i+1]=w2[nops(w2)-i+1] do od: [op(nops(w1)-i+2..nops(w1),w1)]: end: #WordLog(w1,w2): the k such that w2=w1^k or FAIL WordLog:=proc(w1,w2) local k,i: k:=nops(w2)/nops(w1): if not type(k,integer) then RETURN(FAIL): fi: if not w2=[seq(op(w1),i=1..k)] then RETURN(FAIL) else RETURN(k): fi: end: #ListToRE(Resh): Given a list of words, converts it to a regular #expression in the form [Prefix, [Period]*, Suffix], #without the *. For example try: #ListToReOld([[1,2,3],[1,2,2,2,3],[1,2,2,2,2,2,3]]); ListToREOld:=proc(Resh) local lu1,lu2,i,Resh1,Resh2,mu: if nops(Resh)<2 then RETURN(Resh): fi: lu1:=Resh[1]: for i from 2 to nops(Resh) do lu1:=GCP(lu1,Resh[i]): od: Resh1:=[seq([op(nops(lu1)+1..nops(Resh[i]),Resh[i])],i=1..nops(Resh))]: lu2:=Resh1[1]: for i from 2 to nops(Resh1) do lu2:=GCS(lu2,Resh1[i]): od: Resh2:=[seq([op(1..nops(Resh1[i])-nops(lu2),Resh1[i])],i=1..nops(Resh1))]: if not (nops(Resh2)>=3 and Resh2[1]=[]) then RETURN(FAIL): fi: mu:=Resh2[2]: for i from 3 to nops(mu) do if WordLog(mu,Resh2[i])<>i-1 then RETURN(FAIL): fi: od: [lu1,mu,lu2]: end: #Nape(GU): weeding-out duplication Nape:=proc(GU) local gu,mu,i: mu:={}: gu:={}: for i from 1 to nops(GU) do if not member(GU[i][8],mu) then mu:=mu union {GU[i][8]}: gu:=gu union {GU[i]}: fi: od: gu: end: #RL(n): the pair (LeftComb(n),RightComb(n)) and their common words RL:=proc(n) local T1,T2: T1:=LefComb(n): T2:=RigComb(n): [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: Canon:=proc(Setw) local i,gu,j,w1: gu:={}: for i from 1 to nops(Setw) do w1:=Setw[i]: for j from 1 to nops(w1) while w1[j]=0 do od: if w1[j]=1 then gu:=gu union {w1}: fi: od: gu: end: #RRLL00(a,b): The pair consisting of [RigComb(2a),RigComb(2b)] #and [LefComb(2a-1),LefComb(2b+1)], with a,b>=1 RRLL00:=proc(a,b) local T1,T2: T1:=[RigComb(2*a),RigComb(2*b)]: T2:=[LefComb(2*a-1),LefComb(2*b+1)]: if not IsIrredP([T1,T2]) then print(`Not irreducible pair`): RETURN(FAIL): fi: [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: #RRLL01(a,b): The pair consisting of [RigComb(2a),RigComb(2b+1)] #and [LefComb(2a-1),LefComb(2b+2)], with a,b>=1 RRLL01:=proc(a,b) local T1,T2: T1:=[RigComb(2*a),RigComb(2*b+1)]: T2:=[LefComb(2*a-1),LefComb(2*b+2)]: if not IsIrredP([T1,T2]) then print(`Not irreducible pair`): RETURN(FAIL): fi: [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: #RRLL10(a,b): The pair consisting of [RigComb(2a+1),RigComb(2b)] #and [LefComb(2a),LefComb(2b+1)], with a,b>=1 RRLL10:=proc(a,b) local T1,T2: if b<=1 then ERROR(`Bad input`): fi: T1:=[RigComb(2*a+1),RigComb(2*b)]: T2:=[LefComb(2*a),LefComb(2*b+1)]: if not IsIrredP([T1,T2]) then print(`Not irreducible pair`): RETURN(FAIL): fi: [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: #RRLL11(a,b): The pair consisting of [RigComb(2a+1),RigComb(2b+1)] #and [LefComb(2a),LefComb(2b+2)], with a,b>=1 RRLL11:=proc(a,b) local T1,T2: T1:=[RigComb(2*a+1),RigComb(2*b+1)]: T2:=[LefComb(2*a),LefComb(2*b+2)]: if not IsIrredP([T1,T2]) then print(`Not irreducible pair`): RETURN(FAIL): fi: [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: #ttg(T,a,A): converts a complete binary tree to a graph #with vertices labelled by the leaves (numbered from left to right #starting with a) #together with the internal vertices labelled by [i,j] ttg:=proc(T,a,A) local n,T1,T2,G1,G2,lu,lu1,lu2: n:=Size1(T): if n=1 then RETURN([{[a,a]},{}]): fi: T1:=T[1]: T2:=T[2]: G1:=ttg(T1,a,A): G2:=ttg(T2,a+Size1(T1),A): if Size1(T1)=1 then lu1:=[a,a+Size1(T1)-1]: else lu1:=A[a,a+Size1(T1)-1]: fi: if Size1(T2)=1 then lu2:=[a+Size1(T1),a+Size1(T)-1]: else lu2:=A[a+Size1(T1),a+Size1(T)-1]: fi: lu:=A[a,a+Size1(T)-1]: [G1[1] union G2[1] union {lu},G1[2] union G2[2] union {{lu,lu1},{lu,lu2},{lu1,lu2}}]: end: #RRLL11b(a,b): The pair consisting of [RigComb(2a+1),RigComb(2b+1)] #and [LefComb(2a),LefComb(2b+2)], with a,b>=1 RRLL11b:=proc(a,b) local T1,T2: T1:=[RigComb(2*a+1),RigComb(2*b+1)]: T2:=[LefComb(2*a),LefComb(2*b+2)]: if not IsIrredP([T1,T2]) then print(`Not irreducible pair`): RETURN(FAIL): fi: [T1,T2]: end: #LL1(a,b): the pair ([[],LefComb(a+b-1)], and [LefComb(a),LefComb(b)]: LL1:=proc(a,b) local T1,T2: T1:=[[],LefComb(a+b-1)]: T2:=[LefComb(a),LefComb(b)]: [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: #RRLL(a,b): The pair consisting of [RigComb(a),RigComb(b)] #and [LefComb(a-1),LefComb(b+1)], with a>=2, b>=1 RRLL:=proc(a,b) local T1,T2: if a<2 then ERROR(`Bad input`): fi: T1:=[RigComb(a),RigComb(b)]: T2:=[LefComb(a-1),LefComb(b+1)]: if not IsIrredP([T1,T2]) then print(`Not irreducible pair`): RETURN(FAIL): fi: [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: #Katser1(Resh): shrinks a regular expression of the form (a^b)^c #to a^(b*c) Katser1:=proc(Resh) local akha,n,Resh1: n:=nops(Resh): akha:=Resh[n]: if type(akha, integer) then RETURN(Resh): fi: Resh1:=[op(1..n-1,Resh)]: if nops({op(Resh1)})<>1 then RETURN(Resh): fi: [Resh1[1],nops(Resh1)*akha] end: Katser2a:=proc(Resh) local Resh1,Resh2: if Resh[1]<>[] and type(Resh[1][nops(Resh[1])],integer) and not type(Resh[2][nops(Resh[2])],integer) and nops(Resh[2])=2 then Resh1:=Resh[1]: Resh2:=Resh[2]: while Resh1<>[] and Resh1[nops(Resh1)]=Resh2[1] do Resh1:=[op(1..nops(Resh1)-1,Resh1)]: Resh2:=[Resh2[1],Resh2[2]+1]: od: RETURN([Resh1,Resh2,Resh[3]]): fi: Resh: end: Katser2b:=proc(Resh) local Resh3,Resh2: if Resh[3]<>[] and type(Resh[3][nops(Resh[3])],integer) and not type(Resh[2][nops(Resh[2])],integer) and nops(Resh[2])=2 then Resh3:=Resh[3]: Resh2:=Resh[2]: while Resh3<>[] and Resh3[1]=Resh2[1] do Resh3:=[op(2..nops(Resh3),Resh3)]: Resh2:=[Resh2[1],Resh2[2]+1]: od: RETURN([Resh[1],Resh2,Resh3]): fi: Resh: end: #ListToRE(Resh,b): Given a list of words, and s symbol b #converts it to a regular #expression in the form [Prefix, [Period,b], Suffix], #such that it equals Resh[b] #where [Period,b] means Period repeated b times #ListToRe([[1,2,3],[1,2,2,2,3],[1,2,2,2,2,2,3]],b); ListToRE:=proc(Resh,b) local lu1,lu2,i,Resh1,Resh2,mu,b1,j1,try1: if nops(Resh)<2 then RETURN(Resh): fi: lu1:=Resh[1]: for i from 2 to nops(Resh) do lu1:=GCP(lu1,Resh[i]): od: Resh1:=[seq([op(nops(lu1)+1..nops(Resh[i]),Resh[i])],i=1..nops(Resh))]: lu2:=Resh1[1]: for i from 2 to nops(Resh1) do lu2:=GCS(lu2,Resh1[i]): od: Resh2:=[seq([op(1..nops(Resh1[i])-nops(lu2),Resh1[i])],i=1..nops(Resh1))]: if not (nops(Resh2)>=3 and Resh2[1]=[]) then RETURN(FAIL): fi: mu:=Resh2[2]: for i from 3 to nops(mu) do if WordLog(mu,Resh2[i])<>i-1 then RETURN(FAIL): fi: od: for b1 from 1 to nops(Resh) do try1:=[op(lu1),seq(op(mu),j1=1..b1-1),op(lu2)]: if Resh[b1]<>try1 then RETURN(FAIL): fi: od: Katser2b(Katser2a([lu1,Katser1([op(mu),b]),lu2])): end: #RLw(n,p): Given a symbol n and a parity p (0 or 1) #guesses automatically the good work for the pair #[RigComb(2*n+p),LefComb(2*n+p)]. For example, try #RLw(n,0); and : RLw(n,1); RLw:=proc(n,p) local i1,gu: gu:=[seq(RL(2*i1+p)[2][1],i1=1..4)]: subs(n=n-1,ListToRE(gu,n)): end: #ListToRE2(Resh,a,b): Given a list of lists of #Resh, finds a regular expression #[w1,[w2,a],w3,[w4,b],w5] such that #Resh[a][b] equals w1 (w2^a) w3 (w4)^b w5 ListToRE2:=proc(Resh2,a,b) local mu,i,gu: for i from 1 to nops(Resh2) do mu[i]:=ListToRE(Resh2[i],a): od: if nops({seq(mu[i][1],i=1..nops(Resh2))})<>1 and nops({seq(mu[i][2],i=1..nops(Resh2))})<>1 then RETURN(FAIL): fi: gu:=ListToRE([seq(mu[i][3],i=1..nops(Resh2))],b): [mu[1][1],mu[1][2],op(gu)]: end: #LL1w(a,b,p1,p2): The word for ##the pair ([[],LefComb(2*a+p1+2*b+p2-1)], and #[LefComb(2*a+p1),LefComb(2*b+p2)]: #For example, try: LL1w(a,b,0,0); LL1w:=proc(a,b,p1,p2) local a1,b1,gu,mu,gu1,i: for b1 from 1 to 3 do gu[b1]:=ListToRE([seq(LL1(2*a1+p1,2*b1+p2)[2][1],a1=1..3)],a): od: if nops({seq(gu[b1][1],b1=1..3)})<>1 or nops({seq(gu[b1][2],b1=1..3)})<>1 then RETURN(FAIL): fi: mu:=ListToRE([seq(gu[b1][3],b1=1..3)],b): gu:=[gu[1][1],gu[1][2],op(mu)]: gu1:=[]: for i from 1 to nops(gu) do if gu[i]<>[] then gu1:=[op(gu1),gu[i]]: fi: od: subs({a=a-1,b=b-1},gu1): end: #RRLLw(a,b,p1,p2): The formal word for the #pair consisting of [RigComb(a),RigComb(b)] #and [LefComb(a-1),LefComb(b+1)], with a>=2, b>=1 a=2*a+p1, b=2*b+p2 RRLLw:=proc(a,b,p1,p2) local a1,b1,gu,mu,gu1,i: for b1 from 1 to 3 do gu[b1]:=ListToRE([seq(RRLL(2*a1+p1,2*b1+p2)[2][1],a1=1..3)],a): od: if nops({seq(gu[b1][1],b1=1..3)})<>1 or nops({seq(gu[b1][2],b1=1..3)})<>1 then RETURN(FAIL): fi: mu:=ListToRE([seq(gu[b1][3],b1=1..3)],b): gu:=[gu[1][1],gu[1][2],op(mu)]: gu1:=[]: for i from 1 to nops(gu) do if gu[i]<>[] then gu1:=[op(gu1),gu[i]]: fi: od: subs({a=a-1,b=b-1},gu1): end: #LR1(a,b): the pair ([RigComb(a+b-1),[]], and [LefComb(a),RigComb(b)]: LR1:=proc(a,b) local T1,T2: T1:=[RigComb(a+b-1),[]]: T2:=[LefComb(a),RigComb(b)]: [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: #LR1w(a,b,p1,p2): The word for ##the pair ([RigComb(a+b-1),[]], and [LefComb(a),RigComb(b)]: #For example, try: LR1w(a,b,0,0); LR1w:=proc(a,b,p1,p2) local a1,b1,gu,mu,gu1,i: for b1 from 1 to 3 do gu[b1]:=ListToRE([seq(LR1(2*a1+p1,2*b1+p2)[2][1],a1=1..3)],a): od: if nops({seq(gu[b1][1],b1=1..3)})<>1 or nops({seq(gu[b1][2],b1=1..3)})<>1 then RETURN(FAIL): fi: mu:=ListToRE([seq(gu[b1][3],b1=1..3)],b): gu:=[gu[1][1],gu[1][2],op(mu)]: gu1:=[]: for i from 1 to nops(gu) do if gu[i]<>[] then gu1:=[op(gu1),gu[i]]: fi: od: subs({a=a-1,b=b-1},gu1): end: #RRRL(a,b): The pair consisting of [RigComb(a),RigComb(b)] #and [RigComb(a-1),LefComb(b+1)], with a>=2, b>=1 RRRL:=proc(a,b) local T1,T2: if a<2 then print(`Bad input`): RETURN(FAIL): fi: T1:=[RigComb(a),RigComb(b)]: T2:=[RigComb(a-1),LefComb(b+1)]: if not IsIrredP([T1,T2]) then print(`Not irreducible pair`): RETURN(FAIL): fi: [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: #RRRLw(a,b,p1,p2): The formal word for the #pair consisting of [RigComb(a),RigComb(b)] #and [RigComb(a-1),LefComb(b+1)], with a>=2, b>=1 a=2*a+p1, b=2*b+p2 RRRLw:=proc(a,b,p1,p2) local a1,b1,gu,mu,gu1,i: for b1 from 1 to 3 do gu[b1]:=ListToRE([seq(RRRL(2*a1+p1,2*b1+p2)[2][1],a1=1..3)],a): od: if nops({seq(gu[b1][1],b1=1..3)})<>1 or nops({seq(gu[b1][2],b1=1..3)})<>1 then RETURN(FAIL): fi: mu:=ListToRE([seq(gu[b1][3],b1=1..3)],b): gu:=[gu[1][1],gu[1][2],op(mu)]: gu1:=[]: for i from 1 to nops(gu) do if gu[i]<>[] then gu1:=[op(gu1),gu[i]]: fi: od: subs({a=a-1,b=b-1},gu1): end: #RLRL(a,b): The pair consisting of [RigComb(a),LefComb(b)] #and [RigComb(a-1),LefComb(b+1)], with a>=2, b>=1 RLRL:=proc(a,b) local T1,T2: if a<2 then print(`Bad input`): RETURN(FAIL): fi: T1:=[RigComb(a),LefComb(b)]: T2:=[RigComb(a-1),LefComb(b+1)]: if not IsIrredP([T1,T2]) then print(`Not irreducible pair`): RETURN(FAIL): fi: [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: #RLRLw(a,b,p1,p2): The formal word for the #pair consisting of [RigComb(a),LefComb(b)] #and [RigComb(a-1),LefComb(b+1)], with a>=2, b>=1 a=2*a+p1, b=2*b+p2 RLRLw:=proc(a,b,p1,p2) local a1,b1,gu,mu,gu1,i: for b1 from 1 to 3 do gu[b1]:=ListToRE([seq(RLRL(2*a1+p1,2*b1+p2)[2][1],a1=1..3)],a): od: if nops({seq(gu[b1][1],b1=1..3)})<>1 or nops({seq(gu[b1][2],b1=1..3)})<>1 then RETURN(FAIL): fi: mu:=ListToRE([seq(gu[b1][3],b1=1..3)],b): gu:=[gu[1][1],gu[1][2],op(mu)]: gu1:=[]: for i from 1 to nops(gu) do if gu[i]<>[] then gu1:=[op(gu1),gu[i]]: fi: od: subs({a=a-1,b=b-1},gu1): end: #RRR1(a,b): The pair consisting of #RigComb(a+b+1) and [[RigComb(a),RigComb(b)],[]] RRR1:=proc(a,b) local T1,T2: if a<2 then print(`Bad input`): RETURN(FAIL): fi: T1:=RigComb(a+b+1): T2:= [[RigComb(a),RigComb(b)],[]]: if not IsIrredP([T1,T2]) then print(`Not irreducible pair`): RETURN(FAIL): fi: [T1,T2],Canon(Milim(T1) intersect Milim(T2)): end: #RRR1w(a,b,p1,p2): The formal word for the #pair consisting of #RigComb(a+b+1) and [[RigComb(a),RigComb(b)],[]] RRR1w:=proc(a,b,p1,p2) local a1,b1,gu,mu,gu1,i: for b1 from 1 to 3 do gu[b1]:=ListToRE([seq(RRR1(2*a1+p1,2*b1+p2)[2][1],a1=1..3)],a): od: if nops({seq(gu[b1][1],b1=1..3)})<>1 or nops({seq(gu[b1][2],b1=1..3)})<>1 then RETURN(FAIL): fi: mu:=ListToRE([seq(gu[b1][3],b1=1..3)],b): gu:=[gu[1][1],gu[1][2],op(mu)]: gu1:=[]: for i from 1 to nops(gu) do if gu[i]<>[] then gu1:=[op(gu1),gu[i]]: fi: od: subs({a=a-1,b=b-1},gu1): end: MilimP:=proc(Zug): Canon(Milim(Zug[1]) intersect Milim(Zug[2])):end: MilimPv:=proc(Zug):Milim(Zug[1]) intersect Milim(Zug[2]):end: Mir:=proc(T): if T=[] then [] else [Mir(T[2]),Mir(T[1])] fi end: #GPair(P,i,j,a,b,n): Given a pair P, and integers i,j between #1 and the number of leaves and Boolean variables 0(L) and 1(R) #and an integer n, constructs the pair obtained by grafting #LefComb(n) (a,b=0) and/or RigComb(n) (a,b=1) in the i^th and #j^th leaf respectively GPair:=proc(P,i,j,a,b,n) local T1,T2: T1:=P[1]: T2:=P[2]: if a=0 and b=0 then [Graft(T1,LefComb(n),i),Graft(T2,LefComb(n),j)]: elif a=0 and b=1 then [Graft(T1,LefComb(n),i),Graft(T2,RigComb(n),j)]: elif a=1 and b=0 then [Graft(T1,RigComb(n),i),Graft(T2,LefComb(n),j)]: elif a=1 and b=1 then [Graft(T1,RigComb(n),i),Graft(T2,RigComb(n),j)]: else ERROR(`Bad input`): fi: end: #FindOneP(N): Finds all one-parameter pairs of the form #[P,i,j,a,b]: where P is the pair, i,j are the leaves (numbered #form the left) where to stick either LefComb (0) or RigComb(1) #resp. where {a,b} are 0 or 1 #For example, try FindOneP(1); FindOneP:=proc(N) local gu,i1,lu,i,j,a,b,P,n,gu1: gu1:=BT(N): gu1:={seq([gu1[i1],gu1[i1]],i1=1..nops(gu1))}: gu:=BTP(N) union gu1: lu:={}: for i1 from 1 to nops(gu) do P:=gu[i1]: for i from 1 to N do for j from 1 to N do if i<>j then for a from 0 to 1 do for b from 0 to 1 do if IsIrredP(GPair(P,i,j,a,b,6)) then if {seq(IsIrredP(GPair(P,i,j,a,b,n)),n=3..8)}={true} then lu:=lu union {[P,i,j,a,b]}: fi: fi: od:od: fi: od:od: od: lu: end: #DrawT1a(T,Leav): Draws the (complete) binary tree T #with prescribed places for the leaves (except joining the root) #For example, try: DrawT1a([[],[]],[[-1,0],[1,0]]); DrawT1a:=proc(T,Leav) local gu,gu1,gu2,T1,T2,Root1L,Root1R,Leav1,Leav2,Root1: if T=[] then gu:=plot([Leav[1]],style=point,axes=none,scaling=unconstrained): RETURN(gu): fi: T1:=T[1]: T2:=T[2]: Leav1:=[op(1..Size1(T1),Leav)]: Leav2:=[op(Size1(T1)+1..Size1(T),Leav)]: gu1:=DrawT1(T1,Leav1): gu2:=DrawT1(T2,Leav2): Root1L:=Shoresh(T1,Leav1): Root1R:=Shoresh(T2,Leav2): Root1:=Shoresh(T,Leav): gu:= gu1,gu2: end: DrawTa:=proc(T) local i: display(DrawT1a(T,[seq([i,0],i=1..Size1(T))])):end: #FindOnePw(N,c): Finds all one-parameter pairs of the form #[P,i,j,a,b,mu1,mu2]: where P is the pair, i,j are the leaves (numbered #form the left) where to stick either LefComb (0) or RigComb(1) #resp. where {a,b} are 0 or 1, followed by the regular expression #mu1,mu2 for even and odd number of leaves in terms of the symbol c #For example, try FindOnePw(1,c); FindOnePw:=proc(N,c) local gu,i1,luG,luB,i,j,a,b,P,n,gu1,mu1,mu2,i2: gu1:=BT(N): gu1:={seq([gu1[i1],gu1[i1]],i1=1..nops(gu1))}: gu:=BTP(N) union gu1: luG:={}: luB:={}: for i1 from 1 to nops(gu) do P:=gu[i1]: for i from 1 to N do for j from 1 to N do if i<>j then for a from 0 to 1 do for b from 0 to 1 do if IsIrredP(GPair(P,i,j,a,b,6)) then if {seq(IsIrredP(GPair(P,i,j,a,b,n)),n=3..8)}={true} then if nops(MilimP(GPair(P,i,j,a,b,3)))=1 and nops(MilimP(GPair(P,i,j,a,b,4)))=1 then mu1:=ListToRE([seq(MilimP(GPair(P,i,j,a,b,2*i2))[1],i2=2..4)],c): mu2:=ListToRE([seq(MilimP(GPair(P,i,j,a,b,2*i2+1))[1],i2=1..3)],c): if mu1<>FAIL and mu2<>FAIL then luG:=luG union {[P,i,j,a,b,mu1,mu2]}: else luB:=luB union {[P,i,j,a,b]}: fi: else luB:=luB union {[P,i,j,a,b]}: fi: fi: fi: od:od: fi: od:od: od: luG,luB: end: #BTn1n2(n1,n2): the set of binary trees on n1+n2 leaves #with the left-tree with n1 leaves and the right tree with #n2 leaves BTn1n2:=proc(n1,n2) local gu,gu1,gu2,i,j: option remember: if not type(n1+n2,integer) then ERROR(`inputs should be integers`): fi: if n1<=0 or n2<=0 then RETURN({}): fi: gu:={}: gu1:=BT(n1):gu2:=BT(n2): for i from 1 to nops(gu1) do for j from 1 to nops(gu2) do gu:=gu union {[gu1[i],gu2[j]]}: od: od: gu: end: #BTPn1n2(n1,n2): All pairs [T1,T2] of complete binary trees #where T1 has type(n1,n2) and T2 has type (n2,n1) BTPn1n2:=proc(n1,n2) local gu1,gu2,i,j,gu: gu1:=BTn1n2(n1,n2): gu2:=BTn1n2(n2,n1): gu:={}: for i from 1 to nops(gu1) do for j from 1 to nops(gu2) do gu:=gu union {[gu1[i],gu2[j]]}: od: od: gu: end: #IrredPn1n2a(n1,n2,a): all the irreducible pairs of trees #where the first is of type (n1+a,n2) and the second of type #(n1,n2+a) IrredPn1n2a:=proc(n1,n2,a) local Mu1,Mu2,gu,i,j,mu1,mu2,lu1,lu2: Mu1:=BTn1n2(n1+a,n2): Mu2:=BTn1n2(n1,n2+a): gu:={}: for i from 1 to nops(Mu1) do mu1:=Mu1[i]: lu1:=Intervals(mu1): for j from 1 to nops(Mu2) do mu2:=Mu2[j]: lu2:=Intervals(mu2): if lu1 intersect lu2={} then gu:=gu union {[mu1,mu2]}: fi: od: od: gu: end: cannon:=proc(w) local i: for i from 1 while w[i]=0 do od: if w[i]=2 then subs({1=2,2=1},w): else w: fi: end: #Rule1(zug): Applies Rule1 to the pair zug Rule1:=proc(zug) local V,T,U,S,w1,w2: V:=zug[1][1]: T:=zug[1][2]: U:=zug[2][1]: S:=zug[2][2]: if Size1(V)-Size1(U)<>1 or Size1(S)-Size1(T)<>1 then ERROR(`Rule 1 not applicable `): fi: w1:=MilimP([[[],T],S])[1]: w1:=add1(w1): if w1[1]=2 then w1:=subs({0=2,2=0},w1): fi: w2:=MilimP([V,[U,[]]])[1]: w2:=add1(w2): if w2[nops(w2)]=2 then w2:=subs({0=2,2=0},w2): fi: cannon([op(w2),op(2..nops(w1),w1)]): end: #VerifyRule1a(n1,n2): verifies Rule1 for all pairs of type #(n1+1,n2) and the second (n1,n2+1) VerifyRule1a:=proc(n1,n2) local gu,i: gu:=IrredPn1n2a(n1,n2,1): {seq(member(Rule1(gu[i]),MilimP(gu[i])),i=1..nops(gu))}: end: #VerifyRule1(L): verifies Rule1 for all pairs of type (n1+1,n2),(n1,n2+1) #for n1,n2 <=L VerifyRule1:=proc(L) local n1,n2: for n1 from 1 to L do for n2 from 1 to L do print(`n1=`,n1, `n2=`,n2): print(VerifyRule1a(n1,n2)): od: od: end: #Rule2a(zug): Applies Rule2a to the pair zug, if applicable, #otherwise returns FAIL Rule2a:=proc(zug) local V,T,U,S,w1,w2,lu1,mua12,mua21,mub12,mub21,muam,i,lu2: V:=zug[1][1]: T:=zug[1][2]: U:=zug[2][1]: S:=zug[2][2]: if Size1(V)-Size1(U)<>2 or Size1(S)-Size1(T)<>2 then ERROR(`Rule 2a trivially not applicable `): fi: lu1:=Add2(MilimPv([[[[],[]],T],S])): mua12:={}: mua21:={}: for i from 1 to nops(lu1) do muam:=lu1[i]: if [muam[1],muam[2]]=[1,2] then mua12:=mua12 union {muam}: elif [muam[1],muam[2]]=[2,1] then mua21:=mua21 union {muam}: fi: od: lu2:=Add2(MilimPv([V,[U,[[],[]]]])): mub12:={}: mub21:={}: for i from 1 to nops(lu2) do muam:=lu2[i]: if [muam[nops(muam)-1],muam[nops(muam)]]=[1,2] then mub12:=mub12 union {muam}: elif [muam[nops(muam)-1],muam[nops(muam)]]=[2,1] then mub21:=mub21 union {muam}: fi: od: if mua12<>{} and mub12<>{} then w1:=mua12[1]: w2:=mub12[1]: RETURN(cannon([op(w2),op(3..nops(w1),w1)])): fi: if mua21<>{} and mub21<>{} then w1:=mua21[1]: w2:=mub21[1]: RETURN(cannon([op(w2),op(3..nops(w1),w1)])): fi: FAIL: end: #ExploreRule2aa(n1,n2): Explores Ruled2a and checks #the succesful ones for pairs of type #(n1+2,n2) and the second (n1,n2+2), #the output is {true} (hopefully) followed by the number of succesful #ones followed by the number of failures ExploreRule2aa:=proc(n1,n2) local gu,i,w,luF,luS: gu:=IrredPn1n2a(n1,n2,2): luF:={}: luS:={}: for i from 1 to nops(gu) do w:=gu[i]: if Rule2a(w)=FAIL then luF:=luF union {w}: else luS:=luS union {w}: fi: od: [{seq(member(Rule2a(luS[i]),MilimP(luS[i])),i=1..nops(luS))}, nops(luS),nops(luF)]: end: #ExploreRule2a(L): Explores Rule2a for all pairs of type (n1+2,n2),(n1,n2+2) #for n1,n2 <=L ExploreRule2a:=proc(L) local n1,n2: for n1 from 1 to L do for n2 from 1 to L do print(`n1=`,n1, `n2=`,n2): print(ExploreRule2aa(n1,n2)): od: od: end: