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

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包，但不幸的是我已经有很多自定义代码来构建这些树，所以我认为需要一些工作才能使用该包中的构造函数。

标签： haskellfunctional-programmingtreefold

Answer 1

Well, you can't use Foldable (or the related class Traversable) because these classes are for types of kind * -> *. That is, a Foldable instance can only be defined for a type like data Tree a = ... that is parameterized in another type a, but your data Tree = ... is unparameterized.

What you can do is write a function that traverses your tree applying a monadic action to each node, sort of a mapM tailored to your tree that maps a per-node action across the whole tree:

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' }

Now, this can apply any monadic action, including a State-based monadic action that assigns a numbered suffix, with a separate counter for each name. This is, given:

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

you can define the node-renamer:

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 })

and combine the two to create a tree-renamer:

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

and test it on a tree:

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

like so:

> uniquifyTree t0

which prints a tree equivalent to:

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

Note that mapTreeM is essentially equivalent to your mapTree, and you can define mapTree in terms of mapTreeM using runState and state which don't actually do anything except wrap and unwrap data types:

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'))

So, structurally, this isn't much different from what you've already done. You just reinvented the state monad (as (a, Tree) -> (a, Tree)) and wrote a sort of custom mapM to traverse the tree without making the monadic action general.

One thing about the explicit monadic version is that you can use it with some other monadic actions. Here are some examples:

> -- 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

Anyway, the full program is:

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