Free source: COBOL internal table sort

[wahlers]

Any body interested in the following?

Free COBOL source internal table sort routine.

Sorts fields:

1. alphanumeric ( PIC x(..) )
2. binary unsigned ( PIC 9(..) BINARY )
3. binary signed ( PIC s9(..) BINARY )
4. packed-decimal ( PIC 9(..) or s9(..) PACKED-DECIMAL)
5. floating-point short precision ( COMP-1 )
6. floating-point long precision ( COMP-2 )
7. alphanumeric code page independent sort ( PIC x(..) ) with a ASCII or EBCDIC independent collating sequence.

Interested?
I will sent you the source, just write mailto:
ahlers_wim@hotmail.com

Following is some additional information showing how the call structure works:

      *-------------------------------------------------------*
      *                                                       *
      * ALL 'SORT' PERMUTATIONS FOR THE 'combSort' FUNCTION:  *
      *                                                       *
      *-------------------------------------------------------*
  
  
        REPLACE  ==<K>==  BY  ___       / ----------------                  ==<L>==  BY  ___      (  SEE TABLES BELOW  )
                 ==<M>==  BY  ___ .     \ ---------------- /
  
  
           05  returnStatus               PIC  X(01).
             88  allOK                    VALUE  '0'.
             88  NOTok                    VALUE  '1'.
           05  theMethod                  PIC  X(30).
           05  methodData.
             10  sortOrder                PIC  X(03).
             10  tableLength              PIC  9(09) BINARY.
             10  entryLength              PIC  9(09) BINARY.
             10  keyStart                 PIC  9(09) BINARY.
             10  keyLength                PIC  9(09) BINARY.
   
      *    --->  keyLength is NOT used for COMP-1 or COMP-2 sorts.
  
           05  tableSpace.
             10  tableElement             OCCURS 100 TIMES.
               15  tableEntry.
                 20  field1               PIC  X(11).
                 20  field2               PIC  X(13).
                 20  sortKey.
                   25  field3     <K>.
                 20  moreFields           PIC  X(19).
  
           MOVE                  '<L>'    TO  sortOrder
           MOVE                  '<M>'    TO  theMethod
  
  
        REPLACE OFF.
  
  
      * The following  'MOVE  LENGTH OF'  statement is NOT coded for
      * COMP-1 or COMP-2 sorts.
           MOVE  LENGTH OF  sortKey       TO  keyLength
  
  
           ADD   LENGTH OF  field1, LENGTH OF field2, +1
           GIVING  keyStart
  
           MOVE  LENGTH OF  tableSpace    TO  tableLength
           MOVE  LENGTH OF  tableEntry    TO  entryLength
  
           CALL 'CombSort' USING
           , by reference  returnStatus
           , by content    theMethod
           , by content    methodData
           , by reference  tableSpace
           END-CALL
  
  
      *---------------------------------------------------------------
      *
      *
      *  Where <L> is one of the following:
      * .-----------------------.---------------------.
      * !                       !                     !
      * !     sort order        !  replace statement  !
      * !                       !                     !
      * !-----------------------!---------------------!
      * !                       !                     !
      * !  for ASCending sort   !  REPLACE  ==<L>==   !
      * !                       !       BY  ==ASC==.  !
      * !                       !                     !
      * !-----------------------!---------------------!
      * !                       !                     !
      * !  for DEScending sort  !  REPLACE  ==<L>==   !
      * !                       !       BY  ==DES==.  !
      * !                       !                     !
      * '-----------------------'---------------------'
      *
      *
      *  Where the combination of <K> and <M> is one of the following:
      * .-------------------.-----------------------------------------.
      * !                   !                                         !
      * !   sort method     !           replace statement             !
      * !                   !                                         !
      * !-------------------!-----------------------------------------!
      * !                   !                                         !
      * !  byte             !  REPLACE  ==<K>==                       !
      * !                   !       BY  ==PIC X(??)==                 !
      * ! (same as:         !           ==<M>==                       !
      * !  unsignedBinary)  !       BY  ==byte==.                     !
      * !                   !                                         !
      * !-------------------!-----------------------------------------!
      * !                   !                                         !
      * !  unsignedBinary   !  REPLACE  ==<K>==                       !
      * !                   !       BY  ==PIC 9(??) BINARY==          !
      * ! (same as:         !           ==<M>==                       !
      * !  byte)            !       BY  ==unsignedBinary==.           !
      * !                   !                                         !
      * !-------------------!-----------------------------------------!
      * !                   !                                         !
      * !  signedBinary     !  REPLACE  ==<K>==                       !
      * !                   !       BY  ==PIC s9(??) BINARY==         !
      * !                   !           ==<M>==                       !
      * !                   !       BY  ==signedBinary==.             !
      * !                   !                                         !
      * !-------------------!-----------------------------------------!
      * !                   !                                         !
      * !  packedDecimal    !  REPLACE  ==<K>==                       !
      * !                   !       BY  ==PIC s9(??) PACKED-DECIMAL== !
      * !                   !           ==<M>==                       !
      * !                   !       BY  ==packedDecimal==.            !
      * !                   !                                         !
      * !                   !           (sign 's' is optional)        !
      * !                   !                                         !  
      * !-------------------!-----------------------------------------!
      * !                   !                                         !
      * !  alphanumeric     !  REPLACE  ==<K>==                       !
      * !                   !       BY  ==PIC X(??)==                 !
      * !   (code page      !           ==<M>==                       !
      * !   independent     !       BY  ==alphanumeric==.             !
      * !         sort)     !                                         !
      * !                   !                                         !
      * !-------------------!-----------------------------------------!
      * !                   !                                         !
      * !  floating-point   !  REPLACE  ==<K>==                       !
      * !                   !       BY  ==COMP-1==                    !
      * ! (short precision) !           ==<M>==                       !
      * !                   !       BY  ==shortPrecision==.           !
      * !       (*)         !                                         !
      * !                   !                                         !
      * !-------------------!-----------------------------------------!
      * !                   !                                         !
      * !  floating-point   !  REPLACE  ==<K>==                       !
      * !                   !       BY  ==COMP-2==                    !
      * ! (long precision)  !           ==<M>==                       !
      * !                   !       BY  ==longPrecision==.            !
      * !       (*)         !                                         !
      * !                   !                                         !
      * '-------------------'-----------------------------------------'
      *
      *
      *
      *  ADDITIONAL REMARKS:
      *  -------------------
      *
      *  ??   is any legal(!) numeric value.
      *
      *  (*)  COMP-1 and COMP-2 (COMP-1 + 2) are vendor dependent!
      *       COMP-1 + 2 are assumed to be floating-point fields.
      *       COMP-1 + 2 both have a fixed field length.
      *       The keyLength field is not used for COMP-1 + 2 sorts.
      *       consequently, the coding line:
      *       MOVE  LENGTH OF  sortKey       TO  keyLength
      *       is NOT(!) coded for COMP-1 + 2 sorts.
      *
      *       byte sort and unsignedBinary are interchangable.
      *       That is, byte sort and unsignedBinary are exactly the
      *       same sort.
      *
      *       alphanumeric sort is used for sorting text.
      *       alphanumeric sort is a code page independent sort!
      *       It will sort either ASCII or EBCDIC in exactly(!) the
      *       same collating sequence regardless the code page used.
      *       Requirement: This is only(!) true for LATIN based code
      *       pages. LATIN based code pages include the following
      *       characters: (0-9), (A-Z), (a-z)
      *
      *       The methodData contains upper- and lower-case characters.
      *       upper- and lower-case characters should be used asis!
      *       The sort routine may (or may not!) abend when the
      *       upper- and lower-case characters are NOT(!) used asis!
      *
      *
      *---------------------------------------------------------------

