CODEWITHSUNDEEP
haskelltreefunctional-programming
Luftzig
Luftzig

Reputation: 523

Grow a tree from parent relations in Haskell

I have the following data:

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

data ItemTree a = ItemTree ID a [ItemTree a]

And I want to to have this function: buildForest :: [Item a] -> [ItemTree a] which will return a non-trivial forest (that is, a respect parent relations). I can assume that ID for each item is unique, and that all items have their parent the list, if that matters.

I've been trying to wrap my mind around this for several days now. I've implemented a similar code in javascript by mutating the objects (in fact, a copy of them), but I would have liked to know how can this be done Haskell.

My best thoughts on the topic so far where this:

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

So now I can have a list of relations from parent to children, So the arrows point at the right direction. I still need to construct a tree from it, while avoiding doing slow lookups. Does that make sense?

Upvotes: 3

Views: 507

Answers (2)

Will Ness
Will Ness

Reputation: 71065

Convert your [Item a] to Map (Maybe ID) [Item a], keyed on the parent ID of each item.

Now you will have the roots under Nothing, and for each root ID you can pull its children from the map (dict) with lookup, and populate the tree's next level this way, recursively.

To be used as key in Map, ID must be in Ord. I think it's a reasonable assumption. I'll use Int here:

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)

Here instead of passing the dict around, we have it in (shared, inner) scope.

Upvotes: 1

user2407038
user2407038

Reputation: 14578

In a functional language, you write such a program by keeping a state which you pass around as a function parameter. In this case, the state is the 'current' item at which you're looking. 

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)

Note that this relies on your stated assumptions. The algorithm is simple and follows directly from the requirements of the function:

  • the value of the current node is the ID/value pair of the given Item
  • the subforest of the current node is all of the trees whose root nodes' parent IDs are the ID of the current node

Then the function you want simply calls buildTreeFrom on every Item which is a root node (i.e. which has no parent):

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

And a simple test (using the very handy 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')

Note that I've made no effort to optimize this program. If you think it's too slow, profile first!

Upvotes: 2

Related Questions