Wie kann man quicksort auf Listen in TP machen ?

[kak]

Hi,

wie so oft brauch ich wieder mal euren Rat.
Ich komm an einer Stelle nicht weiter. Ich will Quichsort auf Listen haben...

So wie ich immer sonst mein Quicksort gemacht habe, waren es nur arrays... jetzt sollen aber Listen her.

Wie geht das ?
Kann mir da jemand weiterhelfen ?
Danke...

[Felix Kaiser]

Arrays sind eigentlich Listen ...

Normal kannst du das auf alle Art Arraytypen anwenden, egal ob Integer oder String. Hab erst gestern nen alten Pascal Quicksort Code nach JavaScript übersetzt und dort mit StringListen verknüpft, funktioniert wunderbar.

Wo liegt das Problem bei dir?

[kak]

ich glaube ich habe die aufgabe nicht richtig formuliert...

also ich will quicksort auf listen.... die liste jedoch soll kein array sein, sondern eine Zeigerstruktur ^ sein... okay...

da wird nämlich die ganze Sache ein wenig schwerer.... mit arrays soll ja kein thema sein....

bis denn...

[DerWolf]

wenn du mal einen teil des codes posten könntest? dann könnt ich mir das mal anschauen :) cu

[kak]

also so habe ich mir meine quicksort procedure vorgestellt... wie ich aber die Zeigerteile dann nutzen kann weis ich nicht... deswegen brauch ich ja euren Rat...


procedure quicksort (l, r : integer);
var x, i, j, tmp : integer;
begin
if r > l then
begin
x := a[l]; i := l; j := r+1;
repeat
repeat i := i+1 until a[i] >= x;
repeat j := j-1 until a[j] <= x;
tmp := a[j]; a[j] := a[i]; a[i] := tmp;
until j <= i;
a[i] := a[j]; a[j] := a[l]; a[l] := tmp;
quicksort(l, j-1); quicksort(j+1, r)
end

[DerWolf]

hast du so eine art verkettete liste?

[Felix Kaiser]

Poste einfach die Deklaration der Liste und ich bzw. ein anderer wenn wer schneller ist wirds dir hinbiegen.

Und irgendwie hast du da nen schlechten QuickSort Code erwischt :)

[kak]

also bis jetzt habe ich folgendes geschrieben... nur bekomme ich kein quicksort hin ich habe es vor mit einer doppelt verketteten liste zu lösen...
komme aber nicht weiter...

wer mir helfen kann danke..
schaut euch den code mal an... ist aber nur die idee dahinter... einlesen der liste geht aber nicht das sortieren


program quick;
type zeiger = ^listelement;
listelement = record
daten : integer;
nachf : zeiger;
vorg : zeiger;
end;
var TIntList,TIntList2 :zeiger;


(*Pivotlieferung*)
function piv(lauf:zeiger):integer;
var i,j:integer;
begin
i:=lauf^.daten;
while lauf^.nachf <> nil do
begin
lauf := lauf^.nachf;
end; {while}
j:=lauf^.daten;
piv:=(i + j) div 2; {wird bis inklusive nil-Zeiger gezählt,gebraucht um genaue Hälfte zu bekommen}
end; {Ausgabe}

(* Erstellen der Integerliste *)
procedure Erstellen(liste:zeiger);
var zahl : integer;
hilf : zeiger;
begin
writeln('Zahlen eingeben (Ende mit "0"): ');
hilf:=liste;
readln(zahl);
while zahl <> 0 do begin
hilf^.daten := zahl;
hilf^.nachf := nil;
readln(zahl);
if zahl = 0 then break;
new(hilf^.nachf);
hilf := hilf^.nachf;
end; {liefert alle Zahlen ausser den 0 in TIntList}
end; {Erstellen}

{Ausgabe der Integerliste}
procedure Ausgabe(liste:zeiger);
var lauf : zeiger;
begin
lauf := liste;
while lauf <> nil do
begin
if lauf^.daten <> 0 then writeln('Ausgabe: ',lauf^.daten);
lauf := lauf^.nachf;
end; {while}
end; {Ausgabe}

{zusammenfuegen der Listen}
procedure fueg(var beide:zeiger; zweite:zeiger);
var hilf:zeiger;
begin
(* erste Liste bis nil durchlaufen, um Nilzeiger
auf zweite umzuhängen *)
if beide^.daten = 0 then begin
beide:= zweite;
end
else
begin
hilf:=beide;
while hilf^.nachf <> nil do hilf:=hilf^.nachf;
hilf^.nachf:=zweite;
end;
end; {fueg}


