home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / SORTKIT1.ZIP / MERGSORT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-09-05  |  9.3 KB  |  281 lines
  1. (******************************************************************************
  2. *                                  mergSort                                   *
  3. * this unit defines a merge sort object that sorts a file of a fixed length   *
  4. * using merge sort.                                                           *
  5. ******************************************************************************)
  6. unit mergSort;
  7.  
  8.  
  9. interface
  10.  
  11. {$I-}
  12.  
  13. type
  14.    mergeSortPtr = ^mergeSort;
  15.    mergeSort = object
  16.  
  17.       fileName : string; { the original name of the file we manipulate }
  18.       mergFile : file;   { this is the file we read, and sort ... }
  19.       blokSize : word;   { the block size we are interested in ...}
  20.       block1,
  21.       block2   : pointer;{ pointers to blocks beeing compared }
  22.       tempPath : string; { temporary files path }
  23.       fileSize : longInt;{ size of file in records ... }
  24.       t1, t2, 
  25.       t3, t4   : file;   { temporary files used during sort .. }
  26.       telem : longInt; { No of records in a telem ... }
  27.       outputNm : string; { the name of the output sorted file }
  28.  
  29.       constructor init( fn : string;   { file name }
  30.                         bs : word;     { block size }
  31.                         tp : string;   { temp path }
  32.                         on : string    { outfile name }
  33.                         );
  34.       destructor  done; virtual;
  35.       procedure   doYourJob; virtual; { perform the merge sort }
  36.       function    compare : byte; virtual; 
  37.       { compare block1, block2 , 0 eq, 1 (1 > 2), 2 (2 > 1) }
  38.       function    splitFile : longInt; virtual;
  39.       function    mergeFiles(tSize : longInt) : longInt;
  40.       { perform one pass of merge with telem of tSize from t1,2 to t3,4 }
  41.  
  42.    end; { mergeSort object ... }
  43.  
  44. implementation
  45.  
  46. (******************************************************************************
  47. *                               mergeSort.init                                *
  48. ******************************************************************************)
  49. constructor mergeSort.init;
  50. begin
  51.    if (tp[length(tp)] <> '\') then
  52.       tp := tp + '\';
  53.    tempPath := tp;
  54.    fileName := fn;
  55.    blokSize := bs;
  56.    outputNm := on;
  57. end; {mergeSort.init}
  58.  
  59. (******************************************************************************
  60. *                               mergeSort.done                                *
  61. ******************************************************************************)
  62. destructor mergeSort.done;
  63. begin
  64.    close(t1);
  65.    close(t2);
  66.    close(t3);
  67.    close(t4);
  68. end; {mergeSort.done}
  69.  
  70. (******************************************************************************
  71. *                              mergeSort.compare                              *
  72. * method override by user - sort descendant.                                  *
  73. ******************************************************************************)
  74. function mergeSort.compare;
  75. begin
  76. end; {mergeSort.compare}
  77.  
  78. (******************************************************************************
  79. *                             mergeSort.doYourJob                             *
  80. * here the actual sort is performed.                                          *
  81. ******************************************************************************)
  82. procedure mergeSort.doYourJob;
  83. var
  84.    i     : byte;
  85. begin
  86.    assign(mergFile, fileName);
  87.    reset(mergFile, blokSize);
  88.    i := ioResult;
  89.    if (not (i in [0, 100, 103])) then
  90.       exit; { error occured, no sort is performed }
  91.    fileSize := splitFile; { create temp1 and temp2 files from mergFile, count records in file }
  92.    { initial telem size is set in the splitFile procedure }
  93.    while (telem < fileSize) do
  94.       telem := mergeFiles(telem);
  95.    rename(t1, outputNm);
  96.    erase(t2);
  97. end; {mergeSort.doYourJob}
  98.  
  99. (******************************************************************************
  100. *                             mergeSort.splitFile                             *
  101. ******************************************************************************)
  102. function mergeSort.splitFile;
  103. var
  104.    i : longInt;
  105.    exitSplit : boolean;
  106.    writeTo1  : boolean;
  107. begin
  108.    writeTo1 := true;
  109.    i := 0;
  110.    exitSplit := false;
  111.    assign(t1, tempPath + 'mrgsrtt1.$$$');
  112.    rewrite(t1, blokSize);
  113.    if (ioResult <> 0) then
  114.       exitSplit := true;
  115.    assign(t2, tempPath + 'mrgsrtt2.$$$');
  116.    rewrite(t2, blokSize);
  117.    if (ioResult <> 0) then
  118.       exitSplit := true;
  119.    getmem(block1, blokSize);
  120.    while ((not exitSplit) and (not eof(mergFile))) do begin
  121.       blockRead(mergFile, block1^, 1);
  122.       if (writeTo1) then
  123.          blockWrite(t1, block1^, 1)
  124.       else
  125.          blockWrite(t2, block1^, 1);
  126.       writeTo1 := not writeTo1;
  127.       inc(i);
  128.    end;
  129.    close(mergFile);
  130.    close(t1);
  131.    close(t2);
  132.    splitFile := i;
  133.    freeMem(block1, blokSize);
  134.    telem := 1;
  135. end; {mergeSort.splitFile}
  136.  
  137. (******************************************************************************
  138. *                            mergeSort.mergeFiles                             *
  139. ******************************************************************************)
  140. function mergeSort.mergeFiles;
  141. var
  142.    endMerge : boolean;
  143.    writePtr : pointer;
  144.    writeTot3: boolean;
  145.    newTelem : boolean;
  146.    t1Telem,
  147.    t2Telem  : longInt;
  148.    i        : byte;
  149.  
  150.    procedure doWrite(writePtr : pointer);
  151.    begin
  152.       if (writeTot3) then
  153.          blockWrite(t3, writePtr^, 1)
  154.       else
  155.          blockWrite(t4, writePtr^, 1);
  156.    end; { doWrite }
  157.  
  158.    procedure flushBlock2;
  159.    begin
  160.       if (t2Telem = 0) then
  161.          exit;
  162.       doWrite(block2);
  163.       inc(t2Telem);
  164.       while ((t2Telem <= tSize) and (not eof(t2))) do begin
  165.          blockRead(t2, block2^, 1);
  166.          inc(t2Telem);
  167.          doWrite(block2);
  168.       end;
  169.       { rest of code to flush block 2 }
  170.    end;
  171.  
  172.    procedure flushBlock1;
  173.    begin
  174.       if (t1Telem = 0) then
  175.          exit;
  176.       doWrite(block1);
  177.       inc(t1Telem);
  178.       while ((t1Telem <= tSize) and (not eof(t1))) do begin
  179.          blockRead(t1, block1^, 1);
  180.          inc(t1Telem);
  181.          doWrite(block1);
  182.       end;
  183.       { rest of code to flush block 1 }
  184.    end;
  185.  
  186. begin
  187.    mergeFiles := 0; { 0 indicates an error, there is no such telem size }
  188.    assign(t3, tempPath + 'mrgsrtt3.$$$');
  189.    rewrite(t3, blokSize);
  190.    i := ioResult;
  191.    if (not (i in [0, 100, 103])) then 
  192.       exit;
  193.    assign(t4, tempPath + 'mrgsrtt4.$$$');
  194.    rewrite(t4, blokSize);
  195.    i := ioResult;
  196.    if (not (i in [0, 100, 103])) then 
  197.       exit;
  198.    assign(t1, tempPath + 'mrgsrtt1.$$$');
  199.    reset(t1, blokSize);
  200.    i := ioResult;
  201.    if (not (i in [0, 100, 103])) then 
  202.       exit;
  203.    assign(t2, tempPath + 'mrgsrtt2.$$$');
  204.    reset(t2, blokSize);
  205.    i := ioResult;
  206.    if (not (i in [0, 100, 103])) then 
  207.       exit;
  208.    getMem(block1, blokSize);
  209.    getMem(block2, blokSize);
  210.    getMem(writePtr, blokSize);
  211.    writeTot3 := true; { start writing to 3, so we will have 1 as the final one .. }
  212.    endMerge := false;
  213.    t1Telem := 1;
  214.    t2Telem := 1;
  215.    blockRead(t1, block1^, 1);
  216.    blockRead(t2, block2^, 1);
  217.    newTelem := false;
  218.    while (not endMerge) do begin
  219.       if (compare = 2) then begin { block2 is bigger, write block 1 first }
  220.          inc(t1Telem);
  221.          move(block1^, writePtr^, blokSize);
  222.          doWrite(writePtr);
  223.          if ((not eof(t1)) and (t1Telem <= tSize)) then
  224.             blockRead(t1, block1^, 1)
  225.          else begin
  226.             newTelem := true;
  227.             flushBlock2;
  228.          end;
  229.       end else begin
  230.          inc(t2Telem);
  231.          move(block2^, writePtr^, blokSize);
  232.          doWrite(writePtr);
  233.          if ((not eof(t2)) and (t2Telem <= tSize)) then
  234.             blockRead(t2, block2^, 1)
  235.          else begin
  236.             newTelem := true;
  237.             flushBlock1;
  238.          end;
  239.       end; { compare = 0, or 1 }
  240.       if (newTelem) then begin
  241.          writeTot3 := not writeTot3; { next telem written to other file }
  242.          newTelem := false;
  243.          if (not eof(t1)) then begin
  244.             blockRead(t1, block1^, 1);
  245.             t1Telem := 1;
  246.          end else
  247.             t1Telem := 0; { we finished t1, flush t2 if neccessary .. }
  248.          if (not eof(t2)) then begin
  249.             blockRead(t2, block2^, 1);
  250.             t2Telem := 1;
  251.          end else
  252.             t2Telem := 0; { we finished t1, flush t2 if neccessary .. }
  253.          if (t1Telem = 0) then begin
  254.             flushBlock2; { flushBlock2 does nothing if t2Telem is 0 ! }
  255.             endMerge := true;
  256.          end;
  257.          if (t2Telem = 0) then begin
  258.             flushBlock1; { flushBlock1 does nothing if t1Telem is 0 ! }
  259.             endMerge := true;
  260.          end;
  261.       end; { newTelem }
  262.    end; { while not endmerge .. }
  263.    close(t1);
  264.    close(t2);
  265.    close(t3);
  266.    close(t4);
  267.    erase(t1);
  268.    erase(t2);
  269.    rename(t3, tempPath + 'mrgsrtt1.$$$');
  270.    rename(t4, tempPath + 'mrgsrtt2.$$$');
  271.    freeMem(block1, blokSize);
  272.    freeMem(block2, blokSize);
  273.    freeMem(writePtr, blokSize);
  274.    mergeFiles := 2 * tSize;
  275. end; {mergeSort.mergeFiles}
  276.  
  277. (******************************************************************************
  278. *                                    MAIN                                     *
  279. ******************************************************************************)
  280. end.
  281.