test/msdemo.pas

   1 program SortDemo ( Input, Output );\r
   2 uses\r
   3    Crt;\r
   4 \r
   5 const\r
   6    Max = 16;\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 ] : 3 );\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    procedure WriteLT ( Position : Integer;\r
  41                        Level    : Integer );\r
  42    begin\r
  43       GoToXY( 4 * Position - 2, Level );\r
  44       TextColor( White );\r
  45       Write( ' >' );\r
  46       TextColor( LightGray );\r
  47    end;\r
  48 \r
  49    procedure WriteBlank ( Position : Integer;\r
  50                           Level    : Integer );\r
  51    begin\r
  52       GoToXY( 4 * Position - 2, Level );\r
  53       TextColor( Black );\r
  54       Write( '   ' );\r
  55       TextColor( LightGray );\r
  56    end;\r
  57 \r
  58    procedure WriteColor ( I     : Integer;\r
  59                           Value : Integer;\r
  60                           Color : Integer;\r
  61                           Row   : Integer );\r
  62    var\r
  63       X : Integer;\r
  64    begin\r
  65       X := 4 * I - 2;\r
  66       GoToXY( X, Row );\r
  67       TextColor( Color );\r
  68       Write( Value : 3 );\r
  69       TextColor( LightGray )\r
  70    end;\r
  71 \r
  72    procedure WriteNormal ( I     : Integer;\r
  73                            Value : Integer );\r
  74    var\r
  75       X : Integer;\r
  76    begin\r
  77       X := 4 * I - 2;\r
  78       TextColor( LightGray );\r
  79       GoToXY( X, 5 );\r
  80       Write( Value : 3 )\r
  81    end;\r
  82 \r
  83 \r
  84    procedure MergeSort ( var A : ArrayType );\r
  85    {V}  var\r
  86    {V}     Level : Integer;\r
  87    {V}     I : Integer;\r
  88 \r
  89       procedure Transfer( var F, T    : ArrayType;\r
  90                               FromFirst,\r
  91                               FromLast,\r
  92                               ToFirst : Integer );\r
  93       var\r
  94          I : Integer;\r
  95       begin\r
  96          for I := FromFirst to FromLast do\r
  97             T[ ToFirst + ( I - FromFirst ) ] := F[ I ];\r
  98       end;  {Transfer}\r
  99 \r
 100       procedure Merge ( var A    : ArrayType;\r
 101                             First,\r
 102                             Last : Integer );\r
 103       var\r
 104          MidPoint,\r
 105          Left,\r
 106          Right,\r
 107          Count  : Integer;\r
 108          Temp : ArrayType;\r
 109 \r
 110       {V}   I : Integer;\r
 111       {V}   Ch : Char;\r
 112 \r
 113       begin\r
 114          Count := First;\r
 115          MidPoint := ( First + Last ) div 2;\r
 116          Left := First;\r
 117          Right := Midpoint + 1;\r
 118 \r
 119          {V}  for I := First to Midpoint do\r
 120          {V}     WriteColor( I, A[ I ], LightRed, 5 );\r
 121          {V}  for I := Right to Last do\r
 122          {V}     WriteColor( I, A[ I ], LightBlue, 5 );\r
 123          {V}  Ch := ReadKey;\r
 124 \r
 125          {V}  for I := First to Last do\r
 126          {V}     WriteBlank( I, 5 );\r
 127          {V}  for I := First to Midpoint do\r
 128          {V}     WriteColor( I, A[ I ], LightRed, 10 );\r
 129          {V}  for I := Right to Last do\r
 130          {V}    WriteColor( I, A[ I ], LightBlue, 11 );\r
 131          {V}  Ch := ReadKey;\r
 132 \r
 133          while ( Left <= Midpoint ) and ( Right <= Last ) do\r
 134          begin\r
 135             if A[ Left ] < A[ Right ] then\r
 136             begin\r
 137                Temp[ Count ] := A[ Left ];\r
 138 \r
 139                {V}  WriteColor( Count, A[ Left ], LightRed, 5 );\r
 140                {V}  WriteBlank( Left, 10 );\r
 141                {V}  Ch := ReadKey;\r
 142 \r
 143                Inc( Left );\r
 144             end\r
 145             else\r
 146             begin\r
 147                Temp[ Count ] := A[ Right ];\r
 148 \r
 149                {V}  WriteColor( Count, A[ Right ], LightBlue, 5 );\r
 150                {V}  WriteBlank( Right, 11 );\r
 151                {V}  Ch := ReadKey;\r
 152 \r
 153                Inc( Right );\r
 154             end;\r
 155             Inc( Count )\r
 156          end;\r
 157 \r
 158          if ( Left <= MidPoint ) then\r
 159          {V}  begin\r
 160             Transfer( A, Temp, Left, Midpoint, Count );\r
 161             {V}  for I := Left to Midpoint do\r
 162             {V}  begin\r
 163             {V}     WriteColor( Count, A[ I ], LightRed, 5 );\r
 164             {V}     WriteBlank( I, 10 );\r
 165             {V}     Inc( Count );\r
 166             {V}     Ch := ReadKey;\r
 167             {V}  end;\r
 168          {V} end\r
 169 \r
 170          else\r
 171          {V}  begin\r
 172             Transfer( A, Temp, Right, Last, Count );\r
 173             {V}  for I := Right to Last do\r
 174             {V}  begin\r
 175             {V}     WriteColor( Count, A[ I ], LightBlue, 5 );\r
 176             {V}     WriteBlank( I, 11 );\r
 177             {V}     Inc( Count );\r
 178             {V}     Ch := ReadKey;\r
 179             {V}  end;\r
 180          {V}   end;\r
 181 \r
 182          Transfer( Temp, A, First, Last, First );\r
 183 \r
 184 \r
 185       end;  {Merge}\r
 186 \r
 187       procedure MSort ( var A     : ArrayType;\r
 188                             First,\r
 189                             Last  : Integer );\r
 190       var\r
 191          MidPoint : Integer;\r
 192       {V}   I : Integer;\r
 193       {V}   Ch : Char;\r
 194       begin\r
 195          if First < Last then\r
 196          begin\r
 197             MidPoint := ( First + Last ) div 2;\r
 198             MSort( A, First, MidPoint );\r
 199 \r
 200             {V}  for I := First to MidPoint do\r
 201             {V}     WriteLT( I, Level );\r
 202             {V}  Inc( Level );\r
 203 \r
 204             MSort( A, MidPoint + 1, Last );\r
 205 \r
 206             {V}  for I := MidPoint + 1 to Last do\r
 207             {V}     WriteLT( I, Level );\r
 208             {V}  Inc( Level );\r
 209 \r
 210             Merge( A, First, Last );\r
 211 \r
 212             {V}  for I := MidPoint + 1 to Last do\r
 213             {V}  begin\r
 214             {V}     WriteBlank( I, Level );\r
 215             {V}     WriteBlank( I, Level - 1 );\r
 216             {V}     WriteLT( I, Level - 2 );\r
 217             {V}  end;\r
 218             {V}  Dec( Level, 2 );\r
 219 \r
 220             {V}  for I := First to Last do\r
 221             {V}     WriteNormal( I, A[ I ] );\r
 222             {V}  Ch := ReadKey\r
 223          end\r
 224       end;  {MSort}\r
 225 \r
 226    begin\r
 227       {V}  Level := 6;\r
 228 \r
 229       MSort( A, 1, Max );\r
 230 \r
 231       {V}  for I := 1 to Max do\r
 232       {V}     WriteLT( I, Level );\r
 233    end;  {MergeSort}\r
 234 \r
 235 begin\r
 236    FillArray( A );\r
 237    DisplayArray( A );\r
 238    MergeSort( A );\r
 239 end.\r
 240 \r