Category talk:ALGOL 68-rows

From Rosetta Code

Source 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 # ;

    # operators and modes to allow "QUICKSORT x FROMELEMENT lb TOELEMENT ub"  #

    # mode to hold the lower and upper element indexes to sort                #
    MODE SORTBOUNDS = STRUCT( INT lb, ub );

    # unary operator that returns its argument                                #
    # if we were to support multiple sort methods, could retuen the array     #
    # plus a code to specify sorting using quicksort                          #
    OP QUICKSORT = ( REF[]INT    a )REF[]INT:    a;
    OP QUICKSORT = ( REF[]REAL   a )REF[]REAL:   a;
    OP QUICKSORT = ( REF[]STRING a )REF[]STRING: a;

    # constructs a SORTBOUNDS from its parameters                             #
    PRIO TOELEMENT   = 9;
    OP   TOELEMENT   = ( INT lb, ub )SORTBOUNDS: SORTBOUNDS( lb, ub );

    # in-place quick sort an array                                            #
    PRIO FROMELEMENT = 8;
    # in-place quick sort an array of integers                                #
    OP   FROMELEMENT = ( REF[]INT a, SORTBOUNDS bounds )REF[]INT:
         IF INT lb = lb OF bounds;
            INT ub = ub OF bounds;
            ub <= lb
         THEN
            # empty array or only 1 element #
            a
         ELSE
            # more than one element, so must sort #
            INT left   := lb;
            INT right  := ub;
            # choosing the middle element of the array as the pivot #
            INT pivot  := a[ left + ( ( right + 1 ) - left ) OVER 2 ];
            WHILE
                WHILE IF left  <= ub THEN a[ left  ] < pivot ELSE FALSE FI
                DO
                    left  +:= 1
                OD;
                WHILE IF right >= lb THEN a[ right ] > pivot ELSE FALSE FI
                DO
                    right -:= 1
                OD;
                left <= right
            DO
                INT t      := a[ left  ];
                a[ left  ] := a[ right ];
                a[ right ] := t;
                left      +:= 1;
                right     -:= 1
            OD;
            QUICKSORT a FROMELEMENT lb   TOELEMENT right;
            QUICKSORT a FROMELEMENT left TOELEMENT ub;
            a
         FI # FROMELEMENT # ;
    # in-place quick sort an array of reals                                   #
    OP   FROMELEMENT = ( REF[]REAL a, SORTBOUNDS bounds )REF[]REAL:
         IF INT lb = lb OF bounds;
            INT ub = ub OF bounds;
            ub <= lb
         THEN
            # empty array or only 1 element #
            a
         ELSE
            # more than one element, so must sort #
            INT  left  := lb;
            INT  right := ub;
            # choosing the middle element of the array as the pivot #
            REAL pivot := a[ left + ( ( right + 1 ) - left ) OVER 2 ];
            WHILE
                WHILE IF left  <= ub THEN a[ left  ] < pivot ELSE FALSE FI
                DO
                    left  +:= 1
                OD;
                WHILE IF right >= lb THEN a[ right ] > pivot ELSE FALSE FI
                DO
                    right -:= 1
                OD;
                left <= right
            DO
                REAL t     := a[ left  ];
                a[ left  ] := a[ right ];
                a[ right ] := t;
                left      +:= 1;
                right     -:= 1
            OD;
            QUICKSORT a FROMELEMENT lb   TOELEMENT right;
            QUICKSORT a FROMELEMENT left TOELEMENT ub;
            a
         FI # FROMELEMENT # ;
    # in-place quick sort an array of strings                                 #
    OP   FROMELEMENT = ( REF[]STRING a, SORTBOUNDS bounds )REF[]STRING:
         IF INT lb = lb OF bounds;
            INT ub = ub OF bounds;
            ub <= lb
         THEN
            # empty array or only 1 element #
            a
         ELSE
            # more than one element, so must sort #
            INT  left  := lb;
            INT  right := ub;
            # choosing the middle element of the array as the pivot #
            STRING pivot := a[ left + ( ( right + 1 ) - left ) OVER 2 ];
            WHILE
                WHILE IF left  <= ub THEN a[ left  ] < pivot ELSE FALSE FI
                DO
                    left  +:= 1
                OD;
                WHILE IF right >= lb THEN a[ right ] > pivot ELSE FALSE FI
                DO
                    right -:= 1
                OD;
                left <= right
            DO
                STRING t   := a[ left  ];
                a[ left  ] := a[ right ];
                a[ right ] := t;
                left      +:= 1;
                right     -:= 1
            OD;
            QUICKSORT a FROMELEMENT lb   TOELEMENT right;
            QUICKSORT a FROMELEMENT left TOELEMENT ub;
            a
         FI # FROMELEMENT # ;

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


# END rows.incl.a68                                                           #