Computers in Engineering WWW Site - Example 16.4

Example 16.4


FORTRAN Version

!
      PROGRAM P104
!
!
!     CLASS LIST UPDATE PROGRAM
!     USES BINARY SEARCH BY NAME
!
!     DECLARATION STATEMENTS
!
      IMPLICIT NONE
      CHARACTER (LEN=25) :: NAMES(100),CNAME
      INTEGER :: ID(100),MARKS(100,7),GRADES(7)
      INTEGER :: J,I,NREC,KID,M,K,INSERT
      INTERFACE
      SUBROUTINE BSERCH(NAMES,N,NAME,KPOS)
      IMPLICIT NONE
      CHARACTER (LEN=25) ::  NAMES(:),NAME
      INTEGER ,INTENT(IN OUT) :: N,KPOS
      END SUBROUTINE BSERCH
      END INTERFACE 
!
      PRINT *, 'This is Program >>P104 = Binary Search'
!
!     Tell program where data for  READ*  is coming from
      OPEN(UNIT=5, FILE='P104.DAT')
! UNIT=5 is the default input
!
!
!===  READ CURRENT STATE OF FILE
!
L1:   DO J=1,100
         READ 15, ID(J),NAMES(J),(MARKS(J,K),K=1,7)
 15      FORMAT(I7,' ',A25,7I3)
         IF (ID(J) == 0) GOTO 101
         Print 15, ID(J),NAMES(J),(MARKS(J,K),K=1,7)
      END DO L1
      PRINT 16
 16   FORMAT(/'TOO MUCH DATA FOR DEFINED ARRAYS'/  &'INCREASE ARRAY SIZE AND RERUN'//)
      STOP
 101  NREC=J-1
      PRINT 102,NREC
 102  FORMAT(/'CLASS LIST UPDATE PROGRAM'/ & I5,' RECORDS ON FILE')
L2:   DO J=1,100
         READ(5,15) KID,CNAME,(GRADES(M),M=1,7)
         IF (KID == 0) THEN
            PRINT 202,J-1
 202        FORMAT(I5,' UPDATES PROCESSED'/ & / ' UPDATED CLASS LIST')
L3:         DO K=1,NREC
               PRINT 211,ID(K),NAMES(K),(MARKS(K,L),L=1,7)
 211           FORMAT(I9,'  ',A25,7I5)
!
!===           LEAVE A BLANK LINE EVERY FIVE LINES OF OUTPUT
!
               IF (MOD(K,5) == 0) PRINT*
            END DO L3
            STOP
         ELSE
            CALL BSERCH(NAMES,NREC,CNAME,KPOS)
            IF (KPOS < 0) THEN
!
!====  PROGRAM SECTION TO ADD ANEW MEMBER TO CLASS LIST
!
               INSERT=(-KPOS)+1
               NREC=NREC+1
!              STARTING FROM THE END OF THE LIST
!              MOVE THE DATA DOWN 1 PLACE
L4:            DO K=NREC,INSERT+1,-1
                  ID(K)=ID(K-1)
                  NAMES(K)=NAMES(K-1)
L5:               DO M=1,7
                     MARKS(K,M)=MARKS(K-1,M)
                  END DO L5
               END DO L4
!              NOW ADD NEW DATA IN EMPTY SLOT
               ID(INSERT)=KID
               NAMES(INSERT)=CNAME
L6:            DO M=1,7
                  MARKS(INSERT,M)=GRADES(M)
               END DO L6
!
!==== STUDENT FOUND - UPDATE ANY NONZERO GRADES
!
            ELSE
L7:            DO I=1,7
                  IF (GRADES(I) /= 0) THEN
                     MARKS(KPOS,I)=GRADES(I)
                  ENDIF
               END DO L7
            ENDIF
         ENDIF
      END DO L2
      STOP
      END PROGRAM P104
!
     SUBROUTINE BSERCH(NAMES,N,NAME,KPOS)
      IMPLICIT NONE
      CHARACTER (LEN=25) ::  NAMES(:),NAME
      INTEGER ,INTENT(IN OUT) :: N,KPOS
      INTEGER :: LOW,LAST,MID
!
!     B I N A R Y    S E A R C H
!
!     USES 3 INTEGER POINTERS, INITIALLY
!     LOW -  POINTS TO LOCATION BEFORE FIRST ITEM OF LIST
!     LAST - POINTS TO LOCATION AFTER LAST ITEM IN LIST
!     MID -  CALCULATED FROM LOW AND LAST, IS ESSENTIALLY
!            HALF WAY BETWEEN LOW AND LAST
!
      LOW=0
      LAST=N+1
10    MID=(LOW+LAST)/2
      IF(LOW == MID) GO TO 99
      IF(NAMES(MID) == NAME) GO TO 100
      IF(NAMES(MID) < NAME) GO TO 200
!
!     NAME IN FIRST HALF OF LIST
!     RESET LAST TO BE MID-POINT OF LIST - AND TRY AGAIN
!
      LAST=MID
      GO TO 10
!
!     NAME IN SECOND HALF OF LIST
!     RESET LOW TO BE MID POINT AND TRY AGAIN
!
200   LOW=MID
      GO TO 10
!
!     NOT FOUND - SET POSITION POINTER NEGATIVE
!     IF ADDITION NEEDED, THEN INSERT AFTER ABS(KPOS)
99    KPOS=-MID
      RETURN
!     FOUND A MATCH
100   KPOS=MID
      RETURN
      END SUBROUTINE BSERCH

C Version

/*  Demonstration of how one could use a binary search algorithm
    to look up a student's name given his ID number.  A group of
    records is read in, and then sorted.  Then, the user supplies
    the key for the search (a sample ID #), and the list is searched
    with a binary algorithm.  */

#include<stdio.h>
#include<stdlib.h>

#define MAXSTUDENTS 50    /*  Declaration statement */

void id_swap(long int *k, long int *l)
{
  long int temp;

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

void grade_swap(int *grade1, int *grade2)
{
  int temp;

  temp = *grade1;
  *grade1 = *grade2;
  *grade2 = temp;
}

void bsort2( long int id[], int grade[],int n)
{
  int last, k, i, kk;

  printf("Sorting\n");
  last = n - 1;
  do {
    k = 0;
    for (i = 1; i <= last; i++) {
      if (id[i - 1] > id[i]) {
 id_swap(&id[i - 1], &id[i]);
 grade_swap(&grade[i - 1], &grade[i]);
        k = i;
      }
    }
    last = k;
  } while (k != 0);
}

int binary(long int id[], long int key,int n)
{
  int a, b, middle;
  a = 0;
  b = n;
  do{
     middle = (a+b)/2;
     if( id[middle] < key )
        a = middle+1;
     else if( id[middle] > key)
        b = middle-1;
     else
        return(middle);
   }while( a<=b );

  /* If program reaches this point, no match was found, and the value
     returned will indicate this. */
  return(-1);
}

main()
{
  /*  Declaration Statements  */
  long int id[MAXSTUDENTS], key;
  int i, n, flag, cont, yes_no, grade[MAXSTUDENTS];

  do
  {
     printf("How many students? ( <%4d)",MAXSTUDENTS);
     scanf("%d",&n);
     }while( n>MAXSTUDENTS );

  printf("Enter students' names and ID #'s\n");
  printf("in this format ->ID:9421234[ENTER] (no spaces)\n");
  printf("               ->Grade:49[ENTER]\n");
  for( i=0; i<n; i++){
     printf("Student #%d:\n",i+1);
     printf("ID #:");
     scanf("%ld",&id[i]);
     printf("Grade:");
     scanf("%d",&grade[i]);
     }

  printf("\n\n\nDemonstration of binary search\n\n");

 /* Binary searches only work on sorted lists.  First, we'll sort
    by id number using the improved bubble sort */

  bsort2( id, grade, n );

 do{   /* Keep on looking up names until user wants to quit */

  printf("Enter search key\n");
  scanf("%ld",&key);

  printf("\n  **SEARCHING**\n");

  flag = binary(id, key, n);

 /* flag will equal -1 if no match was found, or the correct
    array subscript for the student */

  cont = 0;
  if(flag == -1){
    printf("Search key not found - check spelling\n");
    printf("Try again (1 for yes/0 for no)? ");
    scanf("%d",&yes_no);
    }
  else {
    printf("  **FOUND**\n");
    printf("ID#:%ld  Grade:%d\n\n",id[flag], grade[flag]);
    printf("Look up another student (1 for yes/0 for no)? ");
    scanf("%d",&yes_no);
    }
 }while(yes_no == 1);

}
/* End of program BINARY */
/*
INPUT :
8
9611684  67
9613986  65
9412978  72
9613693  73
9515010  82
9510633  71
9513221  69
0000000  00

OUTPUT :
How many students? ( <  50)8
Enter students' names and ID #'s
in this format ->ID:9421234[ENTER](no spaces)
               ->Grade:49[ENTER]
Student #1:
ID #:9611684
Grade:67
Student #2:
ID #:9613986
Grade:65
Student #3:
ID #:9412978
Grade:72
Student #4:
ID #:9613693
Grade:73
Student #5:
ID #:9515010
Grade:82
Student #6:
ID #:9510633
Grade:71
Student #7:
ID #:9513221
Grade:69
Student #8:
ID #:0000000
Grade:00

Demonstration of binary search

Sorting
Enter search key
9611684
  **SEARCHING**
  **FOUND**
ID#:9611684  Grade:67

Look up another student (1 for yes/0 for no)?0
*/

Pascal Version

{$P256}
{$G512}
{$D+}
PROGRAM p104 (input, output);
{
  Class list update program
  Uses binary search by name

  Declaration statements
}
TYPE
  char_array = ARRAY[1..25] OF CHAR;
  name_array = ARRAY[1..100] OF char_array;
VAR
  names : name_array;
  cname : char_array;
  id : ARRAY[1..100] OF REAL;
  marks : ARRAY [ 1..100, 1..7 ] OF INTEGER;
  grades : ARRAY[1..7] OF INTEGER;
  i, j, k, nrec, l, m, kpos, insert : INTEGER;
  kid : REAL;


PROCEDURE bsearch (names : name_array; n : INTEGER; name : char_array;
                   VAR kpos : INTEGER);

{  BINARY SEARCH  }

{  Uses 3 integer pointers, initially
   low - points to location before first item of list
   last - points to location after last item in list
   mid - calculated from low and last, is essentially half way
         between low and last                                   }

VAR
  low, last, mid : INTEGER;
  found : BOOLEAN;
BEGIN
  low := 0;
  last := n + 1;
  found := false;
  mid := (low + last) div 2;
  WHILE ( ( NOT found ) AND ( low <> mid ) ) DO
    BEGIN
      IF ( names[mid] = name ) THEN

        {  found a match  }

        BEGIN
          kpos := mid;
          found := true
        END

      ELSE IF ( names[mid] < name ) THEN

             {  name in second half of list
                reset low to be mid point and try again  }

             low := mid

           ELSE

             {  name in first half of list
                reset last to be mid-point of list and try again  }

             last := mid;
      mid := (low + last) div 2
    END;
  IF (NOT found) THEN kpos := -mid
END;

BEGIN

  {  Read current state of file  }

  j := 0;
  REPEAT
    j := j + 1;
    read ( id[j], names[j] );
    FOR k := 1 TO 7 DO
      read ( marks [ j, k ] );
    readln;
  UNTIL ( ( j >= 100 ) OR ( id[j] = 0 ) );
  IF ( id[j] <> 0 ) THEN
    BEGIN
      writeln;
      writeln ('Too much data for defined arrays');
      writeln ('Increase array size and rerun');
      writeln;
      writeln
    END
  ELSE
    BEGIN
      nrec := j - 1;
      writeln (^l);
      writeln ('Class list update program');
      writeln (nrec : 5, ' records on file');
      writeln;
      writeln;
      j := 0;
      REPEAT
        j := j + 1;
        read ( kid, cname );
        FOR m := 1 TO 7 DO
          read ( grades[m] );
        readln;
        IF (kid = 0 ) THEN
          BEGIN
            writeln (j-1 : 5, ' updates processed');
            writeln (^l);
            writeln (' Updated class list');
            writeln;
            writeln;
            FOR k := 1 TO nrec DO
              BEGIN
                write ( id[k] :9:0, '  ', names[k] );
                FOR l := 1 TO 7 DO
                  write ( marks [ k, l ] :5 );
                writeln;

           {  Leave a blank line every five lines of output  }

                IF ((k mod 5) = 0) THEN
                  writeln
              END
          END  { end if kid = 0 }
        ELSE
          BEGIN
            bsearch (names, nrec, cname, kpos);
            IF (kpos < 0) THEN
              BEGIN

             {==== Program section to add a new member to class list  }

                insert := (-kpos) + 1;
                nrec := nrec + 1;

             {  Starting from the end of the list, move the data
                down one place                                    }

                FOR k := nrec DOWNTO insert+1 DO
                  BEGIN
                    id[k] := id[k-1];
                    names[k] := names[k-1];
                    FOR m := 1 TO 7 DO
                      marks [ k, m ] := marks [ k-1, m ]
                  END;

              {  Now add new data in empty slot  }

                id[insert] := kid;
                names[insert] := cname;
                FOR m := 1 TO 7 DO
                  marks [ insert, m ] := grades[m];
              END  { end if kpos < 0 }

              {==== Student found - Update any nonzero grades  }

            ELSE
              FOR i := 1 TO 7 DO
                IF ( grades[i] <> 0 ) THEN
                  marks [ kpos, i ] := grades[i]

          END;  { end outer else }
      UNTIL ( (j >= 100) OR ( kid = 0) )
    END  { end outermost else }
END.
DATA :
7611684 Bloom Milo              14  0 16 16 15  0 67
7613986 Cat Bill the            12 13 13 14 13 31 65
7412978 Dallas Steven           14 15 16 16 17 42 72
7613693 John Cutter             15 15 14 16 17 35 73
7515010 Jones Oliver W          17 16 18 17 17 44 82
7510633 Mike Binkley            11 13 13 14 14 45 71
7513221 Opus                    12 14 14 14 14 39 69
0000000 Dummy One               0  0  0  0  0  0  0
7510633 Mike Binkley             0  0  0  0 19  0  0
7973522 Charlie Brown           11 12  0  0  0  0  0
7611684 Bloom Milo               0 17  0  0  0 35  0
0000000 Dummy Two                0  0  0  0  0  0  0

Last modified: 08/07/97