Regards, Wim Ahlers.

 

[webrabbit]

What's wrong with the SORT verb?

 

[wahlers]

To webrabbit:

As far as I know the standard 'SORT' keyword only sorts an input file and returns a sorted output file.

Whereas this sort sorts a table (note: the same table!)
(see example)

(n.b. It might be that the new COBOL 2002 standard also sorts internal tables. I am not familiar with COBOL 2002).


Regards, Wim Ahlers.

 

[webrabbit]

The 1980 standard specifies the the SORT verb can sort a table.

 

[wahlers]

To: webrabbit

I have never heard of, or I am not aware of, a 1980 COBOL standard.

In all the manuals available to me the SORT verb cannot(!) sort a table.
The ability to sort a table might be a specific vendor extension but as far as I know is not part of the COBOL-85 standard or any of the previous COBOL standards.

HOWEVER(!):

Scanning internet I DID find a reference that a table sort is now included in the COBOL 2002 standards! See:

http://www.interex.org/advocacy/survey/mpesib01results.html

How to do this is described in:

http://www.emunix.emich.edu/info/cobol/books/atexam.htm#u016

(note: I am not sure if this is the COBOL 2002 standard. It is just a description I found!).

One of the earlier references I could find (sofar) is:

http://www.jeromegarfunkel.com/jg_cobol/authored/modern.html

