-program SortDemo ( Input, Output );\r
-uses\r
- Crt;\r
-\r
-const\r
- Max = 16;\r
-\r
-type\r
- ArrayType = array [ 1 .. Max ] of Integer;\r
-\r
-var\r
- A : ArrayType;\r
-\r
- procedure DisplayArray ( var A : ArrayType );\r
- var\r
- I : Integer;\r
- begin\r
- ClrScr;\r
- GotoXY( 1, 5 );\r
- Write( '(' );\r
- for I := 1 to Max do\r
- begin\r
- Write( A[ I ] : 3 );\r
- if I <> Max then\r
- Write( ',' )\r
- else\r
- Write( ')' )\r
- end\r
- end;\r
-\r
- procedure FillArray( var A : ArrayType );\r
- var\r
- I : Integer;\r
- begin\r
- Randomize;\r
- for I := 1 to Max do\r
- A[ I ] := Random( 100 )\r
- end;\r
-\r
- procedure WriteLT ( Position : Integer;\r
- Level : Integer );\r
- begin\r
- GoToXY( 4 * Position - 2, Level );\r
- TextColor( White );\r
- Write( ' >' );\r
- TextColor( LightGray );\r
- end;\r
-\r
- procedure WriteBlank ( Position : Integer;\r
- Level : Integer );\r
- begin\r
- GoToXY( 4 * Position - 2, Level );\r
- TextColor( Black );\r
- Write( ' ' );\r
- TextColor( LightGray );\r
- end;\r
-\r
- procedure WriteColor ( I : Integer;\r
- Value : Integer;\r
- Color : Integer;\r
- Row : Integer );\r
- var\r
- X : Integer;\r
- begin\r
- X := 4 * I - 2;\r
- GoToXY( X, Row );\r
- TextColor( Color );\r
- Write( Value : 3 );\r
- TextColor( LightGray )\r
- end;\r
-\r
- procedure WriteNormal ( I : Integer;\r
- Value : Integer );\r
- var\r
- X : Integer;\r
- begin\r
- X := 4 * I - 2;\r
- TextColor( LightGray );\r
- GoToXY( X, 5 );\r
- Write( Value : 3 )\r
- end;\r
-\r
-\r
- procedure MergeSort ( var A : ArrayType );\r
- {V} var\r
- {V} Level : Integer;\r
- {V} I : Integer;\r
-\r
- procedure Transfer( var F, T : ArrayType;\r
- FromFirst,\r
- FromLast,\r
- ToFirst : Integer );\r
- var\r
- I : Integer;\r
- begin\r
- for I := FromFirst to FromLast do\r
- T[ ToFirst + ( I - FromFirst ) ] := F[ I ];\r
- end; {Transfer}\r
-\r
- procedure Merge ( var A : ArrayType;\r
- First,\r
- Last : Integer );\r
- var\r
- MidPoint,\r
- Left,\r
- Right,\r
- Count : Integer;\r
- Temp : ArrayType;\r
-\r
- {V} I : Integer;\r
- {V} Ch : Char;\r
-\r
- begin\r
- Count := First;\r
- MidPoint := ( First + Last ) div 2;\r
- Left := First;\r
- Right := Midpoint + 1;\r
-\r
- {V} for I := First to Midpoint do\r
- {V} WriteColor( I, A[ I ], LightRed, 5 );\r
- {V} for I := Right to Last do\r
- {V} WriteColor( I, A[ I ], LightBlue, 5 );\r
- {V} Ch := ReadKey;\r
-\r
- {V} for I := First to Last do\r
- {V} WriteBlank( I, 5 );\r
- {V} for I := First to Midpoint do\r
- {V} WriteColor( I, A[ I ], LightRed, 10 );\r
- {V} for I := Right to Last do\r
- {V} WriteColor( I, A[ I ], LightBlue, 11 );\r
- {V} Ch := ReadKey;\r
-\r
- while ( Left <= Midpoint ) and ( Right <= Last ) do\r
- begin\r
- if A[ Left ] < A[ Right ] then\r
- begin\r
- Temp[ Count ] := A[ Left ];\r
-\r
- {V} WriteColor( Count, A[ Left ], LightRed, 5 );\r
- {V} WriteBlank( Left, 10 );\r
- {V} Ch := ReadKey;\r
-\r
- Inc( Left );\r
- end\r
- else\r
- begin\r
- Temp[ Count ] := A[ Right ];\r
-\r
- {V} WriteColor( Count, A[ Right ], LightBlue, 5 );\r
- {V} WriteBlank( Right, 11 );\r
- {V} Ch := ReadKey;\r
-\r
- Inc( Right );\r
- end;\r
- Inc( Count )\r
- end;\r
-\r
- if ( Left <= MidPoint ) then\r
- {V} begin\r
- Transfer( A, Temp, Left, Midpoint, Count );\r
- {V} for I := Left to Midpoint do\r
- {V} begin\r
- {V} WriteColor( Count, A[ I ], LightRed, 5 );\r
- {V} WriteBlank( I, 10 );\r
- {V} Inc( Count );\r
- {V} Ch := ReadKey;\r
- {V} end;\r
- {V} end\r
-\r
- else\r
- {V} begin\r
- Transfer( A, Temp, Right, Last, Count );\r
- {V} for I := Right to Last do\r
- {V} begin\r
- {V} WriteColor( Count, A[ I ], LightBlue, 5 );\r
- {V} WriteBlank( I, 11 );\r
- {V} Inc( Count );\r
- {V} Ch := ReadKey;\r
- {V} end;\r
- {V} end;\r
-\r
- Transfer( Temp, A, First, Last, First );\r
-\r
-\r
- end; {Merge}\r
-\r
- procedure MSort ( var A : ArrayType;\r
- First,\r
- Last : Integer );\r
- var\r
- MidPoint : Integer;\r
- {V} I : Integer;\r
- {V} Ch : Char;\r
- begin\r
- if First < Last then\r
- begin\r
- MidPoint := ( First + Last ) div 2;\r
- MSort( A, First, MidPoint );\r
-\r
- {V} for I := First to MidPoint do\r
- {V} WriteLT( I, Level );\r
- {V} Inc( Level );\r
-\r
- MSort( A, MidPoint + 1, Last );\r
-\r
- {V} for I := MidPoint + 1 to Last do\r
- {V} WriteLT( I, Level );\r
- {V} Inc( Level );\r
-\r
- Merge( A, First, Last );\r
-\r
- {V} for I := MidPoint + 1 to Last do\r
- {V} begin\r
- {V} WriteBlank( I, Level );\r
- {V} WriteBlank( I, Level - 1 );\r
- {V} WriteLT( I, Level - 2 );\r
- {V} end;\r
- {V} Dec( Level, 2 );\r
-\r
- {V} for I := First to Last do\r
- {V} WriteNormal( I, A[ I ] );\r
- {V} Ch := ReadKey\r
- end\r
- end; {MSort}\r
-\r
- begin\r
- {V} Level := 6;\r
-\r
- MSort( A, 1, Max );\r
-\r
- {V} for I := 1 to Max do\r
- {V} WriteLT( I, Level );\r
- end; {MergeSort}\r
-\r
-begin\r
- FillArray( A );\r
- DisplayArray( A );\r
- MergeSort( A );\r
-end.\r
-\r
+program SortDemo ( Input, Output );
+uses
+ Crt;
+
+const
+ Max = 16;
+
+type
+ ArrayType = array [ 1 .. Max ] of Integer;
+
+var
+ A : ArrayType;
+
+ procedure DisplayArray ( var A : ArrayType );
+ var
+ I : Integer;
+ begin
+ ClrScr;
+ GotoXY( 1, 5 );
+ Write( '(' );
+ for I := 1 to Max do
+ begin
+ Write( A[ I ] : 3 );
+ if I <> Max then
+ Write( ',' )
+ else
+ Write( ')' )
+ end
+ end;
+
+ procedure FillArray( var A : ArrayType );
+ var
+ I : Integer;
+ begin
+ Randomize;
+ for I := 1 to Max do
+ A[ I ] := Random( 100 )
+ end;
+
+ procedure WriteLT ( Position : Integer;
+ Level : Integer );
+ begin
+ GoToXY( 4 * Position - 2, Level );
+ TextColor( White );
+ Write( ' >' );
+ TextColor( LightGray );
+ end;
+
+ procedure WriteBlank ( Position : Integer;
+ Level : Integer );
+ begin
+ GoToXY( 4 * Position - 2, Level );
+ TextColor( Black );
+ Write( ' ' );
+ TextColor( LightGray );
+ end;
+
+ procedure WriteColor ( I : Integer;
+ Value : Integer;
+ Color : Integer;
+ Row : Integer );
+ var
+ X : Integer;
+ begin
+ X := 4 * I - 2;
+ GoToXY( X, Row );
+ TextColor( Color );
+ Write( Value : 3 );
+ TextColor( LightGray )
+ end;
+
+ procedure WriteNormal ( I : Integer;
+ Value : Integer );
+ var
+ X : Integer;
+ begin
+ X := 4 * I - 2;
+ TextColor( LightGray );
+ GoToXY( X, 5 );
+ Write( Value : 3 )
+ end;
+
+
+ procedure MergeSort ( var A : ArrayType );
+ {V} var
+ {V} Level : Integer;
+ {V} I : Integer;
+
+ procedure Transfer( var F, T : ArrayType;
+ FromFirst,
+ FromLast,
+ ToFirst : Integer );
+ var
+ I : Integer;
+ begin
+ for I := FromFirst to FromLast do
+ T[ ToFirst + ( I - FromFirst ) ] := F[ I ];
+ end; {Transfer}
+
+ procedure Merge ( var A : ArrayType;
+ First,
+ Last : Integer );
+ var
+ MidPoint,
+ Left,
+ Right,
+ Count : Integer;
+ Temp : ArrayType;
+
+ {V} I : Integer;
+ {V} Ch : Char;
+
+ begin
+ Count := First;
+ MidPoint := ( First + Last ) div 2;
+ Left := First;
+ Right := Midpoint + 1;
+
+ {V} for I := First to Midpoint do
+ {V} WriteColor( I, A[ I ], LightRed, 5 );
+ {V} for I := Right to Last do
+ {V} WriteColor( I, A[ I ], LightBlue, 5 );
+ {V} Ch := ReadKey;
+
+ {V} for I := First to Last do
+ {V} WriteBlank( I, 5 );
+ {V} for I := First to Midpoint do
+ {V} WriteColor( I, A[ I ], LightRed, 10 );
+ {V} for I := Right to Last do
+ {V} WriteColor( I, A[ I ], LightBlue, 11 );
+ {V} Ch := ReadKey;
+
+ while ( Left <= Midpoint ) and ( Right <= Last ) do
+ begin
+ if A[ Left ] < A[ Right ] then
+ begin
+ Temp[ Count ] := A[ Left ];
+
+ {V} WriteColor( Count, A[ Left ], LightRed, 5 );
+ {V} WriteBlank( Left, 10 );
+ {V} Ch := ReadKey;
+
+ Inc( Left );
+ end
+ else
+ begin
+ Temp[ Count ] := A[ Right ];
+
+ {V} WriteColor( Count, A[ Right ], LightBlue, 5 );
+ {V} WriteBlank( Right, 11 );
+ {V} Ch := ReadKey;
+
+ Inc( Right );
+ end;
+ Inc( Count )
+ end;
+
+ if ( Left <= MidPoint ) then
+ {V} begin
+ Transfer( A, Temp, Left, Midpoint, Count );
+ {V} for I := Left to Midpoint do
+ {V} begin
+ {V} WriteColor( Count, A[ I ], LightRed, 5 );
+ {V} WriteBlank( I, 10 );
+ {V} Inc( Count );
+ {V} Ch := ReadKey;
+ {V} end;
+ {V} end
+
+ else
+ {V} begin
+ Transfer( A, Temp, Right, Last, Count );
+ {V} for I := Right to Last do
+ {V} begin
+ {V} WriteColor( Count, A[ I ], LightBlue, 5 );
+ {V} WriteBlank( I, 11 );
+ {V} Inc( Count );
+ {V} Ch := ReadKey;
+ {V} end;
+ {V} end;
+
+ Transfer( Temp, A, First, Last, First );
+
+
+ end; {Merge}
+
+ procedure MSort ( var A : ArrayType;
+ First,
+ Last : Integer );
+ var
+ MidPoint : Integer;
+ {V} I : Integer;
+ {V} Ch : Char;
+ begin
+ if First < Last then
+ begin
+ MidPoint := ( First + Last ) div 2;
+ MSort( A, First, MidPoint );
+
+ {V} for I := First to MidPoint do
+ {V} WriteLT( I, Level );
+ {V} Inc( Level );
+
+ MSort( A, MidPoint + 1, Last );
+
+ {V} for I := MidPoint + 1 to Last do
+ {V} WriteLT( I, Level );
+ {V} Inc( Level );
+
+ Merge( A, First, Last );
+
+ {V} for I := MidPoint + 1 to Last do
+ {V} begin
+ {V} WriteBlank( I, Level );
+ {V} WriteBlank( I, Level - 1 );
+ {V} WriteLT( I, Level - 2 );
+ {V} end;
+ {V} Dec( Level, 2 );
+
+ {V} for I := First to Last do
+ {V} WriteNormal( I, A[ I ] );
+ {V} Ch := ReadKey
+ end
+ end; {MSort}
+
+ begin
+ {V} Level := 6;
+
+ MSort( A, 1, Max );
+
+ {V} for I := 1 to Max do
+ {V} WriteLT( I, Level );
+ end; {MergeSort}
+
+begin
+ FillArray( A );
+ DisplayArray( A );
+ MergeSort( A );
+end.
+
projects / z.facultad / 75.40 / 1er-cuat / orden.git / blobdiff