ручной обход дерева. Требуется помощь

[Alexander]

Нужно реализовать ручной проход по дереву, что-то типа поиска в глубину, или ширину, что-то не пойму как это сделать на основе таблиц...
написал тестик:

Код: Выделить всё

Table Struct TmpTable(
   name:string,
   kod   : string
);

Interface TestIfc;
create view vpodr
select * from katpodr, TmpTable, katpodr katpodrcur;
;
procedure InsPodr(n:string; k:string);
begin
   vpodr.insert into TmpTable set TmpTable.name = n, TmpTable.kod=k; 
end;
procedure FindAll(node:comp);
begin
   if(vpodr.getfirst katpodrcur where((node == katpodrcur.nrec))=tsOk){
      InsPodr(vpodr.katpodrcur.name, vpodr.katpodrcur.kod);
   }
   vpodr._loop katpodr where((node == katpodr.cpodr)) ordered by katpodr.cpodr{
      var c:comp;
      c := vpodr.katpodr.nrec
      FindAll(c);
      if(vpodr.getfirst katpodr where((c == katpodr.nrec)) <> tsOk){};
   }
end;
browse b1;
table TmpTable;
fields
   TmpTable.kod;
   TmpTable.name;
end;
handleevent
   cmInit:{
         FindAll(0);
         rescanpanel(#TmpTable);
   }
end;
end.

[Alexander]

вот так, вроде, работает:

Код: Выделить всё

Table Struct TmpTable(
   name:string,
   kod   : string
);

Interface TestIfc;
create view vpodr
select * from katpodr, TmpTable, katpodr katpodrcur;
;
procedure InsPodr(n:string; k:string);
begin
   vpodr.insert into TmpTable set TmpTable.name = n, TmpTable.kod=k; 
end;
procedure FindAll(node:comp);
begin
   if(vpodr.getfirst katpodrcur where((node == katpodrcur.nrec))=tsOk){
      InsPodr(vpodr.katpodrcur.name, vpodr.katpodrcur.kod);
   }
   if(vpodr.getfirst katpodr where((node == katpodr.cpodr))=tsOk){
   do{
      var c:comp;
      c := vpodr.katpodr.nrec
      FindAll(c);
      if(vpodr.getfirst katpodr where((c == katpodr.nrec(noindex))) <> tsOk){};
   }while(vpodr.getnext katpodr where((node == katpodr.cpodr)) ordered by katpodr.cpodr = tsOk)
   }
end;
browse b1;
table TmpTable;
fields
   TmpTable.kod;
   TmpTable.name;
end;
handleevent
   cmInit:{
         FindAll(0);
         rescanpanel(#TmpTable);
   }
end;
end.

[edward_K]

для дерева есть более изящние пути обхода, но дерево должно быть описано как визуальный элемент со всеми вытекающими. А так да - рекурсивная функция с востановлением позиции рулит.

[Den]

Изящнее с помошью маркеров )

[Alexander]

дак я и сделал рекурсивно! а как с помощью маркеров?
Визуальные элементы не навешаны... по визуальным и сам знаю
а можно примерчики? по типу как я тестилку на подразделениях накатал

[Den]

Interface report_derevo ;
create view
var

RootDepartment: comp;
CashMarkers ,PosInCash , Departments : longint ;
curPos:Longint; //позиция в CashMarkers; берётся из PosInCash, как из стека
aparent,curParent: comp; //наверное NREC; текущий родитель, при поиске вложенных
curCount: longint ;
nowComp:comp;

from
KATPODR
katpodr01
;

HandleEvent
CmInit : {
Departments:=InitMarker('', 8, 500, 100, false);
CashMarkers:=InitMarker('', 8, 500, 100, false);
PosInCash :=InitMarker('', 8, 500, 100, false);

aparent:=comp(nrec_уровня обхода) ; // отдаю просто запись для обхода внутрь. Можно переделать на цикл по верхним всем записям таблицы деревянной

InsertMarker(CashMarkers,AParent);
InsertMarker(PosInCash,0);

While GetMarkerCount(PosInCash)>0
{
GetMarker(PosInCash, GetMarkerCount(PosInCash)-1, curPos);
if curPos>=GetMarkerCount(CashMarkers) begin
AtDeleteMarker(PosInCash, GetMarkerCount(PosInCash)-1);
Continue;
end;
While curPos<GetMarkerCount(CashMarkers)
{
GetMarker(CashMarkers, curPos, curParent); //по идее, раз ВСЕГДА должны попадать в границы
AtDeleteMarker(CashMarkers, curPos); //ща мы его выведем, значит ОН нам больше не пригодится
curCount:=GetMarkerCount(CashMarkers);

InsertMarker(Departments, curParent); //ВЫВОД ПРАВИЛЬНО

_loop KATPODR(KATPODR09) where ((curParent == KATPODR.CPODR))
{
InsertMarker(CashMarkers, KATPODR.NREC);
}

if curCount=GetMarkerCount(CashMarkers)
{
//нет детёнышей - вложенностей не будет
}
else
{
//запоминаем, откуда начинался обследованный уровень и переходим к вложенному
InsertMarker(PosInCash,curCount);
break;
}
}
}


//теперь позырим что насобирали....

var li1 : integer ;
var li3 : string ;
var li2 : comp ;

curCount:=GetMarkerCount(Departments);
logstrtofile('c:\debug\derevo.txt','total='curcount);

for(
li1:=0;
li1<curCount;
inc(li1)
)
{
GetMarker(Departments, li1, li2);
if getfirst katpodr01 where ((li2==katpodr01.nrec))=tsok {};
logstrtofile('c:\debug\derevo.txt',li2+'|'+katpodr01.name);
}

}
end;
end.

[edward_K]

ну код 2 раза длинее чем у автора и в 4 чем через обход древа . К слову - для katpodr все еще проще - есть славная табла podrier - через нее удобно в sql фильтровать, тока проверку каталога подразделений иногда нужно делать - показатель что в зарплате в одних фейсах есть, а в других нет какого то подразделения. В других местах вроде как не используется. В ней по главному узлу содержатсся ссылки на все подчиненные записи.

[Alexander]

а... суть понял.... псиб

[Alexander]

edward_K
да я для примера привел просто катподр. у меня свои таблички
код с маркерами хоть и длиннее, но, думаю, быстрее будет. т.к. нет постоянного скакания по позициям, при выходе из рекурсивной функции...

[Den]

edward_K
да я для примера привел просто катподр. у меня свои таблички
код с маркерами хоть и длиннее, но, думаю, быстрее будет. т.к. нет постоянного скакания по позициям, при выходе из рекурсивной функции...

Да, теоретически должно быть побыстрее (проверить бы на деревянных данных в несколько десятков тысяч записей...)) ).
Уж не говоря о об обходе, упомянутым выше , с помощью деревянных treegetxxx.

[Screw]

Вот простейший пример для обхода в ширину любой ветви дерева подразделений, заданной nrec-ом ее корня.

Код: Выделить всё

  // очередь подразделений
  var Departments: longint;
  Departments := InitMarker('', 8, 500, 100, false);
  // обход начинается с BranchRoot
  InsertMarker(Departments, BranchRoot);

  while GetMarkerCount(Departments) > 0
  {
    var D: comp;
    
    GetMarker(Departments, 0, D); 
    AtDeleteMarker(Departments, 0);
    
    // обработать текущее подразделение
    DoSomething(D);    

    // добавить в очередь дочерние подразделения
    _loop KATPODR where ((D == KATPODR.CPODR))
      InsertMarker(Departments, KATPODR.NREC);
  }

[Screw]

Имейте в виду - это только обход. Дерево будет просматриваться как-бы по слоям. Но этот прмер можно заточить для обхода в глубину.