Computers in Engineering WWW Site - Example 16.6

Example 16.6


FORTRAN Version

!
     PROGRAM P106
!
!
!     CLASS LIST UPDATE PROGRAM
!     USES LINKED LIST WITH THE NAME AS THE KEY
!
!     DECLARATION STATEMENTS
!
      IMPLICIT NONE
      CHARACTER (LEN=25) :: NAMES(100),NAME
      INTEGER :: ID(100),MARKS(100,7),GRADES(7),LINK(100)
      INTEGER :: TOP,LAST,I,J,K,NREC,NLINES,M,KPOS
      INTERFACE
      SUBROUTINE LOOK(LIST,LINK,NAME,KPOS,TOP,LAST)
      IMPLICIT NONE
      CHARACTER (LEN=25) :: LIST(:),NAME
      INTEGER ,INTENT(IN OUT) :: LINK(:),KPOS,LAST
      END SUBROUTINE LOOK
      END INTERFACE 
!
      PRINT *, 'This is Program >> P106 = Linked Lists'
!
!     Tell program where data for  READ*  is coming from
      OPEN(UNIT=5, FILE='P106.DAT')
! UNIT=5 is the default input
!
      TOP=1
!
!===  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)
!        SETUP POINTER TO NEXT RECORD
         LINK(J)=J+1
      END DO L1
      PRINT 16
 16   FORMAT(/'TOO MUCH DATA FOR DEFINED ARRAYS'/  &'INCREASE ARRAY SIZE AND RERUN'//)
      STOP
 101  NREC=J-1
!
!==== MARK THE LAST RECORD AS END OF THE FILE
!     WITH A ZERO IN THE LINK FIELD
!
      LINK(NREC)=0
!
      PRINT 102,NREC
 102  FORMAT(/'CLASS LIST UPDATE PROGRAM'/ &I5,' RECORDS ON FILE')
L2:   DO J=1,100
         READ(5,15) KID,NAME,GRADES
         IF (KID == 0) THEN
            PRINT 202,J-1
 202        FORMAT(/I5,' UPDATES PROCESSED'// &'UPDATED CLASS LIST')
!
!===== PRINT OUT A LINKED LIST - IT'S EASY
!      START AT THE TOP OF THE LIST AND FOLLOW THE POINTERS
!      UNTIL YOU HIT A ZERO POINTER
!
            K=TOP
            NLINES=0
 210        PRINT 211,ID(K),NAMES(K),(MARKS(K,L),L=1,7)
 211        FORMAT(I9,'  ',A25,7I5)
            NLINES=NLINES+1
!
!===           LEAVE A BLANK LINE EVERY FIVE LINES OF OUTPUT
!
               IF (MOD(NLINES,5) == 0) PRINT *
            IF(LINK(K) == 0) STOP
            K=LINK(K)
            GO TO 210
         ELSE
            CALL LOOK(NAMES,LINK,NAME,KPOS,TOP,LAST)
            IF (KPOS <= 0) THEN
!
!====  PROGRAM SECTION TO ADD A NEW MEMBER TO CLASS LIST
!      INSERT RECORD AT THE END OF THE FILE
!      WHERE THE FREE SPACE IS, BUT LINK IN CORRECT ORDER
!
            NREC=NREC+1
            IF(NREC > 100) THEN
               PRINT 220,KID,NAME
220            FORMAT(/'ARRAYS FULL - UNABLE TO ADD',I10,2X,A25)
               STOP
            ENDIF
!=====      NOW ADD NEW DATA IN EMPTY SLOT AT END OF FILE
            ID(NREC)=KID
            NAMES(NREC)=NAME
L3:         DO M=1,7
               MARKS(NREC,M)=GRADES(M)
            END DO L3
            KPOS=-KPOS
            LINK(NREC)=KPOS
            IF(LAST == 0) THEN
!
!===   HAVE AN ADDITION IN FRONT OF FIRST RECORD
!
               TOP=NREC
            ELSE
               LINK(LAST)=NREC
            END IF
!
!==== STUDENT FOUND - UPDATE ANY NONZERO GRADES
!
            ELSE
L4:            DO I=1,7
                  IF (GRADES(I) /= 0)
THEN
                     MARKS(KPOS,I)=GRADES(I)
                  ENDIF
               END DO L4
            ENDIF
         ENDIF
      END DO L2
      STOP
      END PROGRAM P106
!
      SUBROUTINE LOOK(LIST,LINK,NAME,KPOS,TOP,LAST)
      IMPLICIT NONE
      CHARACTER (LEN=25) :: LIST(:),NAME
      INTEGER ,INTENT(IN OUT) :: LINK(:),KPOS,LAST
      INTEGER :: NEXT    
!
!     LINKED LIST LOOKUP ROUTINE
!
      NEXT=TOP
      LAST=0
1     IF(LIST(NEXT) == NAME) THEN
!===     YES WE FOUND THE ONE WE WANT AND KPOS IS ITS POSITION
         KPOS=NEXT
         RETURN
      ELSE
         IF(NAME < LIST(NEXT)) THEN
!===        THE ONE WE WANT IS NOT IN LIST - KPOS POINT TO NEXT ONE
!           NEGATIVE KPOS SAYS WE CAN'T FIND IT
            KPOS=-NEXT
            RETURN
         ENDIF
      ENDIF
!     REMEMBER PREVIOUS POINTER VALUE
      LAST=NEXT
      IF(LINK(NEXT) == 0) THEN
!===     WE HAVE REACHED END OF LIST AND STILL NOT FOUND THE ONE
         KPOS=0
         RETURN
      ELSE
!===     HAVE NOT FOUND IT YET
!        POINT TO NEXT ONE
         NEXT=LINK(NEXT)
         GO TO 1
      ENDIF
      RETURN
      END SUBROUTINE LOOK

C Version

/*
    This program demonstrates how a very simple linked list would work.
    First, we will have the user input the initial list, which we will
    sort.  After sorting, we will initialize the links, which means
    simply that we will store information in each record about where
    the next record is.  Finally, we will demonstrate how you would
    update the list, adding new records at the end, but effectively
    inserting them into the list at the right point just by changing
    the links of the old records.
*/

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

#define MAXSTUDENTS 50

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);
}

long int linear(long int list[], long int key, int n){

/*  This is just the linear search function with no alterations */

  int i, flag;
  flag = -2;
  for( i=0; i<n; i++){
    if( list[i] == key ){
      flag = i;
      break;
    }
  }
  return(flag);
}

void print_list(long int id[], int grade[], long int next[], int first)
{
  int i, new;

  printf("first =%d\n",first);
  i = 1;
  printf("\nElement# %d ID# %ld Grade- %d\n", i, id[first], grade[first]);
  new = first;
  while(next[new] >= 0){
    i++;
    new = next[new];
    printf("Element# %d ID# %ld Grade- %d\n", i, id[new], grade[new]);
    }
}

main(){

  long int id[MAXSTUDENTS], key, temp_id, next[MAXSTUDENTS], first, last, lastrecord;
  int i, n, flag, reply, grade[MAXSTUDENTS], temp_grade;

  do{
     printf("How many students? ( <%4d) \n",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]);
     }

  /* We will sort the initial list using the improved bubble sort */

  bsort2( id, grade, n );

  /* Now, we will initialize the links  */
  /* The last record has a null link (-1) */

  for(i=0; i < (n-1); i++)
    next[i] = i+1;
  next[n-1] = -1;
  first = 0;

  print_list( id, grade, next, first );

  printf("Ready to add new records to the list.\n\n");

do{
  printf("Enter 0 for front of list, 1 for back of list : ");
  scanf("%d",&reply);

  last = linear( next, -1, MAXSTUDENTS );
  lastrecord = last;
  if(last == -2){
      printf("ERROR- could not find end of list\n\n\n");
      break;
      }

  printf("\nlast = %d\n\n",last);
  printf("Enter student's name and ID #\n");
  printf("in this format ->ID:9421234[ENTER] (no spaces)\n");
  printf("               ->Grade:49[ENTER]\n");
  printf("ID #:");
  scanf("%ld",&id[last+1]);
  printf("Grade:");
  scanf("%d",&grade[last+1]);

  printf("Reply = %d", reply);
  if(reply == 0){
     printf("Adding record to the front of the list\n");
     lastrecord = lastrecord + 1;
     next[lastrecord] = first;
     first = lastrecord;
     print_list( id, grade, next, first );
     }
 if(reply == 1){
     printf("Adding record to the back of the list\n");
     lastrecord = lastrecord + 1;
     next[lastrecord] = -1;
     next[last] = lastrecord;
     last = lastrecord;
     print_list( id, grade, next, first );
     printf("This is back end! first= %ld",first);
     }
  printf("Add another (0 for no, 1 for yes)?\n");
  scanf("%d",&reply);
  }while( reply == 1 );
}
/*  End of main program linked.c  */
/*
INPUT :

8
9611684  67
9613986  65
9412978  72
9613693  73
9515010  82
9510633  71
9513221  69
0000000  00
1
0        0
0

OUTPUT :
How many students? ( <  50)
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
Sorting
first =0
Element# 1 ID# 0 Grade- 0
Element# 2 ID# 9412978 Grade- 72
Element# 3 ID# 9510633 Grade- 71
Element# 4 ID# 9513221 Grade- 69
Element# 5 ID# 9515010 Grade- 82
Element# 6 ID# 9611684 Grade- 67
Element# 7 ID# 9613693 Grade- 73
Element# 8 ID# 9613986 Grade- 65
Ready to add new records to the list.

Enter 0 for front of list, 1 for back of list : 1
last = 7

Enter student's name and ID #
in this format ->ID:9421234[ENTER] (no spaces)
               ->Grade:49[ENTER]
ID #:0
Grade:0
Reply = 1
Adding record to the back of the list
first =0

Element# 1 ID# 0 Grade- 0
Element# 2 ID# 9412978 Grade- 72
Element# 3 ID# 9510633 Grade- 71
Element# 4 ID# 9513221 Grade- 69
Element# 5 ID# 9515010 Grade- 82
Element# 6 ID# 9611684 Grade- 67
Element# 7 ID# 9613693 Grade- 73
Element# 8 ID# 9613986 Grade- 65
Element# 9 ID# 0 Grade- 0
This is back end! first= 0
Add another (0 for no, 1 for yes)?0

*/

Pascal Version

{$G256}
{$P512}
{D+}
PROGRAM p106 (input, output);
TYPE
  char_array = ARRAY[1..25] OF CHAR;
  cell = RECORD
           name : char_array;
           marks : ARRAY[1..7] OF INTEGER;
           id : REAL;
           next : INTEGER
         END;
  linked_list = ARRAY[1..100] OF cell;

VAR
  top, i, j, k, m, last, lines, position, records : INTEGER;
  kid : REAL;
  list : linked_list;
  grades : ARRAY[1..7] OF INTEGER;
  alias : char_array;

PROCEDURE look ( VAR list : linked_list;
                 VAR position : INTEGER;
                 alias : char_array );
VAR
  link : INTEGER;
BEGIN
  link := top;
  last := 0;
  WHILE ( ( list[link].name < alias ) AND ( link <> 0 ) ) DO
    BEGIN
      last := link;
      link := list[link].next
    END;
  IF ( link = 0 ) THEN
  {
       We have reached the end of the list, and not found
       the one we want
  }
    position := 0
  ELSE
    IF ( list[link].name = alias ) THEN
    {
         Yes, we have found the one we want
    }
      position := link
    ELSE
      IF ( list[link].name > alias ) THEN
      {
           The one we want is not in the list - position points to the
           next one, negative position says we can't find it
      }
        position := -link