(* Prozedur teilt TIntList in gleich, kleiner, groesser
dem Pivotelement auf *)
procedure part(liste:zeiger);
var lauf: zeiger;
glLauf, klLauf,grLauf:zeiger; {hilfszeigerdeklaration}
gleich,kleiner,groesser:zeiger;
pivot: integer;
begin
new(gleich);
new(groesser);
new(kleiner);
gleich^.Nachf := NIL;
groesser^.Nachf:= NIL;
kleiner^.Nachf:= NIL;


pivot := piv(liste);
lauf:=liste;
glLauf:= gleich;
glLauf^.daten := 0;
klLauf:= kleiner;
klLauf^.daten := 0;
grLauf:= groesser;
grLauf^.daten := 0;
while lauf <> nil do
begin
if lauf^.daten = pivot then {wenn Inhalt gleich dem Pivot}
begin
if not((glLauf = gleich) and (glLauf^.daten = 0)) then begin
new(glLauf^.nachf);
glLauf := glLauf^.nachf;
glLauf^.daten := lauf^.daten;
glLauf^.nachf := NIL;
end
else glLauf^.daten := lauf^.daten;
end; {then}

if lauf^.daten < pivot then {wenn Inhalt kleiner als Pivot}
begin
if not((klLauf = kleiner) and (klLauf^.daten = 0)) then begin
new(klLauf^.nachf);
klLauf := klLauf^.Nachf;
klLauf^.daten := lauf^.daten;
klLauf^.nachf := NIL;
end {then}
else klLauf^.daten := lauf^.daten;
end;

if lauf^.daten > pivot then {wenn Inhalt groesser als Pivot}
begin
if not((grLauf = groesser) and (grLauf^.daten = 0)) then begin
new(grLauf^.nachf);
grLauf := grLauf^.Nachf;
grLauf^.daten := lauf^.daten;
grLauf^.nachf := NIL;
end {then}
else grLauf^.daten := lauf^.daten;
end;
lauf := lauf^.Nachf;
end; {while}

{Testausgabe}
{writeln('Pivot: ',pivot);
writeln('gleich dem Pivot: ');
ausgabe(gleich);
writeln('kleiner dem Pivot: ');
ausgabe(kleiner);
writeln('groesser dem Pivot: ');
ausgabe(groesser);}

{dient bisher zu Testzwecken}
if kleiner^.daten <> 0 then part(kleiner); {rekursiver Aufruf von Part wenn Inhalt von kleiner ungleich 0}
fueg(kleiner,gleich); {Zusammenfuegen der Listen kleiner und gleich}
{writeln('1.Fueg: '); Ausgabe(kleiner); writeln;}

if groesser^.daten <> 0 then part(groesser); {rekursiver Aufruf von Part, wenn Inhalt von groesser ungleich 0}
fueg(kleiner,groesser); {Zusammenfuegen der Listen kleiner und groesser}
{writeln('2.Fueg: '); Ausgabe(groesser); writeln;}

TIntList2:=kleiner;
end; {part}

(* Theoretischer Quicksortalgorithmus (eigentlich für Array)
noch nicht implementiert *)
{procedure quickSort(links,rechts:zeiger);
var pivot:integer;
begin
if rechts^.daten > links^.daten then
begin
pivot := piv(TIntList);
quickSort(links, mitte-1);
quickSort(mitte, rechts);
end;
end;} {quickSort}

{---------------Hauptprogramm----------------}
begin
new(TIntList);
TIntList^.Nachf := nil;

erstellen(TIntList);
{ Ausgabe(TIntList);}
part(TIntList);
{Testausgabe}
Ausgabe(TintList2);

readln;
end.

[Diogenes]

Kopiere doch die Liste der Zeiger auf die Records in ein Zeigerarray (hier jetzt ptAry genannt).

Beim Vergleichen erfolgt Zugriff auf die Daten mit ptAry[ Index]^.Daten

Danach komplett neues Aufbauen der Links in der sortierten Reihenfolge. Ich denke, das geht am allerschnellsten. Wenn das Sortieren auch dann nicht funktioniert, muß es am Algorithmus liegen.

Wenn Du TP hast, such' im Verzeichnis (und seinen Unterverzeichnissen) nach QSORT.PAS. Den hab ich, ohne Probleme zu bekommen, verwendet.