(around 97/98 as a proposal!)

Up till and including COBOL-85 the SORT verb had the following syntax:

http://publibz.boulder.ibm.com/cgi-bin/bookmgr_OS390/BOOKS/IGYLR204/6.2.34?DT=19981109161905

Up till and including COBOL-85 the SORT verb was not possible in a CICS environment (whereas my function is environment independent!).

Again! I do NOT know, nor use, the COBOL 2002 standards!
(by the way...is their an official(!) 2002 standard or not?)

I did found the following text fragment:

Unfortunately, COBOL does not provide any verb to sort a table (There is of course one SORT verb for sorting records of a file which you shall study in Unit 2 of Block 2). Now what to do?

see:

http://www.ignou.ac.in/socis/mca/course/cs03/block1/html/cs03-bl1-59.htm

To webrabbit: In which environement are you working and with which compiler? Do you have an official(!) description of the the SORT verb sorting a table?
If so...please post!


Regards, Wim.

 

[webrabbit]

Micro Focus COBOL 3.2.46. I don't have my Language Reference Manual, lent it to someone and never got it back. I use SORT for tables frequently. There must be a KEY clause with the OCCURS clause:

 level-number data-name OCCURS integer TIMES ASCENDING|DESCENDING KEY IS data-name INDEXED BY index-name.

. . .

SORT data-name

 

[k5tm]

It might be that the new COBOL 2002 standard also sorts internal tables.

The 2002 standard contains the format 2 SORT verb (table sort).

Tom Morrison

http://www.liant.com

 

[wahlers]

To everybody:

So, in conclusion, this table sort utility is for everybody that does not have the COBOL 2002 standard compiler (like me) or you may be used for sort functionality not covered by the new COBOL 2002 SORT verb.

e.g. I am not sure if the COBOL 2002 SORT verb also sorts COMP-1 and COMP-2 fields or if you can specify an environment independent collating sequence.


Regards, Wim Ahlers.

 

[webrabbit]

My compiler is copyright 1996.

 

[k5tm]

I am not sure if the COBOL 2002 SORT verb also sorts COMP-1 and COMP-2 fields

Of course it won't, because COMP-1 and COMP-2 are nonstandard!

Tom Morrison

http://www.liant.com

 

[webrabbit]

If you specify the elementary Comp-1|2 field as one of the sort keys, the compiler should be able to sort it properly.

 

[webrabbit]

If you really want a good sort, here is a COBOL implementation of the Shell sort, the fastest know sort.

