mir scheint, daß in TList.Sort ein Bug ist.
Ich versuchte zunächst folgendes Programm:
Code: Alles auswählen
var aa:array[0..14] of integer = (4,1,1,2,5,2,3,1,2,8,4,1,6,9,2);
Liste: Tlist;
function IntSort(p,q:Pchar):integer;
begin
result:= Pinteger(p)^-Pinteger(q)^;
end;
Procedure SortInt;
var i,n:integer;
begin
n:=length(aa);
Liste:=Tlist.create;
with liste do
begin
for i:=0 to n-1 do add(@aa[i]);
sort(@IntSort); // Error!
for i:=0 to n-1 do aa[i]:= Pinteger(items[i])^;
end;
end;
Woran mag das liegen? Was mache ich da verkehrt?
Schließlich erstellte ich mir eine eigene Sortierprozedur für beliebige Arrays (mit Hilfe der Unit Variants), wobei ich da zwischen den Sortieralgorithmen wechseln kann.
Als Sortierliste, in der alle Verschiebe- und Vertauschoperationen erfolgen, nehme ich jedoch statt eines Pointerarrays wie in Lazarus ein Inegerarray. Damit kann ich m.E. leichter den Sortiervorgang verfolgen.
(Da hätte ich auch eine Frage: warum ist die Listlänge MaxListSize in Lazarus nur maxint div 16, und nicht maxint div 4? Ein Pointer hat doch nur 4 Bytes (bzw 8 bei CPU64), und keine 16.
Je nach varType der ArrayElemente wird eine andere Vergleichsfunktion aufgerufen:
Code: Alles auswählen
function VarTypeSort(vt:TVarType; p,q:Pchar):integer;
begin result:=0;
case vt of
varbyte: result := byte(p^) - byte(q^);
varShortint: result := shortint(p^) - Shortint(q^);
varWord: result := Pword(p)^ - PWord(q)^;
varSmallint: result := PSmallint(p)^ - PSmallint(q)^;
varinteger: result := Pinteger(p)^ - Pinteger(q)^;
varLongWord: if PLongWord(p)^>PLongWord(q)^ then result := 1 else
if PLongWord(p)^<PLongWord(q)^ then result := -1;
varint64: if PInt64(p)^>PInt64(q)^ then result := 1 else
if PInt64(p)^<PInt64(q)^ then result := -1;
varQWord: if PQWord(p)^>PQWord(q)^ then result := 1 else
if PQWord(p)^<PQWord(q)^ then result := -1;
// real, double
vardouble: if PDouble(p)^ < PDouble(q)^ then result := -1 else
if PDouble(p)^ > PDouble(q)^ then result := 1;
varsingle: if PSingle(p)^ < PSingle(q)^ then result := -1 else
if PSingle(p)^ > PSingle(q)^ then result := 1;
varstring: result := Comparestr(p,q);
end;
end;
Code: Alles auswählen
{$DEFINE Zeigen}
{$DEFINE JumpSort} // meine eigene Prozedur
Type
TDWordArray = array[0..maxint div 4 -1] of DWOrd; PDWordArray = ^TDWordArray;
TSortArrayType = object // eindimensionale Records
Fdata:Pchar;
FSize, FCount:dword; Ftype:word;
FSkip_Doubles:boolean;
pp:PDWordArray; pplg:dword; ppos:dword;
{$IFDEF JumpSort}
temp:PDwordArray; templg:dword;
next: array of integer; // Vergleich mit nächstem Element
akt:dword; // aktuelles zu sortierendes Element
ReverseCount:integer;
function Get_Next(x:dword; neu:boolean):integer;
function Get_Next:integer; overload;
procedure _move(x,y,cnt:dword); // cnt Elemente von x nach y verschieben, x>y
procedure _insert(x:integer); // n,n+1.. ab x einfuegen, solange<=x
Procedure Erhoehen; // Solange rechts grüßer
procedure Reverse(start, ende:dword); // start..ende Reihenfolge umkehren
Procedure Get_Reverse(n:dword);
procedure JumpSort; // ProcModus: 2
{$ENDIF}
public
{$IFDEF Zeigen}
bb: array[0..20] of integer;
Procedure Zeigen;
{$ENDIF}
procedure SortArray(var a; lg:dword; size:integer; v:variant; modus:array of integer);
// modus = [SortProc, Skip_doubles, ReverseCount]
function Sort(x,y:dword):integer;
procedure Swap(x,y:dword);
procedure _Delete(n,x:dword); // löscht n..x
procedure Delete_Doubles;
Procedure LazQSort(L,R:dword); // ProcModus: 1
procedure KOLQSort(start,anz:Dword); // ProcModus: 0
end;
KOLQSort ist KOL-QSorthelp
JumpSort ist eine eigene SortProzedur (vielleicht gibt es die schon unter anderem Namen: Jedes Mal wird der Suchbereich um die Hälfte verkleinert, bis der Einfügeplatz gefunden wurde. Habe aber noch ein paar Extras hinzugefügt, wodurch es glaube ich noch schneller geht:
u.a. Umkehr der Reihenfolge, sobald diese eine bestimmte Anzahl in absteigender Folge überschreiten.
Mit der Zuhilfenahme von Arrays für die Varianttypen und den Offset läßt sich das auch auf beliebige Records erweitern. Braucht aber noch ein bißchen mehr Prorammieraufwand.
Werde es noch nachschicken, sobald es funktioniert.
Wenn ich nun mit obiger adaptierter Lazarus-QuickSort-Prozedur (habe wortwörtlich die Angaben übernommen, nur an mein Integerarray angepasst) das zu Beginn genannte array aa sortiere, dann bekomme ich als Ergebnis der Sortierung folgendes:
Len=15: {1, 1, 1, 1, 2, 2, 2, 3, 2, 4, 4, 5, 6, 8, 9}
mit KOL (und JumpSort) erhalte ich hingegen das korrekte Ergebnis:
Len=15: {1, 1, 1, 1, 2, 2, 2, 2, 3, 4, 4, 5, 6, 8, 9}
irgendwo muß da also ein Bug sein. Bei mir? in Lazarus?
Hier noch die Implementierung (in der Datei Sort.inc)
Verein
Links
Suche