test/qsdemo.pas

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