[kak]

ich kann damit nicht wirklich viel anfangen... leider....

außerdem gibt es den qsort.pas nicht bei meinem tp ... also die datei ist nicht da

[Diogenes]

Die Quicksort-Theorie (mit einer in Java formulierten Funktion) steht auf: http://www.inf.fh-flensburg.de/lang/algorithmen/sortieren/quick/quick.htm
Die Pascal-Praxis sieht (übersetzt aus der Theorie) etwa so aus:

type
TData = Integer;
{TData kann alles sein; muß nur vergleichbar sein.}
TDataAry=array[ 0 .. Max] of TData;
...
procedure QuickSort( var A: TDataAry; Lo, Hi: Integer);

{lo ist der unterste Index, hi ist der oberste Index des
zu sortierenden (Teil-)Feldes a}

var
I, J: Integer;
H, X: TData;

begin
I := Lo;
J := Hi;
X := A[ (Lo + Hi) div 2];
{Divide}
repeat
while A[ I] < X do
Inc( I);
while A[ J] > X do
Inc( J);
if I < H
then begin
H := A[ I];
A[ I] := A[ J];
A[ J] := H
end
until I > J;
{Conquer}
if Lo < J
then QuickSort( A, Lo, J);
if Hi > I
then QuickSort( A, I, Hi)
end;

Das Combine ergibt sich von alleine.

Zu der Idee, die ich hatte:

Versuche nicht, die verkettete Liste direkt zu sortieren. Du müßtest praktisch jedesmal die Indices neu bestimmen. Das kostet so viel Zeit, daß Du's gleich bleiben lassen kannst.

Stell' Dir eher ein Array aus Zeigern zusammen, die auf die (unsortiert verketteten) Records zeigen.
Sortiere die Zeiger nach dem Kriterium (Bei deinem Beispiel: Zeiger^.Daten)
Jetzt hast Du die Liste als sortiertes Zeiger-Array.
Zum Schluß werden die Records komplett neu verkettet. Die Zeiger stehen ja im Array.
Alles sortiert!

So. Ich hoffe, das hilft!

[kak]

hallo

also den quicksort algorithmus kenn ich... will ich aber nicht machen, da ich einen dynamischen datentyp sortieren soll.

du nimmst ja hier ein festgelegtes array... bringt mir nichts okay ?

kennt denn sich keiner so mit zeigern aus wie ich es oben versucht habe ?

also es kann doch nur ne kleinigkeit fehlen...

danke

[Diogenes]

Na gut. ich werd' mir was einfallen lassen. Ich hab' aber trotzdem das Gefühl, als machte ich deine Hausübungen.

Aber hier als Anmerkungen:
1 Wenn du A^ und B^ tauschen willst, mußt Du tatsächlich die A^.Nachf mit B^.Nachf und A^.Vorg mit B^.Vorg.
2 Das Teilen und Wiederzusammenfügen kannst Du dir eigentlich sparen.

[kak]

das versteh ich nicht... warum kann ich dann das zerlegen und das zusammenfügen wieder weglassen ?

also irgendwas mach ich bei doppelt verketteten listen falsch...

[kak]

also momentan habe ich mein Programm so umgeschrieben... es ist lauffähig funktioniert nur noch nicht ganz richtig... wo ist mein Denkfehler... bitte helft mir..

program quick;
(* -quick ist aufgeteilt in:
1. Initialisierung
2. Input / Output
3. Quicksortalgorithmus mit saemtlichen dazugehoerigen Prozeduren

-zeiger ist globale Variable, die initialisiert wird
-klTIntList, grTIntList, glTIntList sind auch globale, dienen aber nur zur Uebergabe
in den Prozeduren, d.h. sie werden zum zwischenspeichern in der prozedur quickSort benutzt
*)

(* 1. Initialisierung*)

type
TIntList = ^listelement;
listelement = record
daten : integer;
nachf : TIntList;
vorg : TIntList;
end;
var zeiger,test:TIntList;
klTintlist,grTintList,glTintlist:TIntList;

{ 2. Input / Output}

