home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / MRGLGFIL.ZIP / MRGLGFIL.PAS
Encoding:
Pascal/Delphi Source File  |  1987-11-08  |  4.1 KB  |  131 lines
  1. {This is a sorting procedure using the natural merge sort to sort files
  2.  of items larger than can be held in memory.  It is really a demonstration
  3.  of the technique; you'll need to fill in infotype and keytype, and the
  4.  interface providing the appropriate filenames.
  5.  
  6.  I've had several requests for this kind of algorithm.  Unfortunately, I
  7.  can't provide you with a compilable module per se, because that's less
  8.  applicable.  This is a general purpose example, patterned after a routine
  9.  by David F. Moffat.  Best wishes, Glenn Brooke 11/22/85
  10.  }
  11.  
  12. type
  13.     infotype = ...;      {whatever you like}
  14.     keytypte = ...;      {    "}
  15.     item = record       {each file element}
  16.            key : keytype;   {'key' to the data}
  17.            info : infotye;  {information to be stored}
  18.            end;
  19.     itemfile = file of item;    {a sequence of these items}
  20.  
  21. var
  22.    F : itemfile;
  23.    i : item;
  24.  
  25. procedure Sort(var F : itemfile);
  26.      {sort the file F into ascending order, using natural merge sort}
  27.  
  28. var
  29.    runs := 0..maxint;  {# of sequences of ascending order values}
  30.    temp1, temp2 : itemfile;  {these hold runs of items that are from F, to}
  31.                              {be compared and merged back into F}
  32.    endrun : boolean;         {true only at end of run}
  33.  
  34. procedure copyitem(var source : itemfile;
  35.                    var dest : itemfile);
  36.  
  37.    {copy a single value from source to dest, setting global endrun to true
  38.     if this value is the last in an ascending sequence (run)}
  39. var i : item;    {value being copied}
  40. begin {copyitem}
  41.       read(source,i);
  42.       write(dest,i);
  43.       {check for end of run}
  44.       if eof(source) then endrun := true else endrun := (i.key > source@.key)
  45. end; {copyitem}
  46.  
  47. procedure copyrun(var source : itemfile;
  48.                   var dest : itemfile);
  49.    {copy a run (ascending sequence) of values from source to dest}
  50. begin
  51.      repeat
  52.            copyitem(source, dest)
  53.      until endrun  {endrun set by copyitem}
  54. end; {copyrun}
  55.  
  56. procedure splitup(var F : itemfile;
  57.                   var temp1 : itemfile;
  58.                   var temp2 : itemfile);
  59.    {copy the successive runs from F into the files temp1, temp2, alternating
  60.     whole runs between the two files.}
  61. begin
  62.      reset(F);
  63.      rewrite(temp1);
  64.      rewrite(temp2);
  65.      repeat
  66.            copyrun(F, temp1);
  67.            if not eof(F) then copyrun(F, temp2)
  68.      until eof(F)
  69. end; {splitup}
  70.  
  71. procedure MergeRuns(var temp1 : itemfile;
  72.                     var temp2 : itemfile;
  73.                     var F : itemfile);
  74.    {merge the next pair of runs from temp1 to temp2 into a single and
  75.     longer run, back into F}
  76. begin
  77.      repeat
  78.      if temp1@.key < temp2@.key then
  79.         begin  {take from temp1}
  80.         copyitem(temp1, F);
  81.         {the run in temp1 could be the shorter one}
  82.         if endrun then copyrun(temp2, F)
  83.         end
  84.      else
  85.         begin  {take from temp2}
  86.         copyitem(temp2, F);
  87.         if endrun then copyrun(temp1,F)
  88.         end
  89.      until endrun
  90. end; {mergeruns}
  91.  
  92. procedure Recombine(var temp1 : itemfile;
  93.                     var temp2 : itemfile;
  94.                     var F : itemfile);
  95.    {merge all pairs of runs from temp1 and temp2, combining them into
  96.     successive (and longer) runs in F.  Count the number of runs in F}
  97. begin
  98.      reset(temp1);
  99.      reset(temp2);
  100.      rewrite(F);
  101.  
  102.      {merge and count pairs of run}
  103.      while not eof(temp1) and not eof(temp2) do
  104.            begin {each pair}
  105.            mergeruns(temp1,temp2,F);
  106.            runs := succ(runs)
  107.            end; {each pair}
  108.  
  109.      {there may be some runs left in one of the files}
  110.      while not eof(temp1) do
  111.            begin
  112.            copyrun(temp1,F);
  113.            runs := succ(runs)
  114.            end;
  115.      while not eof(temp2) do
  116.            begin
  117.            copyrun(temp2,F);
  118.            runs := succ(runs)
  119.            end
  120. end; {recombine}
  121.  
  122. begin {sort}
  123.       {split the files into successive runs, then recombine paris of runs
  124.        into longer runs, until one 1 run}
  125.      repeat
  126.            splitup(F, temp1, temp2);
  127.            runs := 0;
  128.            recombine(temp1, temp2, F)
  129.      until runs = 1
  130. end; {sort}
  131.