[Back to SORTING SWAG index] [Back to Main SWAG index] [Original]
{ I've been working on a project for most of this year found the SWAG
group a valuable resource for ideas. I've written a mergesort that I
thought others may find of interest. It is written for a doubly
linked list because that is what I needed, but I'm sure it can be
adapted for a single linked list and with a bit more work probably
arrays.
On a 486DX-50 it repeatly sorted a list of 20000 elements in less
than 0.9 of a second (unless I've done something wrong with the
timing).
It is wrapped up in a test program and generates an output file
called 'SORTTEXT.TXT' which includes the initial unsorted list, the
sorted list and the approximate time taken to sort the list. It
should compile straight away.
}
program MergeTest;
uses Dos;{for GetTime}
type
PNodeType = ^NodeType;
NodeType = record Val : integer; {The Value of the node}
Prev : PNodeType; {The Previous Node in the List. This equals nil when first in list}
Next : PNodeType; {The Next Node in the List. This equals nil when last in list}
end;
var
TheList : PNodeType;
TempList : PNodeType;
N : integer;
Count : integer;
OutFile : text;
Hundredths : word; { }
Hundredths2 : word; { }
Seconds : word; { }
Seconds2 : word; { }
Minutes : word; { Used for timing }
Minutes2 : word; { }
Hours : word; { }
Hours2 : word; { }
Total : longint; { }
Total2 : longint; { }
procedure ShowList(TheList : PNodeType);
{This procedure will take a List of PNodeType and write it to a file}
var
Count : integer;
TempList : PNodeType;
begin
TempList := TheList;
Count := 1;
while TempList <> nil do
begin
if TempList^.Prev <> nil then
writeln(OutFile,' Prev : ',TempList^.Prev^.Val)
else
writeln(OutFile,' Prev = nil');
writeln(OutFile,'Val No : ',Count,' is ',TempList^.Val);
if TempList^.Next <> nil then
writeln(OutFile,' Next : ',TempList^.Next^.Val)
else
writeln(OutFile,' Next = nil');
writeln(OutFile);
TempList := TempList^.Next;
inc(Count);
end;
writeln(OutFile,'The Node = nil');
writeln(OutFile);
end;
function MergeSort(TheList : PNodeType; N : integer) : PNodeType;
{This procedure is the MergeSort. It recursively calls itself to sort the
list}
var
TempNode1 : PNodeType;
TempNode2 : PNodeType;
Count : integer;
Size1 : integer;
Size2 : integer;
UsingList1 : boolean;
begin
{check for two or less elements}
if N <= 2 then
begin
if N = 1 then {one element in the list}
MergeSort := TheList {a one element list is already sorted}
else
begin {two elements in the list}
{if the two elements are already sorted, return the list else
swap them and return the list}
if TheList^.Val < TheList^.Next^.Val then
MergeSort := TheList
else
begin
TempNode1 := TheList;
TempNode2 := TheList^.Next;
TempNode1^.Prev := TempNode2;
TempNode2^.Next := TempNode1;
TempNode1^.Next := nil;
TempNode2^.Prev := nil;
MergeSort := TempNode2;
end;
end;
end
else
begin
{more than two element in the list}
{split the list in to two half lists}
{TempNode1 holds the first list}
{TempNode2 holds the second list}
TempNode2 := TheList;
Size1 := N div 2;
Size2 := n - Size1;
for Count := 1 to Size1 - 1 do
TempNode2 := TempNode2^.Next;
TempNode1 := TempNode2;
TempNode2 := TempNode2^.Next;
TempNode1^.Next := nil;
TempNode2^.Prev := nil;
TempNode1 := TheList;
{sort the two half lists}
TempNode1 := MergeSort(TempNode1,Size1);
TempNode2 := MergeSort(TempNode2,Size2);
{Merge the two sorted lists}
{Select which list to start with}
{When UsingList1 is true then the list being moved through is
the first list (TempNode1) else it is the second list
(TempNode2)}
if TempNode1^.Val < TempNode2^.Val then
begin
MergeSort := TempNode1;
UsingList1 := true;
end
else
begin
MergeSort := TempNode2;
UsingList1 := false;
end;
while (TempNode1 <> nil) and (TempNode2 <> nil) do
begin
{A procedure could be used to replace the two branches of this
if statement}
{This is where the merge takes place}
if UsingList1 then
begin
while (TempNode1^.next <> nil) and
(TempNode1^.Next^.Val < TempNode2^.Val) do
{^ Sort criteria ^}
TempNode1 := TempNode1^.Next;
TempNode2^.Prev := TempNode1;
TempNode1 := TempNode1^.Next;
TempNode2^.Prev^.Next := TempNode2;
if TempNode1 = nil then
exit;
end
else
begin
while (TempNode2^.next <> nil) and
(TempNode2^.Next^.Val < TempNode1^.Val) do
{^ Sort criteria ^}
TempNode2 := TempNode2^.Next;
TempNode1^.Prev := TempNode2;
TempNode2 := TempNode2^.Next;
TempNode1^.Prev^.Next := TempNode1;
if TempNode2 = nil then
exit;
end;
UsingList1 := not UsingList1;
end;
end;
end;
begin
{Small piece of code to test the sort}
N := 20000; {Change this to vary the number of
elements in the linked list}
randomize;
{Create the list}
writeln('Initialising List');
new(TheList);
TheList^.Val := random(500);
TheList^.Prev := nil;
TempList := TheList;
for Count := 2 to N do
begin
new(TempList^.Next);
TempList^.Next^.Prev := TempList;
TempList := TempList^.Next;
TempList^.Val := random(500);
end;
TempList^.next := nil;
{Write the list to file}
writeln('Writing Initial list to file');
assign(OutFile,'SortText.Txt'); {The name of the output file}
rewrite(OutFile);
writeln(OutFile,'----- Initial List -----');
writeln(OutFile);
ShowList(TheList);
close(OutFile);
writeln('Sorting List of ', N ,' elements');
{Get the start time}
GetTime(Hours,Minutes,Seconds,Hundredths);
{Sort the list}
TheList := mergesort(TheList,N);
{Get the end time}
GetTime(Hours2,Minutes2,Seconds2,Hundredths2);
writeln('List Sorted');
{Calculate the difference (I'm sure there's a better way)}
Total := Hours * 360000 + Minutes * 6000 + Seconds * 100 + Hundredths;
Total2 := Hours2 * 360000 + Minutes2 * 6000 + Seconds2 * 100 + Hundredths2;
{Display Time taken}
writeln('Approx Time Taken : ',Total2 - Total,' hundredths of a second');
{Write the sorted list and the results to file}
writeln('Writing Sorted list to File');
writeln;
append(OutFile);
writeln(OutFile,'----- Sorted List -----');
writeln(OutFile);
ShowList(TheList);
writeln(OutFile,'Approx Time Taken : ',Total2 - Total,' hundredths of a second');
close(OutFile);
end.
[Back to SORTING SWAG index] [Back to Main SWAG index] [Original]