Quicksort

[bonanza]

Hi,
ich muss ein Array mit Quicksort sortieren. Hier der Quellcode der Procedure:

Delphi-Quellcode:

var
 QS_liste: Array[1..10] of integer;
 l_pos, r_pos, pivot, temp, pivot_feld : integer;
{...}
procedure Quicksort(var a: array of integer; anfang, ende:integer);
var i: integer;
begin
      pivot_feld := (anfang+ende)div 2;
      pivot := a[pivot_feld];

      l_pos := anfang;
      r_pos := ende;
      repeat
            while a[l_pos] < pivot do inc(l_pos);
            while a[r_pos] > pivot do dec(r_pos);
            if l_pos < r_pos then begin

                      temp := a[l_pos];
                      a[l_pos] := a[r_pos];
                      a[r_pos] := temp;

                      inc(l_pos);
                      dec(r_pos);
                      end;
       until (l_pos > r_pos) ;

       if (anfang < r_pos) then quicksort(a, anfang, r_pos);
       if (l_pos < ende) then quicksort(a, l_pos, ende);
end;

ich rufe diese procedure so auf:

Delphi-Quellcode:

QuickSort(QS_liste, 1, 10);

DAs problem ist, dass er komischerweise immer ein Feld verändert.
z.b.:
in qs_liste vor beginn der procdure:
2, 54, 48, 1, 85, 2, 58, 77, 92, 31

nach dem das programm gelaufen ist wurde z.b. die zahl 48 durch die zahl 7 ersetzt.

Wäre für eure hilfe sehr dankbar.
mfg
bonanza

[Hawkeye219]

Hallo bonanza,

der Fehler in deinem Programm tritt wegen einer Indexverschiebung auf. Das Array QS_Liste, welches du beim Aufruf übergibst, ist 1-basiert (Index 1..10). Der Parameter a der Routine Quicksort ist aber ein "open array" und damit 0-basiert.

Die einfachste Lösung besteht darin, das Feld QS_Liste auch auf eine 0-basierte Adressierung umzustellen.

Gruß Hawkeye

[Amateurprofi]

hallo bonanza,

1) Die Variablen l_pos, r_pos, pivot, temp, pivot_feld müssen lokal, d.h. innerhalb der Prozedur Quicksort definiert sein.
2) Wenn Du das Array als Parameter übergibst, dann solltest Du es als array[0..9] definieren.

edit:
3) bei " if l_pos < r_pos then begin " muß es heißen "<=".

[bonanza]

dakne für die antworten.
funktioniert jetzt auch soweit.

Zitat:

Zitat von Amateurprofi

hallo bonanza,
3) bei " if l_pos < r_pos then begin " muß es heißen "&lt;=".

aber warum muss es "<=" sein ? wenn die doch gleich sind also auf einem "Punkt" stehen kann man die ja schlecht tauschen, also es macht keinen großen oder ?

ich habe jetzt all diese Arrayteile in Editfelder ausgegeben um den vorgang des Quicksort zu visualisieren. so mache ich immer einen Pfeil unter dem Editfeld, wo gerade das "Pivot-feld" ist und die Felder, die getauscht werden sollen.
dann:
rote markierung
sleep(1000);
tausch
aktualisierung der Editfelder
grüne markierung;
sleep(1000);
demarkierung der felder (mit weiß)

Doch aus irgendeinem Grund hängt sich dsa Programm immer auf, sobald ich die sleep funktionen reinmache also nicht, dass es dann nur für die 1 sek stehen bleibt sondern, dann werden noch ncihtmal die felder markiert und es hängt sich eben auf.

der Quellcode dazu:

Delphi-Quellcode:

{...}
procedure aktualisieren;
var j: integer;
begin
for j := 0 to 9 do begin
case j of
  0: form1.edit1.text := inttostr(ss_liste[j]);
  1: form1.edit2.text := inttostr(ss_liste[j]);
  2: form1.edit3.text := inttostr(ss_liste[j]);
  3: form1.edit4.text := inttostr(ss_liste[j]);
  4: form1.edit5.text := inttostr(ss_liste[j]);
  5: form1.edit6.text := inttostr(ss_liste[j]);
  6: form1.edit7.text := inttostr(ss_liste[j]);
  7: form1.edit8.text := inttostr(ss_liste[j]);
  8: form1.edit9.text := inttostr(ss_liste[j]);
  9: form1.edit10.text := inttostr(ss_liste[j]);
end; // von CASE
end; // von FOR
end;

procedure markiere (farbe:tcolor;x:integer);
begin
case x of
  0:  form1.edit1.color := farbe;
  1:  form1.edit2.color := farbe;
  2:  form1.edit3.color := farbe;
  3:  form1.edit4.color := farbe;
  4:  form1.edit5.color := farbe;
  5:  form1.edit6.color := farbe;
  6:  form1.edit7.color := farbe;
  7:  form1.edit8.color := farbe;
  8:  form1.edit9.color :=farbe;
  9:  form1.edit10.color := farbe;
end; // von CASE
end;

procedure demarkiere(v:integer);
begin
case v of
  0: form1.edit1.color := clWindow;
  1: form1.edit2.color := clWindow;
  2: form1.edit3.color := clWindow;
  3: form1.edit4.color := clWindow;
  4: form1.edit5.color := clWindow;
  5: form1.edit6.color := clWindow;
  6: form1.edit7.color := clWindow;
  7: form1.edit8.color := clWindow;
  8: form1.edit9.color := clWindow;
  9: form1.edit10.color := clWindow;
end; // von CASE
end;

procedure markieren_pivot (z:integer);
begin
 case z of
  0: form1.image1.visible := true;
  1: form1.image2.visible := true;
  2: form1.image3.visible := true;
  3: form1.image4.visible := true;
  4: form1.image5.visible := true;
  5: form1.image6.visible := true;
  6: form1.image7.visible := true;
  7: form1.image8.visible := true;
  8: form1.image9.visible := true;
  9: form1.image10.visible := true;
end; // von CASE

end;

procedure demarkiere_pivot (z:integer);
begin
 case z of
  0: form1.image1.visible := false;
  1: form1.image2.visible := false;
  2: form1.image3.visible := false;
  3: form1.image4.visible := false;
  4: form1.image5.visible := false;
  5: form1.image6.visible := false;
  6: form1.image7.visible := false;
  7: form1.image8.visible := false;
  8: form1.image9.visible := false;
  9: form1.image10.visible := false;
end; // von CASE
end;


procedure Quicksort(var a: array of integer; anfang, ende:integer);
var i, l_pos, r_pos, pivot, temp, pivot_feld: integer;
begin
      pivot_feld := (anfang+ende)div 2;
      demarkiere_pivot(pivot_feld);
      pivot := a[pivot_feld];
      markieren_pivot(pivot_feld);
      l_pos := anfang;
      r_pos := ende;
      repeat
            while a[l_pos] < pivot do inc(l_pos);
            while a[r_pos] > pivot do dec(r_pos);
            if l_pos < r_pos then begin
markiere(clRed, l_pos);
markiere(clRed, r_pos);
sleep(1000);
                      temp := a[l_pos];
                      a[l_pos] := a[r_pos];
                      a[r_pos] := temp;
aktualisieren;
markiere(clGreen, l_pos);
markiere(clGreen, r_pos);
sleep(500);
for i := 0 to 9 do demarkiere(i);

                      inc(l_pos);
                      dec(r_pos);
                      end;
       until (l_pos > r_pos) ;

       if (anfang < r_pos) then quicksort(a, anfang, r_pos);
       if (l_pos < ende) then quicksort(a, l_pos, ende);
end;

[himitsu]

zu deinem Code ... ich denke ein FindComponent könnte diese CASE-Konstrukte wesentlich leserlicher ersetzen :)

[bonanza]

Zitat:

Zitat von himitsu

zu deinem Code ... ich denke ein FindComponent könnte diese CASE-Konstrukte wesentlich leserlicher ersetzen :)

sorry aber "FindComponent" habe ich noch nie gehört ^^
könntest du mir ein beispiel geben ?

danke schonmal im voraus

[himitsu]

beispiel ... aber immer doch :mrgreen: FindComponent


so wird z.B. aus

Delphi-Quellcode:

case j of 
  0: form1.edit1.text := inttostr(ss_liste[j]); 
  1: form1.edit2.text := inttostr(ss_liste[j]); 
  2: form1.edit3.text := inttostr(ss_liste[j]); 
  3: form1.edit4.text := inttostr(ss_liste[j]); 
  4: form1.edit5.text := inttostr(ss_liste[j]); 
  5: form1.edit6.text := inttostr(ss_liste[j]); 
  6: form1.edit7.text := inttostr(ss_liste[j]); 
  7: form1.edit8.text := inttostr(ss_liste[j]); 
  8: form1.edit9.text := inttostr(ss_liste[j]); 
  9: form1.edit10.text := inttostr(ss_liste[j]); 
end; // von CASE

dieses

Delphi-Quellcode:

TEdit(Form1.FindComponent('Edit' + IntToStr(j))).Text := IntToStr(ss_liste[j]);

'Edit' + IntToStr(j) bildet sozusagen den Namen der Componente, die man sucht

[bonanza]

super danke
das nenne ich ne verkürzung ^^

hat denn noch jemand ne idee warum das programm stockt ?

Delphi-Quellcode:

procedure aktualisieren;
var j: integer;
begin
for j := 1 to 10 do
TEdit(Form1.FindComponent('Edit' + IntToStr(j))).Text := IntToStr(ss_liste[j]);
end;

