← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to demo/text/qsort.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2001-08-29 23:15:17 UTC
  • Revision ID: james.westby@ubuntu.com-20010829231517-thxsp7ctuab584ia
Tags: upstream-1.0.4
Import upstream version 1.0.4

Show diffs side-by-side

added added

removed removed

Lines of Context:
demo/text/qsort.pp
 
1
{
 
2
    $Id: qsort.pp,v 1.1 2000/07/13 06:30:20 michael Exp $
 
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: qsort.pp,v $
 
81
  Revision 1.1  2000/07/13 06:30:20  michael
 
82
  + Initial import
 
83
 
 
84
  Revision 1.1  2000/03/09 02:49:09  alex
 
85
  moved files
 
86
 
 
87
  Revision 1.2  1998/09/11 10:55:26  peter
 
88
    + header+log
 
89
 
 
90
}