######################################################################
##TAG: Save this file as TAG. To use it, stay in the                 #
##same directory, get into Maple (by typing: maple <Enter> )         #
##and then type:  read TAG : <Enter>                                 #
##Then follow the instructions given there                           #
##                                                                   #
#Written by Doron Zeilberger, Rutgers University ,                   #
#zeilberg@math.rutgers.edu.                                          # 
######################################################################

#Created: March 30, 2004 
#This Version: March 31, 2004 
#TAG: A Maple package to study The Conjectured
#Total Ambiguity Grammar for the Context-Free Grammar
#[{A,B,C},{a,b,c},A,{A->a|BC|CB,B->b|AC|CA,C->c|AB|BA}]
#It was discussed at the Princeton Discrete Math Seminar
#March 31, 2004, and may lead to a forthcoming paper
#A prize of $400 is offered for a short proof of the
#Total Ambiguity Conjecture
#Many thanks to my nephew, Noam Zeilberger, for many intriguing
#observations and comments

with(combinat):

print(`Created: March 30, 2004 .`):

print(`This version: March 31, 2004 .`):
lprint(``):
print(`Written by Doron Zeilberger, zeilberg@math.rutgers.edu .`):
lprint(``):
print(`Please report bugs to zeilberg@math.rutgers.edu .`):
lprint(``):
print(`TAG: A Maple package to study the`):
print(`Total Ambiguity of the Context-Free Grammar`):
print(`[{A,B,C},{a,b,c},A,{A->a|BC|CB,B->b|AC|CA,C->c|AB|BA}] .`):
print(`It was discussed at the Princeton Discrete Math Seminar`):
print(`March 31, 2004, and may lead to a forthcoming paper.`):
print(`A prize of $400 is offered for a short proof of the`):
print(`Total Ambiguity Property  which says, in the language.`):
print(`of this Maple package, that CheckTAG1(n)[1]>0 for every positive`):
print(`integer n .`):
print(` Many thanks to my nephew, Noam Zeilberger, for many intriguing`):
print(` observations and comments . `):

print(``):
 print(`The most current version of this  package and paper (once it exists)`):
 print(` are  available from`):
 print(`http://www.math.rutgers.edu/~zeilberg/`):
 print(` For a list of the main procedures type ezra()`):
 print(`a specific procedure, type ezra(procedure_name)`):
 print(``):


ezra:=proc()
if args=NULL then
 print(`The Main are procedures:  `):
 print(` AllWords, AllWordsD, BT, CheckTAG1, CheckTAG2, CheckTAG3a, `):
 print(`CheckTAG3, Etsim, IsGoodPair1, Khaverim, Milim `):
 print(` RandTree`):
fi:

if nops([args])=1 and op(1,[args])=AllWords then
print(`AllWords(n): All the words in the Language generated by the`):
print(`grammer, using the fact that they are all the words`):
print(`where the #1 and #2's have the same parity and opposite the `):
print(`parity of the #0's `):
print(`For example, try: AllWords(5); `):
fi:

if nops([args])=1 and op(1,[args])=AllWordsD then
print(`AllWordsD(n): All the words in the Language generated by the`):
print(`grammer, the Direct Way`):
print(`For example, try: AllWordsD(5); `):
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])=CheckTAG1 then
print(`CheckTAG1(n): `):
print(`The first way to check the TAG conj. for trees with n leaves.`):
print(`It outputs the smallest cardinality that a pair `):
print(`of trees can have in common, and a corresponding pair-of-trees`):
print(`If that smallest cardinality is positive, then it is true`):
print(`For example, try: CheckTAG1(5);`):
fi:

if nops([args])=1 and op(1,[args])=CheckTAG2 then
print(`CheckTAG2(n): `):
print(`The second way to check the TAG conj. for trees with n leaves.`):
print(`It verifies that the union of all pairs of Etsim(w), as w ranges  `):
print(`over all words in the language, equals the set of (unordered) pairs`):
print(`of trees`):
print(`For example, try: CheckTAG2(5);`):
fi:

if nops([args])=1 and op(1,[args])=CheckTAG3 then
print(`CheckTAG3(n): `):
print(`The third way to check the TAG conj. for trees with n leaves.`):
print(`by doing CheckTAG3a(T) for each tree of size n`):
print(`For example, try: CheckTAG3(5);`):
fi:

if nops([args])=1 and op(1,[args])=CheckTAG3a then
print(`CheckTAG3a(T): `):
print(`The third way to check the TAG conj. for a specific tree.`):
print(`T; For example, try: CheckTAG3a(BT(5)[1]);`):
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])=IsGoodPair1 then
print(`IsGoodPair1(T,S): if trees T and S are s.t. Size1(T)=Size1(S)+1`):
print(`finds all words w1,w2 such that w1 is in Milim(([T,[]])`):
print(`w2 in Milim([S,[]]) and w2 is a prefix of w1`):
fi:

if nops([args])=1 and op(1,[args])=Khaverim then
print(`Khaverim(T): All the trees that share a word in common with`):
print(`the tree T, for example, try: Khaverim(BT(4)[1]);`):
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])=RandTree then
print(`RandTree(n): a random tree with n leaves`):
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:

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:

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:

#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:



#EtsimD(w): All the derivation trees for the word w
EtsimD:=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:=EtsimD(add2(w1)):T2:=EtsimD(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:=EtsimD(add1(w1)):T2:=EtsimD(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:

#CheckTAG1(n): Check the TAG conjecture by finding
#the smallest cardinality of words that a pair 
#of trees can have in common, and a corresponding pair-of-trees
#If that smallest cardinality is positive, then it is true
#For example, try: CheckTAG1(5);
CheckTAG1:=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 mu<ka 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:

#AllWordsD(n): All the words in the Language generated by the
#grammer, the Direct Way
AllWordsD:=proc(n) local gu,i: gu:=BT(n):
{seq(op(Milim(gu[i])),i=1..nops(gu))}: end:

#AllWords(n): All the words in the language by observing that
#these are permutations of 0^(2*a)1^(2*b+1)2^(2*c+1) (a,b,c>=0)
#and 0^(2a+1)1^(2b)2^(2c) (a>=0, b+c>0)
AllWords:=proc(n) local a,b,c,gu:

gu:={}:

if  n mod 2 =0 then
 for a from 0 to n/2-1 do
 for b from 0 to n/2-a-1 do
  c:=n/2-a-b-1:
  gu:= gu union convert(permute([0$(2*a),1$(2*b+1),2$(2*c+1)]),set):
 od:
 od:

else
 for a from 0 to (n-3)/2 do
 for b from 0 to (n-1)/2-a do
  c:=(n-1)/2-a-b:
  gu:= gu union convert(permute([0$(2*a+1),1$(2*b),2$(2*c)]),set):
 od:
 od:

fi:
RETURN(gu):
end:

#Khaverim(T): All the trees that share a word in common with
#the tree T, for example, try: Khaverim(BT(4)[1]);
Khaverim:=proc(T) local gu,i:
gu:=Milim(T):{seq(op(Etsim(gu[i])),i=1..nops(gu))}: end:

NuBT:=proc(n):binomial(2*n-2,n-1)/n:end:

#LoadedDice(Li): Given a list Li of non-normalized probablities on
#[1,...,k] (where k=nops(Li)) returns an integer between
#1 and k with the specified probabilities
LoadedDice:=proc(Li)
local i,co,su,ra:
su:=convert(Li,`+`):
ra:=rand(1..su)():
co:=0:
for i from 1 to nops(Li) while co<ra  do 
co:=co+Li[i]:
od:
i-1:
end:

#RandTree(n): a random tree with n leaves
RandTree:=proc(n)
local k:
if n=1 then
  RETURN([]):
fi:
k:=LoadedDice([seq(NuBT(k)*NuBT(n-k),k=1..n-1)]):
[RandTree(k),RandTree(n-k)]:
end:

#GoodBreaks(w): Given a word w, (of length n, say) finds
#all the possible k's that the leftTree can have
#and the label of the left-son. For example,
#GoodBreaks([1,1,0]); should yield [[1,1]];
GoodBreaks:=proc(w)
local c0,c1,c2,i,n,gu:
gu:=[]:
n:=nops(w):
c0:=0:
c1:=0:
c2:=0:
for i from 1 to n-1 do
 if w[i]=0 then
  c0:=c0+1 mod 2:
 elif w[i]=1 then
      c1:=c1+1 mod 2:
  elif w[i]=2 then
         c2:=c2+1 mod 2:
 else
    ERROR(`All letters should be 0,1, or 2`):
 fi:

 if c0=c2 and c0<>c1 then
  gu:=[op(gu),[i,1]]:
 fi:

 if c0=c1 and c0<>c2 then
  gu:=[op(gu),[i,2]]:
 fi:
od:

gu:
end:

  

#Etsim(w): All the derivation trees for the word w
Etsim:=proc(w)
local w1,w2,i,i2,n,T1,T2,gu,i1,j1,mu,a:
n:=nops(w):
if n=1 then
 if w[1]=0 then
   RETURN({[]}):
 else
    RETURN({}):
 fi:
fi:

if n=2 then
 if w=[1,2] or w=[2,1] then
   RETURN({[[],[]]}):
 else
   RETURN({}):
 fi:
fi:

mu:=GoodBreaks(w):
gu:={}:
for i2 from 1 to nops(mu) do
i:=mu[i2][1]:
a:=mu[i2][2]:
w1:=[op(1..i,w)]:
w2:=[op(i+1..n,w)]:
if a=1 then
T1:=Etsim(add2(w1)):T2:=Etsim(add1(w2)):
else
T1:=Etsim(add1(w1)):T2:=Etsim(add2(w2)):
fi:

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:


#CheckTAG2(n): A second way to check the TAG conjecutre
#for complete binary trees with n leaves
#of trees can have in common, and a corresponding pair-of-trees
CheckTAG2:=proc(n) local gu,i: 
gu:=AllWords(n):
evalb({seq(op(choose(Etsim(gu[i]),2)),i=1..nops(gu))} minus {{}}
=choose(BT(n),2)):
end:

Size1:=proc(T): if T=[] then 1 else  Size1(T[1])+Size1(T[2]) fi: end:

#CheckTAG3a(T): A third way to check the TAG conjecture (for a
#fixed tree), by checking that the set of trees that parse
#some word of Milim(T) is BT(n)
CheckTAG3a:=proc(T):evalb(Khaverim(T)=BT(Size1(T))): end:

CheckTAG3:=proc(n) local i,gu: gu:=BT(n):
op({seq(CheckTAG3a(gu[i]),i=1..nops(gu))}):end:

#IsGoodPair1(T,S): if trees T and S are s.t. Size1(T)=Size1(S)+1
#finds all words w1,w2 such that w1 is in Milim(([T,[]])
#w2 in Milim([S,[]]) and w2 is a prefix of w1
IsGoodPair1:=proc(T,S)
local gu,i,j,lu1,lu2,w1,w2:
if Size1(T)-Size1(S)<>1 then
 ERROR(`Bad input, the first tree should have one more leaf then the sec.`):
fi:
lu1:=Milim([T,[]]):
lu2:=Milim([S,[]]):
gu:={}:
for i from 1 to nops(lu1) do
 for j from 1 to nops(lu2) do
  w1:=lu1[i]:
  w2:=lu2[j]:
  if [op(1..nops(w1)-2,w1)]=[op(1..nops(w2)-1,w2)] then
   gu:=gu union {[w1,w2]}:
  fi:
 od:
od:
gu:

end: