home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / fpkbin99.zip / DEMOS / QSORT.PAS < prev   
Pascal/Delphi Source File  |  1998-10-12  |  1KB  |  64 lines
  1. {****************************************************************************
  2.  
  3.                    Copyright (c) 1993,94 by Florian Klämpfl
  4.                    Translated by Eric Molitor (emolitor@freenet.fsu.edu)
  5.  
  6.  ****************************************************************************}
  7.  
  8. { Demonstration Program in FPKPascal }
  9.  
  10.   const
  11.      max = 1000;
  12.  
  13.   type
  14.      tlist = array[1..max] of integer;
  15.  
  16.   var
  17.      data : tlist;
  18.  
  19. procedure qsort(var a : tlist);
  20.  
  21.     procedure sort(l,r: integer);
  22.  
  23.       var
  24.          i,j,x,y: integer;
  25.  
  26.       begin
  27.          i:=l;
  28.          j:=r;
  29.          x:=a[(l+r) div 2];
  30.          repeat
  31.            while a[i]<x do i:=i+1;
  32.            while x<a[j] do j:=j-1;
  33.            if not(i>j) then
  34.              begin
  35.                 y:=a[i];
  36.                 a[i]:=a[j];
  37.                 a[j]:=y;
  38.                 i:=i+1;
  39.                 j:=j-1;
  40.              end;
  41.          until i>j;
  42.          if l<j then sort(l,j);
  43.          if i<r then sort(i,r);
  44.       end;
  45.  
  46.     begin
  47.        sort(1,max);
  48.     end;
  49.  
  50.   var
  51.      i : longint;
  52.  
  53.   begin
  54.     write('Creating ',Max,' random numbers between 1 and 30000');
  55.     randomize;
  56.     for i:=1 to max do
  57.       data[i]:=random(30000);
  58.     write(#13#10'Sorting...');
  59.     qsort(data);
  60.     writeln;
  61.     for i:=1 to max do
  62.       write(data[i]:8);
  63. end.
  64.