Sorting an arrary or table

[hugheskbh]

Hi,

Does anyone know how to sort an array or table in cobol particularly Micro Focus Cobol?

Thanks

 

[PHV]

In your MF Cobol Language Reference have a look at the SORT Statement.

The SORT statement can also be used to sort the elements of a table

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[hugheskbh]

Thanks PHV, but do you have an examples because I don't have a MF Cobol Language reference manual.

Thanks

 

[webrabbit]

SORT occurs-name [[ASCENDING|DESCENING[KEY] element-names].

If the OCCURS clause has a KEY phrase, the KEY clause is not required in the SORT statement.

 

[WMK]

Also, all the Micro Focus documentation is availabe (for free) online.

Check out:

http://supportline.microfocus.com//documentation/index.asp

Bill Klein

 

[baruch]

i have s simple routine, for sorting table, that will work in any cobol version.

000001 IDENTIFICATION DIVISION.
000002 PROGRAM-ID. SORTVECT.
000003 ENVIRONMENT DIVISION.
000004 CONFIGURATION SECTION.
000005 DATA DIVISION.
000006 WORKING-STORAGE SECTION.
000007 01  I                PIC 9(4) COMP.
000008 01  J                PIC 9(4) COMP.
000009 01  K                PIC 9(4) COMP.
000010 01  VECTOR-LENGTH    PIC 9(4) COMP VALUE 13.
000011 01  VECTOR.
000012     02 VEC                        OCCURS 13.
000013       05 VEC-KEY              PIC X(06).
000014       05 FILLER               PIC X(14).
000015 01  VEC-M                     PIC X(20).
000016******************************************************************
000017 PROCEDURE DIVISION.
000018 MAIN SECTION.
000019 1.  MOVE 1 TO K, PERFORM SORT-VEC UNTIL K = 0.

000021 SORT-VEC.
000022     MOVE 0 TO K.
000023     PERFORM VARYING I FROM 1 BY 1 UNTIL I > VECTOR-LENGTH
000024             ADD 1 I GIVING J
000025             IF VEC-KEY(I) < VEC-KEY(J)
000026                 MOVE VEC(I) TO VEC-M
000027                 MOVE VEC(J) TO VEC(I)
000028                 MOVE VEC-M  TO VEC(J)
000029                 MOVE 1 TO K, END-IF
000030             END-PERFORM.

 

[webrabbit]

The above is a bubble sort, the slowest of the generalized sort routines. If you are serious about implementing a faster sort and your compler does not support the SORT verb on internal tables, there are implementaions of other sort routines (quick sort etc.) on this forum.

 

[baruch]

yes but for small array, is the simple,
just one corection, the perform should run to VECTOR-LENGTH -1.

 

[ShawnStanford]

I have an implementation of a comb sort, which is an enhanced bubble sort that performs on a par with quicksort. This implementation is written to be used as an internal subprogram. It sorts a table area of unknown length and undefined content with specifications passed in linkage. It will sort up to the maximum single-element size allowed in COBOL/LE.

Documentation is at the bottom. If you're going to a PC COBOL, you may have to make changes to account for the length of the linkage area.

I've been using it for a while with no ill effects, but as with anything you find on the internet, the onus is on you to make sure it works and suits your needs.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. VRWSSORT.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  L                                    PIC  9(08) BINARY
                                                           VALUE ZERO.
       01  L-OFF                                PIC  9(08) BINARY
                                                           VALUE ZERO.
       01  L-KEY                                PIC  9(08) BINARY
                                                           VALUE ZERO.
       01  H                                    PIC  9(08) BINARY
                                                           VALUE ZERO.
       01  H-OFF                                PIC  9(08) BINARY
                                                           VALUE ZERO.
       01  H-KEY                                PIC  9(08) BINARY
                                                           VALUE ZERO.
       01  SWAP-OFF                             PIC  9(08) BINARY
                                                           VALUE ZERO.
       01  GAP                                  PIC  9(08) BINARY
                                                           VALUE ZERO.
       01  FILLER                               PIC  X(01) VALUE SPACES.
           88  NOT-SWAPPED                                 VALUE 'N'.
           88  SWAPPED                                     VALUE 'S'.

       LINKAGE SECTION.
       01  S-REC-LEN                      PIC  9(08)       BINARY.
       01  S-LST-ENT                      PIC  9(08)       BINARY.
       01  S-KEY-STR                      PIC  9(08)       BINARY.
       01  S-KEY-LEN                      PIC  9(08)       BINARY.
       01  S-TBL                          PIC  X(16777215) .

       PROCEDURE DIVISION
           USING S-REC-LEN
                 S-LST-ENT
                 S-KEY-STR
                 S-KEY-LEN
                 S-TBL.

           COMPUTE SWAP-OFF = (S-LST-ENT * S-REC-LEN) + 1
           COMPUTE GAP = S-LST-ENT

           PERFORM UNTIL NOT SWAPPED AND GAP = 1

               SET NOT-SWAPPED TO TRUE

               COMPUTE GAP = GAP / 1.3
               EVALUATE GAP
                 WHEN 0
                   MOVE 1 TO GAP
                 WHEN 9
                 WHEN 10
                   MOVE 11 TO GAP
               END-EVALUATE

      *        FIGURE MY STARTING OFFSETS OUTSIDE THE WORK LOOP.
               COMPUTE L-KEY = S-KEY-STR
               COMPUTE H-KEY = (GAP * S-REC-LEN) + S-KEY-STR

               PERFORM VARYING L FROM 1 BY 1
                 UNTIL L > (S-LST-ENT - GAP)

                   IF S-TBL(H-KEY:S-KEY-LEN) < S-TBL(L-KEY:S-KEY-LEN)
                       SET SWAPPED TO TRUE
                       COMPUTE L-OFF = (L-KEY - S-KEY-STR) + 1
                       COMPUTE H-OFF = (H-KEY - S-KEY-STR) + 1
                       MOVE S-TBL(H-OFF:S-REC-LEN)
                         TO S-TBL(SWAP-OFF:S-REC-LEN)
                       MOVE S-TBL(L-OFF:S-REC-LEN)
                         TO S-TBL(H-OFF:S-REC-LEN)
                       MOVE S-TBL(SWAP-OFF:S-REC-LEN)
                         TO S-TBL(L-OFF:S-REC-LEN)
                   END-IF

                   ADD S-REC-LEN TO H-KEY
                   ADD S-REC-LEN TO L-KEY
               END-PERFORM
           END-PERFORM.

       END PROGRAM VRWSSORT.
      ******************************************************************      00
      *  PROGRAM NAME: VRWSSORT                                        *      00
      *  DESCRIPTION:  THIS IS AN IMPLEMENTATION OF THE COMB SORT      *      00
      *    ALGORITHM THAT IS DESIGNED TO BE INCLUDED INTO A PARENT     *      00
      *    PROGRAM WITH A COPY STATEMENT AND CALLED. IT WILL SORT      *      00
      *    A WORKING STORAGE TABLE SO IT CAN USE 'SEARCH ALL'. IT IS   *      00
      *    A SIMPLE IMPLEMENTATION THAT WILL SORT A SINGLE KEY STRING  *
      *    INTO ASCENDING ORDER. THIS CAN BE APPLIED AGAINST ANY       *
      *    NUMBER OF TABLES IN WORKING STORAGE.                        *
      *
      *  PARMS:
      *    S-REC-LEN - LENGTH OF THE RECORDS.
      *    S-LST-ENT - NUMBER OF RECORDS TO BE SORTED.
      *    S-KEY-STR - LOCATION OF THE START OF THE KEY.
      *    S-KEY-LEN - LENGTH OF THE KEY.
      *    S-TBL     - TABLE TO BE SORTED.
      *
      *    WHEN SPECIFYING THE KEY START, THE FIRST BYTE OF THE RECORD
      *    IS BYTE ONE (1).
      *
      *    THIS PROGRAM MUST BE ADDED TO THE BOTTOM OF THE CALLING
      *    PROGRAM WITH A 'COPY' STATEMENT AFTER ALL OTHER EXECUTABLE
      *    STATEMENTS. THE CALLING PROGRAM MUST INCLUDE AN
      *    'END PROGRAM XXXXXXXX' AFTER THE COPY OR THE COMPILER WILL
      *    FLAG AN ERROR.
      *
      *    IMPORTANT NOTE: THE TABLE MUST HAVE AT LEAST ONE MORE ENTRY
      *    THAN THE NUMBER OF RECORDS TO BE SORTED. THIS IS USED BY THE
      *    PROGRAM AS A SWAP ENTRY.
      *
      * EXAMPLE:
      *
      *   PROGRAM-ID. EXAMPLE.
      *   DATA DIVISION.
      *   WORKING-STORAGE SECTION.
      *   01  MY-TABLE.
      *       05  MY-RECORD  OCCURS 257 TIMES.
      *           10  MY-REC-D1  PIC X(9).
      *           10  MY-REC-KEY PIC X(10).
      *           10  MY-REC-D2  PIC X(13).
      *   01  REC-LEN PIC 9(08) BINARY VALUE ZERO.
      *   01  REC-CNT PIC 9(08) BINARY VALUE ZERO.
      *   01  KEY-ST  PIC 9(08) BINARY VALUE ZERO.
      *   01  KEY-LEN PIC 9(08) BINARY VALUE ZERO.
      *
      *   PROCEDURE DIVISION.
      *       MOVE 32 TO REC-LEN
      *       MOVE 257 TO REC-CNT
      *       MOVE 10 TO KEY-ST
      *       MOVE 10 TO KEY-LEN
      *
      *       CALL 'VRWSSORT' USING REC-LEN, REC-CNT, KEY-ST,
      *         KEY-LEN, MY-TABLE.
      *
      *       COPY VRWSSORT.
      *       END PROGRAM EXAMPLE.
      ******************************************************************      00