Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Free source: COBOL internal table sort

Status
Not open for further replies.

wahlers

Programmer
May 13, 2004
142
NL
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:
Code:
      *-------------------------------------------------------*
      *                                                       *
      * 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.
 
At the link below is an informative comparison of various sort methods.


Unfortunately, the corresponding source for these sorts are only given in Java. Still the ref is useful for comparison and comprehension of the various sort methods.

&quot;Code what you mean,
and mean what you code!
But by all means post your code!&quot;

Razalas
 
To: Razales

Searching the internet there are many examples of sort routines, either as specification or in a specific programming language including COBOL.

I found the COMBSORT COBOL routine on the net myself. To be specific, on:
N.B. The original authors are(!) credited in my source!

One biblical work is from Knuth who described many data structures and routines, including many (but not all) sort routines.

The only thing I added was writing a generic function by modifying the COMBSORT algorithm so it can now handle various field formats.
One of the primary goals was to keep instructions executed to a minimum.
Without sacrificing the integrity and the robustness of the algorithm of course.


Regards, Wim.
 
I could write a whole lot of comments about this one...where do I start.

If you go on mvshelp.com and search, you'll find things I wrote (Glenn there) with samples of a lot of different kinds of sorts in COBOL and a little bit of discussion about pros and cons in a concrete sort of way (# of sorts, # of comparisons, etc).

Bubble sort is indeed better for almost sorted data, but you really want an insert sort in that case, because it's even faster.

Combsort seems to be the speed king on COBOL platforms, because of how COBOL handles indexing table fields (A VERY SHODDY JOB, PITIFUL IN FACT!), because it does the least amount of that of the algorithms.

