Cod sursa(job #866702)

Utilizator iu.ciocoiuIulian iu.ciocoiu Data 28 ianuarie 2013 17:17:43
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.59 kb
program sort_interclasare;
type vector=array[1..500000] of longint;
var a:vector;
    n,i:longint;
    f,g:text;

procedure sort(p,q:longint;var a:vector);
var m:longint;
begin
if (a[p]>a[q]) then begin m:=a[p];
                          a[p]:=a[q];
                          a[q]:=m;
                    end;
end;

procedure interc(p,q,m:longint; var a:vector);
var b:vector;
    i,j,k:longint;
begin
i:=p;
j:=m+1;
k:=1;
while (i<=m) and (j<=q) do
   if (a[i]<=a[j]) then begin b[k]:=a[i];
                              i:=i+1;
                              k:=k+1;
                        end
                   else begin b[k]:=a[j];
                              j:=j+1;
                              k:=k+1;
                        end;
if (i<=m) then for j:=i to m do begin b[k]:=a[j];
                                      k:=k+1;
                                end
          else for i:=j to q do begin b[k]:=a[i];
                                      k:=k+1;
                                end;
k:=1;
for i:=p to q do
   begin a[i]:=b[k];
         k:=k+1;
   end;
end;

procedure divimp(p,q:longint; var a:vector);
var m:longint;
begin
if (q-p<=1) then sort(p,q,a)
            else begin m:=(p+q) div 2;
                       divimp(p,m,a);
                       divimp(m+1,q,a);
                       interc(p,q,m,a);
                 end;
end;

begin
assign (f,'algsort.in'); reset (f);
assign (g,'algsort.out'); rewrite (g);
readln (f,n);
for i:=1 to n do read(f,a[i]);
divimp(1,n,a);
for i:=1 to n do write (g,a[i],' ');
close (f);
close (g);
end.