qsort.pp 1.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1993-98 by the Free Pascal Development Team
  5. QuickSort Example
  6. See the file COPYING.FPC, included in this distribution,
  7. for details about the copyright.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. **********************************************************************}
  12. program quicksort;
  13. const
  14. max = 100000;
  15. type
  16. tlist = array[1..max] of longint;
  17. var
  18. data : tlist;
  19. procedure qsort(var a : tlist);
  20. procedure sort(l,r: longint);
  21. var
  22. i,j,x,y: longint;
  23. begin
  24. i:=l;
  25. j:=r;
  26. x:=a[(l+r) div 2];
  27. repeat
  28. while a[i]<x do
  29. inc(i);
  30. while x<a[j] do
  31. dec(j);
  32. if not(i>j) then
  33. begin
  34. y:=a[i];
  35. a[i]:=a[j];
  36. a[j]:=y;
  37. inc(i);
  38. j:=j-1;
  39. end;
  40. until i>j;
  41. if l<j then
  42. sort(l,j);
  43. if i<r then
  44. sort(i,r);
  45. end;
  46. begin
  47. sort(1,max);
  48. end;
  49. var
  50. i : longint;
  51. begin
  52. write('Creating ',Max,' random numbers between 1 and 500000');
  53. randomize;
  54. for i:=1 to max do
  55. data[i]:=random(500000);
  56. writeln;
  57. writeln('Sorting...');
  58. qsort(data);
  59. writeln;
  60. for i:=1 to max do
  61. begin
  62. write(data[i]:7);
  63. if (i mod 10)=0 then
  64. writeln;
  65. end;
  66. end.
  67. {
  68. $Log$
  69. Revision 1.2 2002-09-07 15:06:35 peter
  70. * old logs removed and tabs fixed
  71. }