VPF::Двоичные деревья - Форум программистов

ASGDeveloper

Дата 20.6.2006, 14:09 (ссылка)

(нет голосов)

Загрузка ...

developer

Профиль
Группа: Участник
Сообщений: 389
Регистрация: 1.4.2006

Репутация: 1
Всего: 1

После осмотра и анализа кучи сайтов и форумов был создан следующий механизм работы с сабжем (демо-прога):

Код


type
  PTree = ^TTree;
  TTree = record
    Value: string;
    Parent, LChild, RChild: PTree;
  end;
  TTreeAr = array of TTree;

...

var
  TreeAr: TTreeAr;
  Head: PTree;

...

function RandomStr: string;
const
  num = '1234567890abcefghijklmnopqrstuvwxyz';
var
  i: Integer;
begin
  Randomize;
  Result := '';
  for i := 0 to 9 do
    Result := Result + num[Random(Length(num) - 1)];
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  V: Cardinal;
begin
  V := GetTickCount;
  SetLength(TreeAr, 1000);
  for I := 0 to High(TreeAr) do
    TreeAr[I].Value := RandomStr;
  Label1.Caption := 'Заполнено за ' + IntToStr(GetTickCount - V) + ' м.сек';
end;

procedure AddNew(var AHead: PTree; ANew: PTree);
var
  El, Par: PTree;
  Left: Boolean;
begin
  El := AHead;
  Par := nil;
  Left := true;
  //найдем предка нового элемента и запишем его адрес в Par
  while El <> nil do
  begin
    Par := El;
    if ANew.Value >= El.Value then
    begin
      El := El.RChild;
      Left := false;
    end
    else
    begin
      El := El.LChild;
      Left := true;
    end;
  end;

  ANew.Parent := Par; //покажем сыну его отца :)
  ANew.LChild := nil;
  ANew.RChild := nil;

  if Par = nil then
    AHead := ANew
  else
  begin
    if Left then //покажем отцу его сына :)
      Par.LChild := ANew
    else
      Par.RChild := ANew;
  end;

end;

procedure AddWord(Word: string);
var
  len: Byte;
  str: string;
begin
  str := RandomStr;
  len := Length(TreeAr);
  SetLength(TreeAr, len + 1);
  TreeAr[len].Value := Str;
  AddNew(Head, @TreeAr[len]);
end;

function FindStr(AHead: PTree; AVal: string): Boolean;
begin
  Result := false;
  while not Result and (AHead <> nil) do
  begin
    if AVal = AHead.Value then
      result := true
    else if AVal > AHead.Value then
      AHead := AHead.RChild
    else
      AHead := AHead.LChild;
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  I: Integer;
  V: Cardinal;
begin
  V := GetTickCount;

  Head := nil;
  //построим бинарное дерево
  for I := 0 to High(TreeAr) do
  begin
    AddNew(Head, @TreeAr[I]);
  end;

  Label4.Caption := 'Построено за ' + IntToStr(GetTickCount - V) + ' м.сек';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Head := nil;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  F: Boolean;
  S: string;
  V: Cardinal;
begin
  V := GetTickCount;
  F := FindStr(Head, Edit1.Text);
  S := IntToStr(GetTickCount - V) + ' м.сек';
  if F then
    Label5.Caption := 'Найдено за  ' + S
  else
    Label5.Caption := 'Не найдено за  ' + S;
end;

Проблемы возникают при вызове AddWord. Не подскажете где ошибка?
Или может есть другой (аналогичный) метод работы с двоичными деревьями, но безглючный или более быстрый.

Это сообщение отредактировал(а) ASGDeveloper - 20.6.2006, 14:11

ASGDeveloper

Дата 20.6.2006, 15:07 (ссылка)

(нет голосов)

Загрузка ...

developer

Профиль
Группа: Участник
Сообщений: 389
Регистрация: 1.4.2006

Репутация: 1
Всего: 1

Все. Вопрос решен.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »