test/qsdemo.pas

   1 program SortDemo ( Input, Output );
   2 uses
   3    Crt;
   4
   5 const
   6    Max = 12;
   7
   8 type
   9    ArrayType = array [ 1 .. Max ] of Integer;
  10
  11 var
  12    A : ArrayType;
  13
  14    procedure DisplayArray ( var A : ArrayType );
  15    var
  16       I : Integer;
  17    begin
  18       ClrScr;
  19       GotoXY( 1, 5 );
  20       Write( '(' );
  21       for I := 1 to Max do
  22       begin
  23          Write( A[ I ] : 4 );
  24          if I <> Max then
  25             Write( ',' )
  26          else
  27             Write( ')' )
  28       end
  29    end;
  30
  31    procedure FillArray( var A : ArrayType );
  32    var
  33       I : Integer;
  34    begin
  35       Randomize;
  36       for I := 1 to Max do
  37          A[ I ] := Random( 100 )
  38    end;
  39
  40
  41    procedure WriteColor ( I     : Integer;
  42                           Value : Integer;
  43                           Color : Integer );
  44    var
  45       X : Integer;
  46    begin
  47       X := 5 * I - 3;
  48       GoToXY( X, 5 );
  49       TextColor( Color );
  50       Write( Value : 4 );
  51       TextColor( LightGray )
  52    end;
  53
  54    procedure WriteChColor ( I, J : Integer );
  55    var
  56       X : Integer;
  57    begin
  58       X := 5 * I - 1;
  59       TextColor( White );
  60       GotoXY( X, 7 );
  61       Write( 'Lo' );
  62       X := 5 * J - 1;
  63       GoToXY( X, 7 );
  64       Write( 'Hi' );
  65    end;
  66
  67
  68    procedure WriteNormal ( I     : Integer;
  69                            Value : Integer );
  70    var
  71       X : Integer;
  72    begin
  73       X := 5 * I - 3;
  74       TextColor( LightGray );
  75       GoToXY( X, 5 );
  76       Write( Value : 4 )
  77    end;
  78
  79    procedure SetDisplay ( Pivot, Lo, Hi : Integer );
  80    var
  81       Ch : Char;
  82    begin
  83       GoToXY( 1, 9 );
  84       TextColor( Green );
  85       Write( 'Pivot Value = ', Pivot : 3 );
  86       TextColor( LightRed );
  87       Write( '        Lo Index = ', Lo : 3 );
  88       TextColor( LightBlue );
  89       Write( '        Hi Index = ', Hi : 3 );
  90       WriteChColor( Lo, Hi );
  91       Ch := ReadKey;
  92       GoToXY( 1, 9 );
  93       ClrEol;
  94       GoToXY( 1, 7 );
  95       Write('                                                                  ');
  96       GoToXY( 1, 8 );
  97       Write('                                                                  ');
  98       GoToXY( 1, 9 );
  99       Write('                                                                  ');
 100       TextColor( LightGray );
 101    end;
 102
 103    procedure QuickSort ( var A       : ArrayType;
 104                              Lower,
 105                              Upper   : Integer );
 106
 107    var
 108       PivotPoint : Integer;
 109       Ch : Char;
 110       I : Integer;
 111
 112       PPos : Integer;
 113
 114       Procedure Partition ( var A          : ArrayType;
 115                                 Lo,
 116                                 Hi         : Integer;
 117                             var PivotPoint : Integer );
 118       var
 119          Pivot : Integer;
 120       begin
 121          Pivot := A[ Lo ];
 122          PPos := Lo;
 123          WriteColor( PPos, Pivot, Cyan + Black + Blink );
 124          SetDisplay( Pivot, Lo, Hi );
 125          while Lo < Hi do
 126          begin
 127             while ( Pivot < A[ Hi ] ) and ( Lo < Hi ) do
 128             begin
 129                Hi := Hi - 1;
 130                SetDisplay( Pivot, Lo, Hi );
 131             end;
 132             if Hi <> Lo then
 133             begin
 134                WriteColor( Lo, A[ Hi ], LightRed );
 135                A[ Lo ] := A[ Hi ];
 136                if Lo = PPos then
 137                begin
 138                   WriteColor( Hi, Pivot, Cyan + Black + Blink );
 139                   PPos := Hi;
 140                end;
 141                Lo := Lo + 1;
 142                SetDisplay( Pivot, Lo, Hi );
 143             end;
 144
 145             while ( Pivot > A[ Lo ] ) and ( Lo < Hi ) do
 146             begin
 147                Lo := Lo + 1;
 148                SetDisplay( Pivot, Lo, Hi );
 149             end;
 150             if Hi <> Lo then
 151             begin
 152                WriteColor( Hi, A[ Lo ], LightBlue );
 153                A[ Hi ] := A[ Lo ];
 154                if Hi = PPos then
 155                begin
 156                   WriteColor( Lo, Pivot, Cyan + Black + Blink );
 157                   PPos := Lo;
 158                end;
 159                Hi := Hi - 1;
 160                SetDisplay( Pivot, Lo, Hi );
 161             end;
 162
 163          end;
 164          WriteColor( Hi, Pivot, Yellow );
 165          Ch := ReadKey;
 166          A[ Hi ] := Pivot;
 167          PivotPoint := Hi
 168       end;
 169
 170    begin
 171       Partition( A, Lower, Upper, PivotPoint );
 172       for I := Lower to Upper do
 173          if I <> PivotPoint then
 174             WriteNormal( I, A[ I ] );
 175       if Lower < PivotPoint then
 176          QuickSort( A, Lower, PivotPoint - 1 );
 177       if Upper > PivotPoint then
 178          QuickSort( A, PivotPoint + 1, Upper )
 179    end;
 180
 181 begin
 182   FillArray( A );
 183   DisplayArray( A );
 184   QuickSort( A, 1, Max );
 185   ClrScr
 186 end.
 187