While notEOF(F) do

Begin

Var

Var

Type

Uses

Begin

Begin

Begin

Begin

Begin

Begin

Var

Var

Begin

Var

Begin

Begin

Begin

Begin

Begin

Var

Begin

Else

End

Begin

Else

Begin

Begin

Begin

Else

End

Begin

Begin

Begin

Readln(F, S);

if S = ‘’ then Away(1); // Пустая строка нам ни к чему

iDepth:= 0;

while S[1] = ‘ ‘ do // Число пробелов есть глубина узла

Inc(iDepth);

Delete(S, 1, 1);

end;

if S = ‘’ then Away(2); // Пустая строка нам ни к чему

New(pCurr);

pCurr^.iKey:= StrToInt(S);

{$IFDEF StaticArrayOfChildren }

for i:= 1 to N do pCurr^.mpChild[i]:= nil;

{$ENDIF}

{$IFDEF DynamicArrayOfChildren }

Finalize(pCurr^.mpChild);

{$ENDIF}

{$IFDEF ListOfBrothers}

pCurr^.pChild:= nil;

{$ENDIF}

if iDepth = iDepthPrev then

if iDepth = 0 then Away(3);

if iDepth > iDepthPrev then

if iDepth <> iDepthPrev+1 then Away(4);

// У бабушки не может быть внуков (правнуков и т.д.), если у неё не было детей

end;

SetLength(mPath, iDepth+1);

end;

mPath[iDepth]:= pCurr;

if iDepth > 0 then

pParent:= mPath[iDepth-1];

// Фиксируем родителя

{$IFDEF StaticArrayOfChildren }

Inc(npChild);

if npChild > N then Away(5);

pParent^.mpChild[npChild]:= pCurr;

{$ENDIF}

{$IFDEF DynamicArrayOfChildren }

i:= Length(pParent^.mpChild);

SetLength(pParent^.mpChild, i+1);

pParent^.mpChild[i]:= pCurr;

{$ENDIF}

{$IFDEF ListOfBrothers}

pAux:= pParent^.pChild;

if pAux = nil then

// Это будет первый (старший) из потомков родителя

pParent^.pChild:= pCurr

// Это будет последний (младший) из потомков родителя

while pAux^.pNext <> nil do

pAux:= pAux^.pNext;

// Прошли по списку «братьев» до самого младшего

pAux^.pNext:= pCurr;

// Линейный список «братьев» пополнен НОВЫМ младшим «братом»

end;

pCurr^.pNext:= nil;

// Нет ещё более младших «братьев»

{$ENDIF}

// iDepth = 0

if pRoot <> nil then Away(6);

pRoot:= pCurr;

end;

iDepthPrev:= iDepth;

end;

CloseFile(F);

Finalize(mPath);

end;

procedure MyTableProc(var pThis: pMyTreeNode);

// Пополнение (корректировка) таблицы посещаемости ключей дерева

i, j: integer;

i:= Length(mTable);

for j:= 0 to i-1 do

if pThis^.iKey = mTable[j].iKey then

Inc(mTable[j].nKey);

exit;

end;

SetLength(mTable, i+1);

mTable[i].iKey:= pThis^.iKey;

mTable[i].nKey:= 1;

end;

procedure MyIncFreqProc(var pThis: pMyTreeNode);

Inc(pThis^.nKey);

end;

procedure MyDelProc(var pThis: pMyTreeNode);

Dispose(pThis);

pThis:= nil;

end;

procedure MySearchKeyProc(var pThis: pMyTreeNode);

if pThis^.iKey = iKeySought then

writeln(iKeySought, ‘ was found!’);

end;

procedure ShowMyTable;

i, j: integer;

i:= Length(mTable);

for j:= 0 to i-1 do

Writeln('iKey=', mTable[j].iKey, ' nKey=', mTable[j].nKey);

end;

procedure DetourTree(MyProc: MyProcType);

iDepth: integer;

procedure DetourSubTree(pFrom: pMyTreeNode; MyProc: MyProcType);

i: integer;

{$IFDEF ListOfBrothers}

pCurr: pMyTreeNode;

{$ENDIF}

for i:= 1 to iDepth do Write(' ');

Writeln(pFrom^.iKey);

Inc(iDepth);

{$IFDEF StaticArrayOfChildren }

for i:= 1 to npChild do

DetourSubTree(pFrom^.mpChild[i], MyProc);

{$ENDIF}

{$IFDEF DynamicArrayOfChildren }

for i:= 0 to High(pFrom^.mpChild) do

