Einzelnen Beitrag anzeigen

Andy5050

Registriert seit: 27. Sep 2009
6 Beiträge
 
#1

Brauche Hilfe bei Sourcecode von Shellsort-Sortieralgo

  Alt 27. Sep 2009, 09:25
Tachchen erstmal, ich bin neu hier.

Ich hatte mit einem Freund den Auftrag ein Programm zum Sortieralgo "Shellsort" zu schreiben.
Da das nicht so geklappt hat als geplant, haben wir einen aus dem Netz genommen. (Wurde akzeptiert)

--> Shellsort: Bei Shellsort wird die Reihe der Elemente (z.B: 9 3 2 8 7 5 6 1) in Pakete unterteilt --> 9 3 | 2 8 | 7 5 | 6 1

Diese werden dann (nur um es anschaulich zu machen)untereinander geschrieben, also
9 3
2 8
7 5
6 1
dann werden die Zahlen spaltenweise mit Insertionsort sortiert:

3 9 2 8 5 7 6 1 dies wird mit "größeren" Paketen wiederholt, also 3 9 2 8 | 5 7 6 1 usw..

Hier der Code:

Delphi-Quellcode:
unit uSortieren;

interface

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

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Memo1: TMemo;
    Memo2: TMemo;
    Datei1: TMenuItem;
    Laden1: TMenuItem;
    Speichern1: TMenuItem;
    Schlieen1: TMenuItem;
    Sortieren1: TMenuItem;
    Heapsort1: TMenuItem;
    Mergesort1: TMenuItem;
    Sehllsort1: TMenuItem;
    Neu1: TMenuItem;
    Extras1: TMenuItem;
    Zufallszahlen1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Memolschen1: TMenuItem;
    procedure Sehllsort1Click(Sender: TObject);
    procedure Laden1Click(Sender: TObject);
    procedure Speichern1Click(Sender: TObject);
    procedure Neu1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  a : array of integer;

const hoehe = 200;
implementation

{$R *.dfm}

procedure Delay(dwMilliseconds: Longint);
var
  iStart, iStop: DWORD;
begin
  iStart := GetTickCount;
  repeat
    iStop := GetTickCount;
    Application.ProcessMessages;
  until (iStop-iStart) >= dwMilliseconds;
end;

procedure ZeichneVisu(a : array of integer);
var
i :integer;
begin
with Form1.Image1 do
begin
Canvas.Brush.Color := clWhite;
Canvas.Rectangle(0,0,Width,height);
Canvas.Brush.Color := clSkyBlue;
for i := 1 to length(a) do
  begin
    Canvas.Rectangle((i-1)*18+3,Height-ceil(Height/(Hoehe/a[i]))+2,(i-1)*18+13,Height);
  end;
end;
end;

procedure ShellSort(var aSort: array of integer);
var
  iI, iJ, iK,
  iSize: integer;
  wTemp: integer;
begin
  iSize := High(aSort);
  iK := iSize shr 1;
  while iK > 0 do
  begin
    for iI := 0 to iSize - iK do
    begin
      iJ := iI;
      while (iJ >= 0) and (aSort[iJ] > aSort[iJ + iK]) do
      begin
        wTemp := aSort[iJ];
        aSort[iJ] := aSort[iJ + iK];
        aSort[iJ + iK] := wTemp;
        if iJ > iK then
          Dec(iJ, iK)
        else
          iJ := 0 ;
        ZeichneVisu(a);
        Delay(50);
      end;
    end;
    iK := iK shr 1;
  end;
  end;

procedure TForm1.Speichern1Click(Sender: TObject);
begin
 if saveDialog1.execute
  then begin
         memo1.Lines.savetofile(saveDialog1.filename);
         end;
end;

procedure TForm1.Sehllsort1Click(Sender: TObject);
var
i : integer;
begin
SetLength(a,Memo1.Lines.Count);
for i := 0 to Memo1.Lines.Count -1 do a[i] := strtoint(Memo1.Lines[i]);
ShellSort(a);
for i := 0 to high(a) do Memo2.Lines.Add(inttostr(a[i]));
end;

procedure TForm1.Laden1Click(Sender: TObject);
begin
  if openDialog1.execute
  then begin
         memo1.Lines.loadfromfile(openDialog1.filename);
         end;
end;

procedure TForm1.Neu1Click(Sender: TObject);
begin
memo1.lines.Clear;
memo2.lines.Clear;
end;

end.
Ich muss erklären [procedure ShellSort(var aSort: array of integer)], wie der Algo funktioniert bzw. aufdgebaut ist, kann mir jemand helfen?
  Mit Zitat antworten Zitat