procedure markiere (farbe:tcolor;x:integer);
begin
TEdit(Form1.FindComponent('Edit' + IntToStr(x))).color := farbe;
end;

procedure demarkiere(v:integer);
begin
TEdit(Form1.FindComponent('Edit' + IntToStr(v))).color := clWindow;
end;

procedure markieren_pivot (z:integer);
begin
TEdit(Form1.FindComponent('image' + IntToStr(z))).visible := true;
end;

procedure demarkiere_pivot (z:integer);
begin
TEdit(Form1.FindComponent('image' + IntToStr(z))).visible := false;
end;

procedure Quicksort(var a: array of integer; anfang, ende:integer);
var i, l_pos, r_pos, pivot, temp, pivot_feld: integer;
begin
      pivot_feld := (anfang+ende)div 2;
for i := 1 to 10 do demarkiere_pivot(i);
      pivot := a[pivot_feld];
      markieren_pivot(pivot_feld);
      l_pos := anfang;
      r_pos := ende;
      repeat
            while a[l_pos] < pivot do inc(l_pos);
            while a[r_pos] > pivot do dec(r_pos);
            if l_pos < r_pos then begin
markiere(clRed, l_pos);
markiere(clRed, r_pos);
sleep(1000);
                      temp := a[l_pos];
                      a[l_pos] := a[r_pos];
                      a[r_pos] := temp;
aktualisieren;
markiere(clGreen, l_pos);
markiere(clGreen, r_pos);
sleep(1000);
for i := 1 to 10 do demarkiere(i);
                      inc(l_pos);
                      dec(r_pos);
                      end;
       until (l_pos > r_pos) ;
       if (anfang < r_pos) then quicksort(a, anfang, r_pos);
       if (l_pos < ende) then quicksort(a, l_pos, ende);
end;

aufruf mit:

Delphi-Quellcode:

QuickSort(ss_liste, 0, 9);

[himitsu]

Das mit dem Aufhängen ...

Das Sleep macht ja 'ne Pause bei jedem Schritt, also alles OK.
Nur braucht jetzt die gesamte Prozedur solange, wie alle Sleeps, die aufgerufen brauchen ... wenn also Slepp(1000) 1000-mal aufgerufen wird, dann ergibt das 1000 Sekunden.

Du änderst zwar die Eigenschaften, aber aktualisierst nicht die Oberfläche, noch gibts du der Form etwas Zeit sich mal um ihre angelegenheiten zu kümmern ... mach mal vor die Sleep's noch ein Application.ProcessMessages;

[bonanza]

danke das läuft jetzt schonmal flüssig

aber ich habe manchmal einen Error in der markierten zeile

Delphi-Quellcode:

{...}
markiere(clRed, l_pos);
markiere(clRed, r_pos);
Application.ProcessMessages;
sleep(1000);
                      temp := a[l_pos];
                      a[l_pos] := a[r_pos];
                      a[r_pos] := temp;
aktualisieren;
markiere(clGreen, l_pos);
markiere(clGreen, r_pos);   //<-------- Hier
Application.ProcessMessages;
sleep(1000);

der Error is eine EAccessVioliation

[Amateurprofi]

Zitat:

aber warum muss es "<=" sein ? wenn die doch gleich sind also auf einem "Punkt" stehen kann man die ja schlecht tauschen, also es macht keinen großen oder ?

Bonanza,
Schau Dir doch mal die Repeat Schleife an.
Nimm an, die beiden While Schleifen seien abgearbeitet und l_pos ist gleich r_pos.
Wenn jetzt weder l_pos noch r_pos verändert wird, dann wird die beim until definierte Abbruchbedingung ganz sicher nicht erfüllt.
Also wird die Repeat Schleife wiederholt, mit dem Ergebnis, daß sich an l_pos und r_pos nichts ändert.
Tja, und dann läuft dein Programm in einer Endlos-Schleife.

Wenn l_pos = r_pos ist müssen a[l_pos] und a[r_pos] nicht vertauscht werden (es ist aber auch nicht schädlich).
Wichtig ist nur, daß l_pos um erhöht und r_pos gesenkt wird.

Delphi-Quellcode:

   repeat
      while a[l_pos] < pivot do inc(l_pos);
      while a[r_pos] > pivot do dec(r_pos);
      if l_pos <= r_pos then begin
         temp := a[l_pos];
         a[l_pos] := a[r_pos];
         a[r_pos] := temp;
         inc(l_pos);
         dec(r_pos);
      end;
   until (l_pos > r_pos) ;

[bonanza]

ok das leuchtet ein...danke !

aber jetzt habe ich wieder das problem, dass Edit10 immer überschrieben wird und da immer "+ 1".
Hätte jemand eine idee warum ?

[Hawkeye219]

@Amateurprofi

Vielleicht könntest du dir die Delphi-Implementierung auf dieser Seite einmal ansehen bzw. sie korrigieren. Laut Diskussion ist man sich dort auch nicht ganz einig, welcher Vergleichsoperator nun der richtige ist.

Gruß Hawkeye

[Amateurprofi]

Zitat:

Vielleicht könntest du dir die Delphi-Implementierung auf dieser Seite einmal ansehen bzw. sie korrigieren. Laut Diskussion ist man sich dort auch nicht ganz einig, welcher Vergleichsoperator nun der richtige ist.

@Hawkeye:

Diese Prozedur aus Wikipedia meinst Du?!

Delphi-Quellcode:

procedure quicksort(var a:array of integer;l,r:integer);
var lpos,rpos,tmp,pivot:integer;
begin
  pivot:=a[(l+r) div 2];
  lpos:=l;
  rpos:=r;

  while lpos<=rpos do
    begin
      while a[lpos]<pivot do inc(lpos);
      while a[rpos]>pivot do dec(rpos);
      if lpos<rpos then
        begin
          tmp:=a[lpos];
          a[lpos]:=a[rpos];
          a[rpos]:=tmp;
          inc(lpos);
          dec(rpos);
        end;
    end;
  if l<rpos then quicksort(a,l,rpos);
  if lpos<r then quicksort(a,lpos,r);
end

Um ehrlich zu sein, ich habe mir nie die Mühe gemacht, Quicksort wirklich zu verstehen - mir hat es immer gereicht, daß die Prozedur, so wie ich sie einsetze, funktioniert.

Anders als die "Bonanza-Version" verwendet die "Wikipedia-Version" als "outer loop" nicht ein Repeat-Until sondern ein While Do Konstrukt, das auch den Fall lpos=rpos abfängt, somit tritt auch keine Endlos-Schleife auf. Rein gefühlsmäßig hätte ich aber Bedenken gegen die "Wikipedia-Version".
Warum?:
Quicksort teilt das zu sortierende Feld jeweils in 2 Teilfelder auf, die dann, jedes für sich sortiert werden.
Wenn die "outer loop" abgebrochen wird dann folgt.

Delphi-Quellcode:

if l<rpos then quicksort(a,l,rpos);
if lpos<r then quicksort(a,lpos,r);

und wenn der Abbruch der "outer loop" erfolgte, weil lpos=rpos ist, dann würde a[lpos], das ja identisch ist mit a[rpos]
zu beiden neuen Teilfeldern gehören. Weiß nicht, ob das kritisch ist, aber nach meinem Verständnis ist dann keine saubere Trennung der einzelnen Teilfelder gegeben.

Wenn ich mal viel Zeit habe, werde ich mich damit eingehender befassen - zur Zeit solltest Du obigen Text als "aus der Hüfte geschossen" betrachten.

[bonanza]

Ich habe noch einmal ein Problem und zwar will ich den jeweils veränderten Bereich (durch quicksort) in einem Stringgrid darstellen...
dazu haben ich folgendes geschrieben:

Delphi-Quellcode:

{....}
var
  Form1: TForm1;
  Zahlen : Array[1..100] of boolean;
  ZZahlen: Array[1..10] of boolean;
  SS_liste: Array[0..9] of integer;
  durchlauf : integer;
{...}
procedure akt_sg (a: array of integer; b, c:integer);
var j, start, ende: integer;
begin
if (b >= c) then begin start := c; ende:= b; end;
for j := start to ende do begin
form2.Stringgrid1.Cells[j+1, durchlauf] := IntToStr(ss_liste[j]);
end;
end;


{...vorderer Teil der QS-Prozedur...Rest siehe 3. letztes Posting (wollte dies hier nich zu voll packen)...}
                      temp := a[l_pos];
                      a[l_pos] := a[r_pos];
                      a[r_pos] := temp;
                      inc(durchlauf);
                      if (l_pos < pivot_feld) then akt_faktor := anfang else akt_faktor := ende;  //*1
                      akt_sg(a, akt_faktor, pivot);
{...danach folgender Teil...}

Ich hab mir da so gedacht, dass mit dem bei "*1*" markierten bereich kontrolliert wird, welcher Teil des gesamten verändert wurde ich dann mit der oberen "akt_sg" prozedur das in das Stringgrid übertrage, doch aus irgendeinem Grund funktioniert da schon etwas mit der parameter übergabe nicht so ganz, wie ich es haben möchte.

Wäre für eure Hilfe sehr dankbar

[Hawkeye219]

Zitat:

Zitat von bonanza

if (b >= c) then begin start := c; ende:= b; end;

Und was ist bei b < c? :gruebel:

[Angel4585]

dann iss schon richtig rum un muss nich getauscht werden :stupid:

[Hawkeye219]

:shock: er soll mit nicht initialisierten Variablen weiterarbeiten?