AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Code-Bibliothek Library: Algorithmen Delphi ShellSort für beliebige Arrays
Thema durchsuchen
Ansicht
Themen-Optionen

ShellSort für beliebige Arrays

Ein Thema von MStoll · begonnen am 2. Sep 2006
Antwort Antwort
MStoll

Registriert seit: 15. Nov 2005
131 Beiträge
 
Turbo Delphi für Win32
 
#1

ShellSort für beliebige Arrays

  Alt 2. Sep 2006, 23:34
Hallo.

Habt ihr euch nicht auch schon geärgert, dass man für jeden neuen dynamischen Array-Typ ne eigene Sortierprozedur schreiben muss oder dass ihr einen bestimmten strukturierten Array-Typ (array of record) nach verschiedenen Kriterien sortieren wollt und dabei die Sortierprozedur unübersichtlich wird?
Ich denke, dass ich hier eine Lösung hab. Sie basiert auf Pointern und sieht daher vll etwas umständlich aus, sollte allerdings sehr allgemein und daher flexibel sein.

Delphi-Quellcode:
unit Sort;

interface

type TCmpFkt = function(P : Pointer; a, b : integer) : boolean;
     //TExchFkt = procedure(P : Pointer; a, b : integer);

procedure ShSortArr(P : Pointer; Size, ElSize : integer; CmpFkt : TCmpFkt);

implementation

procedure Exch(P : Pointer; ElSize : integer; a, b : integer);
var P1, P2 : Pointer;
    B1 : byte;
    x : integer;
begin
     P1 := Pointer(Integer(P) + ElSize * a);
     P2 := Pointer(Integer(P) + ElSize * b);
     
     for x := 0 to ElSize-1 do
     begin
          b1 := Byte(Pointer(Integer(P1)+x)^);
          Byte(Pointer(Integer(P1)+x)^) := Byte(Pointer(Integer(P2)+x)^);
          Byte(Pointer(Integer(P2)+x)^) := b1;
     end;
end;

procedure ShSortArr(P : Pointer; Size, ElSize : integer; CmpFkt : TCmpFkt);
var k, i, j, bis: integer;
begin
     bis := Size - 1;

     if Size = 2 then
     begin
          if CmpFkt(P, 0, 1) then
             Exch(P, ElSize, 0, 1);
     end;

     k := bis shr 1;
     while k > 0 do
     begin
          for i := 0 to bis-k do
          begin
               j := i;
               while (j >= 0) and
                     (CmpFkt(P, j, j+k)) do
               begin
                    Exch(P, ElSize, j, j+k);
                    If j > k then
                       Dec(j,k)
                    else if j = 0 then
                         break
                    else
                         j := 0;
               end;
          end;
          k := k shr 1;
     end;
end;

end.
Ne Verlgeichsprozedur, um 2 Elemente zu vergleichen, kann z.B. so aussehen:
Delphi-Quellcode:
type tintarr = array of integer;

function Cmp(P : Pointer; a, b : integer) : boolean;
begin
     result := tintarr(P)[b] < tintarr(P)[a];
end;
So habt ihr die Möglichkeit, die Sortierrichtung zu bestimmen und bei records das Vergleichskriterium.

Beispiel für records:
Delphi-Quellcode:
type trecarr = array of record
                              name : string;
                              plz : integer;
                        end;

function Cmp(P : Pointer; a, b : integer) : boolean;
begin
     result := trecarr(P)[b].plz < trecarr(P)[a].plz;
end;
Der Sortieraufruf sieht dann so aus:
ShSortArr(Arr, Length(Arr), SizeOf(Arr[0]), Cmp); Dabei ist Arr das Array, Cmp die Vergleichsprozedur.

Für Feedback und Verbesserungsvorschläge bin ich offen.

Gruß
Michael

[Edit]Natürlich kann man hier auch noch ne Standard-Vergleichsprozedur einbauen (ähnlich aufgebaut wie die Exch-Prozedur), die dann bei Bedarf durch eine eigene ersetzt wird.[/Edit]
  Mit Zitat antworten Zitat
Antwort Antwort

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:23 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz