SQL and Delphi: recursive mechanism for creating a tree from a table

Question

The DBMS I'm working with is MySQL, the programming environment is Delphi 7 (which doesn't really matter for this example).

I have a table called 'subject' where I store all book subjects in the system. Subjects can have a parent-child relationship, like science can be divided, let's say, into math and physics whereas math can be subdivided into calculus, algebra, geometry and on we go.

What I would like is create a tree populated with the date from that table. Please, help me do that. It even doesn't matter what language you use for illustration purposes, it simply can be pseudocode.

The database diagram for the Subject table looks like this:

The Subject table definition:

DROP TABLE IF EXISTS subject;
CREATE TABLE IF NOT EXISTS subject (                  # Comment
    subject_id  INT UNSIGNED NOT NULL AUTO_INCREMENT, # Subject ID
    subject     VARCHAR(25)  NOT NULL,                # Subject name
    parent_id   INT UNSIGNED     NULL DEFAULT NULL,   # Parent ID as seen from
    PRIMARY KEY (subject_id),                         # the diagram refers to
    UNIQUE (subject),                                 # the subject_id field
    INDEX (parent_id),
    CONSTRAINT fk_subject_parent
    FOREIGN KEY (parent_id)
        REFERENCES subject (subject_id)
            ON DELETE RESTRICT
            ON UPDATE CASCADE
) ENGINE=InnoDB DEFAULT CHARSET=utf8;

Populating the Subject table with some dummy data:

INSERT INTO subject (subject, parent_id) VALUES
                    ('Science',    NULL),
                    ('Mathematics',   1),
                    ('Calculus',      2),
                    ('Algebra',       2),
                    ('Geometry',      2),
                    ('Languages',  NULL),
                    ('English',       6),
                    ('Latin',         6);

SELECT statement returns this:

SELECT * FROM subject;
╔════════════╦═════════════╦═══════════╗
║ subject_id ║   subject   ║ parent_id ║
╠════════════╬═════════════╬═══════════╣
║          1 ║ Science     ║      NULL ║
║          2 ║ Mathematics ║         1 ║
║          3 ║ Calculus    ║         2 ║
║          4 ║ Algebra     ║         2 ║
║          5 ║ Geometry    ║         2 ║
║          6 ║ Languages   ║      NULL ║
║          7 ║ English     ║         6 ║
║          8 ║ Latin       ║         6 ║
╚════════════╩═════════════╩═══════════╝

Stored procedures:

DELIMITER$$

DROP PROCEDURE IF EXISTS get_parent_subject_list;
CREATE PROCEDURE get_parent_subject_list ()
BEGIN
    SELECT subject_id, subject
    FROM subject
    WHERE parent_id IS NULL
    ORDER BY subject ASC;
END$$


DROP PROCEDURE IF EXISTS get_child_subject_list;
CREATE PROCEDURE get_child_subject_list (IN parentID INT)
BEGIN
    SELECT subject_id, subject
    FROM subject
    WHERE parent_id = parentID
    ORDER BY subject ASC;
END$$

DELIMITER ;

Next is my Delphi procedure that attempts to populate a tree view with data, but as can be seen further, it can't get any deeper than the second level:

procedure TForm1.CreateSubjectTreeView(Sender: TObject);
var
    i : integer;
begin
    i := 0;

    q1.SQL.Clear;
    q1.SQL.Add('CALL get_parent_subject_list()');
    q1.Open;
    q1.First;

    while not q1.EOF do
    begin
        TreeView.Items.Add(nil, q1.Fields[1].Value);

        q2.SQL.Clear;
        q2.SQL.Add('CALL get_child_subject_list(' +
                    VarToStr(q1.Fields[0].Value) + ')');
        q2.Open;
        q2.First;

        while not q2.EOF do
        begin
            TreeView.Items.AddChild(TreeView.Items.Item[i], q2.Fields[1].Value);
            q2.Next;
        end;

        i := TreeView.Items.Count;
        q1.Next;
    end;
end;

This is what this snippet of code does:

+- Science
|   |
|   +- Mathematics
|
+- Languages
    |
    +- English
    +- Latin

But I would like it to look like this:

+- Science
|   |
|   +- Mathematics
|       |
|       +- Calculus
|       +- Algebra
|       +- Geometry
|
+- Languages
    |
    +- English
    +- Latin

Answer 1

I suggest you not load the whole tree at once, why should you ? no man can view at the moment a thousand of items. And it can be long and your program would look frozen. And it makes a huge load pike over network and server.

You better use VirtualTreeView approach, where each item loads its children items on request. That would require one parametrized prepared query like

 Select ID, Title, This, That from TREE where Parent_ID = :ID

• http://code.google.com/p/virtual-treeview/
• http://www.lischke-online.de/index.php/controls/virtual-treeview-gallery
• Tree-like Datastructure (for use with VirtualTreeview)
• VirtualStringTree Correct/recommended use