DetourSubTree(pFrom^.mpChild[i], MyProc);

{$ENDIF}

{$IFDEF ListOfBrothers}

pCurr:= pFrom^.pChild;

while pCurr <> nil do

DetourSubTree(pCurr, MyProc);

pCurr:= pCurr^.pNext;

end;

{$ENDIF}

Dec(iDepth);

MyProc(pFrom);

end;

iDepth:= 0;

DetourSubTree(pRoot, MyProc);

end;

nAux:= 0;

{$IFDEF StaticArrayOfChildren }

Inc(nAux);

{$ENDIF}

{$IFDEF DynamicArrayOfChildren }

Inc(nAux);

{$ENDIF}

{$IFDEF ListOfBrothers}

Inc(nAux);

{$ENDIF}

if nAux <>1 then Away(0);

// Следует «включать» один и только один из этих трех режимов

pRoot:= nil;

ReadTree;

Readln;

Finalize(mTable);

DetourTree(MyTableProc);

Readln;

ShowMyTable;

Readln;

iKeySought:= '77';

DetourTree(MySearchKeyProc);

Readln;

end.

Двоичные деревья

Двоичное дерево может состоять, например, из узлов типа

MyNodeType = record

iKey: integer;

pLeft, pRight: pMyNodeType;

end;

Здесь поле iKey – ключ узла, значение этого поля должно быть уникальным в дереве, поля pLeft, pRight – ссылки на левого и правого потомков. Эти ссылки принимают значение nil, если потомков у узла нет.

Традиционно, тип-ссылка объявляется перед объявлением типа, на который эта ссылка ссылается:

pMyNodeType = ^MyNodeType;

Обход двоичного дерева

Обход (посещение всех узлов) двоичного дерева может осуществляться с помощью рекурсивной процедуры, например, такой:

procedure Detour(pStart: pMyNodeType);

WriteLN(pStart^.iKey);

Detour(pStart^.pLeft);

Detour(pStart^.pRight);

end;

Оператор WriteLN(pStart^.iKey) доступен в консольном режиме и показан в качестве простейшего примера; вместо него может быть применен какой-нибудь другой.

Первый экземпляр процедуры (например Detour(pRoot) вызывается по отношению к переменной, которая указывает на корень всего дерева (например, pRoot).

Показанный вариант процедуры Detour понятен, но не очень удобен. Ключи располагаются на экране строго один под другим. Хорошо бы вывод ключей на экран вести так, чтобы полученная картина была похожа на дерево. Простейшим путем этого можно достичь, отступая от края экрана (при выводе ключа) на столько позиций, какова глубина выводимого узла. Например, «подправленная» процедура обхода

procedure Detour(pStart: pMyNodeType; Level: integer);

var i: integer;

for i:=1 to Level do Write(Chr(32)); // В начале строки “Level” пробелов

WriteLN(pStart^.iKey);

Detour(pStart^.pLeft, Level + 1);

Detour(pStart^.pRight, Level + 1);

end;

впервые вызывается в виде Detour(pRoot, 0).

Дерево поиска

Деревом поиска называется двоичное дерево, подчиняющееся требованиям:

· для ключевых полей узлов определены отношения «больше» – «меньше» – «равно»,

· ключ каждого из узлов больше ключа левого потомка (если он есть) и меньше ключа правого потомка (если он есть).

Следовательно, ключ каждого из узлов больше ключей каждого из узлов левого поддерева (если левое поддерево есть) и меньше ключей каждого из узлов правого поддерева (если правое поддерево есть).

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

Сбалансированное дерево иногда именуется АВЛ-деревом (см ссылку http://ru.wikipedia.org/wiki/%D0%90%D0%92%D0%9B-%D0%B4%D0%B5%D1%80%D0%B5%D0%B2%D0%BE).

Двоичное дерево идеально сбалансировано, если для каждого из узлов количества узлов его левого и правого поддеревьев отличаются не более, чем на единицу.

program Project2;

{$APPTYPE CONSOLE}

SysUtils;

pMyNodeType = ^MyNodeType;

MyNodeType = record

iKey: integer;

nKey: integer;

pLeft, pRight: pMyNodeType;

end;

pRoot: pMyNodeType;

mItem: array of pMyNodeType;

nItem: integer;

procedure ReadItems;

F: TextFile;

pCurr: pMyNodeType;

Finalize(mItem);

nItem:= 0;

AssignFile(F, 'Tree2.txt');

Reset(F);

Дата добавления: 2014-01-03