SHELL-SORT.
     Move NUMBER-OF-ITEMS                      to GAP
     Perform Until GAP < 2
         Divide 2                            into GAP
         Move GAP                              to INTERVAL
         Perform Until INTERVAL not < NUMBER-OF-ITEMS
             Add 1                             to INTERVAL
             Set INDEX-1, INDEX-2              to INTERVAL
             Set INDEX-1                  down by GAP
             If TABLE-KEY(INDEX-1) > TABLE-KEY(INDEX-2)
                 Move TABLE-ENTRY(INDEX-2)     to HOLD-ENTRY
                 Perform Until INDEX-2 not > GAP or HOLD-KEY not < TABLE-KEY(INDEX-1)
                     Move TABLE-ENTRY(INDEX-1) to TABLE-ENTRY(INDEX-2)
                     Set INDEX-1          down by GAP
                     Set INDEX-2          down by GAP
                 End-Perform
                 Move HOLD-ENTRY               to TABLE-ENTRY(INDEX-2)
             End-If
         End-Perform
    End-Perform
    .

NUMBER-OF-ITEMS is the occurance factor of the table.

GAP and INTERVAL are binary fields large enough to hold the value of NUMBER-OF-ITEMS.

TABLE-ENTRY is the field having the OCCURS clause.

TABLE-KEY is the key field of the table, must be subordinate to TABLE-ENTRY.

HOLD-ENTRY is a field as long as TABLE-ENTRY.

HOLD-KEY is subordinate to HOLD-ENTRY and must be equivalent to TABLE-KEY.

INDEX-1 and INDEX-2 are indices of TABLE-ENTRY.

If this code is made into a copybook, REPLACING can be used to replace NUMBER-OF-ITEMS by the acctual occurance of TABLE-ENTRY, and the other names can, if neccessary, be replaced by the appropriate pre-defined names. By REPLACING SHELL-SORT also, multiple copies of the copybook could be used in the same program.

 

[wahlers]

Some response to the response

To: Tom

1. As long as COMP-1 and COMP-2 respectively represents the short and long precision floating-point then my SORT routine sorts without problems.
2. As long as a LATIN based codepage ( 0-9, A-Z, a-z ) is used (true for most of the western hemisphere) then my SORT offers the option to sort according to UTF-8.
(and it does not take to much effort to include an extra method that takes the collating sequence for any(!) except for the most esoteric codepages as an argument and sort accordingly. See source!).
3. I don't know if the COBOL 2002 built in SORT routine can also sort PACKED-DECIMAL (again: I have no (, zero, zip) experience or knowledge of the COBOL 2002 standards!), but my SORT routine does sort PACKED-DECIMAL (either signed or unsigned (C,D,F)).

To: webrabbit

I don't use, neither promote, to place code fragments into copybooks. It makes the source hard to read and the various sources very dependent on each other.
I reserve the use of copybooks for interface definitions only (either in the linkage or working-storage section).
This, to me, is acceptable because the interface is the basis for communication and should be a fixed inflexible agreed upon definition (interface contract).


Regards, Wim.

 

[kkitt]

At our shop, we use code fragments to hold what the shop standards are for DB2 Error Routines, specific Date routines, specific Company Business needs and such.

If all of these routines are place in a common area maintaining is not an issue. Also by having these specific routines pre-defined and copied into their programs then everybody is handling the situation the same and make maintenance later that much easier.

When I first starting working for this company we had 18 division each with their own set of coding. This was a maintenance nightmare when the Business rules changes. Had to make the same changes in 18 + programs. I convert the common program code to the copybook, make the changes once and just have to recompile the program. No more accidentally missing statement in the code or a whole division.

 

[wahlers]

To: kkit

I disagree with you!

The code is exposed. It is not based any more on an interface contract but on the internal workings! These internal workings are spreadout through the system.

Why not make it a callable routine?
Instead of code fragments copied into main sources!

Imagine if it is used in 100 programs and you just want to change one line of code.
You have to check all of the 100 programs because potentially each and every program can use the content of these copybook in a unpredictable and mysterious ways!