---

And yes, don't make new SQL text for every item. It is both dangerous and slow (you need to drop all the data gathered for an old request and parse the new one)

You should make one parametrized query, Prepare it and just do close/change param values/open.

See reasons and Delphi sample at http://bobby-tables.com/

---

One example of "load it all at once altogether" rush is at dynamically create popup menu tree from sql server table in Delphi - though i don't think rush is good approach for more or less large trees.

Note about this approach: you fill in root elements, then you find one way or another to fill in elements, not filled yet, but already referenced by others until there is no such elements at last.

You can do it recursively of course, traversing tree to its ends - but that would ask for many nested database queries.

You may make a recursive SQL request, but it would probably be very server-dependent and RDBMS engines usually impose their limits on recursion depth.

An approach maybe slightly worse on tree control but more clean and easier on RDBMS would be to make a dedicated TQueue of just added tree items . After you load some element - initially all root ones - you remember it in the queue. Then you remove one by another from the queue and fill in (load and enqueue) its children. Until the queue gets empty.

Answer 2

I like using a hash table to create an index of all nodes indexed by keyID and use this to build the tree. It requires 2 passes of the table. The first pass creates a root tree node for each record and adds a hash entry of keyID against tree node. the second pass walks the table looking up the parentId in the hash. If it finds it, then it moves the current node under the parent node otherwise ignores it. At the end of the second pass, you have the complete tree built.

    var i,imax,ikey,iParent : integer;
        aNode,aParentNode : TTreeNode;
        aData : TMyData;
        aContainer : TSparseObjectArray; // cDataStructs , delphi fundamentals
        aNodeIndex : TSparseObjectArray; // delphi 7
    begin
      try
        aContainer := TSparseObjectArray.Create(true);
        aNodeIndex := TSparseObjectArray.Create(False);
        imax := 10000;
        // create test data;
        for i := 1 to imax do
        begin
          aData := TMyData.Create;
          aData.iKey := i;
          aData.iParent := Random(imax); // random parent
          aData.Data := 'I:' + IntToStr(aData.iKey);
          aContainer.Item[i] := aData;
        end;

        tv1.Items.Clear;
        tv1.Items.BeginUpdate;
        // build tree
        // First Pass - build root tree nodes and create cross ref. index
        for i := 1 to imax do
        begin
          aData := TMYData(aContainer.Item[i]);
          aNode := tv1.Items.AddChild(nil,aData.Data);
          aNodeIndex.Item[aData.iKey] := aNode;
        end;
        // Second Pass - find parent node using index and move node
        for i := 1 to imax do
        begin
          aData := TMYData(aContainer.Item[i]);
          aNode := TTreeNode(aNodeIndex.Item[aData.iKey]);
          if aNodeIndex.HasItem(aData.iparent)
          then begin
                 aParentNode := TTreeNode(aNodeIndex.Item[aData.iparent]);
                 aNode.MoveTo(aParentNode,naAddChild);
               end;
        end;
        tv1.Items.EndUpdate;
        tv1.Select( tv1.Items.GetFirstNode);
      finally
        aContainer.Free;
        aNodeIndex.free;
      end;
  end;

Answer 3

 procedure TdfmMed.Button1Click(Sender: TObject); var NodePai : TTreeNode; procedure MontaFilho(Node : TTreeNode; Cod : integer); var qry : TFDQuery; node1 : TTreeNode; begin qry := TFDQuery.Create( nil ); qry.Connection := dm1.FDConnection1; qry.close; qry.SQL.Add('SELECT cod, nome_grupo FROM teste WHERE parent_cod = :cod ORDER BY nome_grupo ASC'); qry.ParamByName('cod').AsInteger := cod; qry.Open(); qry.First; while not qry.EOF do begin node1 := TreeView1.Items.AddChild(NODE, qry.Fields[1].Value); MontaFilho(node1, qry.Fields[0].Value ); qry.Next; end; end; begin TreeView1.Items.Clear; qryGrupoPai.close; qryGrupoPai.Open; qryGrupoPai.First; while not qryGrupoPai.EOF do begin NodePai := TreeView1.Items.Add(nil, qryGrupoPai.Fields[1].Value); MontaFilho( NodePai, qryGrupoPai.Fields[0].Value); qryGrupoPai.Next; end; end; 

Answer 4

I wrote an example at stackoverflow en español Consumir menu del sql server , may be useful to somebody else.

It use several Fields:

• ID for the element ID
• PID for Parent ID
• NAME for the command to be executed
• CAPTION for TreeNode caption
• ISVISIBLE to know if this element will be visible to end user (Y/N).

It works for any menu levels, and is intended to be use with any database by using a TDataSource as a parameter

