Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi RedBlackTrees (https://www.delphipraxis.net/40560-redblacktrees.html)

Coolboarder_9 17. Feb 2005 16:14


RedBlackTrees
 
So.
Wir haben n Rot-schwarz-baum implementiert. Aber eigentlich isses mehr in rotschwarzes Problem.

Hier is der Quelltext.Weis jemand was da falsch is?
Ne andere Möglichkeit der Implementation wär auch klasse.

Cu, Olli un Adrian

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type link = ^node;
        node = record
                info, key : integer;
                l,r : link;
                red : boolean;
                end;

var head, z : link;


procedure Bild(xa,xe,y: integer; b:link);
var x1: integer;
begin
form1.Image1.Canvas.pen.color:=0;
if b<>z then
  begin
    x1:=(xa+xe)div 2;
    Form1.Image1.Canvas.MoveTo(x1+3,y+13);
    Form1.Image1.Canvas.LineTo((x1+xe)div 2,y+40);
    Bild(xa,x1,y+40,b^.r);
    if b^.red then
      Form1.Image1.Canvas.Pen.Color:=clRed else
      Form1.Image1.Canvas.Pen.Color:=clBlack;
    Form1.Image1.Canvas.TextOut((xa+xe)div 2,y,IntToStr(b^.info));
    Form1.Image1.Canvas.MoveTo(x1+3,y+13);
    Form1.Image1.Canvas.LineTo((x1+xa)div 2,y+40);
    Bild(x1,xe,y+40,b^.l);
  end
  else
    Form1.Image1.Canvas.TextOut((xa+xe)div 2,y,'nil');
end;

procedure rbtinitialize;
begin
new(z);
z^.l:=z;
z^.r:=z;
z^.red := false;

new(head);
head^.key:=0;
head^.r:=z;
head^.l:=z;
end;

function rotate(v:integer; y:link) : link;
 var c,gc : link;
 begin
        if v < y^.key then
                c :=y^.l
        else
                c:=y^.r;

        if v < c^.key
                then
                begin
                        gc:=c^.l;
                        c^.l:=gc^.r;
                        gc^.r:=c;
                end

        else
                begin
                        gc:=c^.r;
                        c^.r:=gc^.l;
                        gc^.l:=c;
                end;

        if v < y^.key then
                y^.l:=gc
        else
                y^.r:=gc;

        rotate := gc
 end;

function split (v:integer; gg,g,p,x : link) : link;
 begin
        x^.red:=true;
        x^.l^.red := false;
        x^.r^.red:= false;

        if p^.red then
                begin
                        g^.red := true;

                        if (v < g^.key) <> (v < p^.key) then
                                p:=rotate(v,g);

                        x:= rotate(v,gg);
                        x^.red :=false
                        end;
                head^.r^.red := false;
                split:=x;

 end;

function rbtreeinsert(v:integer; x : link) : link;
var gg, g, p : link;
begin
        p:=x;
        g:=x;
        repeat
                gg:=g;
                g:=p;
                p:=x;
            if v < x^.key then
                x:=x^.l
            else
                x:=x^.r;

            if x^.l^.red and x^.r^.red then x:= split(v,gg,g,p,x);

        until x=z;

        new(x);
        x^.info := v ;
        x^.l:=z;
        x^.r:=z;

           if v < p^.key then
                p^.l:=x
            else
               p^.r:=x;
        rbtreeinsert:=x;
        x := split (v,gg,g,p,x);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
image1.Canvas.Rectangle(0,0,500,500);
rbtinitialize;
randomize;
for i:=1 to 20 do
  rbtreeinsert(i,head);

if head.red then Button1Click(self) else
Bild(0,400,10,head^.r);
end;

end.

Daniel 17. Feb 2005 16:17

Re: RedBlackTrees
 
"Hier habt Ihr meinen Quelltext - guckt mal rüber" - so geht das nicht.

Was passiert denn, wenn Du Deinen Code ausführst? Worin besteht der Fehler? Du musst uns schon nähere Angaben machen, wenn Du eine klare und konkrete Hilfestellung haben möchtest.

Coolboarder_9 18. Feb 2005 08:55

Re: RedBlackTrees
 
Ja hast recht.

Er zeichnet halt den baum. Jedoch stimmt die Rot verknüpfung nicht. Es sind immer dieglöeichn Pfade rot und immer die gleich Zahlen, wenn auch in unterschiedlichen Ästen....

Also der Sinn stimmt nicht.

Hat sich jemand schon ma mit RBtrees beschäftigt und sie implementiert? vielelciht könnte ich dann ma vergleichen...

Thx, Olli


Alle Zeitangaben in WEZ +1. Es ist jetzt 00:27 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz