Mergesort ohne extra Speicher

Delphi-Laie · Verfasst: Mi 30.09.09 22:55

So, Gausi und alle anderen, ich habe es im zweiten Anlauf hinbekommen

(eine Arbeit über mehrere Stunden, das meiste davon natürlich Fehlersuche): Verschmelzen ohne zusätzlichen Speicher, mit Ausnahme eines (einzigen!) Variablenspeicherplatzes für das Tauschen, das ja eigentlich ein zyklisches bzw. ringförmiges Verschieben bzw. Tauschen ist.

Verwandt habe ich letztlich die Idee des von ihm so getauften Swapsortes von Siegfried Sielaff. Entweder, ich kann C(++/#) zu schlecht lesen, oder das, was er anbietet, funktioniert so nicht (natürlich nehme ich ersteres an).

Und, Gausi, Du hast insofern völlig recht, es ist ein elend fragile Indizierungsfummelei, aber ein Computer kommt schließlich nicht durcheinander. :wink:

Wenn ich an Smoothsort, AVL-Sort oder B-Sort denke, so ist ein Mergesort mit (rekursivem) "In-Place-Mergen" noch relativ überschaubar. Und es ist allein von der „gefühlten“ Laufzeit her keinesfalls elementar bzw. quadratisch, sondern eindeutig schneller (Bitonicsort schafft es ja auch asymptotisch optimal, auch die graphische Veranschaulichung läßt die Ähnlichkeit mit Bitonicsort erkennen).

Hier mein bei mir durchaus funktionierender Quelltext für das eigentliche Mergen eines Arrays, aus zwei miteinander zu verschmelzenden Teilarrays (a-b, c-d) bestehend:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

procedure swapmerge(a,b,c,d:word);
var lauf,z:word;

begin
z:=0;
while (b-z>=a) and (c+z<=d) and (Menge[b-z]>Menge[c+z]) do inc(z);//Ermittlung der Größe der zu swappenden Teil-Teilarrays
for lauf:=1 to z do tausche(b-(z-lauf),c+pred(lauf));           //Swap
{Erläuterung: Mit tausche wird eine externe Prozedur zum Zwecke des Tauschens (wer hätte das gedacht) aufgerufen,
die die Indizes der zu tauschenden Elemente der zu sortierenden Menge übergeben bekommt; es werden demnach
Menge[b-(z-lauf)] und Menge[c+pred(lauf)] miteinander ver-/ausgetauscht.}

if z>0 then
  begin
  if a<=b-z then swapmerge(a,b-z,succ(b-z),b);
  if c+z<=d then swapmerge(c,pred(c+z),c+z,d)
  end
end;

Mehr ist das eigentliche Swapmergen nicht und damit im Code verblüffend simpler als das, was ich auf Herrn Sielaffs Internetseite dazu fand.

Heiko, ich bin durchaus auch dafür, Abiturienten zu fordern, aber das, was Dein Lehrer dort erwartet, ja womöglich gefordert hatte, war m.E. eindeutig eine Überforderung. Sollte er tatsächlich von „einer kleinen Optimierung“ gesprochen haben, so finde ich das fast schon ein wenig zynisch. Vielleicht bringt das mal jemand ihm schonend bei....

Delphi-Laie · Verfasst: Fr 02.10.09 15:56

Und noch eins drauf: Mit der rekursiven Lösung gab ich mich nicht zufrieden. Die Rekursion (nebenbei bemerkt: sie ist eine Selbstähnlichkeit und ein Selbstbezug im Bereich der Algorithmen, der auf der internenen Ähnlichkeiten, auf Wiederholungen in deren Ablaufprozessen beruht) ist zwar elegant und führt zu kürzeren, oft überschaubareren Quelltexten, doch sie hat andere Nachteile (Stack(speicher)verbrauch inkl. Gefahr des Überlaufes, geringere Geschwindigkeit). Nur als intellektuell anspruchsvolle Herausforderung, Alternativen zu ersinnen, ist sie mir willkommen.

Nach der Idee Robert Sedgewicks (zumindest seine Veröffentlichung in seinem Hauptwerk) analog seinem Quicksort gestaltete ich die obige Prozedur iterativ um, wobei ein eigens dafür genutzter Vektor (Array) namens Stack letztlich den Stack emuliert und der deshalb als Namenspatron herhalten mußte, jedoch deutlich weniger (Haupt-)Speicher, als was vom Stack benutzt würde, verbrauchen und zudem laufzeitgünstiger sein dürfte:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:

procedure swapmerge(a,b,c,d:word);
var lauf,n,z:word;
begin
n:=4;
  repeat
  z:=0;
  while (b-z>=a) and (c+z<=d) and (Menge[b-z]>Menge[c+z]) do inc(z);//Ermittlung der Größe der zu swappenden Teil-Teilarrays
  for lauf:=1 to z do tausche(b-(z-lauf),c+pred(lauf));//Swap
  if z>0 then
    begin
    {Die rekursive Variante dieser Funktion kommt ohne die Variable n, die äußere
    (repeat-until-)Schleife und den emulierten Stack aus, benutzt dafür aber an
    folgender Stelle die rekursiven Aufrufe:}
    //if a<=b-z then swapmerge(a,b-z,succ(b-z),b);
    //if c+z<=d then swapmerge(c,pred(c+z),c+z,d);
    if a<=b-z then
      begin
      stack[n]:=a;
      stack[succ(n)]:=b-z;
      stack[n+2]:=succ(b-z);
      stack[n+3]:=b;
      inc(n,4)
      end;
    if c+z<=d then
      begin
      stack[n]:=c;
      stack[succ(n)]:=pred(c+z);
      stack[n+2]:=c+z;
      stack[n+3]:=d;
      inc(n,4)
      end
    end
  else //z>0
    begin
    dec(n,4);
    a:=stack[n];
    b:=stack[succ(n)];
    c:=stack[n+2];
    d:=stack[n+3]
    end
  until n=0
end;

Diese Prozedur ermöglicht einen Sortieralgorithmus, der bei dem heutigen Softwareniveau (meine ich positiv!) als optimal angesehen werden kann:

- allgemeingültig i.d.S., daß alle Werte (und eben nicht nur integre) können sortiert werden,
- stabil (d.h., wertgleiche Elemente werden nicht vertauscht, deren ursprüngliche Reihenfolge bleibt also im Verlaufe der Sortierung enthalten),
- laufzeit- bzw. geschwindigkeitsoptimal (n*log(n)),
- "intelligent" genug, (vor-)sortierte Mengen zu "erkennen", indem er darauf mit einer Laufzeitverkürzung "reagiert",
- nur iterativ, keine Rekursion und
- (fast) kein zusätzlicher Speicher wird benötigt, insbesondere der etwas heikle Stack wird geschont.

All' diese Eigenschaften besitzt das Natural Mergesort mit dem In-Place-Mischen mit dieser Prozedur.

Horst_H · Verfasst: Sa 03.10.09 12:23

Hallo,

kannst Du mal ein minimales funktionierdes Beispielprogramm posten?
Zum Beispiel 100.000 Zufalsszahlen sortieren.Irgendwie habe ich heute ein Brett vorm Kopf. Bei mir wird nichts sortiert.

Das hier funktioniert überhaupt nicht:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:

program test;
{$Apptype console}
 
uses  
  sysutils,math;
  
type
  tSorttype = integer;

var
  i:integer;
  tmp: tSorttype;
  Menge : array[1..16] of tSorttype;
{
procedure tausche (wer,mitwem:word); inline;
begin
   tmp:= Menge[wer];
  Menge[wer]:= Menge[mitwem];
  Menge[mitwem] := tmp;
end;
}
procedure swapmerge(a,b,c,d:integer);
var lauf,n,z:integer;
    stack : array of integer;
begin
n:=4;
z :=round(ln((MAX(b-a,d-c))/ln(2))+1)+1;
setlength(stack,4*z);
writeln(#10#13,'StackSize= ',z);

repeat
  z:=0;
  writeln('Mische a-b: ',a,'..',b,' mit c-d ',c,'..',d);
  while (b-z>=a) and (c+z<=d) and (Menge[b-z]>Menge[c+z]) do 
    inc(z);//Ermittlung der Größe der zu swappenden Teil-Teilarrays
    writeln('z = ',z);
  for lauf:=1 to z do 
    begin
    //tausche(b-(z-lauf),c+pred(lauf));//Swap
    tmp:= Menge[b-(z-lauf)];
    Menge[b-(z-lauf)]:= Menge[c+pred(lauf)];
    Menge[c+pred(lauf)] := tmp;
    end;
    
  if z>0 then
    begin
    {Die rekursive Variante dieser Funktion kommt ohne die Variable n, die äußere
    (repeat-until-)Schleife und den emulierten Stack aus, benutzt dafür aber an
    folgender Stelle die rekursiven Aufrufe:}
    //if a<=b-z then swapmerge(a,b-z,succ(b-z),b);
    //if c+z<=d then swapmerge(c,pred(c+z),c+z,d);
    if a<=b-z then
      begin
      stack[n]:=a;
      stack[n+1]:=b-z;
      stack[n+2]:=succ(b-z);
      stack[n+3]:=b;
      inc(n,4)
      end;
    if c+z<=d then
      begin
      stack[n]:=c;
      stack[n+1]:=pred(c+z);
      stack[n+2]:=c+z;
      stack[n+3]:=d;
      inc(n,4)
      end
    end
  else //z>0
    begin
    dec(n,4);
    a:=stack[n];
    b:=stack[succ(n)];
    c:=stack[n+2];
    d:=stack[n+3]
    end;
  writeln('StackPos ',n div 4);
  until n=0;
setlength(stack,0);  
end;

Begin
//gleiche Startbedingungen
randseed:= 0;
writeln(Low(Menge):10,High(Menge));
For i := low(Menge) to High(Menge) do
  begin
  Menge[i]:= random(High(tSortType));
  write(Menge[i]:8);
  if i AND 7 = 0 then
    writeln;
  end;
swapmerge(1,8,9,16);
writeln;
For i := low(Menge) to High(Menge) do
  begin
  write(Menge[i]:8);
  if i AND 7 = 0 then
    writeln;
  end;
end.

Gruß Horst

Delphi-Laie · Verfasst: So 04.10.09 11:31

Horst_H hat folgendes geschrieben :

Hallo,

kannst Du mal ein minimales funktionierdes Beispielprogramm posten?
Zum Beispiel 100.000 Zufalsszahlen sortieren.Irgendwie habe ich heute ein Brett vorm Kopf. Bei mir wird nichts sortiert.

Jetzt nicht, aber demnächst (irgendwann innerhalb der nächsten Woche), mein Sortierkinoprogramm, daran gibt es nur noch wenige Dinge zu erledigen. Wird in drei Varianten veröffentlicht werden, natürlich wie immer inkl. kompletter Quelltexte.

Ich bin noch nicht ganz mit den zwei Varianten ab Delphi 4 damit fertig, nur die mit statischer Arraydimensionieren, bei der die Bildschirmkoordinaten im Quelltext ziemlich weit oben entweder gelassen oder kleiner als 1600x1200 eingestellt werden können, bei noch größerer Bildschirmauflösung jedoch nach oben angepaßt werden sollten (oder kleinere Fenstergröße wählen).

Ganz davon abgesehen, ziehe ich Deine Arraydimensionierung mit Setlength nicht nach (womit ich jedoch nicht behaupte, daß sie falsch sei). Ich meinen Delphi4-Varienten werde ich - analog, wie ich es mit dem iterativen Quicksort tue - die Größe des Arrays prüfen (bei jeder Inkrementierung des Stack-Indixes "n" und ggf. anpassen. Mag nicht laufzeitoptimal sein, doch damit vermeide ich das Risiko der Unterdimensionierung.

Bist Du Dir sicher, daß Du immer auf tatsächlich existente Arrayelemente zugreifst? Die (Array-)Bereichsüberprüfung ist in den mir näher bekannten Delphi-Versionen (bis 7) im Standardfall ausgeschaltet, könnte darin schon der Fehler liegen?

Ich schicke Dir im Vertrauen die Delphi2++ - Variante schon mal vorab privat zu - einverstanden?

Gruß Delphi-Laie

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme