Страница 1 из 1
ручной обход дерева. Требуется помощь
Добавлено: 11 ноя 2009, 14:30
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.
Добавлено: 11 ноя 2009, 14:48
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.
Добавлено: 11 ноя 2009, 15:17
edward_K
для дерева есть более изящние пути обхода, но дерево должно быть описано как визуальный элемент со всеми вытекающими. А так да - рекурсивная функция с востановлением позиции рулит.
Добавлено: 11 ноя 2009, 15:25
Den
Изящнее с помошью маркеров )
Добавлено: 11 ноя 2009, 16:06
Alexander
дак я и сделал рекурсивно! а как с помощью маркеров?
Визуальные элементы не навешаны... по визуальным и сам знаю

а можно примерчики? по типу как я тестилку на подразделениях накатал

Добавлено: 11 ноя 2009, 16:24
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.
Добавлено: 11 ноя 2009, 16:40
edward_K
ну код 2 раза длинее чем у автора

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

Добавлено: 11 ноя 2009, 16:49
Alexander
edward_K
да я для примера привел просто катподр. у меня свои таблички

код с маркерами хоть и длиннее, но, думаю, быстрее будет. т.к. нет постоянного скакания по позициям, при выходе из рекурсивной функции...
Добавлено: 11 ноя 2009, 16:53
Den
Alexander писал(а):edward_K
да я для примера привел просто катподр. у меня свои таблички

код с маркерами хоть и длиннее, но, думаю, быстрее будет. т.к. нет постоянного скакания по позициям, при выходе из рекурсивной функции...
Да, теоретически должно быть побыстрее (проверить бы на деревянных данных в несколько десятков тысяч записей...)) ).
Уж не говоря о об обходе, упомянутым выше , с помощью деревянных treegetxxx.
Добавлено: 11 ноя 2009, 21:26
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);
}
Добавлено: 11 ноя 2009, 21:29
Screw
Имейте в виду - это только обход. Дерево будет просматриваться как-бы по слоям. Но этот прмер можно заточить для обхода в глубину.