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

Program Sorts (Input,Output,Sort);

Type ARRAYS=ARRAY[1..200] OF INTEGER;

(* Written by DREW BERNSTEIN *)
(* 3/22/86 *)
(* Program to sort a file with different sorting routines and compare the *)
(* effectiveness of each routine *)
(* Input: SORT a file on disk containing various pieces of data *)
(* Output: Either to screen or file, contains a data table for the sorts and *)
(* the resulting sorted data. *)


(*****************************************************************************)
Procedure INSTUFF (VAR INP:TEXT);

(* Prepares SORT for input *)

Var INFILE:STRING[4];

Begin
INFILE:='SORT';
ASSIGN (INP,INFILE);
RESET (INP);
End;
(*****************************************************************************)
Procedure OUTSTUFF (VAR OUTPT:BOOLEAN;
VAR OUT:TEXT);

(* Finds where output will go and prepares output file *)

Var OUTFILE:STRING[12];
OUTYN:CHAR;

Begin
CLRSCR; (* Clean that messy screen *)
WRITE (OUTPUT,'Do you want an OUTPUT? (Y OR N) ');
READLN (INPUT,OUTYN);
IF OUTYN='Y' (* Do we want external output? *)
THEN (* Yep *)
BEGIN (* Set output *)
OUTPT:=TRUE;
WRITE (OUTPUT,'Enter the output file or device: ');
READLN (INPUT,OUTFILE);
END
ELSE
BEGIN (* Nope *)
OUTFILE:='CON:'; (* Set CONSOLE ,CON: *)
OUTPT:=FALSE;
END;
ASSIGN (OUT,OUTFILE);
REWRITE (OUT);
End;
(*****************************************************************************)
Procedure READIN (VAR AMOUNT:INTEGER;
VAR ORIGDATA:ARRAYS;
VAR INP:TEXT);

VAR X:INTEGER;

(* Reads in SORT to ORIGDATA and finds number of data *)

Begin
AMOUNT:=1; (* Initializing Amount *)
READLN (INP,ORIGDATA[AMOUNT]); (* Priming read *)
WHILE NOT EOF (INP) DO (* Until EOF do this loop *)
BEGIN
AMOUNT:=AMOUNT+1;
READLN (INP,ORIGDATA[AMOUNT]); (* Get DATA and Store *)
END;
CLOSE (INP); (* Done with INP so close *)
End;
(*****************************************************************************)
Procedure RESETTOSORT (VAR TOSORT:ARRAYS;
ORIGDATA:ARRAYS;
AMOUNT:INTEGER);

(* Resets TOSORT array for each different sort *)

Var X:INTEGER;

Begin
FOR X:=1 TO AMOUNT DO
TOSORT[X]:=ORIGDATA[X];
End;
(*****************************************************************************)
Function TIME:REAL;

(* Get time from system clock, converts Minutes, Seconds, and *)
(* Hundredths of Seconds to time in Miliseconds. This makes it *)
(* easy to measure elapsed time by subtracting one time from a *)
(* later time. *)

TYPE REGISTER_TYPE = RECORD
AX, BX, CX, DX : INTEGER
END;

VAR REG: REGISTER_TYPE;

Begin
REG.AX := $2C00;
INTR($21,REG);
TIME :=
+ (REG.CX AND $00FF) * 6000 (* Minutes *)
+ (REG.DX SHR 8) * 100 (* Seconds *)
+ (REG.DX AND $00FF) (* / 100 ; Hundredths *)
End;
(*****************************************************************************)
Procedure BUBBLESORT (AMOUNT:INTEGER;
VAR TOSORT:ARRAYS;
VAR BUBBLETIME:REAL;
VAR BUBBLESWAPS:INTEGER);

(* Your basic BUBBLESORT *)

Var X,Y,TEMP:INTEGER;
BTIME:REAL;