(* -Erstellen der Integerliste
-die Leere Liste wird uebergeben
-die hinzukommenden Elemente werden angehaengt, nil zeiger wird weitergehaengt
dazu wird ein Hilfsliste benoetigt
-die erstellte Liste wird zurueckgegeben
-Es werden ganze Zahlen eingelesen, dabei ist die Eingabe der 0 die Ab-
bruchbedingung
*)
procedure Erstellen(liste:TIntList);
var zahl : integer;
hilf : TIntList;
begin
writeln('Zahlen eingeben (Ende mit "0"): ');
hilf:=liste;
readln(zahl);
while zahl <> 0 do begin
hilf^.daten := zahl;
hilf^.nachf := nil;
readln(zahl);
if zahl = 0 then break;
new(hilf^.nachf);
hilf := hilf^.nachf;
new(hilf^.vorg);
hilf^.vorg:=hilf;
end; {liefert alle Zahlen ausser den 0 in TIntList}
end; {Erstellen}

(* -Ausgabe der Integerliste
-die sortierte Liste wird uebergeben, die einzelnen Elemente werden durchlaufen
und ausgegeben
-dazu wird eine Hilfsliste zum durchlaufen der Liste benoetigt
*)
procedure Ausgabe(liste:TIntList);
var lauf : TIntList;
begin
lauf := liste;
while lauf <> nil do
begin
if lauf^.daten <> 0 then writeln('Ausgabe: ',lauf^.daten);
lauf := lauf^.nachf;
end; {while}
end; {Ausgabe}

{ 3. Quicksortalgorithmus mit den dazugehoerigen Prozeduren}

(* -die Funktion dient der Pivotlieferung
-die Liste wird uebergeben und wird durchlaufen
-zwei Variablen dienen dem abspeichern des ersten und letzten Elementes,
um dann das Pivotelement der Liste zu ermitteln
-Rueckgabe des Pivotwertes
*)



function qsort(s,t:tintlist):tintlist;
var a:integer;u,l,r,h:tintList;
begin
if s = nil then Qsort:=t
else with s^ do begin
a:=daten; u:=nachf;
l:=nil;r:=nil;

while u <> nil do with u^ do
if daten < a then
begin h:=nachf; nachf:=l;l:=u;u:=h end
else
begin h:=nachf;nachf:=r;r:=u;u:=h end;
nachf:= Qsort(r,t);
Qsort:=Qsort(l,s);
end
end;


{---------------Hauptprogramm----------------}
begin

new(zeiger);
zeiger^.Nachf := nil;
zeiger^.Vorg :=nil;

erstellen(zeiger);
qsort(zeiger,test);
ausgabe(zeiger);
ausgabe(test);
readln;
end.

[Diogenes]

@kak:

Laß mir bitte ein wenig Zeit. Ich bin berufstätig und habe auch noch andere Hobbies. Du stellst mich vor ein ungwöhnliches Problem, das überdacht sein will.

[Diogenes]

@kak:

Ich habe eine Lösung für Dein Problem gefunden. Sie ist in Form eines neuen Quellcodes dargestellt, weil ich, ehrlich gesagt, Deinen Code verwirrend gefunden habe.

Ein paar Anmerkungen zu den Bezeichnern:
Ich verwende TXxxx als Form für neue Datentypen. Zeiger Typen auf diese haben die Form PXxxx. Variablen haben kein Präfix, es sei denn, sie seien Zeigervariablenb, in welchem Falle das Präfix pt ist.

program ListSort;

type

{Pointers}

PElement = ^TElement;
PList = ^TList;

{Records}

TElement = record

Data: Integer; {Datum}
ptPred, {Vorgaenger}
ptSucc: PElement {Nachfolger}

end;

TList = record

Size: LongInt; {Groesse der Liste in Elementen.
Mindestgroesse eines Elementes ist 5 Byte * MaxLongInt macht
10GB}
ptFirst, ptLast: PElement {Zeiger auf das 1. und das letzte
Element.}

end;

var

List: TList;

function CreateList( var Lis: TList): Boolean;
{Erzeugen einer Liste mittels Zufallsgenerator. Bei Verwendung dieses
Systems sollte TList.Size nach Manipulationen aktualisiert werden!
CreateList gibt True zurueck, wenn mindestens ein Element erzeugt werden
konnte.}

var
I: LongInt;
ptNewElement: PElement;

