RedBlackTrees

[Coolboarder_9]

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.