Some tree examples

We implement an acceptor for a language of binary branching trees, over an alphabet 'a', 'b', 'f', where 'a' and 'b' must be leaves, and 'f' must be an internal node. Furthermore, there must be exactly one 'b' leaf in the tree. There will be two states, identified with the booleans True and False. State True tells us that we have seen exactly one 'b', and state False that we have not seen any 'b's.

acceptorRules =
  [(('a',[]),False) -- a leaf 'a' has no bs
  , (('b',[]),True) -- a leaf 'b' has exactly one b
  , (('f',[False,False]),False) -- a tree with b-less daughters has no b
  , (('f',[False,True]),True) -- a tree with a b-less left daughter, and a b-full right daughter has exactly one b
  , (('f',[True,False]),True) -- a tree with a b-full left daughter, and a b-less right daughter has exactly one b
  ]

Note that we can get away with having just two states because we are missing a transition: what should happen when f has two daughters with a b leaf? (I.e. there is no rule with left-hand side ('f',[True,True]).) Without a rule telling what to do in such a situation, the acceptor 'crashes.' The description of the list of rules can be simplified once we realize that the acceptor is essentially computing a disjunction:

acceptorRules =
  fmap leaves ['a','b'] ++ [fs [b1,b2] | b1 <- bool, b2 <- bool, not (b1 && b2)]
  where
    bool = [False,True]
    leaves x = ((x,[]), or [])
    fs bs = (('f',bs), or bs)

Given the rules above, we construct an acceptor whose only final state is True.

acceptor = mkAcceptor acceptorRules [True]

We implement a transducer over the language of binary branching trees defined above. It will replace the unique 'b' in the tree with a 'c', and add a new node with left daughter 'b' three steps up in the tree, rejecting if the tree is too small. (This can be visualized by the syntactically inclined as the movement of the b to a position three nodes higher, leaving behind a trace 'c'.) There will be four states, identified with the terms Nothing, Just 0, Just 1 and Just 2 of type Maybe Int. State Nothing is the only accepting state, and tells us that we are not waiting to 'move' a 'b'. States Just n tell us that we have replaced a 'b' with a 'c' n steps ago.

leafA = NodeC 'a' []
leafC = NodeC 'c' []
intF = NodeC 'f' [Hole 0, Hole 1]
moveB = NodeC 'f' [NodeC 'b' [], intF]

buRules =
  [(('a',[]),(Nothing,leafA)) 
  , (('b',[]),(Just 0, leafC)) 
  , (('f',[Nothing,Nothing]),(Nothing,intF))
  , (('f',[Nothing,Just 0]),(Just 1,intF)) 
  , (('f',[Nothing,Just 1]),(Just 2,intF)) 
  , (('f',[Nothing,Just 2]),(Nothing,moveB)) 
  , (('f',[Just 0,Nothing]),(Just 1,intF)) 
  , (('f',[Just 1,Nothing]),(Just 2,intF)) 
  , (('f',[Just 2,Nothing]),(Nothing,moveB)) 
  ]

Given the rules above, we construct a transducer whose only final state is Nothing.

buTrans = mkBUTrans buRules [Nothing] 

We implement a transduction from the set of monadic branching trees (i.e. strings) over 'a' and 'b' (with special root symbol '$' and special leaf symbol '#') to trees whose yield is a string over the copy language wcw. We will construct a degenerate, one-state transducer (aka a homomorphism).

For convenience, here is a function that maps Haskell strings to appropriate monadic branching trees.

mkTree :: String -> Tree Char
mkTree w = Node '$' [foldr (\a t -> Node a [t]) (Node '#' []) w]

We will need four different CContext's to translate our characters into.

hash = CHole0 0
dollar = CHole1 0 [NodeCC 'c' []]
aCC =  NodeCC 'f' [NodeCC 'a' [],CHole1 0 [NodeCC 'f' [CHole0 0, NodeCC 'a' []]]]
bCC =  NodeCC 'f' [NodeCC 'b' [],CHole1 0 [NodeCC 'f' [CHole0 0, NodeCC 'b' []]]]

Note that the context context dollar will plug the hole of its context argument, resulting in a tree (modulo the node constructors). Given these context contexts, we construct the rules of the macro transducer as follows.

macroRules =
  [(('#',[]),((),hash)) 
  , (('a',[()]),((),aCC)) 
  , (('b',[()]),((),bCC)) 
  , (('$',[()]),((),dollar))
  ]

We use these rules to construct a macro transducer (with final state the only state ()).

macroTrans = mkMacroTrans macroRules [()]