Ich hab da was aus
TP Zeiten ausgegraben, es muß also auf jeden Fall überarbeitet werden:
Delphi-Quellcode:
type
sortpoint =^sorts;
sorts =
record next :sortpoint;
{- 4 -}
last :sortpoint;
{- 4 -}
satz :
string;
{ +1 -}
end;
var
markpoint:^integer;
lsterst :sortpoint;
lstlezt :sortpoint;
actsatz :sortpoint;
sc :longint;
c :integer;
{ z„hler sc- lc-L„ufe c-geschriebeneS.}
hilfp :
string[5];
cc :integer;
procedure HEAPSORT;
(*..............................................*)
var
helpp :sortpoint;
medium :sortpoint;
{ mittleres Element }
klein :sortpoint;
{ Kleineres Element }
gross :sortpoint;
{ GrӇeres Element }
n,m,i :integer;
begin
{ -----------------------------------------INITIALISIEREN -----------}
n:=0;
m:=0;
medium :=lsterst;
{-- erstes E = MittelElem --}
klein :=medium;
gross :=medium;
lstlezt:=lsterst^.next;
medium^.last:=nil;
medium^.next:=nil;
{ ----------------------------------------- SORTIEREN ---------------}
repeat
actsatz:=lstlezt;
lstlezt:=lstlezt^.next;
if actsatz^.satz<medium^.satz
then begin {------------------}
inc(n,1);
{----------------- actsatz kleiner mittlerer satz --}
if actsatz^.satz<klein^.satz
then begin {-- act<klein -----}
if klein^.last=nil
then begin
klein^.last:=actsatz;
actsatz^.next:=klein;
klein:=actsatz;
klein^.last:=nil;
end
else begin
repeat
helpp:=klein;
klein:=klein^.last;
until (klein^.satz<=actsatz^.satz)
or (klein=nil);
helpp^.last:=actsatz;
actsatz^.last:=klein;
actsatz^.next:=helpp;
klein^.next:=actsatz;
klein:=actsatz;
end;
end { -------------------- actsatz< klein -------------------}
else begin {----------- actsatz>= klein-------------------}
helpp:=klein;
repeat
helpp:=helpp^.next;
until helpp^.satz>actsatz^.satz;
klein:=helpp^.last;
helpp^.last:=actsatz;
klein^.next:=actsatz;
actsatz^.next:=helpp;
actsatz^.last:=klein;
end;
end {------------ act<medium ----------------------------------- }
else begin {------------------- actsatz>= medium --------------- }
inc(m,1);
if gross^.satz<=actsatz^.satz
then begin { gross<=act. ---}
if gross^.next=nil
then begin
gross^.next:=actsatz;
actsatz^.last:=gross;
gross:=actsatz;
gross^.next:=nil;
end
else begin
repeat
helpp:=gross;
gross:=gross^.next;
until (gross^.satz>actsatz^.satz)
or (gross=nil);
helpp^.next:=actsatz;
actsatz^.last:=helpp;
actsatz^.next:=gross;
gross^.last:=actsatz;
gross:=actsatz;
end
end
else begin {------------------ gross>actsatz -----------------}
repeat
gross:=gross^.last;
until gross^.satz<=actsatz^.satz;
helpp:=gross;
gross:=gross^.next;
helpp^.next:=actsatz;
actsatz^.last:=helpp;
actsatz^.next:=gross;
gross^.last:=actsatz;
gross:=actsatz;
end;
{---- gross>actsatz -----------------------------------------}
end;
{-------------- actsatz>=medium ----------------------------- }
{ ------------ ende Einfgen ------------------------------------- }
(*
gotoxy(5,19);
writeln(n:5,m:6);
*)
if abs(n-m)>200
then begin
if m>n
then begin
for c:=1
to 50
do medium:=medium^.next;
n:=n+50;
m:=m-50;
end
else begin
for c:=1
to 50
do medium:=medium^.last;
m:=m+50;
n:=n-50;
end;
if klein^.last<>
nil then
repeat
klein:=klein^.last
until klein^.last=nil;
if gross^.next<>
nil then
repeat
gross:=gross^.next
until gross^.next=nil;
end;
until lstlezt=nil;
{ -------------------- ENDE SORTIEREN ------------------------------ }
if klein=nil
then klein:=medium;
if klein^.last <>
nil then repeat
klein:=klein^.last;
until klein^.last=nil;
lsterst:=klein;
writeln('
verarbeitete S„tze: ',n+m+1);
end;
{------------ HEAPSORT ------------------------------------------- }
Gruß
K-H