使用 Haskell 中的 Lenses 遍历并将元素添加到 Data.Tree
Traversing and adding elements to a Data.Tree using Lenses in Haskell
我开始使用镜头,直到现在我还无法在我正在编写的代码库的具体部分使用它们。我的 objective 是通过在现有节点之一中添加一个新节点来更新玫瑰树结构,例如 Data.Tree
中的结构。为此,我认为用唯一 id 标识每个节点是有意义的,所以它看起来像这样:
type MyTree = Tree Id
type Path = [Id]
addToTree :: MyTree -> MyTree -> Path -> MyTree
addToTree originalTree newNode path = undefined
函数 addToTree
必须按照 id 的路径遍历 originalTree
并在该级别添加 newNode
,返回整个更新的树。我没有为此制作 getter 的问题,但我无法找到合适的镜头来执行操作。
这就是我到目前为止所得到的:
import Control.Lens
import Data.Tree
import Data.Tree.Lens
addToTree :: MyTree -> Path -> MyTree -> MyTree
addToTree tree path branch = tree & (traversalPath path) . branches %~ (branch:)
traversalPath :: (Foldable t, Applicative f, Contravariant f) => t Id -> (MyTree -> f MyTree) -> MyTree -> f MyTree
traversalPath = foldl (\acc id-> acc . childTraversal id) id
childTraversal :: (Indexable Int p, Applicative f) => Id -> p MyTree (f MyTree) -> MyTree -> f MyTree
childTraversal id = branches . traversed . withId id
withId :: (Choice p, Applicative f) => Id -> Optic' p f MyTree MyTree
withId id = filtered (\x -> rootLabel x == id)
但编译失败:
• No instance for (Contravariant Identity)
arising from a use of ‘traversalPath’
• In the first argument of ‘(.)’, namely ‘(traversalPath path)’
In the first argument of ‘(%~)’, namely
‘(traversalPath path) . branches’
In the second argument of ‘(&)’, namely
‘(traversalPath path) . branches %~ (branch :)’
谢谢!
这不是特别优雅,但应该可以解决问题:
import Control.Lens
import Data.Monoid (Endo(..)) -- A tidier idiom for 'foldr (.) id'.
import Data.List.NonEmpty (NonEmpty(..)) -- You don't want an empty path.
import qualified Data.List.NonEmpty as N
import Data.Tree
import Data.Tree.Lens -- That's where I got 'branches' from.
addToTree :: Eq a => NonEmpty a -> Tree a -> Tree a -> Tree a
addToTree path newNode oldTree = head $ over pathForests (newNode :) [oldTree]
where
pathForests = appEndo $ foldMap (Endo . goDown) path
goDown x = traverse . filtered ((x ==) . rootLabel) . branches
(特别是,我从来不喜欢使用 head
,即使在这种不可能失败的情况下也是如此。请随意将其替换为您最喜欢的绕口令。)
演示:
GHCi> addToTree (1 :| []) (Node 2 []) (Node 1 [])
Node {rootLabel = 1, subForest = [Node {rootLabel = 2, subForest = []}]}
GHCi> addToTree (4 :| []) (Node 2 []) (Node 1 [])
Node {rootLabel = 1, subForest = []}
GHCi> addToTree (1 :| [5]) (Node 2 []) (Node 1 [Node 5 [], Node 6 []])
Node {rootLabel = 1, subForest = [Node {rootLabel = 5, subForest = [Node {rootLabel = 2, subForest = []}]},Node {rootLabel = 6, subForest = []}]}
GHCi> addToTree (1 :| [7]) (Node 2 []) (Node 1 [Node 5 [], Node 6 []])
Node {rootLabel = 1, subForest = [Node {rootLabel = 5, subForest = []},Node {rootLabel = 6, subForest = []}]}
GHCi> addToTree (1 :| [5,3]) (Node 2 []) (Node 1 [Node 5 [], Node 6 []])
Node {rootLabel = 1, subForest = [Node {rootLabel = 5, subForest = []},Node {rootLabel = 6, subForest = []}]}
请注意,我们处理的是遍历,而不是镜头——不能保证或期望路径的目标存在或唯一。
这是一个更程式化的变体,没有 head
并使用 alaf
来处理 Endo
包装。
addToTree :: Eq a => NonEmpty a -> Tree a -> Tree a -> Tree a
addToTree (desiredRoot :| path) newNode oldTree@(Node x ts)
| x == desiredRoot = Node x (over pathForests (newNode :) ts)
| otherwise = oldTree
where
pathForests = alaf Endo foldMap goDown path
goDown x = traverse . filtered ((x ==) . rootLabel) . branches
我开始使用镜头,直到现在我还无法在我正在编写的代码库的具体部分使用它们。我的 objective 是通过在现有节点之一中添加一个新节点来更新玫瑰树结构,例如 Data.Tree
中的结构。为此,我认为用唯一 id 标识每个节点是有意义的,所以它看起来像这样:
type MyTree = Tree Id
type Path = [Id]
addToTree :: MyTree -> MyTree -> Path -> MyTree
addToTree originalTree newNode path = undefined
函数 addToTree
必须按照 id 的路径遍历 originalTree
并在该级别添加 newNode
,返回整个更新的树。我没有为此制作 getter 的问题,但我无法找到合适的镜头来执行操作。
这就是我到目前为止所得到的:
import Control.Lens
import Data.Tree
import Data.Tree.Lens
addToTree :: MyTree -> Path -> MyTree -> MyTree
addToTree tree path branch = tree & (traversalPath path) . branches %~ (branch:)
traversalPath :: (Foldable t, Applicative f, Contravariant f) => t Id -> (MyTree -> f MyTree) -> MyTree -> f MyTree
traversalPath = foldl (\acc id-> acc . childTraversal id) id
childTraversal :: (Indexable Int p, Applicative f) => Id -> p MyTree (f MyTree) -> MyTree -> f MyTree
childTraversal id = branches . traversed . withId id
withId :: (Choice p, Applicative f) => Id -> Optic' p f MyTree MyTree
withId id = filtered (\x -> rootLabel x == id)
但编译失败:
• No instance for (Contravariant Identity) arising from a use of ‘traversalPath’ • In the first argument of ‘(.)’, namely ‘(traversalPath path)’ In the first argument of ‘(%~)’, namely ‘(traversalPath path) . branches’ In the second argument of ‘(&)’, namely ‘(traversalPath path) . branches %~ (branch :)’
谢谢!
这不是特别优雅,但应该可以解决问题:
import Control.Lens
import Data.Monoid (Endo(..)) -- A tidier idiom for 'foldr (.) id'.
import Data.List.NonEmpty (NonEmpty(..)) -- You don't want an empty path.
import qualified Data.List.NonEmpty as N
import Data.Tree
import Data.Tree.Lens -- That's where I got 'branches' from.
addToTree :: Eq a => NonEmpty a -> Tree a -> Tree a -> Tree a
addToTree path newNode oldTree = head $ over pathForests (newNode :) [oldTree]
where
pathForests = appEndo $ foldMap (Endo . goDown) path
goDown x = traverse . filtered ((x ==) . rootLabel) . branches
(特别是,我从来不喜欢使用 head
,即使在这种不可能失败的情况下也是如此。请随意将其替换为您最喜欢的绕口令。)
演示:
GHCi> addToTree (1 :| []) (Node 2 []) (Node 1 [])
Node {rootLabel = 1, subForest = [Node {rootLabel = 2, subForest = []}]}
GHCi> addToTree (4 :| []) (Node 2 []) (Node 1 [])
Node {rootLabel = 1, subForest = []}
GHCi> addToTree (1 :| [5]) (Node 2 []) (Node 1 [Node 5 [], Node 6 []])
Node {rootLabel = 1, subForest = [Node {rootLabel = 5, subForest = [Node {rootLabel = 2, subForest = []}]},Node {rootLabel = 6, subForest = []}]}
GHCi> addToTree (1 :| [7]) (Node 2 []) (Node 1 [Node 5 [], Node 6 []])
Node {rootLabel = 1, subForest = [Node {rootLabel = 5, subForest = []},Node {rootLabel = 6, subForest = []}]}
GHCi> addToTree (1 :| [5,3]) (Node 2 []) (Node 1 [Node 5 [], Node 6 []])
Node {rootLabel = 1, subForest = [Node {rootLabel = 5, subForest = []},Node {rootLabel = 6, subForest = []}]}
请注意,我们处理的是遍历,而不是镜头——不能保证或期望路径的目标存在或唯一。
这是一个更程式化的变体,没有 head
并使用 alaf
来处理 Endo
包装。
addToTree :: Eq a => NonEmpty a -> Tree a -> Tree a -> Tree a
addToTree (desiredRoot :| path) newNode oldTree@(Node x ts)
| x == desiredRoot = Node x (over pathForests (newNode :) ts)
| otherwise = oldTree
where
pathForests = alaf Endo foldMap goDown path
goDown x = traverse . filtered ((x ==) . rootLabel) . branches