Category : Pascal Source Code
Archive   : T-SORTS.ZIP
Filename : MERGE.PAS

PROGRAM Final_Merge_Sort(input,output);


{ Merge sort program by Chris Gorman of 2AM Associates.
If you have comments of questions you can reach Chris at the original
2AM-BBS, the DREW UNIVERSITY UNDERGROUND. (201)-377-8245 }


CONST max = 20; {max # elements in the array}

TYPE pieces = record
data:integer;
order:integer; {for the stability tests, this field
differentiates between two pieces
of data w. the same value}
end; {record definition}

sortray = array[1..max] of pieces;

VAR x,a,b:sortray;
xn,an,bn:integer; {length of array}
ncomp,nswap:integer; {to keep track of how many comparisions
and swaps were made}

PROCEDURE Grab_Values(Var a,b:sortray; var an,bn:integer);

{You will see a lot of this procedure, it just lets you "load" the
array into memory. Here it is modified for the mergesort. Odd values
are loaded into array A and even values are loaded into array B.
Arrays a and b will then be merged into array x later.}

VAR data_holder:integer;
rep_holder:integer;
i,n:integer;

begin
data_holder:=0;
n:=0; an:=0; bn:=0;
while (data_holder<>-1000) do begin
Writeln('Enter a piece of data (-1000 to end) ');
readln(data_holder);
if (data_holder<>-1000) then begin
Writeln('Enter a "1" if this number will be repeated');
Writeln('(used for stable test) ');
readln(rep_holder);
n:=n+1;
case (n mod 2) of
0: begin
an:=an+1;
a[an].data:=data_holder;
if (rep_holder = 1) then a[an].order:=2
else a[an].order:=1;
end; {case of 1}
1: begin
bn:=bn+1;
b[bn].data:=data_holder;
if (rep_holder = 1) then b[bn].order:=2
else b[bn].order:=1;
end; {case of 2}
end; {case structure}
end; {compound then stmt}
end; {While loop}
end; {procedure}


PROCEDURE result(x,a,b:sortray; nx,na,nb:integer);

Var i:integer;
begin
Writeln('Array A:');
for i:=1 to na do begin
Writeln('Element # ',i:2,' Value is: ',a[i].data:2);
If (a[i].order = 2) then writeln('MARKED');
end; {for i}
Writeln('Array B:');
for i:=1 to nb do begin
Writeln('Element # ',i:2,' Value is: ',b[i].data:2);
If (b[i].order = 2) then writeln('MARKED');
end; {for i}
Writeln('Array X:');
for i:=1 to nx do begin
Writeln('Element # ',i:2,' Value is: ',x[i].data:2);
If (x[i].order = 2) then writeln('MARKED');
end; {for i}
end; {procedure}


PROCEDURE swap(Var a,b:pieces);

{Just a simple swapper}

Var Temp:pieces;
begin
temp:=a;
a:=b;
b:=temp;
end; {procedure}


PROCEDURE Bubblesort (var x:sortray; n:integer);

VAR i,j:integer;

begin
For i:= 1 to (n-1) do
For j:= n downto (i+1) do
If (x[j-1].data>x[j].data) then
Swap (x[j-1],x[j])
end; {procedure}


PROCEDURE Mergesort (var x,a,b:sortray; Var xn,an,bn:integer;
Var ncomp,nswap:integer);

VAR apoint,bpoint,xpoint:integer;

begin
ncomp:=0; nswap:=0;
xn:=an+bn;
{apoint and bpoint are indicators of how far we are in arrays
a and b respectively}
apoint:=1;
bpoint:=1;
xpoint:=1;
while (apoint <= an) and (bpoint <= bn) do begin
Writeln('So far we are through the sub-arrays to locations: ',
apoint:3,bpoint:3);
Writeln('Here are the arrays:');
Result(x,a,b,xn,an,bn);
ncomp:=ncomp+1; {for the while loop}
ncomp:=ncomp+1; {for the if just below}
if (a[apoint].data < b[bpoint].data) then begin
x[xpoint]:=a[apoint];
nswap:=nswap+1;
apoint:=apoint+1;
end {compound then}
else begin
x[xpoint]:=b[bpoint];
nswap:=nswap+1;
bpoint:=bpoint+1;
end; {else}
xpoint:=xpoint+1;
end; {while}
{copy any remaining elements}
while (apoint <= an) do begin
ncomp:=ncomp+1; {for the while}
x[xpoint]:=a[apoint];
nswap:=nswap+1; {actually this sort copies, but
we will count swaps anyway}
xpoint:=xpoint+1;
apoint:=apoint+1;
end; {while}
while (bpoint <= bn) do begin
ncomp:=ncomp+1; {for the while}
x[xpoint]:=b[bpoint];
xpoint:=xpoint+1;
bpoint:=bpoint+1;
end; {while}
end; {procedure mergesort}



PROCEDURE Stabletest(x:sortray; nx:integer);

VAR cursor:integer;

begin
cursor:=1; {start at the beginning of the array}
while (x[cursor].order <> 2) do cursor:=cursor+1;
{assumes that it will find a value with an order of 2...that is,
one which exists twice in the array. Now, if it finds that
value later on in the array, the sort is stable. This is so
because the value earmarked with a 2 in the order field was
entered first in the sort (see grabvalues above). So, if
stabletest finds this repetition first and then goes on to find
the other, (i.e. the next element) after it, the two elements
are in the same order as entered}
If (x[cursor+1].data = x[cursor].data) then
writeln('This sort was found to be STABLE')
else writeln('This sort was NOT found to be STABLE');
end; {procedure stabletest}

BEGIN
Grab_values(a,b,an,bn);
Bubblesort(a,an);
Bubblesort(b,bn);
Mergesort(x,a,b,xn,an,bn,ncomp,nswap);
Writeln('Sort is completed.');
Writeln('Final state of the arrays are:');
Result(x,a,b,xn,an,bn);
Writeln(' For the array entered, the sort made ',ncomp:5,
' comparisons');
Writeln(' The sort made ',nswap:5,' swaps.');
Writeln(' These figures do not count the swaps and comparisons');
Writeln(' made sorting arrays a and b before they were',
' combined into x');
Stabletest(x,xn);
end. {That's all folks}