home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / games / 65 / pascal / quick.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-10-16  |  3.9 KB  |  150 lines
  1. (*                                 Quick-Sort                                *)
  2. (*                    Originally translated into Pascal by                   *)
  3. (*                                 Brian Solan                               *)
  4. (*                   Translated into OSS Personal Pascal by                  *)
  5. (*                                Mike Matthews                              *)
  6. (*                                                                           *)
  7. (*                               (anyone for C?)                             *)
  8. (*                                                                           *)
  9. (*                  Sorts 500 numbers in less than 5 seconds!                *)
  10. (*                          Do with it what you please                       *)
  11. (*                                                                           *)
  12. (*                   It's as complicated as it is fast, so I                 *)
  13. (*                   won't even try to explain how it works.                 *)
  14. (*                  Except that 'n' is the array to be sorted                *)
  15. (*                   and 's9' takes really no more than 20x2,                *)
  16. (*                              for 500 numbers.                             *)
  17. (*                        (but I have RAM to spare...)                       *)
  18. (*                                                                           *)
  19.  
  20. Program quick_sort(input,output);
  21.  
  22. type oned=array[1..5000] of integer;
  23.      twod=array[1..5000,1..2] of integer;
  24.  
  25. var i1,i,j1,j,k:integer;
  26.     p,t,amt,m:integer;
  27.     s:boolean;
  28.     n:oned;
  29.     s9:twod;
  30.     printer:file of text;
  31.     choice:char;
  32.  
  33. Function random:Long_Integer;
  34.   XBIOS(17);
  35.  
  36. Procedure switch(var a,b:integer;var s1:boolean);
  37.  
  38.   var t:integer;
  39.  
  40.   begin
  41.     t:=a;
  42.     a:=b;
  43.     b:=t;
  44.     s1:=not s1
  45.   end;
  46.  
  47. Procedure save1(var q:integer;var s8:twod;a,k1:integer);
  48.  
  49.   begin
  50.     q:=q+1;
  51.     s8[q,1]:=a+1;
  52.     s8[q,2]:=k1
  53.   end;
  54.  
  55. Procedure restore(s8:twod;var i2,j2,q:integer);
  56.  
  57.   begin
  58.     i2:=s8[q,1];
  59.     j2:=s8[q,2];
  60.     q:=q-1
  61.   end;
  62.  
  63. Procedure init(var a,b,a1,b1:integer;var es:boolean);
  64.  
  65.   begin
  66.     a:=a1;
  67.     b:=b1;
  68.     es:=false
  69.   end;
  70.  
  71. Procedure print(n:oned;choice:char);
  72.  
  73.   var i:integer;
  74.  
  75.   begin
  76.     if (choice='P') or (choice='p') then
  77.       begin
  78.         writeln(printer);
  79.         writeln(printer,'Done!');
  80.         for i:=1 to amt do
  81.           begin
  82.             write(printer,n[i],'  ');
  83.             if i mod 15=0 then writeln(printer)
  84.           end;
  85.         writeln(printer)
  86.       end
  87.     else
  88.       begin
  89.         writeln(output);
  90.         writeln(output,'Done!');
  91.         for i:=1 to amt do
  92.           begin
  93.             write(output,n[i],'  ');
  94.             if i mod 15=0 then writeln(output)
  95.           end;
  96.           writeln(output)
  97.       end
  98.   end;
  99.  
  100. Procedure sort;
  101.  
  102.   begin
  103.     repeat
  104.       if n[i]>n[j] then switch(n[i],n[j],s);
  105.       if s then i:=i+1
  106.            else j:=j-1;
  107.     until i=j;
  108.     if not(i+1>=j1) then save1(p,s9,i,j1);
  109.     j1:=i-1;
  110.     if i1<j1 then
  111.       begin
  112.         init(i,j,i1,j1,s);
  113.         sort
  114.       end;
  115.     if p<>0 then
  116.              begin
  117.                restore(s9,i1,j1,p);
  118.                init(i,j,i1,j1,s);
  119.                sort
  120.              end
  121.   end;
  122.  
  123. begin
  124.   rewrite(printer,'PRN:');
  125.   i1:=1;
  126.   p:=0;
  127.   write('Enter number to sort ? ');
  128.   readln(amt);
  129.   write('[P]rinter or [S]creen ? ');
  130.   readln(choice);
  131.   j1:=amt;
  132.   for m:=1 to amt do
  133.     begin
  134.       n[m]:=trunc((random)/16000)+1;
  135.       if (choice='P') or (choice='p') then
  136.         begin
  137.           write(printer,n[m],'  ');
  138.           if m mod 15=0 then writeln(printer)
  139.         end
  140.       else
  141.         begin
  142.           write(output,n[m],'  ');
  143.           if m mod 15=0 then writeln(output)
  144.         end
  145.     end;
  146.   init(i,j,i1,j1,s);
  147.   sort;
  148.   print(n,choice)
  149. end.
  150.