(在评论中提到的问题的答案中,我已经证明这是一个线性时间算法。在这个答案的先前版本中有一个更长的更手动的解决方案。)
基因表达编程:Karva 表示法。
使用延续传递 monad, 可能有一个巧妙的解决方案Cont
,但我没有想到它。这是该问题的一个相当干净的纯功能解决方案。我将借此机会命名一些好的通用递归方案。
计划:
使用前一行的总数量将输入分成列表,每层一个。这是一个变形,即从种子 ( []
) 中生成一个列表,并且可以使用unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
或等效地编写,unfoldr' :: (b -> (a, b)) -> (b -> Bool)-> b -> [a]
input: "Q/a*+b-cbabaccbac"
arities: 12022020000000000
output: ["Q","/","a*","+b","-c","ba"]
递归地用于splitAt
将子级粘合在父级之下。这是一种变态,即将列表折叠为单个(树)值,可以使用foldr :: (a -> b -> b) -> b -> [a] -> b
将变形和变形合二为一。这就是所谓的hylomorphism。这些术语在开创性论文Functional Programming with Bananas, Lenses and Barbed wire中介绍给 FP 社区。
代码
如果您不熟悉它,请Data.Tree
提供.data Tree a = Node {rootLabel :: a, subForest :: Forest a}
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
为了抽出一个关卡,我们使用上一个关卡的总arity 来找到在哪里拆分这个新关卡,然后传递这个关卡的总arity 以备下次使用:
pullLevel :: (Int,String) -> (String,(Int,String))
pullLevel (n,cs) = (level,(total, cs')) where
(level, cs') = splitAt n cs
total = sum $ map arity level
要将关卡(作为字符串)与下面的关卡(已经是森林)结合起来,我们只需提取每个角色需要的树的数量。
combineLevel :: String -> Forest Char -> Forest Char
combineLevel "" [] = []
combineLevel (c:cs) levelBelow = Node c subforest : combineLevel cs theRest
where (subforest,theRest) = splitAt (arity c) levelBelow
现在我们可以使用hylomorphism 解析Karva。请注意,我们使用来自 的字符串之外的全部数量来播种它1
,因为在根级别只有一个节点。我使用了这个head
函数,因为它1
导致顶层是一个包含一棵树的列表。
karvaToTree :: String -> Tree Char
karvaToTree cs = let
zero (n,_) = n == 0
in head $ hylomorphism [] combineLevel pullLevel zero (1,cs)
演示
让我们画出结果(因为 Tree 的语法如此之多,以至于很难阅读输出!)。你必须cabal install pretty-tree
得到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 = []}]}]}]}
当我们看到它时,它匹配see
:
ghci> see $ karvaToTree "Q/a*+b-cbabaccbac"
Q
|
/
|
------
/ \
a *
|
-----
/ \
+ b
|
----
/ \
- c
|
--
/ \
b a
评估
一旦有了树,就很容易将其转换为其他东西。让我们用 Karva 表示法计算一个表达式:
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