Pointer "Bäume"

[n00b_on_knees]

Hallo miteinander!

Ich soll einen Pointer Baum erzeugen, mit den Zahlen 123456789 und 529613847.
Außerdem brauche ich einen Code für dass Suchen einer Zahl. Das ganze soll mit dem Baum 2 geschehen (529613847), und mit den Werten 6 und 3.
Weiters, ist ein Code für dass Löschen einer Zahl erforderlich. Baum und Werte sind die selben.

Als Beispiel hier eine Funktion "Lesen", die einen Baum sortieren soll.

Code:

procedure lesen(a: DynamischesArray);
begin
  if a <> nil then
    begin
      read (a^.left);
      mmaus.Lines.Add(IntToStr(a^^.Daten));
      read(a^.right);
  end;
end;

Ich hoffe mir kann jemand behilflich sein.
Danke im Vorraus für eure Antworten.

Mit freundlichen Grüßen.

[DelphiDeveloper]

dann mach dich mal ans googlen

binaerer baum, binaerer suchbaum, traversieren, tiefensuche etc.


das waere doch schon mal was fuer den anfang:
http://www.informatiktreff.de/materi.../baum/baum.htm

[n00b_on_knees]

Danke erstmal für den Link..habe selbst schon einige Stunden damit verbracht etwas zu finden, aber leider nichts gefunden..:(

[Jens Schumann]

Hallo,
ist es das was Du meinst

Delphi-Quellcode:

unit Unit1;

interface

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

type

  PNode = ^TNode;
  TNode = Record
          Left   : PNode;
          Right  : PNode;
          Number : Integer;
          end;

  TSeachCallBack = procedure(Node : PNode) of object;

  TForm1 = class(TForm)
    Panel1: TPanel;
    PbNodes: TPaintBox;
    Edit1: TEdit;
    btnAdd: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    procedure btnAddClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
    FRoot : PNode;
    procedure AddToTree(aNumber: Integer; var Node: PNode);
    function  SearchInTree(Node : PNode; aNumber : Integer; SCB : TSeachCallBack) : PNode;
    procedure DisposeNodes(Node : PNode);
    procedure SeachCallBack(Node : PNode);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.AddToTree(aNumber: Integer;var Node: PNode);
begin
  If Node=Nil then
    begin
    New(Node);
    With Node^do
      begin
      Number:=aNumber;
      Left:=Nil;
      Right:=Nil;
      end;
    end
      else
        begin
        If aNumber<Node^.Number then
          AddToTree(aNumber,Node^.Left)
            else
              AddToTree(aNumber,Node^.Right);
        end;
end;

procedure TForm1.btnAddClick(Sender: TObject);
begin
  AddToTree(StrToInt(Edit1.Text),FRoot);
  Edit1.Clear;
end;

procedure TForm1.DisposeNodes(Node: PNode);
begin
  If Node^.Left<>Nil then
    DisposeNodes(Node^.Left);
  If Node^.Right<>Nil then
    DisposeNodes(Node^.Right);
  Dispose(Node);  
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  If FRoot<>Nil then
    DisposeNodes(FRoot);
end;

{SearchInTree findet alle Vorkommen von aNumber im Baum. Wenn aNumber gefunden
 wird, wird die procedure SCB mit dem entsprechenden Node im Parameter aufgerufen}
function TForm1.SearchInTree(Node: PNode; aNumber: Integer;SCB : TSeachCallBack): PNode;
begin
  If Node<>Nil then
    begin
    If Node^.Number=aNumber then
      SCB(Node)
        else
          begin
          SearchInTree(Node^.Left,aNumber,SCB);
          SearchInTree(Node^.Right,aNumber,SCB);
          end;
    end;
end;
procedure TForm1.Button1Click(Sender: TObject);

begin
  SearchInTree(FRoot,StrToInt(Edit1.Text),SeachCallBack);
end;

procedure TForm1.SeachCallBack(Node: PNode);
begin
  ShowMessage(IntToStr(Node^.Number));
end;

end.

[n00b_on_knees]

Ja ist es. Jedenfalls dass Suchen..warst mir eine große Hilfe, danke!
Falls sich noch jemand mit dem Löschen auskennt, bitte gebt mir ne kleine Hilfe. :)

[Jens Schumann]

Hallo,
die o.g. genannte function SearchInTree besucht nicht jeden Knoten.
So wäre es besser

Delphi-Quellcode:

function TForm1.SearchInTree(Node: PNode; aNumber: Integer;SCB : TSeachCallBack): PNode; 
begin 
  If Node<>Nil then 
    begin 
    If Node^.Number=aNumber then 
      SCB(Node) 
    SearchInTree(Node^.Left,aNumber,SCB); 
    SearchInTree(Node^.Right,aNumber,SCB); 
    end; 
end;

[n00b_on_knees]

habe ich mir auch ähnlich gedacht, aber habe es dennoch gelassen :)..danke für die Erläuterungen.
Wir haben dazu heute etwas weitergearbeitet..im Bereich "Löschen", der Elemente im Baum.
Da gibt es 3 verschiedene Möglichkeiten. Links keine Elemente, Rechts keine Elemente, oder auf beiden Seiten Elemente. Das Programm soll in allen 3 Fällen funktionieren. Rekursiv wäre ein Vorteil. Habe mir dass ganze schon in etwa überlegt, nur weiß ich leider nicht genau, wie man dies umsetzen könnte.

[n00b_on_knees]

tut mir leid für den Doppelpost :)
langsam brauche ich es wirklich *g*...ich wäre euch sehr verbunden, wenn mir jemand vielleicht doch noch mit dem Löschen helfen könnte :)

[n00b_on_knees]

hier der fertige code der so in etwa funktionieren müsste, leider steige ich in "fall3" irgendwie nicht richtig durch.

Delphi-Quellcode:

procedure delete(p: PDynArray; var loesch: PDynArray);
var vor: PDynArray;
begin
  vor := p;
  suchevor(loesch,vor);
  if (loesch^.left = nil) and (loesch^.right = nil) then
    free(loesch)
  else
    if (loesch^.Right = nil) then
      aufruecken(vor,loesch,loesch^.left)
    else
      if (loesch^.Left = nil) then
        aufruecken(vor,loesch,loesch^.right)
      else
        fall3(loesch);
end;

procedure aufruecken(vor,akt,nach : PDynArray);
begin
  if (vor^.Right = akt) thenvor^Right := nach
  else vor^.Left := nach;
  free(akt);
end;

procedure suchevor(loesch:PDynArray; var vor:PDynArray);
begin
  while (vor^.left <> loesch) and (vor^.right <> loesch) do
    if (vor^.Daten < loesch^.Daten) then vor := vor^.Right
    else vor := vor^.Left;
end;

procedure fall3(loesch: PDynArray);
var
  akt,akt2:PDynArray;
begin
  akt := loesch^.Left;
  akt2 := akt;
  while (akt^.Right <> nil) do
  begin
    akt2 := akt;
    akt := akt^.Right;
  end;
  loesch^.Daten := akt^.Daten;
  akt2^.Right := nil;
  free(akt);
end;