Question

我有以下数据：

data Item a = { id :: ID
              , parentId :: Maybe ID
              , data :: a
              }

data ItemTree a = ItemTree ID a [ItemTree a]

我希望有这个功能：buildForest :: [Item a] -> [ItemTree a]将返回一个非平凡的森林（即尊重父母关系）。我可以假设每个项目的ID是唯一的，并且所有项目的父项都是列表，如果这很重要的话。

我现在已经试着将这种想法包围了好几天了。我通过改变对象（实际上是它们的副本）在javascript中实现了类似的代码，但我想知道如何做到这一点Haskell。

到目前为止，我对这个主题的最佳想法是：

toRelations :: Item a -> ((ID, ID), Item a)
toRelations it@{id, parentId} = ((parentId, id), it)

所以现在我可以得到从父母到孩子的关系列表，所以箭头指向正确的方向。我仍然需要从中构造一个树，同时避免进行慢速查找。这有意义吗？

Answer 1

在函数式语言中，您通过将传递的状态保持为函数参数来编写此类程序。在这种情况下，状态是您正在查看的“当前”项目。

import Data.Maybe (isNothing)
import Data.Tree

type ID = Int

data Item a = Item
  { _id :: ID
  , _parentId :: Maybe ID
  , _value :: a
  } deriving (Show)

type Items a = [Item a]
type ItemTree a = Tree (ID, a)

buildTreeFrom :: Items a -> Item a -> ItemTree a
buildTreeFrom m (Item i _ v) = Node (i,v) (map (buildTreeFrom m) . filter ((== Just i) . _parentId) $ m)

请注意，这取决于您陈述的假设。算法很简单，直接来自函数的要求：

当前节点的值是给定Item
当前节点的子林是其根节点的父ID是当前节点的ID的所有树

然后你想要的函数只在每个buildTreeFrom上调用Item，这是一个根节点（即没有父节点）：

buildForest :: Items a -> Forest (ID, a)
buildForest m = map (buildTreeFrom m) . filter (isNothing . _parentId) $ m

一个简单的测试（使用非常方便的Data.Tree.drawForest）：

>test0 = [ Item 0 Nothing 'a', Item 1 (Just 0) 'b', Item 2 (Just 0) 'c', Item 3 (Just 1) 'd'
        , Item 4 Nothing 'a', Item 5 (Just 4) 'b', Item 6 (Just 5) 'c', Item 7 (Just 6) 'd' ]
>putStrLn $ drawForest $ (fmap.fmap) show $ buildForest test0
(0,'a')
|
+- (1,'b')
|  |
|  `- (3,'d')
|
`- (2,'c')

(4,'a')
|
`- (5,'b')
   |
   `- (6,'c')
      |
      `- (7,'d')

请注意，我没有努力优化此计划。如果您认为它太慢，请先介绍一下！

Answer 2

将您的[Item a]转换为Map (Maybe ID) [Item a]，以每个项目的父ID为键。

现在，您将拥有Nothing下的根，并且对于每个根ID，您可以使用lookup从地图（dict）中提取其子项，并以递归方式填充树的下一级别。

要在Map中用作密钥，ID必须位于Ord。我认为这是一个合理的假设。我会在这里使用Int：

import qualified Data.Map.Strict as Map
import Data.Maybe (maybeToList)

type ID = Int

data Item a = Item { id :: ID
                   , parentId :: Maybe ID
                   , payload :: a
                   } deriving Show

data ItemTree a = ItemTree ID a [ItemTree a] deriving Show

buildForest :: [Item a] -> [ItemTree a]
buildForest items = map mkTree roots
   where
   -- dict :: Map.Map (Maybe ID) [Item a]
      dict  = Map.fromListWith (++) [ (parentId i, [i]) | i <- items ]
      itemsUnder k = join . maybeToList . Map.lookup k $ dict
      roots = itemsUnder Nothing 
      mkTree item =                 -- using `dict`, recursively build the tree
        ItemTree (id item) (payload item) 
               . map mkTree $ itemsUnder (Just $ id item)

这里不是传递dict，而是在（共享，内部）范围内。

在Haskell中从父母关系中长出一棵树

2 个答案: