Category talk:ALGOL 68-rows

From Rosetta Code

Source code

This is the source of the "row related" library used by some ALGOL 68 samples on Rosetta Code.

# rows.incl.a68: array related utilities for Algol 68 RC tasks                #

    # prints the elements of an array of integers separated by spaces         #
    OP   SHOW = ( []INT list )VOID:
         FOR i FROM LWB list TO UPB list DO
            print( ( " ", whole( list[ i ], 0 ) ) )
         OD # SHOW # ;
    # prints the elements of an array of reals separated by spaces            #
    OP   SHOW = ( []REAL list )VOID:
         FOR i FROM LWB list TO UPB list DO
            print( ( " ", fixed( list[ i ], -14, 8 ) ) )
         OD # SHOW # ;

    # returns the kth lowest element of list usng the quick select algorithm #
    PRIO QUICKSELECT = 9;
    OP   QUICKSELECT = ( REF[]INT qs list, INT k )INT:
         IF LWB qs list > UPB qs list THEN
             # empty list #
             0
         ELSE
             # non-empty list #
             # partitions the subset of p list from p left to p right #
             PROC partition = ( REF[]INT p list, INT p left, p right, pivot index )INT:
                  BEGIN
                      # swaps elements a and b in s list #
                      PROC swap = ( REF[]INT s list, INT a, b )VOID:
                           BEGIN
                               INT t        = s list[ a ];
                               s list[ a ] := s list[ b ];
                               s list[ b ] := t
                           END # swap # ;
                      INT pivot value = p list[ pivot index ];
                      swap( p list, pivot index, p right );
                      INT store index := p left;
                      FOR i FROM p left TO p right - 1 DO
                          IF p list[ i ] < pivot value THEN
                              swap( p list, store index, i );
                              store index +:= 1
                          FI
                      OD;
                      swap( p list, p right, store index );
                      store index
                  END # partition # ;
             INT  qs left  := LWB qs list, qs right := UPB qs list, result := 0;
             BOOL qs found := FALSE;
             WHILE NOT qs found DO
                 IF qs left = qs right THEN
                     result   := qs list[ qs left ];
                     qs found := TRUE
                 ELSE
                     INT pivot index
                       = partition( qs list
                                  , qs left
                                  , qs right
                                  , ( qs left
                                    + ENTIER ( ( random * ( qs right - qs left ) + 1 ) )
                                    )
                                  );
                     IF qs found := k = pivot index THEN
                         result   := qs list[ k ]
                     ELIF k < pivot index THEN
                         qs right := pivot index - 1
                     ELSE
                         qs left  := pivot index + 1
                     FI
                 FI
             OD;
             result
         FI # QUICKSELECT # ;

    # returns the median element from data                                    #
    OP   MEDIAN = ( REF[]INT data )REAL:
         IF   INT len = ( UPB data - LWB data ) + 1;
              INT mid = ( len OVER 2 ) + LWB data;
              ODD len
         THEN     data QUICKSELECT   mid
         ELSE ( ( data QUICKSELECT ( mid - 1 )
                + data QUICKSELECT   mid
                )
              / 2
              )
         FI # MEDIAN # ;

    # returns the average of the elements of a                                #
    OP   AVERAGE = ( []INT a )REAL:
         IF   INT len = ( UPB a - LWB a ) + 1;
              len < 1
         THEN 0
         ELSE INT sum := 0;
              FOR i FROM LWB a TO UPB a DO
                  sum +:= a[ i ]
              OD;
              sum / len
         FI # AVERAGE # ;
    OP   AVERAGE = ( []REAL a )REAL:
         IF   INT len = ( UPB a - LWB a ) + 1;
              len < 1
         THEN 0
         ELSE REAL sum := 0;
              FOR i FROM LWB a TO UPB a DO
                  sum +:= a[ i ]
              OD;
              sum / len
         FI # AVERAGE # ;

    # returns the standard deviation of a                                     #
    OP   STANDARDDEVIATION = ( []INT a )REAL:
         IF   INT len = ( UPB a - LWB a ) + 1;
              len < 1
         THEN 0
         ELSE REAL m = AVERAGE a;
              REAL sum := 0;
              FOR i FROM LWB a TO UPB a DO
                  sum +:= ( a[ i ] - m ) ^ 2
              OD;
              ( sum / len )
         FI # STANDARDDEVIATION # ;
    OP   STANDARDDEVIATION = ( []REAL a )REAL:
         IF   INT len = ( UPB a - LWB a ) + 1;
              len < 1
         THEN 0
         ELSE REAL m = AVERAGE a;
              REAL sum := 0;
              FOR i FROM LWB a TO UPB a DO
                  sum +:= ( a[ i ] - m ) ^ 2
              OD;
              sqrt( sum / len )
         FI # STANDARDDEVIATION # ;


    IF FALSE THEN                             # avoid warnings from ALGOL 68G #
        [ 1 : 3 ]INT  qig3mm1 := ( 1, 2, 3 );
        [ 1 : 3 ]REAL qrg3mm1 := ( 1, 2, 3 );
        SHOW qrg3mm1; SHOW qig3mm1; print( ( AVERAGE qig3mm1, MEDIAN qig3mm1 ) );
        print( ( STANDARDDEVIATION qrg3mm1, " ", STANDARDDEVIATION qig3mm1 ) )
    FI;

# END rows.incl.a68                                                           #