(I proved that it is a linear time algorithm in this answer to the question mentioned in the comments. There is a longer, more tame solution to the previous version of this answer.)
Programming gene expressions: designation of Karva.
There may be a neat solution using the continuation of the passing monad, Cont , but I did not think about it. Here's a pretty clean clean functional solution to the problem. I take the opportunity to name a few good general recursion schemes along the way.
Plan:
divide the input into lists, one for each layer, using the common arity of the previous line. This is an anamorphism, i.e. The list grows from the 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"]
Use splitAt to glue children to the parent. This is a catamorphism, i.e. Collapses the list to one (tree) value and can be written with foldr :: (a -> b -> b) -> b -> [a] -> b
Combine anamorphism and catamorphism into a unit. This is called chylomorphism. These terms are introduced to the FP community in the original work. Functional programming with bananas, lenses and barbed wire .
the code
If you are 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 the level, we use the general arity from the previous level to find where to separate this new level, and pass the general arity for this ready 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 (like String) with a level below (which is already a Forest), we simply remove 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 Karva using a hyomorphism. Note that we are sowing it with full arity outside row 1 , since there is only one node at the root level. I used the head function because 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 get the result (because Tree is so strong that it's hard to read the result!). You should 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 * | -- / \ bc 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 = []}]}]}]}
What are the coincidences 
as we see when we see it:
ghci> see $ karvaToTree "Q/a*+b-cbabaccbac" Q | / | ------ / \ a * | ----- / \ + b | ---- / \ - c | -- / \ ba
Eval
Once you have a Tree, it is easy to convert it to other things. Let the expression in the designation of Karva be evaluated:
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