Computers in Engineering WWW Site - Example 16.3

Example 16.3


FORTRAN Version

!
       PROGRAM P103
!
!
!      CLASS LIST UPDATE PROGRAM
!      USING A LINEAR SEARCH BY ID - NOT SORTED
!      ADDITIONS AT END OF FILE
!
!      DECLARE ARRAYS FOR FILE
!
      IMPLICIT NONE
      CHARACTER (LEN=25) :: NAMES(100),NAME
      INTEGER :: ID(100),MARKS(100,7),GRADES(7),I,J
      INTEGER :: NREC,NREQ,KID,NUPD,K
      INTERFACE
      SUBROUTINE SCANID(LIST,N,KEY,KPOS)
      IMPLICIT NONE
      INTEGER ,INTENT(IN OUT) :: LIST(:),KEY
      INTEGER ,INTENT(IN OUT) :: N,KPOS
      END SUBROUTINE SCANID
      END INTERFACE
!
      PRINT *, 'This is Program >> P103 = Update with Linear Search'
!
!     Tell program where data for  READ is coming from
      OPEN(UNIT=5, FILE='P103.DAT')
! UNIT=5 is the default input
!
!
!==== READ IN FILE AND STORE IN MAIN MEMORY
!
L1:   DO J=1,100
         READ 15,ID(J),NAMES(J),(MARKS(J,I),I=1,7)
15       FORMAT(I7,' ',A25,7I3)
         IF(ID(J) == 0) GO TO 101
         Print 15,ID(J),NAMES(J),(MARKS(J,I),I=1,7)
      END DO L1
16    FORMAT(/'TOO MUCH DATA FOR DEFINED ARRAYS'/  &'INCREASE ARRAY SIZE AND RERUN'//)
      STOP
!
!==== READ AND PROCESS UPDATE CARDS
!
101   NREC=J-1
      PRINT 102,NREC
102   FORMAT(/'CLASS LIST UPDATE PROGRAM'/  & I5,' RECORDS ON FILE')
L2:   DO J=1,100
         READ 15,KID,NAME,GRADES
         IF(KID == 0) THEN
            NUPD=J-1
            PRINT 203,NUPD

203         FORMAT(/I5,' UPDATES PROCESSED'/ &/ 'UPDATED CLASS LIST'//)
!
L3:         DO K=1,NREC
               PRINT 211,ID(K),NAMES(K),(MARKS(K,I),I=1,7)
211            FORMAT(I10,'  ',A25,7I5)
!
!===           LEAVE A BLANK LINE EVERY 5
!
               IF(MOD(K,5) == 0) PRINT*  ! Nothing = a blank line
            END DO L3
            STOP

         ELSE
            CALL SCANID(ID,NREC,KID,KPOS)
            IF(KPOS <= 0) THEN
!
!====    GOODIE! WE HAVE A NEW MEMBER OF THE CLASS
!        ADD AT THE END
!
            NREC=NREC+1
            IF(NREC > 100) THEN
               PRINT 220,KID,NAME
220            FORMAT(/'ARRAYS FULL- UNABLE TO ADD',I10,2X,A25)
               STOP
            ENDIF
!
!====       DO ACTUAL UPDATE
!
            ID(NREC)=KID
            NAMES(NREC)=NAME
L4:         DO I=1,7
               MARKS(NREC,I)=GRADES(I)
            END DO L4
            ELSE
!
!==== THIS STUDENT IS ON FILE - UPDATE ANY NONZERO ENTRY IN GRADES
!     INTO THE ARRAY MARKS
!
L5:            DO I=1,7
                  IF(GRADES(I) /= 0) THEN  ! grades(i) not zero
                     MARKS(KPOS,I)=GRADES(I)
                  END IF
               END DO L5
            ENDIF
         ENDIF
      END DO L2
      STOP
      END PROGRAM P103
!
      SUBROUTINE SCANID(LIST,N,KEY,KPOS)
      IMPLICIT NONE
      INTEGER ,INTENT(IN OUT) :: LIST(:),KEY
      INTEGER ,INTENT(IN OUT) :: N,KPOS
      INTEGER :: I
!
!==== LINEAR SEARCH
!
L1:   DO I=1,N
         IF(KEY == LIST(I)) GO TO 100
      END DO L1
      KPOS=0
      RETURN
 100  KPOS=I
      RETURN
      END SUBROUTINE SCANID

C Version

/* Demonstration of linear search algorithm used to find
   a student's grade from a set of grade records.  The key
   for the search is the student's I.D. number.
*/

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

#define MAXSTUDENTS 50     /*  Constant  */

/*  linear Function Declaration  */
int linear(long int id[], long int key, int n)
{
/*   Simple linear search - check all the elements of the
     array for a match starting at zero until a match is found.
     On average, the function will make n/2 comparisons.
     If no match is found, a not-found flag is returned, otherwise
     the function returns the correct subscript for the student record
*/
  int i, flag;
  flag = -1;
  for( i=0; i<n; i++){
    if( id[i] == key ){
      flag = i;
      break;
    }
  }
  return(flag);
}

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

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

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

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

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

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

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

  flag = linear(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 ID #\nTry again (y/n)? ");
    scanf("%d",&yes_no);
    }
  else {
    printf("  **FOUND**\n");
    printf("Name:%s  ID #:%ld\n\n", names[flag], id[flag]);
    printf("Look up another student (0 for no, 1 for yes)? ");
    scanf("%d",&yes_no);
    }
 }while(yes_no == 1);

}
/*  End of main program linear.c  */
/*
INPUT :

8
Milo,Bloom    9611684
Cat,theBill   9613986
Dallas,Steven 9412978
Cutter,John   9613693
Jones,Oliver  9515010
Binkley,Mike  9510633
Opus,Holland  9513221
Dummy,One     0000000
OUTPUT :
How many students? (<  50)Enter students' names and grades
in this format ->Name:Doe,John[ENTER] (no spaces)
               ->ID #:9421234[ENTER]
Student #1:
Name:Milo,Bloom
ID #:9611684
Student #2:
Name:Cat,theBill
ID #:9613986
Student #3:
Name:Dallas,Steven
ID #:9412978
Student #4:
Name:Cutter,John
ID #:9613693
Student #5:
Name:Jones,Oliver
ID #:9515010
Student #6:
Name:Binkley,Mike
ID #:9510633
Student #7:
Name:Opus,Holland
ID #:9513221
Student #8:
Name:Dummy,One
ID #:0000000

Demonstration of linear search

Enter search key (ID#)
9611684
  **SEARCHING**
  **FOUND**
Name:Milo,Bloom  ID #:9611684

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

*/

