home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / MEGASORT.ZIP / MEGASORT.LTG
Encoding:
Text File  |  1987-10-19  |  6.4 KB  |  268 lines
  1. Megasort: A Distribution Sort
  2.  
  3. Listing 1
  4.  
  5.     1: PROGRAM megaa; {Copyright 1986 by Steve Heller, Inc.  All rights reserved.}
  6.     2: 
  7.     3: CONST
  8.     4:   MaxSize = 5000;
  9.     5: 
  10.     6: TYPE
  11.     7:   AnyString = String[255];
  12.     8:   SomeString = String[10];
  13.     9:   StrPtrArr = ARRAY [1..MaxSize] OF ^AnyString;
  14.    10:   SortArray = ARRAY [Char] OF Integer;
  15.    11: 
  16.    12: VAR
  17.    13:   TestArray : ^StrPtrArr;
  18.    14:   TestArray2 : ^StrPtrArr;
  19.    15:   TestArray3 : ^StrPtrArr;
  20.    16:   junk : AnyString;
  21.    17:   i : Integer;
  22.    18:   infile : text[10000];
  23.    19:   infilename : AnyString;
  24.    20:   outfile : text[10000];
  25.    21:   outfilename : AnyString;
  26.    22:   KeyLen : Integer;
  27.    23:   ArrayLength : Integer;
  28.    24: 
  29.    25: PROCEDURE Megasort(VAR PtrArray:StrPtrArr; VAR SubArray1:StrPtrArr;
  30.    26:                     VAR Subarray2:StrPtrArr;
  31.    27:                     ArrayCount:Integer;KeyLength:Integer;ArraySize:Integer);
  32.    28: 
  33.    29: VAR
  34.    30:   l : Char;
  35.    31:   m : Char;
  36.    32:   i : Integer;
  37.    33:   j : Integer;
  38.    34:   BucketCount  : SortArray;
  39.    35:   BucketPosition : SortArray;
  40.    36:   TempPtrArr : ^StrPtrArr;
  41.    37:   TempSubArr1: ^StrPtrArr;
  42.    38:   TempSubArr2: ^StrPtrArr;
  43.    39: 
  44.    40: 
  45.    41: BEGIN
  46.    42: 
  47.    43:   New(TempPtrArr);
  48.    44:   New(TempSubArr1);
  49.    45:   New(TempSubArr2);
  50.    46: 
  51.    47:   FOR i := KeyLength DOWNTO 1 DO
  52.    48:     BEGIN
  53.    49:       FOR l := #0 TO #255 DO
  54.    50:         BucketCount[l] := 0;
  55.    51:       FOR j := 1 TO ArraySize DO
  56. è   52:         BEGIN
  57.    53:           IF i > length(PtrArray[j]^) THEN
  58.    54:             m := #0
  59.    55:           ELSE
  60.    56:             m := PtrArray[j]^[i];
  61.    57:           BucketCount[m] := BucketCount[m] + 1;
  62.    58:         END;
  63.    59: 
  64.    60:       BucketPosition[#0] := 1;
  65.    61:       FOR l := #1 TO #255 DO
  66.    62:         BucketPosition[l] := BucketCount[pred(l)] + BucketPosition[pred(l)];
  67.    63: 
  68.    64:       FOR j := 1 TO ArraySize DO
  69.    65:         BEGIN
  70.    66:           IF i > length(PtrArray[j]^) THEN
  71.    67:             m := #0
  72.    68:           ELSE
  73.    69:             m := PtrArray[j]^[i];
  74.    70:           TempPtrArr^[BucketPosition[m]] := PtrArray[j];
  75.    71:           IF ArrayCount >=2 THEN
  76.    72:             TempSubArr1^[BucketPosition[m]] := SubArray1[j];
  77.    73:           IF ArrayCount =3 THEN
  78.    74:             TempSubArr2^[BucketPosition[m]] := SubArray2[j];
  79.    75:           BucketPosition[m] := BucketPosition[m] + 1;
  80.    76:         END;
  81.    77: 
  82.    78:       FOR j := 1 TO ArraySize DO
  83.    79:         BEGIN
  84.    80:           PtrArray[j] := TempPtrArr^[j];
  85.    81:           IF ArrayCount >=2 THEN
  86.    82:             SubArray1[j] := TempSubArr1^[j];
  87.    83:           IF ArrayCount = 3 THEN
  88.    84:             SubArray2[j] := TempSubArr2^[j];
  89.    85:         END;
  90.    86: 
  91.    87:     END;
  92.    88: 
  93.    89:     Dispose(TempPtrArr);
  94.    90:     Dispose(TempSubArr1);
  95.    91:     Dispose(TempSubArr2);
  96.    92: 
  97.    93:   END;
  98.    94: 
  99.    95: 
  100.    96: 
  101.    97: 
  102.    98: BEGIN
  103.    99:   New(TestArray);
  104.   100: 
  105.   101:   Write('Input file name: ');
  106.   102:   ReadLn(infilename);
  107.   103:   Write('Output file name: ');
  108.   104:   ReadLn(outfilename);
  109.   105:   Write('Key length: ');
  110.   106:   ReadLn(KeyLen);
  111. è  107:   Assign(infile,infilename);
  112.   108:   Reset(infile);
  113.   109:   Assign(outfile,outfilename);
  114.   110:   Rewrite(outfile);
  115.   111: 
  116.   112:   WriteLn('Reading input file.');
  117.   113: 
  118.   114:   i := 0;
  119.   115:   WHILE NOT EOF(infile) DO
  120.   116:     BEGIN
  121.   117:       i := i + 1;
  122.   118:       ReadLn(infile,junk);
  123.   119:       GetMem(TestArray^[i],length(junk)+1);
  124.   120:       TestArray^[i]^ := junk;
  125.   121:     END;
  126.   122: 
  127.   123:   ArrayLength := i;
  128.   124: 
  129.   125:   WriteLn('Sorting.');
  130.   126: 
  131.   127:   Megasort(TestArray^,TestArray^,TestArray^,1,KeyLen,ArrayLength);
  132.   128: 
  133.   129:   WriteLn('Writing output file.');
  134.   130: 
  135.   131:   FOR i := 1 TO ArrayLength DO
  136.   132:     WriteLn(outfile,TestArray^[i]^);
  137.   133: 
  138.   134:   Close(infile);
  139.   135:   Close(outfile);
  140.   136: 
  141.   137:   WriteLn('Done.');
  142.   138: 
  143.   139: END.
  144.  
  145.  
  146. Listing 2
  147.  
  148. Listing 2
  149.  
  150. {SORTDAT.PAS - generates sort data for MEGASORT testing}
  151. {861223 :2200}
  152.  
  153. VAR
  154.   i,j : Integer;
  155.   ir  : Real;
  156.   s : String[255];
  157.   t : Text[10000];
  158.   n : Real;
  159.   Itype : Char;
  160.   MaxLength : Integer;
  161.   Ran : Char;
  162.   RealTemp : Real;
  163.   IntTemp : Integer;
  164.   RealExp : ARRAY [-30..30] OF Real;
  165.   FName   : String[80];
  166. èBEGIN
  167.   RealExp[-30] := 1E-30;
  168.   FOR i := -29 TO 30 DO
  169.     RealExp[i] := RealExp[i-1]*10;
  170.   Write('Name of data file to be generated: ');
  171.   ReadLn(FName);
  172.   Write('Number of items to generate: ');
  173.   ReadLn(n);
  174.   Write('Type of items (R for real, I for integer, S for string): ');
  175.   ReadLn(Itype);
  176.   Itype := Upcase(Itype);
  177.  
  178.   IF Itype = 'S' THEN
  179.     BEGIN
  180.       Write('Maximum length of strings: ');
  181.       ReadLn(MaxLength);
  182.       Write('Random string length or all maximum length (R or M): ');
  183.       ReadLn(Ran);
  184.       Ran := Upcase(Ran);
  185.     END;
  186.  
  187.   Assign(t,Fname);
  188.   Rewrite(t);
  189.   ir := 1.0;
  190.   REPEAT
  191.     BEGIN
  192.       IF ir = 1000*int(ir/1000) THEN WriteLn(ir:10:0);
  193.       IF Itype = 'S' THEN
  194.         BEGIN
  195.           s := '';
  196.           IF Ran = 'R' THEN
  197.             FOR j := 1 TO random(MaxLength) DO
  198.               s := s + chr(random(64)+32)
  199.           ELSE
  200.             FOR j := 1 TO MaxLength DO
  201.               s := s + chr(random(64)+32);
  202.           WriteLn(t,s);
  203.         END
  204.       ELSE IF Itype = 'R' THEN
  205.         BEGIN
  206.           RealTemp := Random;
  207.           IF Random > 0.5 THEN
  208.             RealTemp := -RealTemp;
  209.           IntTemp := Random(30);
  210.           RealTemp := RealTemp * RealExp[IntTemp];
  211.           Str(RealTemp,s);
  212.           IF RealTemp > 0 THEN
  213.             s := copy(s,3,length(s))
  214.           ELSE
  215.             s := copy(s,2,length(s));
  216.           WriteLn(t,s);
  217.         END
  218.       ELSE IF Itype = 'I' THEN
  219.         BEGIN
  220.           IntTemp := Random(32767);
  221. è          IF Random >0.5 THEN
  222.             IntTemp := -IntTemp;
  223.           Str(IntTemp,s);
  224.           WriteLn(t,s);
  225.         END;
  226.     END;
  227.     ir := ir + 1.0;
  228.   UNTIL ir > n;
  229.   Close(t);
  230. END.
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.                                                     MEGAA.PAS page 3
  271.  
  272.