Cod sursa(job #480418)

Utilizator cont_de_testeCont Teste cont_de_teste Data 27 august 2010 18:04:17
Problema Sortare prin comparare Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.44 kb
type vec = array[0..500000] of longint ;
var A : vec ;
    i, N : longint ;
    f : text ;
    Bufin : array[1 .. 1 shl 17] of boolean;
Procedure QSort(var numbers :vec ;
                left : Integer; right : Integer);
Var pivot, l_ptr, r_ptr : Integer;


Begin
 l_ptr := left;
 r_ptr := right;
 pivot := numbers[left];
 While (left < right) do
  Begin
   While ((numbers[right] >= pivot) AND (left < right)) do
    right := right - 1;
   If (left <> right) then
    Begin
     numbers[left] := numbers[right];
     left := left + 1;
    End;
   While ((numbers[left] <= pivot) AND (left < right)) do
    left := left + 1;
   If (left <> right) then
    Begin
     numbers[right] := numbers[left];
     right := right - 1;
    End;
  End;
 numbers[left] := pivot;
 pivot := left;
 left := l_ptr;
 right := r_ptr;
 If (left < pivot) then
  QSort(numbers, left, pivot-1);
 If (right > pivot) then
  QSort(numbers, pivot+1, right);
End;
Procedure QuickSort(var numbers : vec; size : Integer);
Begin
 QSort(numbers, 0, size-1);
End;

   begin
     assign ( f, 'algsort.in' ) ; reset ( f ) ;
    // SetTextBuf ( f, Bufin ) ;
     readln ( f, N ) ;
     for i := 0 to N - 1 do
         read ( f, A[i] ) ;
     close ( f ) ;
     quicksort ( A, N ) ;
     assign ( f, 'algsort.out' ) ; rewrite ( f ) ;
    // SetTextBuf ( f, Bufin ) ;
     for i := 0 to N - 1 do
         write ( f, A[i], ' ' ) ;
     close ( f ) ;
   end .