development/compilers/freepascal/demo/text/qsort.pp

   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
   6     QuickSort Example
   7
   8     See the file COPYING.FPC, included in this distribution,
   9     for details about the copyright.
  10
  11     This program is distributed in the hope that it will be useful,
  12     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14
  15  **********************************************************************}
  16 program quicksort;
  17
  18   const
  19      max = 100000;
  20
  21   type
  22      tlist = array[1..max] of longint;
  23
  24   var
  25      data : tlist;
  26
  27
  28 procedure qsort(var a : tlist);
  29
  30     procedure sort(l,r: longint);
  31       var
  32          i,j,x,y: longint;
  33       begin
  34          i:=l;
  35          j:=r;
  36          x:=a[(l+r) div 2];
  37          repeat
  38            while a[i]<x do
  39             inc(i);
  40            while x<a[j] do
  41             dec(j);
  42            if not(i>j) then
  43              begin
  44                 y:=a[i];
  45                 a[i]:=a[j];
  46                 a[j]:=y;
  47                 inc(i);
  48                 j:=j-1;
  49              end;
  50          until i>j;
  51          if l<j then
  52            sort(l,j);
  53          if i<r then
  54            sort(i,r);
  55       end;
  56
  57     begin
  58        sort(1,max);
  59     end;
  60
  61 var
  62   i : longint;
  63 begin
  64   write('Creating ',Max,' random numbers between 1 and 500000');
  65   randomize;
  66   for i:=1 to max do
  67     data[i]:=random(500000);
  68   writeln;
  69   writeln('Sorting...');
  70   qsort(data);
  71   writeln;
  72   for i:=1 to max do
  73    begin
  74      write(data[i]:7);
  75      if (i mod 10)=0 then
  76       writeln;
  77    end;
  78 end.
  79 {
  80   $Log$
  81   Revision 1.1  2002/02/19 08:24:25  sasu
  82   Initial revision
  83
  84   Revision 1.1  2000/07/13 06:30:20  michael
  85   + Initial import
  86
  87   Revision 1.1  2000/03/09 02:49:09  alex
  88   moved files
  89
  90   Revision 1.2  1998/09/11 10:55:26  peter
  91     + header+log
  92
  93 }