home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / epmmac.zip / SORTE.E < prev    next >
Text File  |  1993-02-08  |  8KB  |  228 lines
  1. /***************************************************************/
  2. /* SORTE.E            Sorts internally, in E3 language.        */
  3. /* Bryan Lewis        Jan 87.  Updated Oct 87                  */
  4. /*                                                             */
  5. /* This is faster than calling any of the external sort        */
  6. /* utilities, up to about 100 lines.  Gets slow after that.    */
  7. /* Avoids the worries about disk space and file handles.       */
  8. /***************************************************************/
  9.  
  10. ;defc ESORT=   /* alternative name */
  11.  defc SORT =
  12.    TypeMark=marktype()
  13.    if TypeMark='' then  /* if no mark, default to entire file */
  14.       getfileid fileid
  15.       firstline=1 ; lastline=.last ; firstcol=1; lastcol = 40
  16.    else
  17.       getmark firstline,lastline,firstcol,lastcol,fileid
  18.    endif
  19.  
  20.    /* If it was a line mark, the LastCol value can be 255.  Can't */
  21.    /* imagine anyone needing a key longer than 40.                */
  22.    if TypeMark='LINE' then lastcol=40 endif
  23.  
  24. compile if EVERSION < 5
  25.    sayerror SORTING__MSG lastline-firstline+1 LINES__MSG '...'
  26. compile endif
  27.  
  28.    /* Pass the sort switches "rc", if any, as a sixth argument to sort().    */
  29.    call sort(firstline,lastline,firstcol,lastcol,fileid, arg(1) )
  30.  
  31.    sayerror 0
  32.  
  33.  
  34.  
  35. defproc sort(firstline,lastline,firstcol,lastcol,fileid)
  36.         /* optional sixth arg = reverse/case switches: "rc" */
  37.    Revers=0
  38.    IgnoreCase=0
  39. compile if EVERSION >= '5.20'
  40.    undotime = 1            -- 1 = when starting each command
  41.    undoaction 4, undotime  -- Disable state recording at specified time
  42. compile endif
  43.    if arg() > 5 then  /* if sixth argument was passed ... */
  44.       if not verify('R',upcase(arg(6))) then  /* R anywhere */
  45.          Revers=1
  46.       endif
  47.       if not verify('C',upcase(arg(6))) then  /* C anywhere */
  48.          IgnoreCase=1
  49.       endif
  50.    endif
  51.  
  52. compile if RESTORE_MARK_AFTER_SORT
  53.    call psave_mark(savemark)
  54.    call prestore_mark(savemark)
  55. compile endif
  56.    call psave_pos(save_pos)
  57.  
  58.    X = lastline-firstline+1         /* X = number of lines. */
  59.  
  60.    /* An optimal set of increments for successive passes is:
  61.    ** 1, 4, 13, 40, 121, 364, 1093, ....   See Knuth ACP vol.2 p.95.
  62.    ** Pick the starting increment, then each successive one can be
  63.    ** obtained by dividing the previous one by 3 (integer division).
  64.    */
  65.    M=1
  66.    while (9*M+4) < X do
  67.       M = M*3+1
  68.    endwhile
  69.  
  70.    /* Copy the lines to a hidden file, for safety's sake and also for speed;
  71.    ** we won't have to calculate line offsets.
  72.    ** We want to copy complete lines, not a piece.  Change to line mark.
  73.    */
  74.    call pset_mark(firstline,lastline,firstcol,lastcol,'LINE',fileid)
  75.  
  76. compile if EVERSION < 4
  77.    'xcom e /n'             /*  Create a temporary no-name file. */
  78. compile else
  79.    'xcom e /c temp'        /*  Create a temporary file. */
  80. compile endif
  81.    getfileid tempofid
  82.    rc = 0
  83.    copy_mark
  84.    if rc then stop endif
  85.    unmark
  86. ;; activatefile tempofid     -- Shouldn't be necessary??
  87.    top; deleteline         /* Delete extra blank line at top. */
  88.  
  89.    /* Insert a column of an arbitrary alpha character before the key field
  90.    ** to prevent leading spaces and numbers from affecting the comparison.
  91.    ** (E ignores leading spaces in the test:  string1 <= string2. )
  92.    ** Any non-digit non-space character will do; use '!'.
  93.    */
  94.    top; .col=firstcol
  95.    mark_block; bottom; mark_block   /* mark a single column */
  96.    shift_right; fill_mark '!'       /* insert column of '!' */
  97.    unmark
  98.  
  99.    /* Insert a field of sequence numbers after the key field to insure the
  100.    ** sort is stable.  If two records have equal keys then the comparison
  101.    ** will be determined by the sequence numbers, thus preserving their
  102.    ** original order.
  103.    ** The sequence-number field will be 5 characters long.  The full key will
  104.    ** look like "!datakey10001".  So key length = length(datakey) + 6.
  105.    */
  106.    keylength = (lastcol-firstcol+1) + 6
  107.  
  108.    /* Optimize for speed (saving about 20%) by using two separate sort loops,
  109.    ** one for each Reverse case.  Removes extra IF clauses from the loop.
  110.    */
  111.    if not Revers then
  112.       /* The fast way to create fixed-length numbers is to add 10000. */
  113.       for i=1 to .last
  114.          seq = 10000 + i   /* fixed-length numeric field */
  115. compile if EPM
  116.          replaceline insertstr(seq,textline(i),lastcol+1), i
  117. compile else
  118.          getline line,i
  119.          replaceline substr(line,1,lastcol+1)||seq||substr(line,lastcol+2),i
  120. compile endif
  121.       endfor
  122.  
  123.       while M > 0 do    /* finally the actual sorting */
  124.          K=X-M
  125.          for J=1 to K
  126.             I=J
  127.             while I > 0 do
  128.                L=I+M
  129.                getline lineI,I; getline lineL,L /* Compare line I to line L. */
  130.                keyI = substr(lineI,firstcol,keylength)
  131.                keyL = substr(lineL,firstcol,keylength)
  132.                if IgnoreCase=1 then
  133.                   keyI=upcase(keyI)
  134.                   keyL=upcase(keyL)
  135.                endif
  136.                if keyI<=keyL then leave endif
  137.                replaceline lineL,I  /* swap */
  138.                replaceline lineI,L
  139.                I=I-M
  140.             endwhile
  141.          endfor
  142.          M=M%3    /* generate next increment -- INTEGER division! */
  143.       endwhile
  144.    else
  145.       /* For reverse the sequence field must be descending, sub from 20000. */
  146.       for i=1 to .last
  147.          seq = 20000 - i   /* fixed-length numeric field */
  148.          getline line,i
  149. compile if EPM
  150.          replaceline insertstr(seq,textline(i),lastcol+1), i
  151. compile else
  152.          getline line,i
  153.          replaceline substr(line,1,lastcol+1)||seq||substr(line,lastcol+2),i
  154. compile endif
  155.       endfor
  156.       while M > 0 do
  157.          K=X-M
  158.          for J=1 to K
  159.             I=J
  160.             while I > 0 do
  161.                L=I+M
  162.                getline lineI,I; getline lineL,L
  163.                keyI =substr(lineI,firstcol,keylength)
  164.                keyL =substr(lineL,firstcol,keylength)
  165.                if IgnoreCase=1 then
  166.                   keyI=upcase(keyI)
  167.                   keyL=upcase(keyL)
  168.                endif
  169.                if keyL<=keyI then leave endif
  170.                replaceline lineL,I
  171.                replaceline lineI,L
  172.                I=I-M
  173.             endwhile
  174.          endfor
  175.          M=M%3    /* Integer division */
  176.       endwhile
  177.    endif
  178.  
  179.    /* Remove the extra columns we inserted. */
  180.    top; .col=firstcol; mark_block
  181.    bottom; mark_block; delete_mark
  182.    top; .col=lastcol+1; mark_block
  183.    bottom; .col=lastcol+5; mark_block; delete_mark
  184.  
  185.    /* Fix rare bug.  If you just barely run out of memory at            */
  186.    /* the end, E3 might not allow the copying of the sorted lines.      */
  187.    /* The old way did a delete_mark first, could ruin the original text.*/
  188.    /* Now we try to copy_mark first (so we temporarily have two copies  */
  189.    /* of the lines in the same file) and then, if that goes well, delete*/
  190.    /* the old lines.  This approach means we can't sort quite as big a  */
  191.    /* block as before, but the file never gets trashed.                 */
  192.    top; mark_line          /* Copy the new lines.  */
  193.    bottom; mark_line
  194.    activatefile fileid
  195.    lastline
  196.    rc=0
  197.    copy_mark
  198.    if rc then
  199.       sayerror NO_SORT_MEM__MSG
  200.       stop
  201.    endif
  202. ;  unmark         -- Unnecessary; pset_mark starts with UNMARK.
  203.    activatefile tempofid   /* Release temporary file. */
  204.    .modify=0; 'xcom q'
  205.  
  206.    /* NOW we can delete the original! */
  207.    activatefile fileid
  208.    call pset_mark(firstline,lastline,firstcol,lastcol,'LINE',fileid)
  209.    delete_mark
  210.  
  211. compile if RESTORE_MARK_AFTER_SORT
  212.    call prestore_mark(savemark)
  213. compile endif
  214.    call prestore_pos(save_pos)
  215. compile if EVERSION >= '5.20'
  216.    undoaction 5, undotime  -- Enable state recording at specified time
  217. compile endif
  218.    return 0
  219.  
  220.  
  221. /* Sample call of sort as a procedure, for testing.
  222. defc testsort
  223.    getfileid fileid
  224.    call sort(1,2,1,20,fileid)
  225.    sayerror 0
  226. */
  227.  
  228.