|
In September 1995 I received the following article through the „Internet".
|
From Robert Beicht <Robert.Beicht@lrz.fh-muenchen.de> Newsgroups: de.comp.lang.pascal Subject: Re: ?: Sortierroutine Date: 5 Sep 1995 20:55:56 GMTAlso ich löse sowas immer mit dem üblichen Quick-Sort. Wer sich mit dem Algorithmus noch nicht auseinandergesetzt hat, findet ihn bei den Demo-Programmen. Hier eine modifizierte Version, die einen RECORD sortiert, nach 'Nachname' und ' Vorname'. Entscheidend ist die Funktion 'Less', die entsprechend den Anforderungen angepaßt werden muß. After you have connected the two Computers at the serial connectors (you need a crossed null modem cable): Um das Ding anzupassen, muß
{************************************************}
{ }
{ QuickSort Demo }
{ Copyright (c) 1985,90 by Borland International } { und: Robert Beicht ;-) }
{ }
{************************************************}
program QSort;
{$R-,S-}
uses Crt;
{ This program demonstrates the quicksort algorithm, which }
{ provides an extremely efficient method of sorting arrays in }
{ memory. The program generates a list of 1000 random numbers }
{ between 0 and 29999, and then sorts them using the QUICKSORT }
{ procedure. Finally, the sorted list is output on the screen. }
{ Note that stack and range checks are turned off (through the }
{ compiler directive above) to optimize execution speed. }
const
Max = 100;
type { ***** }
PData = ^TData; { ***** }
TData = record { ***** }
NachName: String[25]; { ***** }
VorName: String[25]; { ***** }
{..} { ***** }
end; { ***** }
List = array[1..Max] of TData;
var
Data: List;
I: Integer;
function Less(var d1,d2:TData): Boolean; { ***** }
begin { ***** }
if d1.NachName < d2.NachName then Less := True else { ***** }
if d1.NachName > d2.NachName then Less := False else { ***** }
if d1.VorName < d2.VorName then Less := True else { ***** }
if d1.VorName > d2.VorName then Less := False else Less := False; { ***** }
end; { ***** }
{ QUICKSORT sorts elements in the array A with indices between }
{ LO and HI (both inclusive). Note that the QOICKSORT proce- }
{ dure provides only an "interface" to the program. The actual }
{ processing takes place in the SORT procedure, which executes }
{ itself recursively. }
procedure QuickSort(var A: List; Lo, Hi: Integer);
procedure Sort(l, r: Integer);
var
i, j, x: integer; { ***** }
y: TData; { ***** }
begin
i := 1; j := r; x := (l+r) DIV 2;
repeat
while Less(a[i], a[x]) do i := i + 1; { ***** }
while Less(a[x], a[j]) do j := j - 1; { ***** }
if i <= j then
begin
y :=a[i]; a[i] :=a[j]; a[j] :Y y;
i := i + 1; j := j - 1;
end;
until i > j;
if l < j then Sort(l, j);
if i < r then Sort(i, r);
end;
begin {QuickSort};
Sort(Lo,Hi);
end;
begin {QSort}
(*Initialisiere List*)
Sort(List, 1, Count);
end.
| [ |
Das oben dargestellte Programm ist nicht für CP/M ausgelegt, die unter CP/M lauffähige Version findet sich
hier. Das Programm ist lediglich als Rumpf zu verstehen, da keine zu sortierenden Daten vorhanden sind. |
] |
---------------------------------------------------------------------------- --- Robert Beicht e-Mail: Robert.Beicht@lrz.fh-muenchen.de --- --- R.Beicht@lrz.fh-muenchen.de --- --- RBeicht@lrz.fh-muenchen.de --- --- Beicht@lrz.fh-muenchen.de --- --- p7003ot@sunmail.lrz-muenchen.de --- --- p7003ot@hpmail.lrz-muenchen.de --- --- (ja, ich weiß endlich, wie man am LRZ Mail-Adressen 'aliassen' kann) --- --- CompuServe: 100551,2212 --- ---------------------------------------------------------------------------- --- WWW: http://www.lrz-muenchen.de/a7p7003ot/home.htm --- ----------------------------------------------------------------------------
Scanned by
Werner Cirsovius
November 2002
© Robert Beicht