Begin
WRITELN (OUTPUT,'Bubble sorting...');
BUBBLESWAPS:=0;
BTIME:=TIME;
FOR Y:=1 TO AMOUNT-1 DO
FOR X:=1 TO AMOUNT-Y DO
IF TOSORT[X]>TOSORT[X+1]
THEN
BEGIN
BUBBLESWAPS:=BUBBLESWAPS+1;
TEMP:=TOSORT[X];
TOSORT[X]:=TOSORT[X+1];
TOSORT[X+1]:=TEMP;
END;
BUBBLETIME:=TIME-BTIME;
End;
(*****************************************************************************)
Procedure MINMAXSORT (AMOUNT:INTEGER;
VAR TOSORT:ARRAYS;
VAR MINMAXTIME:REAL;
VAR MINMAXSWAPS:INTEGER);

(* A MIN-MAX sort *)

Var X,Y,PLACE,TEMP:INTEGER;
BTIME:REAL;

Begin
WRITELN (OUTPUT,'MinMax sorting...');
MINMAXSWAPS:=0;
BTIME:=TIME;
PLACE:=1;
FOR Y:=1 TO AMOUNT-1 DO
BEGIN
FOR X:=1 TO AMOUNT-Y DO
IF TOSORT[Y+X] THEN PLACE:=Y+X;
IF TEMP<>Y
THEN
BEGIN
MINMAXSWAPS:=MINMAXSWAPS+1;
TEMP:=TOSORT[Y];
TOSORT[Y]:=TOSORT[PLACE];
TOSORT[PLACE]:=TEMP;
END;
END;
MINMAXTIME:=TIME-BTIME;
End;
(*****************************************************************************)
Procedure SHELLSORT (AMOUNT:INTEGER;
VAR TOSORT:ARRAYS;
VAR SHELLTIME:REAL;
VAR SHELLSWAPS:INTEGER);

(* A SHELLSORT *)

Var X,TEMP,GAP:INTEGER;
NOEXCHANGES:BOOLEAN;
BTIME:REAL;

Begin
WRITELN (OUTPUT,'Shell sorting...');
SHELLSWAPS:=0;
BTIME:=TIME;
GAP:=AMOUNT DIV 2;
REPEAT
REPEAT
NOEXCHANGES:=TRUE;
FOR X:=1 TO AMOUNT-GAP DO
IF TOSORT[X]>TOSORT[X+GAP]
THEN
BEGIN
SHELLSWAPS:=SHELLSWAPS+1;
TEMP:=TOSORT[X];
TOSORT[X]:=TOSORT[X+GAP];
TOSORT[X+GAP]:=TEMP;
NOEXCHANGES:=FALSE;
END;
UNTIL NOEXCHANGES;
GAP:=GAP DIV 2;
UNTIL GAP<1;
SHELLTIME:=TIME-BTIME;
End;
(*****************************************************************************)
Procedure QUICKSORT (FIRST,LAST:INTEGER;
VAR TOSORT:ARRAYS;
VAR QUICKSWAPS:INTEGER);

(* The best one, QUICKSORT *)

Var X,Y,DIVIDING_LINE,TEMP:INTEGER;

Begin
X:=FIRST;
Y:=LAST;
DIVIDING_LINE:=TOSORT[(FIRST+LAST) DIV 2];
REPEAT
WHILE TOSORT[X] X:=X+1;
WHILE TOSORT[Y]>DIVIDING_LINE DO
Y:=Y-1;
IF X<=Y
THEN
BEGIN
QUICKSWAPS:=QUICKSWAPS+1;
TEMP:=TOSORT[X];
TOSORT[X]:=TOSORT[Y];
TOSORT[Y]:=TEMP;
X:=X+1;
Y:=Y-1;
END;
UNTIL X>Y;
IF FIRST THEN QUICKSORT (FIRST,Y,TOSORT,QUICKSWAPS); (* Recursive call *)
IF X THEN QUICKSORT (X,LAST,TOSORT,QUICKSWAPS); (* Recursive call *)
End;
(*****************************************************************************)
Procedure RESULTS (AMOUNT,
BUBBLESWAPS,MINMAXSWAPS,SHELLSWAPS,QUICKSWAPS:INTEGER;
BUBBLETIME,MINMAXTIME,SHELLTIME,QUICKTIME:REAL;
TOSORT:ARRAYS;
OUTPT:BOOLEAN;
VAR OUT:TEXT);

(* Prints the results to OUT *)

Var X,Y:INTEGER;

