algorytm.org

Implementacja w Delphi/Pascal

Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Drzewa Poszukiwań Binarnych (BST) - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 14
SłabyŚwietny
Nadesłany przez Michał Knasiecki, 16 sierpnia 2005 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.
Pobierz pełne rozwiązanie.

Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.

bst_d/Unit1.pas:
//Program pobrano ze strony www.algorytm.org
//Opracował Michał Knasiecki
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  wskaznik=^Drzewo;
        drzewo=record
        dane:integer;
        l,r:wskaznik;
        end;
        Tstos=array of wskaznik; //prymitywny stos
var
  Form1: TForm1;
  i:integer;
  first,current:wskaznik;
  stos:Tstos;
  LStos:integer=0;
  implementation

{$R *.DFM}
procedure removeall;
var tmp:wskaznik;
begin
tmp:=stos[Lstos];
stos[Lstos]:=nil;
dec(lstos);
if tmp^.l<>nil then
        begin
        inc(Lstos);
        stos[lstos]:=tmp^.l;
        end;
if tmp^.r<>nil then
        begin
        inc(Lstos);
        stos[lstos]:=tmp^.r;
        end;
dispose(tmp);
dec(i);
end;

function findnode(s:integer):boolean;//znajdź element
var koniec:boolean;
begin
koniec:=false;
if first<>nil then
        begin
        current:=first;
        if s<>first^.dane
                then repeat
                if (s<=current^.dane)and(current^.l<>nil) then current:=current^.l else
                if (s>current^.dane)and(current^.r<>nil) then current:=current^.r else
                koniec:=true;
                until (s=current^.dane)or(koniec);
        if koniec=false then result:=true else result:=false;
        end;
end;
procedure erasenode;
begin

end;
procedure add(s:integer);
var
prev:wskaznik;
koniec:boolean;
begin
koniec:=false;
current:=first;
if first=nil then
        begin
        new(first);
        with first^ do
                begin
                dane:=s;
                l:=nil;
                r:=nil;
                end;
        end else
while not (koniec) do
if s<=current^.dane then
        if current^.l=nil then
        begin
        prev:=current;
        new(current);
        prev^.l:=current;
                with current^ do
                begin
                dane:=s;
                l:=nil;
                r:=nil;
                koniec:=true;
                end;
        end else current:=current.l
else if s>current^.dane then
        if current^.r=nil then
                begin
                prev:=current;
                new(current);
                prev^.r:=current;
                        with current^ do
                        begin
                        dane:=s;
                        l:=nil;
                        r:=nil;
                        koniec:=true;
                        end;
                end
        else current:=current^.r;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
i:=0;
current:=nil;
first:=nil;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
inc(i);
add(strtoint(edit1.text));
edit1.SetFocus;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if first=nil then showmessage('Drzewo jest puste') else
if findnode(strtoint(edit2.text))=true then
showmessage('Znaleziono: '+inttostr(current.dane)) else
showmessage('Brak elementu w drzewie');
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
if first<>nil then
begin
setlength(stos,i);
stos[1]:=first;
Lstos:=1;
while not (Lstos=0) do
removeall;
end;
finalize(stos);
application.terminate;
end;

end.
Dodaj komentarz