home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / MODULA2 / MERGESOR.MOD < prev    next >
Text File  |  2000-06-30  |  4KB  |  159 lines
  1. (* Natural merge sort with 3 files and 2 phases. *)
  2.  
  3. MODULE mergesort;
  4.  
  5. FROM InOut       IMPORT Write,WriteCard,WriteString,WriteInt,
  6.                         WriteLn,ReadInt,Read;
  7. FROM FileNames    IMPORT ReadFileName;
  8. FROM FileSystem  IMPORT File,Response,Close,Create,ReadWord,
  9.                         WriteWord,SetPos,GetPos,Reset,SetRead,SetWrite;
  10. FROM ByteBlockIO IMPORT WriteByteBlock,ReadByteBlock;
  11.  
  12. TYPE item = RECORD 
  13.               key : INTEGER
  14.             END;
  15.  
  16. VAR f,a,b,c : File;
  17.     n,buf: item;
  18.     FileA,FileB,FileC : ARRAY [0..10] OF CHAR;
  19.     high1,low1,high2,low2 : CARDINAL;
  20.     ch : CHAR;
  21.  
  22. PROCEDURE list(VAR f: File);
  23.   VAR x: item;
  24. BEGIN
  25.   Reset(f);
  26.   LOOP
  27.     ReadByteBlock(f,x);
  28.     IF f.eof THEN EXIT END;
  29.     WriteInt(x.key,4);
  30.     WriteString('  ');
  31.   END;
  32.   WriteLn
  33. END list; 
  34.  
  35. PROCEDURE naturalmerge;
  36.   VAR l: INTEGER;  (*no. of runs merged*)
  37.     eor: BOOLEAN; (*end-of-run indicator*)
  38.  
  39.   PROCEDURE copy(VAR x,y: File);
  40.     VAR buf,next: item;
  41.         high,low : CARDINAL; 
  42.   BEGIN 
  43.     ReadByteBlock(x, buf);
  44.     IF  x.eof THEN
  45.       eor:= TRUE 
  46.     ELSE 
  47.      WriteByteBlock(y,buf);
  48.      GetPos(x,high,low);
  49.      ReadByteBlock(x,next);
  50.      SetPos(x,high,low);
  51.      eor:= buf.key > next.key;
  52.     END
  53.   END copy;
  54.  
  55.   PROCEDURE copyrun(VAR x,y: File);
  56.   BEGIN (*copy one run from x to y*)
  57.     REPEAT copy(x,y) UNTIL eor
  58.   END copyrun;
  59.  
  60.   PROCEDURE distribute;
  61.   BEGIN (*from c to a & b*)
  62.     REPEAT
  63.       copyrun (c,a);
  64.       IF NOT c.eof THEN copyrun(c,b) END;
  65.     UNTIL c.eof;
  66.   END distribute;
  67.  
  68.   PROCEDURE mergerun;
  69.     VAR nexta,nextb : item;
  70.   BEGIN (*from a and b to c*)
  71.     REPEAT
  72.       GetPos(a,high1,low1);
  73.       ReadByteBlock(a,nexta);
  74.       SetPos(a,high1,low1);
  75.       GetPos(b,high2,low2);
  76.       ReadByteBlock(b,nextb);
  77.       SetPos(b,high2,low2);
  78.       IF nexta.key < nextb.key THEN
  79.         copy(a,c);
  80.         IF eor THEN copyrun(b,c) END
  81.       ELSE
  82.        copy(b,c);
  83.        IF eor THEN copyrun (a,c) END
  84.       END
  85.     UNTIL eor
  86.   END mergerun;
  87.  
  88.   PROCEDURE merge;
  89.   VAR dummy: item;
  90.       high,low: CARDINAL;
  91.       teof: BOOLEAN;
  92.  
  93.   BEGIN (*from a and b to c*)
  94.     REPEAT mergerun; INC(l)
  95.     UNTIL a.eof OR b.eof;
  96.     GetPos(a,high,low);
  97.     ReadByteBlock(a,dummy);
  98.     teof := a.eof;
  99.     SetPos(a,high,low);
  100.     WHILE NOT teof DO
  101.       copyrun(a,c);
  102.       INC(l);
  103.       teof := a.eof
  104.     END ;
  105.     GetPos(b,high,low);
  106.     ReadByteBlock(b,dummy);
  107.     teof := b.eof;
  108.     SetPos(b,high,low);
  109.     WHILE NOT teof DO
  110.       copyrun (b,c);
  111.       INC(l);
  112.       teof := b.eof
  113.     END;
  114.     list(c)
  115.   END merge;
  116.  
  117. BEGIN (*naturalmerge*)
  118.   REPEAT 
  119. WriteLn; WriteString('In Loop:');
  120.     Close(a);
  121.     Create(a,'DK.');
  122.     Close(b);
  123.     Create(b,'DK.');
  124.     Reset(c);
  125.     distribute;
  126.     Reset(a);
  127.     Reset(b);
  128.     Reset(c);
  129.     l := 0;
  130.     merge;
  131.   UNTIL l = 1
  132. END naturalmerge;
  133.  
  134. BEGIN (*main program. read input sequence ending with 0*)
  135.   Create(a,'DK.');
  136.   IF a.res # done THEN WriteString('FileA not opened.') END;
  137.   Create(b,'DK.');
  138.   IF b.res # done THEN WriteString('FileB not opened.') END;
  139.   Create(c,'DK.');
  140.   IF c.res # done THEN WriteString('FileC not opened.') END;
  141.   WriteString('Type in an Integer, exit by typing a 0 -> ');   
  142.   ReadInt(buf.key);
  143.   WriteLn;
  144.   REPEAT
  145.     WriteByteBlock(c,buf);
  146.     WriteString('Type in an Integer, exit by typing a 0 -> ');
  147.     ReadInt(buf.key);
  148.     WriteLn
  149.   UNTIL buf.key = 0;
  150.   list(c);
  151. WriteString('Before naturalmerge'); WriteLn;
  152.   naturalmerge;
  153. WriteString('After naturalmerge'); WriteLn;
  154.   list(c);
  155.   Close(a);
  156.   Close(b);
  157.   Close(c);
  158. END mergesort .
  159.