In contrast...you don't have this problem at all when it is a callable routine with a well-defined interface (interface contract).
Also it is just a minor effort to define a new method to implement a new way that was not anticipated at creation time of the routine.

For a more detailed discussion see:

http://www.programmersheaven.com/2/Art_ObjBasedSystems

Also I recommend you study the source I offer you here (just sent Email to me then I will sent you the source) to see how easy it is to expand this source with a strong resistence to the usual entropy.


Regards, Wim Ahlers.

 

[kkitt]

I would perfer to make these callable routines (and this is being worked on), but until I can convert all division to using Common Item, Customer, ect files (each division has it own and all in different layouts).

With using the copybook all I have to put in is:

   copy xxITM replacing ==XX== by ==NW==
                        ==YY== by ==NWITM==.

else I need to have a move statement for each field that is used in that routine to the linkage and then the call.

 

[wahlers]

To: kkitt

Of course!
As usual: you don't change historical practices without reason!
Or (from a slightly different angle): you don't change for the sake of change!
There must(!) be a (commercial) reason.

It was and is NOT my intention to suggest to:
'just throw away everything and start all over again'.

You already indicated that you are in the process of using callable routines instead of copy and rename code fragments.
By now you probably know that I heartily support this approach (even better would be to also take an object oriented approach in consideration!).

Again, I am always interested in other peoples approaches (even when they still use ALTER!).
You may not agree with my approach but it might give you ideas you never considered.
That is why I suggest to look at the material I provide.
(purely on a non-commercial, open source basis)


Regards, Wim.

 

[wahlers]

To: webrabbit

It was just something I could not resist reacting to...

There is no such thing as 'the fastest sort'. This all depends on the number of records to be sorted and the initial (sort) order of the records.

However, assuming that the most common circumstances (random order, and a substantial - whatever that means - number of records) you can calculate the theoretical efficiency of the sort routines.

The SHELL-SORT source you provided looks a lot like the COMBSORT sortroutine I use in my source.
Included in my source is some calculus information related to the efficiency of COMBSORT (compared to the efficiency - or should I say inefficiency! - of the BUBBLE sort).

The source also includes a remark of COMBSORT compared to HEAPSORT. I could also have made a remark of COMBSORT compared to QUICKSORT but I did not include information of QIUCKSORT.
I am actually not familiar with SHELL sort (...note: must look in to it...)

By the way: QUICKSORT is difficult to implement into (standard) COBOL due to its recursive nature.
(note: I am not familiar with COBOL 2002! It may, or may not, be the case that COBOL 2002 now supports recursive calls).

I already gave my (negative!) opinion about using copybooks for code fragments (see discussion with kkitt).

I recommend you study the material I offer you and see what you can use (or discard it if you don't like it).


Regards, Wim.

 

[webrabbit]

I don't have the quick-sort algorithm. I have heard that it is even faster than shell-sort. I agree with the admonation that the "fastest" depends on various factors. I always assume worst-case, unless the data are known well. If the data are almost in order, perhaps the bubble sort might be best!

In general, I found that the bubble sort is the slowest. I had not run into it until I found a discussion of various sorts, where I got the shell-sort algorithm. Before that, I used a binary-sort.

If the comparison of the keys is complex (non contiguous, signed-numeric fields, mixed ascending/decending, etc.), perhaps the fastest sort would be one that reduces the number of comparisons.

If each entry is very large, it might be best to reduce the number of swaps. Years ago, I wrote a sort that returned a table of pointers (INDEX data-items) to reduce the swaps to 4-byte fields.

 

[wahlers]

To: webrabbit

You said:
If the comparison of the keys is complex (non contiguous, signed-numeric fields, mixed ascending/decending, etc.), perhaps the fastest sort would be one that reduces the number of comparisons.

My answer:
These are exactly the issues that are all addressed in the COMBSORT routine I provide for free.



Regards, Wim Ahlers.