Building a tree from database rows

Question

I need to build a tree from database rows. To be more specific I have a table wich contains the chart of accounts.

Instead of querying the table recursively I want to load all the tables' information, the account rows which contain ids and parentIds in a single step and then build the tree from there.

One of the problems with this is that the account rows are not in any order, ie. I could encounter a child before I encounter the parent.

I reckon that this problem is quite generic so I presume there might even already be a haskell library for it.

Can anyone help?

Answer 1

As Nikita said, what is your real problem?

You do not provide any data type, tree key classification, ...

Anyway, this code can help to think about your problem...

data Tree a = Node a [Tree a] deriving Show

db = [(0, 1)
     ,(1, 2)
     ,(1, 3)
     ,(2, 4)
     ,(2, 6)
     ,(3, 5)
     ]

rootTree = Node 0 []

insert parent child (Node key childs) =
  Node key $ if key == parent then Node child []:childs
                              else map (insert parent child) childs

insertFromDB rows = foldl insertRow rootTree rows
  where insertRow tree (parent, child) = insert parent child tree

If you can not get ordered data, you can order it searching parents, next function calculate deep level of each node (with same db data)

calculateDeepLevel db = compute 0 roots
  where roots = filter (not.flip elem snds) fsts
        fsts = nub $ map fst db
        snds = map snd db
        compute level parents = map (\n -> (n, level)) parents ++
                                concatMap (addChilds (level + 1)) parents
        addChilds level node = compute level $ map snd $ filter ((node==).fst) db

with calculateDeepLevel you can calculate a ordered db version and 0-based from a unordered and no rooted (without 0 node) version of db.

Answer 2

First some imports,

import qualified Data.Map as M
import qualified Data.Tree as T
import Data.List (foldl')
import Control.Arrow ((&&&))
import Data.Maybe (fromMaybe)

Next, let's assume we have records that have an id, and an optional parent id (root nodes have no parent), and carry some value:

data Rec a = Rec { recId       :: Int
                 , recParentId :: Maybe Int
                 , recValue    :: a
                 }

There's nothing to prevent more than one node from having a Nothing parent id, so we might find more than one tree, so our function for transforming the list into a tree could look like this:

toTree :: [Rec a] -> [T.Tree a]
toTree rs = ts where

First, let's build a map from optional parent id to a list of the records that have that parent id:

    -- gs :: M.Map (Maybe Int) [Rec a]
    gs = foldl' f M.empty rs where
        f m r = M.insertWith (const (r:)) (recParentId r) [r] m

Next, let's unfold a tree starting from a dummy root node, the children of which will be the roots of the trees we're interested in. Note that the dummy root node has no value, so we use undefined:

    -- t :: T.Tree a
    t = T.unfoldTree mkNode (undefined, Nothing)

The mkNode function is passed the value and id of the node we want to build. It returns the value, and a list of the child value/id pairs using the Map we constructed earlier:

    -- mkNode :: (a, Maybe Int) -> (a, [(a, Maybe Int)])
    mkNode (a, i) = (a, map (recValue &&& Just . recId)
                          . fromMaybe []
                          . M.lookup i $ gs)

Finally, we can discard the dummy root node, and return its immediate children as the roots of the trees we're interested in:

    ts = T.subForest t

And here's a test:

main = mapM_ (putStrLn . T.drawTree)
         $ toTree [ Rec 0 Nothing "rootA"
                  , Rec 1 (Just 0) "rootA.childA"
                  , Rec 2 (Just 0) "rootA.childB"
                  , Rec 3 (Just 1) "rootA.childA.childA"
                  , Rec 4 (Just 1) "rootA.childA.childB"
                  , Rec 5 (Just 2) "rootA.childB.childA"
                  , Rec 6 (Just 2) "rootA.childB.childB"
                  , Rec 7 Nothing "rootB"
                  , Rec 8 (Just 7) "rootB.childA"
                  , Rec 9 (Just 7) "rootB.childB"
                  , Rec 10 (Just 8) "rootB.childA.childA"
                  , Rec 11 (Just 8) "rootB.childA.childB"
                  , Rec 12 (Just 9) "rootB.childB.childA"
                  , Rec 13 (Just 9) "rootB.childB.childB"
                  ]

Which generates:

rootB
|
+- rootB.childB
|  |
|  +- rootB.childB.childB
|  |
|  `- rootB.childB.childA
|
`- rootB.childA
   |
   +- rootB.childA.childB
   |
   `- rootB.childA.childA

rootA
|
+- rootA.childB
|  |
|  +- rootA.childB.childB
|  |
|  `- rootA.childB.childA
|
`- rootA.childA
   |
   +- rootA.childA.childB
   |
   `- rootA.childA.childA