type
    tElementoMenu = Class(TObject)
      Comando : String;
      //Nombre : String;
      ID : String;
    End;
...
procedure TForm1.CrearMenuDeArbol(dsOrigen: TDataSource; CampoID, IDPadre,
  CampoComando, CampoCaption, CampoVisible: String; Raiz : TTreeNode = Nil);
var
  RamaActual, PrimeraRama : TTreeNode;
  ElementoMenu : TElementoMenu;
  iIndiceImagen : Integer;
begin
  RamaActual := Nil;
  PrimeraRama := Nil;
  if not assigned(Raiz) then
    VaciarArbol;

  with dsOrigen.DataSet do
  begin
    //For this example I use filter, however it can be use with WHERE sentence
    Filtered := False;
    IF not assigned(Raiz) then
      Filter := IdPadre + ' IS NULL '
    else
      Filter := IDPadre + ' = ' + TElementoMenu(Raiz.Data).ID;
    Filtered := True;

    First;
    while not Eof do
    begin
      if FieldByName(CampoVisible).AsString = 'Y' then
      begin
        ElementoMenu := TElementoMenu.Create;
        ElementoMenu.Comando := FieldByName(CampoComando).AsString;
        ElementoMenu.ID := FieldByName(CampoID).AsString;
        //ElementoMenu.Nombre := FieldByName(CampoName).AsString; //Otros datos para agregar al elemento del menu
        iIndiceImagen := 0;
        if Not Assigned(Raiz) then
          RamaActual := TreeView1.Items.AddObject(Nil, FieldByName(CampoCaption).AsString, ElementoMenu )
        else
        Begin
          RamaActual := TreeView1.Items.AddChildObject(Raiz, FieldByName(CampoCaption).AsString, ElementoMenu );
          iIndiceImagen := 1;
        End;

        RamaActual.ImageIndex := iIndiceImagen;
        RamaActual.SelectedIndex := iIndiceImagen;
      end;
      Next;
    end;

    if not Assigned(Raiz) then
      PrimeraRama := TreeView1.Items.GetFirstNode
    else
      PrimeraRama := Raiz.getFirstChild;

    while Assigned(PrimeraRama) do
    begin
      CrearMenuDeArbol(dsOrigen, CampoID, IDPadre, CampoComando, CampoCaption, CampoVisible, PrimeraRama);
      PrimeraRama := PrimeraRama.getNextSibling;
    end;    
  end;    
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  VaciarArbol;
end;

procedure TForm1.TreeView1DblClick(Sender: TObject);
begin
  if Assigned(treeView1.Selected) then
    ShowMessage(TElementoMenu(treeView1.Selected.Data).Comando);
end;

procedure TForm1.VaciarArbol;
var
  itm : TTreeNode;
begin
  while TreeView1.Items.Count > 0 do
  begin
    itm := TreeView1.Items[TreeView1.Items.Count-1];
    TElementoMenu(itm.Data).Free;
    TreeView1.Items.Delete(itm);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CrearMenuDeArbol(ds1, 'ID', 'PID', 'NAME', 'CAPTION', 'ISVISIBLE');
  Treeview1.FullExpand;
end;

Answer 5

I have run in the same problem, and wanted to fix it using SQL in order to avoid too many calls to the DB server (for each record/recursion step). Our embedded RDBMS NexusDB does not allow for recursive queries like oracle or MSSQL does. So here's what I came up with, explanation inline. It allows loading the tree in 1 pass, but still loads the entire tree using the provided rootid as a starting point. My DB table is called OBJDAT , has an unique integer ID and the parent link goes by the field TechPar

Calling the routine should look like this, you have to provide a parameter value foor RootID. NULL will select all objects from all roots (having TachPar=NULL)

   SELECT Obj.* FROM TABLE(RECURTABLE(:RootID)) AS Obj

The result will be a table that is ordered with the root (aka top level) objects first. Then you can iterate through the result table and add objects to your tree control (or in memory structure) like below:

//pseudodelphicode
ResultSet:=SQLQueryResult

ResultSet.First
while not ResultSet.EOF do
begin
  NewNode:=TreeNode.Create;
  NewNode.ID:=ResultSet.ID;
  NewNode.Name:=ResultSet.Name
  ... load more relevant stuff
  ParentID:=ResultSet.TechPar
  if ParentID<>nil then
    Tree.FIndNode(ParentID).AddChild(NewNode)
  else Tree.AddRoot(NewNode)

  ResultSet.Next;
end

The implementation of the stored procedure that actually does the work is like this:

-- NexusDB variant of SQL stored procedure to return data from the -- Asset Register or library.

DROP ROUTINE IF EXISTS RECURTABLE;

