All pastes #12327 Raw Edit

Totti's MergeSort

public text v1 · immutable
#12327 ·published 2005-05-21 11:50 UTC
rendered paste body
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    RadioGroup1: TRadioGroup;
    procedure FormCreate(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  ints: array[0..999999] of integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  k: integer;
begin
  randomize;
  for k:=0 to length(ints)-1 do
    ints[k]:=random(length(ints)*10);
end;

procedure old_bubbleSort;
var
  i,k,tmp: integer;
begin
  for i:=0 to length(ints)-2 do
      for k:=0 to length(ints)-2-i do
        if ints[k] > ints[k+1] then
          begin
            tmp:=ints[k];
            ints[k]:=ints[k+1];
            ints[k+1]:=tmp;
          end;
end;

procedure bubbleSort;  //mit Abbruchbedingung
var
  i,k,tmp: integer;
  getauscht: boolean;
begin
  for i:=0 to length(ints)-2 do
    begin
      getauscht:=false;
      for k:=0 to length(ints)-2-i do
        if ints[k] > ints[k+1] then
          begin
            tmp:=ints[k];
            ints[k]:=ints[k+1];
            ints[k+1]:=tmp;
            getauscht:=true;
          end;
      if not getauscht then
        break;
    end;
end;

procedure minimumSort; //a.k.a. SelectionSort or minSort
var
  i,k,pos,tmp: integer;
begin
  for i:=0 to length(ints)-2 do
    begin
      pos:=i;
      for k:=i+1 to length(ints)-1 do
        if ints[k] < ints[pos] then
          pos:=k;
      if i <> pos then
        begin
          tmp:=ints[i];
          ints[i]:=ints[pos];
          ints[pos]:=tmp;
        end;
    end;
end;

procedure quickSort(Vli,Vre: integer; var liste: array of integer);
var
  li,re,mi,tmpInt: integer;
begin
  li:=Vli;
  re:=Vre;
  mi:=liste[(li+re) div 2];
//  mi:=liste[random(re-li)+li];
  repeat
    while liste[li] < mi do
      inc(li);
    while mi < liste[re] do
      dec(re);
    if li <= re then
      begin
        tmpInt:=liste[li];
        liste[li]:=liste[re];
        liste[re]:=tmpInt;
        inc(li);
        dec(re);
      end;
  until li > re;
  if Vli < re then
    quickSort(Vli,re,liste);
  if Vre > li then
    quickSort(li,Vre,liste);
end;

procedure mergeIt(Vli,Vmi,Vre: integer; var liste: array of integer);
var
  tmpArr: array{[0..9999]} of integer;
  k,IndexLi,IndexRe,IndexTmp: integer;
begin
  setlength(tmpArr,Vre-Vli+1);
  IndexLi:=Vli;
  IndexRe:=Vmi+1;
  IndexTmp:=0;
  repeat
    if liste[IndexLi] <= liste[IndexRe] then
      begin
        tmpArr[IndexTmp]:=liste[IndexLi];
        inc(IndexTmp);
        inc(IndexLi);
      end
    else
      begin
        tmpArr[IndexTmp]:=liste[IndexRe];
        inc(IndexTmp);
        inc(indexRe);
      end;
  until (IndexLi > Vmi) or (IndexRe > Vre);
  while IndexLi <= Vmi do
    begin
      tmpArr[IndexTmp]:=liste[IndexLi];
      inc(IndexTmp);
      inc(indexLi);
    end;
  while IndexRe <= Vre do
    begin
      tmpArr[IndexTmp]:=liste[IndexRe];
      inc(IndexTmp);
      inc(IndexRe);
    end;
  for k:=Vli to Vre do
    liste[k]:=tmpArr[k-Vli];
end;

procedure mergeSort(Vli,Vre: integer; var liste: array of integer); //mischSortieren
var
  mi: integer;
begin
  if Vli < Vre then
    begin
      mi:=(Vli+Vre) DIV 2;
      mergeSort(Vli,mi,liste);
      mergeSort(mi+1,Vre,liste);
      mergeIt(Vli,mi,Vre,liste);
    end;
end;

procedure TForm1.RadioGroup1Click(Sender: TObject);
var
  startzeit: Cardinal;
  k: integer;
begin
  listbox1.Clear;
  startzeit:= GetTickCount;
  case Radiogroup1.ItemIndex of
    0: old_bubbleSort;
    1: bubbleSort;
    2: minimumSort;
    3: quickSort(0,length(ints)-1,ints);
    4: mergeSort(0,length(ints)-1,ints);
  end;
  caption:=IntToStr(GetTickCount-startzeit)+'ms wurden benötigt';
  if length(ints) <= 10000 then
    for k:= 0 to length(ints)-1 do
      listbox1.Items.Add(inttostr(ints[k]));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FormCreate(self);
  radiogroup1.ItemIndex:=-1;
  listbox1.clear;
  caption:='';
end;

end.