Computers in Engineering WWW Site - Example 15.7

Example 15.7


FORTRAN version

!
! =====> 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


C Version


#include <conio.h>
#include <stdlib.h>
#include <stdio.h>
#define  true  1
#define  false 0

/* This is a demonstration of various sorting techniques
   An array is entered by the user, and  the computer
   uses all the algorithms discussed in the course to sort
   it.  This allows for comparison of the efficiency of
   methods. */


/* ncomp and nswap are global variables, and each sorting function
   will update them with the number of comparisons and swaps it did
   when it was called. */
short ncomp, nswap;

void swap(k, l)
short *k, *l;
{
  short temp;

  temp = *k;
  *k = *l;
  *l = temp;
}

void sort1(list, n)
short *list;
short n;
{
  short i, j;

  ncomp = 0;
  nswap = 0;
  for (i = 0; i <= n - 2; i++) {
    for (j = i + 1; j < n; j++) {
      ncomp++;
      if (list[i] > list[j]) {
     swap(&list[i], &list[j]);
     nswap++;
      }
    }
  }
}

void bsort1(list, n)
short *list;
short n;
{
  short i, k;

  ncomp = 0;
  nswap = 0;
  do {
    k = 0;
    for (i = 1; i < n; i++) {
      ncomp++;
      if (list[i - 1] > list[i]) {
     swap(&list[i - 1], &list[i]);
     nswap++;
     k = 1;
      }
    }
  } while (k != 0);
}

void bsort2(list, n)
short *list;
short n;
{
  short last, k, i;

  ncomp = 0;
  nswap = 0;
  last = n - 1;
  do {
    k = 0;
    for (i = 1; i <= last; i++) {
      ncomp++;
      if (list[i - 1] > list[i]) {
     swap(&list[i - 1], &list[i]);
     nswap++;
     k = i;
      }
    }
    last = k;
  } while (k != 0);
}

void bsortr(list, l, m, k)
short *list;
short *l, *m, *k;
{

  /*  Right bubble sort  */
  short i, FORLIM;

  (*m)--;
  *k = 0;
  FORLIM = *m;
  for (i = *l; i <= FORLIM; i++) {
    ncomp++;
    if (list[i - 1] > list[i]) {
      swap(&list[i - 1], &list[i]);
      nswap++;
      *k = i;
    }
  }
  *m = *k;
}

void bsortl(list, l, m, k)
short *list;
short *l, *m, *k;
{

  /*  Left bubble sort  */
  short i, FORLIM;

  (*l)++;
  *k = 0;
  FORLIM = *l;
  for (i = *m; i >= FORLIM; i--) {
    ncomp++;
    if (list[i - 1] < list[i - 2]) {
      swap(&list[i - 1], &list[i - 2]);
      nswap++;
      *k = i;
    }
  }
  *l = *k;
}

void shake(list, n)
short *list;
short n;
{
  short left, right, i, k;

  ncomp = 0;
  nswap = 0;
  left = 1;
  right = n;
  i = 1;
  do {
    bsortr(list, &left, &right, &k);
    if (k != 0)
      bsortl(list, &left, &right, &k);
    i++;
  } while (i <= n && k != 0);
}


void shell(short list[], short n)
{
  short temp, a, b, h;
  nswap=0;
  ncomp=0;

  /* Outer loop varies the interval size */
  for (h = n/2 ; h > 0; h = h/2){

    /* This loop considers all sequences for a given interval size */
    for (a = h; a < n; a = a + 1){

      /* This loop sorts each individual sequence */
      b = a-h;
      while( b >= 0 ){
	 if( list[b] > list[b+h] ){
	    temp = list[b];
	    list[b]=list[b+h];
	    list[b+h]=temp;
	    nswap++;
	 }
      b = b - h;
      ncomp++;
      }
    }
  }
}

void printinfo()
{
  printf("number of comparisons = %5d\n", ncomp);
  printf("number of exchanges = %5d\n", nswap);
}

int main(void)

{
    short initial_list[1000];
    short list[1000];
    short n, i;

    clrscr();
    printf("This is a demonstration of sorting algorithms. \n\n");
    printf("  You will be prompted to enter how large of an array you\n");
    printf("to try sorting, and then enter the elements one by one.\n");
    printf("Then the computer will sort them using all the algorithms\n");
    printf("discussed under this section in the book, and will give\n");
    printf("a comparison of how efficient each algorithm was.\n\n");

    printf("Enter No. of Elements : ");
    scanf("%hd", &n);

    /* Now the computer must read in all the elements of the array.
       It will store them in two arrays, called initial_list[] and
       list[].  This is done so that after one technique sorts the
       list, there is a copy of the original, unsorted list for the
       next technique to work on, etc. */

    for( i=0; i


Pascal version

{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: 08/07/97