Cod sursa(job #296204)

Utilizator mlazariLazari Mihai mlazari Data 4 aprilie 2009 14:10:08
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.43 kb
Program Algsort;
var n : longint;
    A,B : array[0..500000] of longint; { B - pentru interclasare }

procedure Citeste;
var Intrare : text;
    i : longint;
begin
  assign(Intrare,'algsort.in');
  reset(Intrare);
  readln(Intrare,n);
  for i:=1 to n do read(Intrare,A[i]);
  close(Intrare);
end;

procedure Interclasare(i1,i2,i3 : longint);
{ Interclaseaza A[i1..i2] cu A[i2+1..i3] }
var i,j,k : longint;
begin
  i:=i1;
  j:=i2+1;
  k:=i1;
  while k<=i3 do begin
    if i>i2 then begin { Daca prima parte s-a terminat }
      B[k]:=A[j];
      j:=j+1;
    end
    else
     if j>i3 then begin { Daca a doua parte s-a terminat }
       B[k]:=A[i];
       i:=i+1;
     end
     else
      if A[i]<=A[j] then begin { Daca elementul din prima parte e mai mic }
        B[k]:=A[i];
        i:=i+1;
      end
      else begin { Daca elementul din a doua parte e mai mic }
        B[k]:=A[j];
        j:=j+1;
      end;
    k:=k+1;
  end;
  for i:=i1 to i3 do A[i]:=B[i];
end;

procedure MergeSort(i1,i2 : longint);
var mij : longint;
begin
  if i2>i1 then begin
    mij:=(i1+i2) div 2;
    MergeSort(i1,mij);
    MergeSort(mij+1,i2);
    Interclasare(i1,mij,i2);
  end;
end;

procedure Scrie;
var Iesire : text;
    i : longint;
begin
  assign(Iesire,'algsort.out');
  rewrite(Iesire);
  for i:=1 to n do write(Iesire,A[i],' ');
  close(Iesire);
end;

begin
  Citeste;
  MergeSort(1,n);
  Scrie;
end.