Rendezés ütközésmentesítő algoritmussal Delpiben

         Az ütközésmentesítő algoritmus már több feladat kapcsán bizonyította hatékonyságát. Ezen a lapon arra keresem a választ, vajon rendezésre alkalmas-e ez az algoritmus. A tesztek azt mutatják, hogy igen, a véletlen választás alkalmas a rendezettség elérésére.

Nem egy gyors rendezési eljárást ad, de azért elfogatható időn belül befejezi a rendezést. Az időtényező az 1000-es elemszám fölött szokott kritikus lenni minden rendező eljárásnál. Ezzel a programmal 5000 elemig rendezhetünk. Minden százezredik lépés után frissül a képernyő, mely a megfelelő sebességet is biztosítja. A maximális lépésszám tízmillió. A program méri és kijelzi az időt. Ha sikeres rendezéssel áll le a program, akkor azt egy Kész felirat jelzi. Ha nem sikerült rendezni a számokat, akkor a felirat szövege: Vége.

unit UUtkRend;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, 

  Graphics, Controls, Forms, Dialogs, StdCtrls;

Const Max=5000;

type
  TfmUtkRend = class(TForm)
    lbUtkRend: TLabel;
    ldUtkRend: TListBox;
    btKilepes: TButton;
    btRendez: TButton;
    edMenet: TEdit;
    edHiba: TEdit;
    btKever: TButton;
    edSzam: TEdit;
    edStart: TEdit;
    edStop: TEdit;
    lbKesz: TLabel;
    Procedure Kever;
    Function Hiba(A: Word): LongInt;
    procedure btKilepesClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btRendezClick(Sender: TObject);
    procedure btKeverClick(Sender: TObject);
    procedure edSzamChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmUtkRend: TfmUtkRend;
  T: Array[0..Max] Of Word;
  Szam: Word;

implementation

{$R *.dfm}

procedure TfmUtkRend.btKilepesClick(Sender: TObject);
begin
  Close;
end;

procedure TfmUtkRend.FormCreate(Sender: TObject);
begin
  Szam:= 1000; Randomize; Kever;
end;

procedure TfmUtkRend.edSzamChange(Sender: TObject);
Var Kod: Integer;
begin
  Val(edSzam.Text,Szam,Kod);
end;

Procedure TfmUtkRend.Kever;
Var I, A, B, P: Word;
Begin
  For I:= 0 To Szam Do T[I]:= I;
  For I:= 0 To 10*Szam Do
  Begin
    A:= Random(Szam+1); B:= Random(Szam+1); P:= T[A]; T[A]:= T[B]; T[B]:= P;
  End;
  With ldUtkRend Do
  Begin Clear;  For I:= 0 To Szam Do Items.Add(IntToStr(T[I])) End;
End;

procedure TfmUtkRend.btKeverClick(Sender: TObject);
begin
  Kever; edMenet.Text:= '0'; edHiba.Text:= '0';
  edStart.Text:= ''; edStop.Text:= ''; lbKesz.Visible:= True;
end;

Function TfmUtkRend.Hiba(A: Word): LongInt;
Var I: Word;
    N: LongInt;
Begin
  N:= 0;
  For I:= 0 To Szam Do
  Begin
    If (I<A) And (T[I]>T[A]) Then Inc(N);
    If (I>A) And (T[I]<T[A]) Then Inc(N);
  End;
  Hiba:= N;
End;

procedure TfmUtkRend.btRendezClick(Sender: TObject);
Var I, A, B, P, H, H2: LongInt;
    Menet: LongInt;
    Van: Boolean;
begin
  edStart.Text:= TimeToStr(GetTime); edStart.Repaint;
  edStop.Text:= ''; edStop.Repaint;
  With lbKesz Do Begin Caption:= '        '; Repaint End;
  H:= 0; Menet:= 0; Van:= False;
  For I:= 0 To Szam-1 Do If T[I+1]<T[I] Then Begin Van:= True; Break End;
  While Van And (Menet<10000000) Do
  Begin
    Van:= False; Inc(Menet);
    A:= 0; While T[A+1]>T[A] Do A:= Random(Szam); B:= Random(Szam+1);
    H:= Hiba(A)+Hiba(B); P:= T[A]; T[A]:= T[B]; T[B]:= P; H2:= Hiba(A)+Hiba(B);
    If H2>H Then
    Begin P:= T[B]; T[B]:= T[A]; T[A]:= P; H:= Hiba(A)+Hiba(B) End Else H:= H2;
    If Menet Mod 100000=0 Then
    With ldUtkRend Do
    Begin
      Clear; For I:= 0 To Szam Do Items.Add(IntToStr(T[I])); RePaint;
      edMenet.Text:= IntToStr(Menet); edMenet.Repaint;
      edHiba.Text:= IntToStr(H); edHiba.Repaint;
    End;
    For I:= 0 To Szam-1 Do If T[I+1]<T[I] Then Begin Van:= True; Break End;
  End;
  With ldUtkRend Do
  Begin Clear; For I:= 0 To Szam Do Items.Add(IntToStr(T[I])) End;
  edMenet.Text:= IntToStr(Menet);
  edHiba.Text:= IntToStr(H);
  edStop.Text:= TimeToStr(GetTime);
  With lbKesz Do If Not Van Then
  Caption:= 'Kész' Else Caption:= 'Vége';
  lbKesz.Visible:= True;
end;

end.