END;

BEGIN
  top := 1;
  j := 0;
  REPEAT
    j := j + 1;
    WITH list[j] DO
      BEGIN
        read ( id, name );
        FOR k := 1 TO 7 DO
          read ( marks[k] );
        readln;
        next := j + 1
      END
  UNTIL ( ( j >= 100 ) OR ( list[j].id = 0 ) );
  IF ( ( j >= 100 ) AND ( list[j].id <> 0 ) ) THEN
    BEGIN
      writeln;
      writeln ( 'Too much data for defined arrays');
      writeln ( 'increase array size and rerun');
      writeln
    END
  ELSE
    BEGIN
      records := j - 1;
      {
           Mark the last record as the end of the file
           with a zero in the next field
      }
      list[records].next := 0;
      writeln;
      writeln ( ^l );
      writeln ( ' Class list update program');
      writeln;
      writeln ( records:5, ' records on file' );
      writeln;
      REPEAT
        read ( kid, alias );
        FOR m := 1 TO 7 DO
          read ( grades[m] );
        readln;
        IF ( kid <> 0 ) THEN
          BEGIN
            look ( list, position, alias );
            IF ( position <= 0 ) THEN
              BEGIN
              {
                   Program section to add a new member to class list
                   Insert record at the end of the file where the free
                   space is, link in correct order
              }
                records := records + 1;
                IF ( records <= 100 ) THEN
                {
                     Now add new data at empty slot at end of file
                }
                  BEGIN
                    WITH list[records] DO
                      BEGIN
                        id := kid;
                        name := alias;
                        FOR m := 1 TO 7 DO
                          marks[m] := grades[m];
                        position := -position;
                        next := position
                      END;  { end with }
                    IF ( last = 0 ) THEN
                    {
                         Have an addition in front of first record
                    }
                      top := records
                    ELSE
                      list[last].next := records
                  END { end if }
              END { end if }
            ELSE
              FOR i := 1 TO 7 DO
                IF ( grades[i] <> 0 ) THEN
                  list[position].marks[i] := grades[i]
        END { end if }
      UNTIL ( ( records > 100 ) OR ( kid = 0 ) );
      writeln ( ( j - 1 ):5, ' updates processed' );
      writeln ( ^l );
      writeln ( 'Updated class list' );
      writeln;
      {
           Print out a linked list, - it's easy
           Start at the top of the list, and
           follow the pointers until you hit
           a zero pointer
      }
      k := top;
      lines := 0;
      WHILE ( k <> 0 ) DO
        WITH list[k] DO
          BEGIN
            write ( id:9:0, ' ':2, name );
            FOR m := 1 TO 7 DO
              write ( marks[m]:5 );
            writeln;
            lines := lines + 1;
            IF ( ( lines MOD 5 ) = 0 ) THEN
              writeln;
            k := next
          END { end with }
      END { end else }
END.
DATA :
7611864 Brande, Bernardo                        14  0 16 16 15  0 67
7613986 Burke, Christina                        12 13 13 14 13 31 65
7412978 Colmenro, Jimi                          14 15 16 16 17 42 72
7613693 Lauzier, Guy                            15 15 14 16 17 35 73
7515010 Lim, Leong                              17 16 18 17 17 44 82
7510633 Nguy, Gulliver                          11 13 13 14 14 45 71
7513221 Talko, Stephen                          12 14 14 14 14 39 69
0000000 Dummy                                    0  0  0  0  0  0  0
7510633 Nguy, Gulliver                           0  0  0  0 19  0  0
7415795 Smith, John                             11 12  0  0  0  0  0
7611684 Brande, Bernardo                         0 17  0  0  0 35  0
9999999 Zylinski, Zarro                          0  0  0  0  0  0 99
1111111 Aardvark, Andrew                         0  0  0  0  0 41  0
0000000 Dummy                                    0  0  0  0  0  0  0

Last modified: 08/07/97