Question

假设我具有以下数据结构。

data Tree = Tree
  { name        :: String
  , children    :: [Tree]
  , ...
  }

我的目标是能够映射树木及其子代的列表，以便我可以唯一地命名每棵树，因此以下代码中的Map结构代表了使用特定名称的次数，换句话说，Map Name Count。因此，如果我有函数baseName :: SystemTree -> String根据未列出的属性返回未编号的名称，则可以将其与映射中的数字组合，这样，即使重用了baseName，也不会使用任何名称两次。

nameSystemTrees :: Map String Int -> [Tree] -> (Map String Int, [Tree])
nameSystemTrees nameState trees =
  ...

我的问题是，在Haskell中解决此问题的最佳方法是什么？是否可以在此处使用可折叠？我注意到这里有Data.Tree软件包，但不幸的是，我已经有很多自定义代码来构造这些树，因此我认为要使用该软件包中的构造函数需要花费一些工作。

Answer 1

我想这回答了我的问题，尽管我仍然想知道是否有一种更简洁的方法来使用Foldable。

mapTree :: ((a, Tree) -> (a, Tree)) -> (a, Tree) -> (a, Tree)
mapTree f startingPoint =
  let
    root = f startingPoint

    (rootAcc, rootTree) = root

    originalChildren :: [Tree]
    originalChildren = children rootTree

    (newAcc, newChildren) =
      foldr (\child (acc, children) ->
        let
          (newAcc, newTree) = mapTree f (acc, child)
        in
          (newAcc, newTree : children)
      ) (rootAcc, []) originalChildren
  in
    ( newAcc
    , rootTree
      { children = newChildren
      }
    )

Answer 2

好吧，您不能使用Foldable（或相关类Traversable），因为这些类适用于类型* -> *的类型。也就是说，只能为Foldable这样的类型定义data Tree a = ...实例，而该类型已在另一类型a中进行了参数化，但是您的data Tree = ...没有参数化。

您可以做的操作是编写一个遍历树的函数，该函数对每个节点应用单子动作，类似于为树定制的mapM，可在每个树上映射每个节点的动作整棵树：

mapTreeM :: Monad m => (Tree -> m Tree) -> Tree -> m Tree
mapTreeM f = mtm  -- @f@ is the per-node action, @mtm@ the whole-tree action
  where mtm tree = do
          -- apply node action @f@ to root node
          tree' <- f tree
          -- recurse over children with @mtm@
          children' <- mapM mtm (children tree')
          -- update the children
          return $ tree' { children = children' }

现在，这可以应用任何单子动作，包括基于State的单子动作，该动作分配一个带编号的后缀，每个name都有一个单独的计数器。给出：

data Tree = Tree
  { name :: String
  , children :: [Tree]
  } deriving (Show, Eq)

您可以定义节点重命名器：

uniquifyNode :: Tree -> State (Map String Int) Tree
uniquifyNode node = do
  let nm = name node
  -- get current count for this name
  n <- gets (Map.findWithDefault 1 nm)
  -- store an updated count
  modify (Map.insert nm (n+1))
  -- return uniquified name
  return (node { name = nm ++ show n })

并结合两者以创建树重命名器：

uniquifyTree :: Tree -> Tree
uniquifyTree t = evalState (mapTreeM uniquifyNode t) Map.empty

并在一棵树上对其进行测试：

t0 :: Tree
t0 = Tree "a" [ Tree "a" []
              , Tree "b" [ Tree "a" []
                         , Tree "b" []
                         , Tree "c" []
             ]
      , Tree "c" [ Tree "a" [] ]
      ]

像这样：

> uniquifyTree t0

它将打印与以下内容等效的树

t1 :: Tree
t1 = Tree "a1" [ Tree "a2" []
               , Tree "b1" [ Tree "a3" []
                           , Tree "b2" []
                           , Tree "c1" []
                           ]
              , Tree "c2" [ Tree "a4" [] ]
              ]

请注意，mapTreeM本质上与您的mapTree等效，您可以使用mapTree和mapTreeM根据runState来定义state除了包装和解包数据类型外，它们实际上不做：

mapTree :: ((a, Tree) -> (a, Tree)) -> (a, Tree) -> (a, Tree)
mapTree f (a, t) = let (t', a') = runState (mapTreeM g t) a in (a', t')
  where g t = state (\a -> let (a', t') = f (a, t) in (t', a'))

因此，从结构上讲，这与您已经完成的操作没有太大不同。您只是重新发明了状态monad（如(a, Tree) -> (a, Tree)）并编写了一种自定义mapM来遍历树而无需使monadic动作通用化。

关于显式monadic版本的一件事是，您可以将其与其他一些monadic操作一起使用。以下是一些示例：

> -- replace all names with "foo" (Identity action)
> import Data.Functor.Identity
> runIdentity $ mapTreeM (\(Tree n c) -> Identity (Tree "foo" c)) t0
> -- read the names from a file (IO action)
> import System.IO
> withFile "/usr/share/dict/words" ReadMode $ 
    \h -> mapTreeM (\(Tree n c) -> flip Tree c <$> hGetLine h) t0    
> -- get a list of names in order (Writer action)
> import Control.Monad.Writer
> execWriter $ mapTreeM (\t@(Tree n _) -> tell [n] >> return t) t0

无论如何，完整的程序是：

import Control.Monad.State
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

data Tree = Tree
  { name :: String
  , children :: [Tree]
  } deriving (Show, Eq)

mapTreeM :: Monad m => (Tree -> m Tree) -> Tree -> m Tree
mapTreeM f = mtm
  where mtm tree = do
          tree' <- f tree
          children' <- mapM mtm (children tree')
          return $ tree' { children = children' }

uniquifyNode :: Tree -> State (Map String Int) Tree
uniquifyNode node = do
  let nm = name node
  n <- gets (Map.findWithDefault 1 nm)
  modify (Map.insert nm (n+1))
  return (node { name = nm ++ show n })

uniquifyTree :: Tree -> Tree
uniquifyTree t = evalState (mapTreeM uniquifyNode t) Map.empty

t0 :: Tree
t0 = Tree "a" [ Tree "a" []
              , Tree "b" [ Tree "a" []
                         , Tree "b" []
                         , Tree "c" []
                         ]
              , Tree "c" [ Tree "a" [] ]
              ]

t1 :: Tree
t1 = Tree "a1" [ Tree "a2" []
               , Tree "b1" [ Tree "a3" []
                           , Tree "b2" []
                           , Tree "c1" []
                           ]
              , Tree "c2" [ Tree "a4" [] ]
              ]

main = print $ uniquifyTree t0 == t1

在Haskell中命名没有重复名称的树（带有子级）结构的最佳方法

2 个答案: