Beiträge von Erleon

unit Unit1;


interface


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


type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Zufallszahlen1: TMenuItem;
    Wrfeln1: TMenuItem;
    Ende1: TMenuItem;
    ListBox1: TListBox;
    Sortieren1: TMenuItem;
    Bubble1: TMenuItem;
    ListBox2: TListBox;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Insertion1: TMenuItem;
    Label3: TLabel;
    Label4: TLabel;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Speichern1: TMenuItem;
    Laden1: TMenuItem;
    unsortiertLschen1: TMenuItem;
    sortiertLschen1: TMenuItem;
    Selection1: TMenuItem;
    Label5: TLabel;
    Label6: TLabel;
    Shell1: TMenuItem;
    Label7: TLabel;
    Label8: TLabel;
    Quick1: TMenuItem;
    procedure quicksort(links , rechts: integer);
    procedure Quick1Click(Sender: TObject);
    procedure Shell1Click(Sender: TObject);
    procedure Selection1Click(Sender: TObject);
    procedure sortiertLschen1Click(Sender: TObject);
    procedure unsortiertLschen1Click(Sender: TObject);
    procedure Laden1Click(Sender: TObject);
    procedure Speichern1Click(Sender: TObject);
    procedure Insertion1Click(Sender: TObject);
    procedure Bubble1Click(Sender: TObject);
    procedure Wrfeln1Click(Sender: TObject);
    procedure Ende1Click(Sender: TObject);
    procedure zeigen;
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;


const
  max = 1000;


var
  Form1: TForm1;
  reihe : Array[1..max] of integer;
  lauf : integer;
  tausch_bubble : integer;
  start_bubble, ende_bubble : real;
  tausch_ins : integer;
  start_ins, ende_ins : real;
  tausch_sel : integer;
  start_sel, ende_sel : real;
  tausch_shell : integer;
  start_shell, ende_shell : real;


implementation


{$R *.dfm}


procedure TForm1.zeigen;
begin
  for lauf := 1 to max do
  begin
    ListBox2.Items[lauf - 1] := IntToStr(reihe[lauf]);
  end;
end;


procedure TForm1.Ende1Click(Sender: TObject);
begin
  close;
end;


procedure TForm1.Wrfeln1Click(Sender: TObject);
begin
  randomize;
  for lauf := 1 to max do
  begin
    reihe[lauf] := random(90000) + 10000;
    ListBox1.Items[lauf - 1] := IntToStr(reihe[lauf]);
  end;
end;


procedure TForm1.Bubble1Click(Sender: TObject);
var
  lauf1, lauf2 : integer;
  hilfe : integer;
begin
  tausch_bubble := 0;
  start_bubble := time;
  for lauf2 := 1 to max do
    for lauf1 := 2 to max do
    begin
      if reihe[lauf1 - 1] > reihe[lauf1] then
      begin
        {Tausch}
        inc(tausch_bubble);
        hilfe := reihe[lauf1 - 1];
        reihe[lauf1 - 1] := reihe[lauf1];
        reihe[lauf1] := hilfe;
      end;
    end;
  ende_bubble := time;
  zeigen;
  Label1.Caption := 'Tauschvorgänge : ' + IntToStr(tausch_bubble);
  Label2.Caption := 'Sortierzeit : ' + FloatToStrF((ende_bubble-start_bubble)*24*3600,fffixed,10,3)+' s';
end;


procedure TForm1.Insertion1Click(Sender: TObject);
var
  lauf1, lauf2 : integer;
  hilfe : integer;
begin
  tausch_ins := 0;
  start_ins := time;
  for lauf1 := 2 to max do
  begin
    hilfe := reihe[lauf1];
    lauf2 := lauf1;
    while (lauf2 > 1) and (reihe[lauf2 - 1] > hilfe) do
    begin
      reihe[lauf2] := reihe[lauf2 - 1];
      dec(lauf2);
    end;
    reihe[lauf2] := hilfe;
    inc(tausch_ins);
  end;
  ende_ins := time;
  zeigen;
  Label3.Caption := 'Tauschvorgänge : ' + IntToStr(tausch_ins);
  Label4.Caption := 'Sortierzeit : ' + FloatToStrF((ende_ins-start_ins)*24*3600,fffixed,10,3)+' s';
end;


procedure TForm1.Speichern1Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    Listbox1.Items.SaveToFile(SaveDialog1.Filename);
end;


procedure TForm1.Laden1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Listbox1.Items.LoadFromFile(OpenDialog1.Filename);
  for lauf := 1 to max do
    reihe[lauf] := StrToInt(Listbox1.Items[lauf - 1]);
end;


procedure TForm1.unsortiertLschen1Click(Sender: TObject);
begin
  ListBox1.Clear;
end;


procedure TForm1.sortiertLschen1Click(Sender: TObject);
begin
  ListBox2.Clear;
end;


procedure TForm1.Selection1Click(Sender: TObject);
var
  lauf1, lauf2, imax, smax : integer;
begin
  tausch_sel := 0;
  start_sel := time;
  for lauf1 := max downto 2 do
  begin
    imax := lauf1;
    smax := reihe[lauf1];
    for lauf2 := 1 to lauf1 - 1 do
      if reihe[lauf2] > smax then
      begin
        imax := lauf2;
        smax := reihe[lauf2];
      end;
    reihe[imax] := reihe[lauf1];
    reihe[lauf1] := smax;
    inc(tausch_sel);
  end;
  ende_sel := time;
  zeigen;
  Label5.Caption := 'Tauschvorgänge : ' + IntToStr(tausch_sel);
  Label6.Caption := 'Sortierzeit : ' + FloatToStrF((ende_sel-start_sel)*24*3600,fffixed,10,3)+' s';
end;


procedure TForm1.Shell1Click(Sender: TObject);
var
  abstand, lauf1, lauf2, merke : integer;
  fertig : boolean;
begin
  tausch_shell := 0;
  start_shell := time;
  abstand := max;
  while (abstand > 1) do
  begin
    abstand := abstand div 2;
    repeat
      fertig := true;
      for lauf2 := 1 to max - abstand do
      begin
        lauf1 := lauf2 + abstand;
        if (reihe[lauf2] > reihe[lauf1]) then
        begin
          merke := reihe[lauf2];
          reihe[lauf2] := reihe[lauf1];
          reihe[lauf1] := merke;
          fertig := false;
          inc(tausch_shell);
        end;
      end;
    until fertig;
  end;
  ende_shell := time;
  zeigen;
  Label7.Caption := 'Tauschvorgänge : ' + IntToStr(tausch_shell);
  Label8.Caption := 'Sortierzeit : ' + FloatToStrF((ende_shell-start_shell)*24*3600,fffixed,10,3)+' s';
end;


procedure TForm1.quicksort(links, rechts:integer);
var
   lauf1,lauf2,mitte, merke: integer;


begin
  lauf1:= links;
  lauf2:= rechts;  {übergebene Variable werden eingelesen}
  mitte:= reihe[(links + rechts) div 2];
  repeat


  while reihe[lauf1] < mitte do inc(lauf1);
  while Mitte < reihe[lauf2] do dec(lauf2);
  if lauf1 <= lauf2 then
    begin
      merke:= reihe[lauf1];
      reihe[lauf1] := reihe[lauf2];
      reihe[lauf2] := merke;
      inc(lauf1);
      dec(lauf2);
    end;
  until lauf1 > lauf2;


  if links < lauf2 then quicksort(links,lauf2);
  if lauf1 < rechts then quicksort(lauf1, rechts);
end;


procedure TForm1.Quick1Click(Sender: TObject);
begin
{ein iteratives Programm}
quicksort(1,a);
zeigen;
end;


end.