Parsing Karva notation in haskell - haskell

Question

Karva notation is used in Gene Expression Programming to represent mathematical expressions.
See here http://www.gene-expression-programming.com/Tutorial002.asp
You create an expression tree by reading the off the gene and filling in nodes from left to right, top to bottom.
So for example using the operators ( +, * ) and terminals (1,2,3,4,5,6) in "+*+1+2*3456" would evaluate to 39.
How would I do this in haskell using attoparsec (or parsec)?
karvaParser :: Parser Int
karvaParser = ????????????
Prelude> parse karvaParser "+*+1+2*3456"
Done 39

Answer 1

(I've proved this is a linear time algorithm in this answer to the question mentioned in the comments. There's a lengthier more hand-rolled solution in a previous revision of this answer.)
Gene Expression Programming: Karva notation.
There's probably a neat solution using the continuation passing monad, Cont, but I haven't thought of it. Here's a fairly clean pure functional solution to the problem. I'll take the opportunity to name drop some good general recursion schemes along the way.
Plan:
split the input into lists, one for each layer, using the total arity of the previous line. This is an anamorphism, i.e. grows a list from a seed ([]) and can be written using unfoldr :: (b -> Maybe (a, b)) -> b -> [a] or equivalently, unfoldr' :: (b -> (a, b)) -> (b -> Bool)-> b -> [a]
input: "Q/a*+b-cbabaccbac"
arities: 12022020000000000
output: ["Q","/","a*","+b","-c","ba"]
Recursively use splitAt to glue the children under the parent. This is a catamorphism, i.e. collapses a list down to a single (tree) value, and can be written using foldr :: (a -> b -> b) -> b -> [a] -> b
Combine the anamorphism and the catamorphism into one. That's called a hylomorphism.
These terms are introduced to the FP community in the seminal paper Functional Programming with Bananas, Lenses and Barbed wire.
Code
In case you're not familiar with it, Data.Tree supplies data Tree a = Node {rootLabel :: a, subForest :: Forest a} where type Forest a = [Tree a].
import Data.Tree
import Data.Tree.Pretty -- from the pretty-tree package
arity :: Char -> Int
arity c
| c `elem` "+*-/" = 2
| c `elem` "Q" = 1
| otherwise = 0
hylomorphism :: b -> (a -> b -> b) -> (c -> (a, c)) -> (c -> Bool) -> c -> b
hylomorphism base combine pullout stop seed = hylo seed where
hylo s | stop s = base
| otherwise = combine new (hylo s')
where (new,s') = pullout s
To pull out a level, we use the total arity from the previous level to find where to split off this new level, and pass on the total arity for this one ready for next time:
pullLevel :: (Int,String) -> (String,(Int,String))
pullLevel (n,cs) = (level,(total, cs')) where
(level, cs') = splitAt n cs
total = sum $ map arity level
To combine a level (as a String) with the level below (that's already a Forest), we just pull off the number of trees that each character needs.
combineLevel :: String -> Forest Char -> Forest Char
combineLevel "" [] = []
combineLevel (c:cs) levelBelow = Node c subforest : combineLevel cs theRest
where (subforest,theRest) = splitAt (arity c) levelBelow
Now we can parse the Karva using a hylomorphism. Note that we seed it with a total arity from outside the string of 1, since there's only one node at the root level. I've used the head function because that 1 causes the top level to be a list containing one tree.
karvaToTree :: String -> Tree Char
karvaToTree cs = let
zero (n,_) = n == 0
in head $ hylomorphism [] combineLevel pullLevel zero (1,cs)
Demo
Let's have a draw of the results (because Tree is so full of syntax it's hard to read the output!). You have to cabal install pretty-tree to get Data.Tree.Pretty.
see :: Tree Char -> IO ()
see = putStrLn.drawVerticalTree.fmap (:"")
ghci> arity '+'
2
ghci> pullLevel (3,"+a*bc/acb")
("+a*",(4,"bc/acb"))
ghci> combineLevel "a*" [Node 'b' [],Node 'c' []]
[Node {rootLabel = 'a', subForest = []},Node {rootLabel = '*', subForest = [Node {rootLabel = 'b', subForest = []},Node {rootLabel = 'c', subForest = []}]}]
ghci> see . Node '.' $ combineLevel "a*" [Node 'b' [],Node 'c' []]
.
|
---
/ \
a *
|
--
/ \
b c
ghci> karvaToTree "Q/a*+b-cbabaccbac"
Node {rootLabel = 'Q', subForest = [Node {rootLabel = '/', subForest = [Node {rootLabel = 'a', subForest = []},Node {rootLabel = '*', subForest = [Node {rootLabel = '+', subForest = [Node {rootLabel = '-', subForest = [Node {rootLabel = 'b', subForest = []},Node {rootLabel = 'a', subForest = []}]},Node {rootLabel = 'c', subForest = []}]},Node {rootLabel = 'b', subForest = []}]}]}]}
Which matches
as we see when we see it:
ghci> see $ karvaToTree "Q/a*+b-cbabaccbac"
Q
|
/
|
------
/ \
a *
|
-----
/ \
+ b
|
----
/ \
- c
|
--
/ \
b a
Eval
Once you have a Tree, it's easy to convert it to other things. Let's evaluate an expression in Karva notation:
action :: (Read num,Floating num) => Char -> [num] -> num
action c = case c of
'Q' -> sqrt.head
'+' -> sum
'*' -> product
'-' -> \[a,b] -> a - b
'/' -> \[a,b] -> a / b
v -> const (read (v:""))
eval :: (Read num,Floating num) => Tree Char -> num
eval (Node c subforest) = action c (map eval subforest)
ghci> see $ karvaToTree "Q+-*826/12"
Q
|
+
|
-------
/ \
- *
| |
-- ---
/ \ / \
8 2 6 /
|
--
/ \
1 2
ghci> eval $ karvaToTree "Q+-*826/12"
3.0