Pascal Version

{$G256}
{$P512}
{$D+}
PROGRAM p103 (input, output);
{
     Class list update program
     Using a linear search - not sorted
     Additions at end of file

     Declare array for file
}
TYPE
  char_array = ARRAY[1..25] OF CHAR;
  real_array = ARRAY[1..100] OF REAL;
VAR
  names : ARRAY[1..100] OF char_array;
  name : char_array;
  id : real_array;
  marks : ARRAY [ 1..100, 1..7 ] OF INTEGER;
  grades : ARRAY[1..7] OF INTEGER;
  i, j, k, rec, update, pos : INTEGER;
  kid : REAL;

PROCEDURE scan_id ( list : real_array;
                    n : INTEGER;
                    key : real;
                    VAR pos : INTEGER );
VAR
  i : INTEGER;
{
      Linear search
}
BEGIN
  i := 1;
  WHILE ( ( key <> list[i] ) AND ( i < n ) ) DO
    i := i + 1;
  IF ( key = list[i] ) THEN
    pos := i
  ELSE
    pos := 0
END;

BEGIN
{
     Read in file and store in main memory
}
  j := 0;
  REPEAT
    j := j + 1;
    read ( id[j], names[j] );
    FOR i := 1 TO 7 DO
      read ( marks [ j, i ] );
    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
    END
  ELSE
    BEGIN
{
     Read and process update lines
}
      rec := j - 1;
      writeln ( ^l );
      writeln ( 'Class list update program' );
      writeln;
      writeln;
      writeln ( rec:5, ' records on file' );
      j := 0;
      REPEAT
        j := j + 1;
        read ( kid, name );
        FOR i := 1 TO 7 DO
          read ( grades[i] );
        readln;
        IF ( kid <> 0 ) THEN
          BEGIN
            scan_id ( id, rec, kid, pos );
            IF ( pos <= 0 ) THEN
            {
                  Goodie!  We have a new member of the class
                  Add at the end
            }
              BEGIN
                rec := rec + 1;
                IF ( rec <= 100 ) THEN
                {
                      Do actual update
                }
                  BEGIN
                    id[rec] := kid;
                    names[rec] := name;
                    FOR i := 1 TO 7 DO
                      marks [ rec, i ] := grades[i]
                  END
                ELSE
                  BEGIN
                    writeln;
                    writeln ( 'arrays full - unable to add', kid:10:0,
                              ' ':2, name )
                  END
              END
            ELSE
            {
                 This student is on file - update any nonzero entry in grades
                 into the array marks
            }

                FOR i := 1 TO 7 DO
                  IF ( grades[i] <> 0 ) THEN
                    marks [ pos, i ] := grades [ i ]
          END { end if }
        ELSE
          BEGIN
            update := j - 1;
            writeln;
            writeln ( update:5, ' updates processed' );
            writeln ( ^l );
            writeln ( 'Updated class list' );
            writeln;
            FOR k := 1 TO rec DO
              BEGIN
                write ( id[k]:10:0, ' ':2, names[k] );
                FOR i := 1 TO 7 DO
                  write ( marks [ k, i ]:5 );
                writeln;
                IF ( ( k mod 5 ) = 0 ) THEN
                  writeln
              END { end for }
          END { end else }
      UNTIL ( ( rec > 100 ) OR ( kid = 0 ) OR ( j > 100 ) )
   END
END.

DATA
8414154 Opus                    15 16 16 17 17 39 76
7613986 Bloom Milo              16 17 16 18 17 41 79
7412978 Dallas Steven           13 12 11 13 14 31 64
7613693 Cat Bill the            18 18 19 17 19 41 82
7515010 John Cutter             15 16 15 15 15 38 77
7510633 Jones Oliver W          17 17 18 17 17 42 80
7513221 Mike Binkley            19 19 19 18 19 45 91
0000000 Dummy                    0  0  0  0  0  0  0
7712526 Snoopy                   0  0  0  0  0 48  0
7973522 Charlie Brown            0  0  0  0  0  0 95
7613986 Linus Van Pelt           0  0  0  0  0  0 80
7515010 Woodstock                0  0  0  0 19  0  0
0000000

Last modified: 08/07/97