!
! =====> Program - P97.F90
!
PROGRAM SrtDmo
! Program to demonstrate a number of simple
! sorting algorithms. N random integers are
! to be sorted in increasing order (from smallest
! to largest) in an array A.
PARAMETER (NMax = 1000)
INTEGER A(NMax), A0(NMax)
PRINT *, 'This is Program >> P97 = Sorting Demo'
!
! Tell program where data for READ * is coming from
OPEN(UNIT=5, FILE='P97.DAT') ! UNIT=5 is the default input
!
PRINT *, 'Number of elements to sort: '
READ *, N
Print *, N
Print *
CALL IniAry(A0, N)
CALL PrnAry(A0, N)
! Repeat for each sorting method
PRINT *, 'Bubble'
CALL CpyAry(A0, A, N)
CALL Bubble(A, N)
CALL PrnAry(A, N)
Print *
PRINT *, 'Insertion'
CALL CpyAry(A0, A, N)
CALL Insert(A, N)
CALL PrnAry(A, N)
Print *
PRINT *, 'Selection'
CALL CpyAry(A0, A, N)
CALL Select(A, N)
CALL PrnAry(A, N)
Print *
PRINT *, 'Shell'
CALL CpyAry(A0, A, N)
CALL Shell(A, N)
CALL PrnAry(A, N)
Print *
STOP
END
! SUPPORT ROUTINES
SUBROUTINE IniAry(A, N)
! Initializes N elements of array A to random
! non-negative integers.
PARAMETER (MaxInt = 32700)
INTEGER A(N), Seed
Seed = 31415
L1: DO I = 1, N
A(I) = ABS(MOD(INT(URand(Seed) * MaxInt) ,MaxInt))
END DO L1
RETURN
END
SUBROUTINE CpyAry(A0, A, N)
! Copy elements 1..N of array A0 to A.
INTEGER A0(N), A(N)
L1: DO I = 1, N
A(I) = A0(I)
END DO L1
RETURN
END
SUBROUTINE PrnAry(A, N)
! Prints the N elements of array A.
INTEGER A(N)
L1: DO I = 1, N
PRINT 101, I, A(I)
END DO L1
RETURN
101 FORMAT(1X, 'A(', I3, ') = ', I9)
END
SUBROUTINE Swap(I, J)
! Exchanges the integers I and J.
ITemp = I
I = J
J = ITemp
RETURN
END
! ALGORITHMS
SUBROUTINE Bubble(A, N)
INTEGER A(N)
! Make N-1 passes through the array.
! On pass i, "bubble" the next smallest element
! up from the end of the array to position i.
L1: DO I = 1, N-1
L2: DO J = N, I+1, -1
IF (A(J) < A(J-1)) THEN
CALL Swap(A(J), A(J-1))
ENDIF
END DO L2
END DO L1
RETURN
END
SUBROUTINE Insert(A, N)
INTEGER A(N)
! Make repeated passes through the array.
! On pass i, place the i'th element in its
! proper sorted position amongst the (sorted)
! A(1),...,A(i-1).
L1: DO I = 2, N
J = I
20 IF (A(J) >= A(J-1)) CYCLE
CALL Swap(A(J), A(J-1))
J = J-1
IF (J > 1) GO TO 20
END DO L1
RETURN
END
SUBROUTINE Select(A, N)
INTEGER A(N)
! Make N-1 passes through the array.
! On pass i, find the smallest element in
! A(i+1),...,A(N) and swap it with A(i),
! leaving the elements A(1),...,A(i) in their
! final, sorted order.
L1: DO I = 1, N-1
LowIdx = I
LowKey = A(I)
L2: DO J = I+1, N
IF (A(J) .LT. LowKey) THEN
LowKey = A(J)
LowIdx = J
ENDIF
END DO L2
CALL Swap(A(I), A(LowIdx))
END DO L1
RETURN
END
SUBROUTINE Shell(A, N)
INTEGER A(N)
! Incr is the number of positions separating
! elements of a particular tuple.
Incr = N / 2
! Make passes for Incr = N DIV 2, N DIV 4,
! N DIV 8,..., 1, and use Insertion Sort on
! elements separated by distances Incr
! on each pass.
DO WHILE (Incr > 0)
L1: DO I = Incr+1, N
J = I - Incr
15 IF (J <= 0) CYCLE
IF (A(J) > A(J+Incr)) THEN
CALL Swap(A(J), A(J+Incr))
J = J - Incr
ELSE
J = 0
ENDIF
GO TO 15
END DO L1
Incr = Incr / 2
END DO
RETURN
END
!
!
REAL FUNCTION URAND( XN )
INTEGER XN
!
! Uniform random number generator based on techniques described
! in "The Art of Computer Programming", Vol.2, Knuth.
!
! Xn+1 = a*Xn + c mod m
! where
! Xn is the seed supplied by the caller
! m = 2**31
! a = 2147437301
! c = 453816693
!
! 'a' satisfies the following:
!
! max( sm, m/10 ) < a < m - sm, where sm = square root of m
! a mod 8 = 5
!
! 'c' is computed as follows:
!
! c = idnint( 2d0**31 * ( .5d0 - dsqrt( 3d0 ) / 6d0 ) ) + 1
!
! Note: Integer arithmetic is automatically done modulo 2**31.
!
INTEGER A, M, C
DATA A/2147437301/
DATA M/80000000/
DATA C/453816693/
XN = A * XN + C
IF( XN < 0 ) XN = XN + M
URAND = XN / 2.0**31
END
DATA:
10
OUTPUT:
[FTN90 Version 1.12 Copyright (c)SALFORD SOFTWARE LTD 1992 & ]
[ (c)THE NUMERICAL ALGORITHMS GROUP 1991,1992]
NO ERRORS [FTN90]
Program entered
This is Program >> P97 = Sorting Demo
Number of elements to sort:
10
A( 1) = 17439
A( 2) = 4611
A( 3) = 15716
A( 4) = 12578
A( 5) = 19692
A( 6) = 3013
A( 7) = 144
A( 8) = 26656
A( 9) = 2094
A( 10) = 28624
Bubble
A( 1) = 144
A( 2) = 2094
A( 3) = 3013
A( 4) = 4611
A( 5) = 12578
A( 6) = 15716
A( 7) = 17439
A( 8) = 19692
A( 9) = 26656
A( 10) = 28624
Insertion
A( 1) = 144
A( 2) = 2094
A( 3) = 3013
A( 4) = 4611
A( 5) = 12578
A( 6) = 15716
A( 7) = 17439
A( 8) = 19692
A( 9) = 26656
A( 10) = 28624
Selection
A( 1) = 144
A( 2) = 2094
A( 3) = 3013
A( 4) = 4611
A( 5) = 12578
A( 6) = 15716
A( 7) = 17439
A( 8) = 19692
A( 9) = 26656
A( 10) = 28624
Shell
A( 1) = 144
A( 2) = 2094
A( 3) = 3013
A( 4) = 4611
A( 5) = 12578
A( 6) = 15716
A( 7) = 17439
A( 8) = 19692
A( 9) = 26656
A( 10) = 28624
Fortran-90 STOP
{256}
{12}
{}
PROGRAM p96 (input, output);
TYPE
listarray = ARRAY[1..1000] OF INTEGER;
VAR
list : listarray;
ncomp, nswap, n, i : INTEGER;
PROCEDURE swap (VAR k, l : INTEGER);
VAR
temp : INTEGER;
BEGIN
temp := k;
k := l;
l := temp
END;
PROCEDURE sort1 (VAR list : listarray; n : INTEGER);
VAR
i, j : INTEGER;
BEGIN
ncomp := 0;
nswap := 0;
FOR i := 1 TO n-1 DO
FOR j := i+1 TO n DO
BEGIN
ncomp := ncomp + 1;
IF (list[i] > list[j]) THEN
BEGIN
swap (list[i], list[j]);
nswap := nswap + 1
END
END
END;
PROCEDURE bsort1 (VAR list : listarray; n : INTEGER);
VAR
i, k : INTEGER;
BEGIN
ncomp := 0;
nswap := 0;
REPEAT
k := 0;
FOR i := 1 TO n-1 DO
BEGIN
ncomp := ncomp + 1;
IF ( list[i] > list[i+1] ) THEN
BEGIN
swap (list[i], list[i+1]);
nswap := nswap + 1;
k := 1
END
END
UNTIL k = 0
END;
PROCEDURE bsort2 (VAR list : listarray; n : INTEGER);
VAR
last, k, i : INTEGER;
BEGIN
ncomp := 0;
nswap := 0;
last := n - 1;
REPEAT
k := 0;
FOR i := 1 TO last DO
BEGIN
ncomp := ncomp + 1;
IF ( list[i] > list[i+1] ) THEN
BEGIN
swap (list[i], list[i+1]);
nswap := nswap + 1;
k := i
END
END;
last := k
UNTIL k = 0
END;
PROCEDURE bsortr (VAR list : listarray; VAR l, m, k : INTEGER);
{ Right bubble sort }
VAR
i : INTEGER;
BEGIN
m := m - 1;
k := 0;
FOR i := l TO m DO
BEGIN
ncomp := ncomp + 1;
IF ( list[i] > list[i+1] ) THEN
BEGIN
swap (list[i], list[i+1]);
nswap := nswap + 1;
k := i
END
END;
m := k
END;
PROCEDURE bsortl (VAR list : listarray; VAR l, m, k : INTEGER);
{ Left bubble sort }
VAR
i : INTEGER;
BEGIN
l := l + 1;
k := 0;
FOR i := m DOWNTO l DO
BEGIN
ncomp := ncomp + 1;
IF ( list[i] < list[i-1] ) THEN
BEGIN
swap (list[i], list[i-1]);
nswap := nswap + 1;
k := i
END
END;
l := k
END;
PROCEDURE shake (VAR list : listarray; n : INTEGER);
VAR
left, right, i, k : INTEGER;
BEGIN
ncomp := 0;
nswap := 0;
left := 1;
right := n;
i := 1;
REPEAT
bsortr (list, left, right, k);
IF (k <> 0) THEN
bsortl (list, left, right, k);
i := i + 1;
UNTIL ( (i > n) OR (k = 0) )
END;
PROCEDURE shell (VAR list : listarray; n : INTEGER);
VAR
m, i, j : INTEGER;
done : BOOLEAN;
BEGIN
ncomp := 0;
nswap := 0;
m := n;
REPEAT
m := (m + 2) div 3;
FOR i := m+1 TO n DO
BEGIN
j := i;
done := false;
WHILE ((j >= m+1) AND (NOT done)) DO
BEGIN
ncomp := ncomp + 1;
IF ( list[j-m] < list[j] ) THEN
done := true
ELSE
BEGIN
swap (list[j], list[j-m]);
nswap := nswap + 1
END;
j := j - m
END
END;
UNTIL m <= 1
END;
PROCEDURE printinfo;
BEGIN
writeln ( 'number of comparisons = ', ncomp:5 );
writeln ( 'number of exchanges = ', nswap:5 );
writeln;
writeln
END;
PROCEDURE gen ( VAR list : listarray ;
n : INTEGER );
VAR
i : INTEGER;
BEGIN
{
Random (x) returns a random integer between 0 and x not inclusive
Randomize resets the random generator
}
randomize;
FOR i := 1 TO n DO
list[i] := random ( n + 1 )
END;
BEGIN
WHILE ( NOT eof ) DO
BEGIN
readln ( n );
gen ( list, n );
sort1 ( list, n );
writeln ( 'Sort1 : ' );
printinfo;
gen ( list, n );
bsort1 ( list, n );
writeln ( 'Bsort1 : ');
printinfo;
gen ( list, n );
bsort2 (list, n );
writeln ( 'Bsort2 : ');
printinfo;
gen ( list, n );
shake ( list, n );
writeln ( 'Shake : ' );
printinfo;
gen ( list, n );
shell ( list, n );
writeln ( 'Shell : ' );
printinfo
END
END.
DATA:
10 100
Last modified: 19-02-96