Begin
Y:=0; (* Initialize Y *)
WRITELN (OUT,'The resulting sort gives this:');
FOR X:=1 TO AMOUNT DO (* Print TOSORT array *)
BEGIN
Y:=Y+1; (* Add to Y for screen check *)
IF (Y=23) AND (NOT OUTPT) (* Is SCREEN full *)
THEN (* Yep *)
BEGIN
WRITELN (OUT,'Hit any key to continue');
WHILE NOT KEYPRESSED DO; (* Pause till Key hit *)
CLRSCR;Y:=0; (* Clear screen and reset Y *)
END;
WRITELN (OUT,TOSORT[X]); (* Print data *)
END;
WRITELN (OUT);
WRITELN (OUT,' Sort Time Number Amount');
WRITELN (OUT,' in MS of swaps of Data');
WRITELN (OUT,'-----------------------------------------');
WRITELN (OUT,'BUBBLE',BUBBLETIME:9:0,BUBBLESWAPS:14,AMOUNT:11);
WRITELN (OUT,'MIN-MAX',MINMAXTIME:8:0,MINMAXSWAPS:14,AMOUNT:11);
WRITELN (OUT,'SHELL',SHELLTIME:10:0,SHELLSWAPS:14,AMOUNT:11);
WRITELN (OUT,'QUICK',QUICKTIME:10:0,QUICKSWAPS:14,AMOUNT:11);
CLOSE (OUT); (* Done with OUT so close *)
End;
(*****************************************************************************)
Procedure DRIVER;

(* Main data handler, also does extra work not able to in other procedures *)

Var ORIGDATA,TOSORT:ARRAYS; (* Array that holds data *)
AMOUNT, (* Amount of data in array *)
BUBBLESWAPS,MINMAXSWAPS,SHELLSWAPS,QUICKSWAPS:INTEGER; (* # of swaps *)
BTIME,BUBBLETIME,MINMAXTIME,SHELLTIME,QUICKTIME:REAL; (* Time elapsed *)
OUTPT:BOOLEAN; (* If there is an external output *)
INP,OUT:TEXT;

Begin
INSTUFF (INP);
OUTSTUFF (OUTPT,OUT);
READIN (AMOUNT,ORIGDATA,INP);
RESETTOSORT (TOSORT,ORIGDATA,AMOUNT);
BUBBLESORT (AMOUNT,TOSORT,BUBBLETIME,BUBBLESWAPS);
RESETTOSORT (TOSORT,ORIGDATA,AMOUNT);
MINMAXSORT (AMOUNT,TOSORT,MINMAXTIME,MINMAXSWAPS);
RESETTOSORT (TOSORT,ORIGDATA,AMOUNT);
SHELLSORT (AMOUNT,TOSORT,SHELLTIME,SHELLSWAPS);
RESETTOSORT (TOSORT,ORIGDATA,AMOUNT);
BTIME:=TIME;QUICKSWAPS:=0;WRITELN (OUTPUT,'Quick sorting...');
QUICKSORT (1,AMOUNT,TOSORT,QUICKSWAPS);
QUICKTIME:=TIME-BTIME; (* Find time in QUICKSORT *)
IF OUTPT (* Is there external output *)
THEN (* Yep *)
BEGIN (* Print to external first *)
RESULTS (AMOUNT,
BUBBLESWAPS,MINMAXSWAPS,SHELLSWAPS,QUICKSWAPS,
BUBBLETIME,MINMAXTIME,SHELLTIME,QUICKTIME,
TOSORT,OUTPT,OUT);
ASSIGN (OUT,'CON:'); (* Set up for output to Console *)
REWRITE (OUT); (* Print to console *)
OUTPT:=FALSE;
RESULTS (AMOUNT,
BUBBLESWAPS,MINMAXSWAPS,SHELLSWAPS,QUICKSWAPS,
BUBBLETIME,MINMAXTIME,SHELLTIME,QUICKTIME,
TOSORT,OUTPT,OUT);
END
ELSE (* Nope, Print to console *)
RESULTS (AMOUNT,
BUBBLESWAPS,MINMAXSWAPS,SHELLSWAPS,QUICKSWAPS,
BUBBLETIME,MINMAXTIME,SHELLTIME,QUICKTIME,
TOSORT,OUTPT,OUT);
End;
(*****************************************************************************)

Begin
DRIVER;
End.