As far as the quicksort angle, you will find two versions of that algorithm that I wrote when you search in COBOL. One works under the standard COBOL logic, but is perhaps too slow because of that speed issue in handling index addressing (I tested it on a PC compiler, but maybe mainframe is better?). The other is written under the new IBM standard which allows recursive calls to SUBPROGRAMS (I wish we could get user-defined functions :( ), but is untested because I didn't have access to an IBM compatible mainframe compiler to do so.
 
Glenn,

You said:
I could write a whole lot of comments about this one...where do I start.

I don't exactly know what you react on, but I only wrote this routine to sort an internal table for various key formats (see original - is top - post).
That is all!

I choose combSort for simplicity but I actually don't care which sort algorithm is used as long as it is performant enough for the sorting job it has to perform!

Look at the original post...it only contains a call to the sort routine without showing the internal workings.
The source code contains the internal workings.
It is this source that I offer.
This source contains 3000 lines of code - including comments and space lines - and has 14 defined sorting methods.

This source is tested, can be used as-is, or you add (new) methods if you like. This is up to whoever wants to use it.

The point is: It is nothing more or less then a bundled optimised sort routine useful for some situations and, of course, not useful at all in other situations. There is no 'best' sorting routine (though you can say that some are more generally useful then others. I believe this bundled source is generally useful!).

Again(!): COBOL-2002 does have some standard sort functionality that is also - and therefore redundantly - coded in this source.
This source was coded for a COBOL-85 compatible environment.


Regards, Wim.

(If you still want the source then sent me a mail. Mail address is in the original post - see top - )
 
I react on what I could say about this whole thread and the comments, not just you (the OP).

As far as a "best sorting routine" goes, yes there is one, but it depends on what you are wanting to do with it, and that's what I was trying to state. Actually there's whole books on the matter, and even giving a summary could be pages (well I did that in a post on mvshelp). Look up "Big O Notation" if you want to know more.

As I stated, COMBSORT seems to work best with COBOL because it is a reasonably efficient method. Combsort also features the least table addresses, which seems to be a definite advantage in COBOL, because it doesn't seem to handle that aspect very well.

As far as requesting your sort code goes, I already did that via private BB message, and you should be able to discern my e-mail address from there to send it to.
 
To: Glenn9999

I either did not receive your 'private BB message' (by the way; what is a BB message anyway?) or - which is more likely - I don't know how to access this BB message.

Can you help me with this problem?
I like to send you the source!

By the way: My source also includes the big O notation (though I did not know it under this name).
The big O notation for bubble sort is easy, but combSort is more complicated. Have a look at the internal source documentation once you have it (almost at the bottom of the source!).

Also: I like to see your own forum entries that you mentioned. I also have problems with finding your posts.
Can you please give me a hint in how to find these posts?

Finally, I am aware of the zillion pages written on source routines. It was not my intention to yet add another additional and redundant routine.
I only coded an implementation of an existing sort routine. The original authors are credited in my source.
If you check the posts I also mentioned Knuth (and of course he is not the only one) and several other resources.


Regards, Wim Ahlers.
 
Mvshelp has a private message system in its bulletin board system. Check it by going into your profile. A message from me should be there, assuming you received it. Actually I just see now you did, because I see a message from you, which I have replied to.

See the Bubble sort thread on the other forum and you will see some threads once I get the chance to post (lightning is starting over here right now).
 
Hi
I use more then 20 years, a simple routine for sorting tables (not too long).
Code:
           MOVE 1 TO K, PERFORM SORT-TAB UNTIL K = 0.
       SORT-TAB.
           MOVE 0 TO K.
           PERFORM VARYING I FROM 1 BY 1 UNTIL I > LNG-OF-TABLE
                   ADD 1 I GIVING J
                   IF KEY-TAB-TAB(I) < KEY-TAB-TAB(J)
                       MOVE KEY-TAB(I)   TO KEY-TAB-HOLD
                       MOVE KEY-TAB(J)   TO KEY-TAB(I)
                       MOVE KEY-TAB-HOLD TO KEY-TAB(J)
                       MOVE 1 TO K, END-PERFORM.
       EX-SORT-TAB.
This is for DESCENDING, for ASCENDING use
Code:
                   IF KEY-TAB-TAB(I) > KEY-TAB-TAB(J)
 
To: Baruch

...of course, what you used is the simple bubble sort.

The combSort - though simple and based on bubble sort - is slightly more complicated and a heck more performant.

What I have done is generalised the concept and placed the algorithmic complexity into a callable routine.
The advantage is that you don't have to worry about the algorithm anymore as illustrated in the following coding example (fragment):
Code:
DATA DIVISION.
WORKING-STORAGE SECTION.
 
01  someCALLdata.
 
  05  theSortRoutine  PIC  X(08)
      VALUE 'COMBSORT'. 
 
  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.
  
01  someTables.
 
  05  tableA.
    10  theRowsA         OCCURS 1000 TIMES.
      15  theRowA.
        20  field1A      PIC  X(11).
        20  field2A      PIC  X(13).
        20  keyA.
          25  keyFieldA  PIC s9(05)v9(03)
                         PACKED-DECIMAL.
        20  moreFieldsA  PIC  X(100).
 
  05  tableB.
    10  theRowsB         OCCURS 2000 TIMES.
      15  theRowB.
        20  keyFieldB    PIC  X(40).
        20  moreFieldsB  PIC  X(19).
  
  05  tableC.
    10  theRowsC         OCCURS 3000 TIMES.
      15  theRowC.
        20  keyFieldC    COMP-1.
        20  moreFieldsC  PIC  X(3000).
 
PROCEDURE DIVISION.
mainProcedure.
 
     PERFORM  sortTableA
     IF  allOK
     , PERFORM  sortTableB
     , IF  allOK
     , , PERFORM  sortTableC
     , END-IF
     END-IF
 
     GOBACK
     .
 
sortTableA.
 
     MOVE 'ASC'                TO  sortOrder
     MOVE 'packedDecimal'      TO  theMethod
     MOVE  LENGTH OF  keyA     TO  keyLength  
     MOVE  LENGTH OF  tableA   TO  tableLength
     MOVE  LENGTH OF  theRowA  TO  entryLength
     ADD   LENGTH OF  field1A,
     ,     LENGTH OF field2A,
     ,     +1
     GIVING  keyStart
  
     CALL  theSortRoutine  USING
     , by reference  returnStatus
     , by content    theMethod
     , by content    methodData
     , by reference  tableA
     END-CALL
     .
 
sortTableB.
 
     MOVE 'DES'                  TO  sortOrder
     MOVE 'alphanumeric'         TO  theMethod
     MOVE  LENGTH OF  tableB     TO  tableLength
     MOVE  LENGTH OF  theRowB    TO  entryLength
     MOVE  LENGTH OF  keyFieldB  TO  keyLength
     MOVE  1                     TO  keyStart
  
     CALL  theSortRoutine  USING
     , by reference  returnStatus
     , by content    theMethod
     , by content    methodData
     , by reference  tableB
     END-CALL
     .
 
sortTableC.
 
     MOVE 'ASC'                TO  sortOrder
     MOVE 'shortPrecision'     TO  theMethod
     MOVE  LENGTH OF  tableC   TO  tableLength
     MOVE  LENGTH OF  theRowC  TO  entryLength
     MOVE  1                   TO  keyStart
  
     CALL  theSortRoutine  USING
     , by reference  returnStatus
     , by content    theMethod
     , by content    methodData
     , by reference  tableC
     END-CALL
     .
Of course the execution can still go wrong when the wrong values are being passed.
However(!) the algorithm is never wrong because the algorithm is contained in a callable function.
As always, it is easier to check the values passed then it is to debug an algorithm.

I hope the example is clear enough to provide enough justification for 'hiding' commonly used algorithms into callable function.
E.g.: the JAVA has a simple function that looks more or less like this:
returnHighest( A, B)
I know in COBOL you can code this as:
Code:
IF  A  >  B
, MOVE  A  TO  C
ELSE
, MOVE  B  TO  C
END-IF
COBOL does not have a standard function for this - though there might be because I did not check the intrinsic functions - but you may decide to write your own routine and code something similar to the following:
Code:
CALL  returnHighest  USING  A, B, by reference C
Throughout the years I have learned to write generic callable routines for almost everything, and use and reuse them extensively! As a result my programs consists of (almost) only calling functions and/or objects.
For an indepth discussion concerning object-based (and partly object-oriented) programing download the PDF document from:


Regards, Wim Ahlers.
 
Backing up a bit:

- As far as "Standards" goes,
- The '85 ANSI/ISO Standard did not support Table sorts
- the '89 and '91 amendments to the above did not support table sorts
- the 2002 ANSI/ISO Standard *does* include table sorts
- the CCC (CODASYL COBOL Committee) JOD (circa 198?) included table sorts

Micro Focus implemented table sorts in the early 90's (as an extension - now standard with their 2002 dialect)

***

As far as doing table sorts in an '85 conforming way, it is entirely possible (using Input/Output procedures). See (for example):


As for how this will PERFORM for any particular '85 Standard conforming compiler (as compared to "hand-crafted" table sorts), I can't tell you. However, the source code WILL be portable across conforming implementatiojs which may (or may not) be important.

Bill Klein
 
To: Bill (and all),


COBOL -85, -2002 standards were discussed before
(see some of the posts in this thread).

Your reference to (or something similar) is known and also mentioned in one - or more - of the previous replies in this thread.

And yes...what I have written is a handcrafted tablesort!
Regarding the COBOL-85 compliance see the various discussions and remarks in this thread.

The code as offered was coded as a reaction on a forum question. The question was something like:
Can you sort a table internally(!) using COBOL?
(note: mentioned was COBOL-85!)
The requestor did not mean writing a routine but some kind of command.
To my knowledge there isn't,
therefore I wrote a general purpose and callable routine.
Which, by the way is also easy modifiable and easily extendible
(see source...I can sent you the source by mail...for my email address see mail address in the top post)

That is all!


Regards, Wim.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top