begin
CreateList := False;
FillChar( List, SizeOf( List), #000);
Randomize;
with List do
begin
Write( 'Enter List size: '); ReadLn( Size);
for I := 1 to Size do
begin
New( ptNewElement);
CreateList := True;
FillChar( ptNewElement^, SizeOf( TElement), #000);
with ptNewElement^ do
begin
Data := Trunc( Random * MaxInt);
if I = 1
then begin
ptFirst := ptNewElement;
ptLast := ptNewElement
end
else begin
ptLast^.ptSucc := ptNewElement;
ptNewElement^.ptPred := ptLast;
ptLast := ptNewElement
end
end
end
end
end;

procedure WriteList( var List: TList);
{Drucken der Liste}

var
ptElement: PElement;

begin
ptElement := List.ptFirst;
while ptElement <> nil do
begin
WriteLn( ptElement^.Data);
ptElement := ptElement^.ptSucc
end
end;

procedure DisposeList( var List: TList);
{Zerstoeren der Liste.}

var
ptElement: PElement;

begin
while List.ptLast <> nil do
begin
ptElement := List.ptLast;
List.ptLast := ptElement^.ptPred;
Dispose( ptElement)
end;
List.ptFirst := nil
end;

(**************************************************)
(* The Reason of it all! *)
(**************************************************)

procedure QuickSort( var List: TList);
{Die Hauptroutine spielt "Interface" gegenueber dem Programm, sodass man nur
die Listen-Variable uebergeben muá.
Der eigentliche Trick dieser Version besteht darin, dass mittels
Mitfuehren der Positionsindices ein Array "emuliert" wird. Dadurch muessen
wir den klassischen Quicksort nur um ein weniges modifizieren.
Ich habe hier einige Unterroutinen eingebaut, die diese "Emulation"
bewerkstelligen.}

procedure ExecSort( iLeftBorder, iRightBorder: LongInt;
ptLeftBorder, ptRightBorder: PElement);

var
iLeft, iRight: LongInt;
ptLeft, ptRight: PElement;
PivotData: Integer;

procedure SeekPivotData;
{Dies ist das l„stigste: wir muessen uns leider durch die Liste
"durchhangeln", wenn wir das Pivot-Element errechen wollen. Geht trotzdem
recht flott. ;)
Entspricht "klassischem"
... PivotData := Ary[ (iLeftBorder + iRightBorder) div 2]}

var
I: LongInt;
ptPivot: PElement;

begin
I := (iLeftBorder + iRightBorder) div 2 - iLeftBorder;
ptPivot := ptLeftBorder;
while I > 0 do
begin
ptPivot := ptPivot^.ptSucc;
Dec( I)
end;
PivotData := ptPivot^.Data
end;

procedure IncLeft;

begin
Inc( iLeft);
ptLeft := ptLeft^.ptSucc
end;

procedure DecRight;

begin
Dec( iRight);
ptRight := ptRight^.ptPred;
end;

procedure SwapData;
{Datentausch. Bei gr”áeren Daten w�rde ich das mit Move machen.}

var
TmpData: Integer;

begin
TmpData := ptLeft^.Data;
ptLeft^.Data := ptRight^.Data;
ptRight^.Data := TmpData
end;

begin {ExecSort Codeblock}
iLeft := iLeftBorder; ptLeft := ptLeftBorder;
iRight := iRightBorder; ptRight := ptRightBorder;
SeekPivotData;
repeat
while ptLeft^.Data < PivotData do
IncLeft;
while PivotData < ptRight^.Data do
DecRight;
if iLeft <= iRight
then begin
SwapData;
IncLeft;
DecRight
end
until iLeft > iRight;
if iLeftBorder < iRight {Zur Verhinderung unnoetiger Sortierungen}
then ExecSort( iLeftBorder, iRight, ptLeftBorder, ptRight);
if iLeft < iRightBorder {Zur Verhinderung unnoetiger Sortierungen}
then ExecSort( iLeft, iRightBorder, ptLeft, ptRightBorder)
end;

begin
with List do
if Size > 1 {Einer Einser-Liste ist _immer_ schon sortiert...}
then ExecSort( 1, Size, ptFirst, ptLast)
end;

(***************************************************************************)
(* End of QuickSort *)
(***************************************************************************)

begin
if CreateList( List)
then begin
WriteLn( '---------- Unsortiert ----------');
WriteList( List);
QuickSort( List);
WriteLn( '----------- Sortiert -----------');
WriteList( List);
DisposeList( List);
Write( 'Bitte ''ENTER'' dr�cken'); ReadLn
end
end.

{Zum Schluss ein geschaetzter Benchmark-Test: Auf einem P75 braucht dieser
Quicksort cirka eine halbe Sekunde. Womm!}


Das ist getestet und funktioniert auf meinem Rechner klaglos.