home *** CD-ROM | disk | FTP | other *** search
/ Hacker Chronicles 2 / HACKER2.BIN / 458.NETSORT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-01-25  |  2KB  |  75 lines
  1. function comp(var p,q : log_type): boolean;
  2. var test : boolean;
  3. begin
  4.   test := false;
  5.   case comparison of
  6.     0  : if ((p.suffix = q.suffix) AND ((p.prefix+p.area) < (q.prefix+q.area)))
  7.             OR (p.suffix < q.suffix)
  8.          then test := true;
  9.     1  : if ( (p.area < q.area) OR
  10.             ( (p.area = q.area) AND (p.suffix < q.suffix) ) OR
  11.             ( (p.area = q.area) AND (p.suffix = q.suffix)
  12.               AND (p.prefix < q.prefix) ) )
  13.            THEN test := true;
  14.     end;
  15.   comp := test;
  16. end;
  17.  
  18. procedure qsort(var x: net_array; m,n : integer);
  19. var  i,j : integer;
  20.  
  21.   procedure partit(var a: net_array; var i,j : integer;
  22.                    left, right: integer);
  23.   var pivot: log_type;
  24.  
  25.     procedure swap (var p,q : log_type);
  26.     var  hold : log_type;
  27.     begin
  28.       hold := p;
  29.       p := q;
  30.       q := hold;
  31.     end;
  32.  
  33.   begin
  34.     pivot := a[(left+right) div 2]^;
  35.     i := left;
  36.     j := right;
  37.     while ( i <= j) do
  38.     begin
  39.       while (comp(a[i]^, pivot)) do
  40.       i := i + 1;
  41.       while (comp(pivot, a[j]^)) do
  42.         j := j - 1;
  43.         if (i <= j ) then
  44.         begin
  45.           swap(a[i]^,a[j]^);
  46.           i := i + 1;
  47.           j := j - 1;
  48.         end;
  49.     end;
  50.   end;
  51.  
  52. begin { qsort }
  53.   if (m < n) then
  54.   begin
  55.     partit(x,i,j,m,n);
  56.     qsort(x,m,j);
  57.     qsort(x,i,n);
  58.   end;
  59. end;
  60.  
  61. procedure sort(var x: net_array; n : integer);
  62. begin
  63.   comparison := 0;
  64.   write('Sorting by suffix, prefix, area');
  65.   qsort(x,1,n);
  66. end;
  67.  
  68. procedure re_sort(var x: net_array; n : integer);
  69. begin
  70.   comparison := 1;
  71.   write('Sorting by area, suffix, prefix');
  72.   qsort(x,1,n);
  73. end;
  74.  
  75.