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