Monad 结构和这种树嫁接之间通常存在紧密的对应关系。这是一个例子
data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving Functor
instance Monad Tree where
return = Leaf
Leaf a >>= f = f a
Branch l r >>= f = Branch (l >>= f) (r >>= f)
(>>=) 只是基于某些功能 f :: a -> Tree a 进行叶子扩展(树嫁接)。
然后我们就可以轻松进行您要寻找的嫁接
graftRight :: Eq a => a -> a -> Tree a -> Tree a
graftRight a new t = t >>= go where
go a' | a' == a = Node a new
| otherwise = Leaf a'
但这非常低效,因为它会访问您树中的每个Leaf,以搜索您要替换的特定那个。如果我们知道更多信息,我们可以做得更好。如果树以某种方式排序和排序,那么您可以使用fingertree 或splaytree 进行有效替换。如果我们只知道要通过其路径替换的节点,我们可以使用 Zipper。
data TreeDir = L | R
data ZTree a = Root
| Step TreeDir (Tree a) (ZTree a)
这让我们可以进出树的根
stepIn :: Tree a -> (Tree a, ZTree a)
stepIn t = (t, Root)
stepOut :: (Tree a, ZTree a) -> Maybe (Tree a)
stepOut (t, Root) = Just t
stepOut _ = Nothing
一旦我们进去了,就往我们喜欢的任何方向走
left :: (Tree a, ZTree a) -> Maybe (Tree a, ZTree a)
left (Leaf a, zip) = Nothing
left (Branch l r, zip) = Just (l, Step R r zip)
right :: (Tree a, ZTree a) -> Maybe (Tree a, ZTree a)
right (Leaf a, zip) = Nothing
right (Branch l r, zip) = Just (r, Step L l zip)
up :: (Tree a, ZTree a) -> Maybe (Tree a, ZTree a)
up (tree, Root) = Nothing
up (tree, Step L l zip) = Just (branch l tree, zip)
up (tree, Step R r zip) = Just (branch tree r, zip)
编辑树叶
graft :: (a -> Tree a) -> (Tree a, ZTree a) -> Maybe (Tree a, ZTree a)
graft f (Leaf a, zip) = Just (f a, zip)
graft _ _ = Nothing
或者也许使用我们从上方绑定的某个位置下方的所有叶子!
graftAll :: (a -> Tree a) -> (Tree a, ZTree a) -> (Tree a, ZTree a)
graftAll f (tree, zip) = (tree >>= f, zip)
然后我们可以在进行移植之前走到树上的任何一点
graftBelow :: (a -> Tree a) -> [TreeDir] -> Tree a -> Maybe (Tree a)
graftBelow f steps t = perform (stepIn t) >>= stepOut where
perform = foldr (>=>) Just (map stepOf steps) -- walk all the way down the path
>=> (Just . graftAll f) -- graft here
>=> foldr (>=>) Just (map (const up) steps) -- walk back up it
stepOf L = left
stepOf R = right
>>> let z = Branch (Branch (Leaf "hello") (Leaf "goodbye"))
(Branch (Branch (Leaf "burrito")
(Leaf "falcon"))
(Branch (Leaf "taco")
(Leaf "pigeon")))
>>> graftBelow Just [] z == z
True
>>> let dup a = Branch (Leaf a) (Leaf a)
>>> graftBelow dup [L, R] z
Just (Branch (Branch (Leaf "hello")
(Branch (Leaf "goodbye")
(Leaf "goodbye")))
(Branch (Branch (Leaf "burrito") (Leaf "falcon"))
(Branch (Leaf "taco") (Leaf "pigeon"))))
>>> graftBelow dup [L, R, R] z
Nothing
通常有很多方法可以实现这一目标。