CREATE FUNCTION RECURTABLE(aRootID INTEGER)
RETURNS TABLE
MODIFIES SQL DATA
BEGIN

  -- pre-clean temporary tables
  CREATE LOCAL TEMPORARY TABLE #tmpsublayer
  (
    ID INTEGER,
    Name VARCHAR(50),
    UserID VARCHAR(50),
    ObjType INTEGER,
    TechPar INTEGER
  );
  CREATE LOCAL TEMPORARY TABLE #tmpobjparsublayer (LIKE #tmpsublayer);
  CREATE LOCAL TEMPORARY TABLE #tmpResultTable (LIKE #tmpsublayer);

--  for debugging purpose, ignore
--  DROP TABLE IF EXISTS #tmpobjparsublayer;
--  DROP TABLE IF EXISTS #tmpsublayer;
--  DROP TABLE IF EXISTS #tmpResultTable;


  DECLARE lRecursionCounter,lParentID INTEGER;
  DECLARE lRootPath TEXT;  
  START TRANSACTION;
  TRY
    IF (aRootID=0) OR (aRootID IS NULL) THEN
      --  No root provided: select all root records into the intermediate sublayer result set
      INSERT INTO #tmpsublayer
       SELECT
          ID,
          Name,
          UserID,
          ObjType,
          TechPar
        FROM OBJDAT
        WHERE (TechPar IS NULL) OR (TechPar=0); -- Match on TechPar in (Null,0)

    ELSE
       -- a root record was provided, select the root record into the result list

       SET lRootPath=NULL;
       SET lParentID=aRootID;
       SET lRecursionCounter=0;
       -- this loop resolves the path from the selected root object to the ultimate root object
       REPEAT
         SET lRecursionCounter=lRecursionCounter+1;
         -- avoid infinite loop by cyclical links here by usning a recursion counter watchdog
         IF lRecursionCounter>100 THEN
           SIGNAL 'Resolve root path for ('+ToStringLen(aRootID,10)+'): Maximum hierarchical depth reached.';
         END IF;
         SET lParentID=(SELECT TechPar FROM $AMOBJTABLENAME WHERE ID=lParentID);
         IF NullIf(lParentID,0) IS NULL THEN
            LEAVE;
         ELSE
           SET lRootPath=TOSTRINGLEN(lParentID,10)+COALESCE(';'+lRootPath,'');
         END IF;
         UNTIL FALSE
       END REPEAT;

      -- actually select the single root object into the intermediate sublayer result set
      INSERT INTO #tmpsublayer
      SELECT
        ID,
        Name,
        UserID,
        ObjType,
        TechPar
      FROM OBJDAT
      WHERE ID=aRootID;  // match on ID
     END IF;


    -- copy our rootlayer of results into out final output result set
    INSERT INTO #tmpResultTable
      SELECT
        *
      FROM #tmpsublayer;

    SET lRecursionCounter=0;
    -- this loop adds layers of sub objects to the result table
    REPEAT
      SET lRecursionCounter=lRecursionCounter+1;
      IF (SELECT TOP 1 ID FROM #tmpsublayer) IS NULL THEN
        LEAVE; -- empty result set, we are done get out of the loop
      END IF;

      -- watchdog for loop count to avoid infinite loops caused by cyclical links
      IF lRecursionCounter>100 THEN
        SIGNAL 'RecurSelect('+ToStringLen(aRootID,10)+'): Max hierarchical depth reached.';
      END IF;


      --  get a sublayer from the main table based on the current parent layer and technical parent field
      -- Not required DROP TABLE IF EXISTS #tmpobjparsublayer;
      DELETE FROM #tmpobjparsublayer;
      INSERT INTO #tmpobjparsublayer
        SELECT
          D.ID ID,
          D.Name Name,
          D.UserID UserID,
          D.ObjType TypeID,
          D.TechPar TechPar
      FROM #tmpsublayer P
      JOIN OBJDAT ON P.ID=D.TechPar;

      --  insert our sublayer of regular linked objects into the result table
      INSERT INTO #tmpResultTable
        SELECT
          *
        FROM #tmpobjparsublayer;

      -- clear current sublayer
      DELETE FROM #tmpsublayer;
      -- Move the newly selected objects layer to the sublayer set for the next iteration
      INSERT INTO #tmpsublayer
        SELECT
          *
        FROM #tmpobjparsublayer;

      UNTIL FALSE -- trust the LEAVE and SIGNAL statements
    END REPEAT;

    -- clean up temporary tables
    DELETE FROM #tmpobjparsublayer;
    DELETE FROM #tmpsublayer;
    COMMIT;
  CATCH TRUE 
    -- cleanup if something went wrong
    ROLLBACK;
    SIGNAL ERROR_MESSAGE;
  END;

  DROP TABLE IF EXISTS #tmpobjparsublayer;
  DROP TABLE IF EXISTS #tmpsublayer;

  -- return result
  RETURN SELECT * FROM #tmpResultTable;
END;