Cod sursa(job #406594)

Utilizator zseeZabolai Zsolt zsee Data 1 martie 2010 17:40:29
Problema Sortare prin comparare Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.59 kb
program fesu;
type vektor=^longint;
var n,i:longint;
    be,ki:text;
    v:vektor;
    
procedure insertsort(k,veg:integer);
  var i,j:integer;
      p:longint;
  begin
   for i:=k+1 to veg do
    begin
     p:=v[i];
     j:=i;
     while v[j-1] > p do
       begin
        v[j]:=v[j-1];
        dec(j);
        if j=k then break;
       end;
     v[j]:=p;
    end;
  end;
  
procedure rendez_fesu(var v:vektor;n:longint);
var a:vektor;
  procedure fesu(k1,k2,veg:longint);
  var i,j,k:longint;
  begin
    i:=k1;
    j:=k2;
    k:=k1;
    while (i<=k1)and(j<=veg) do
      begin
        if v[i] < v[j] then
           begin
            a[k]:=v[i];
            inc(i);
           end
            else
           begin
            a[k]:=v[j];
            inc(j);
           end;
      end;
    if i < k1+1 then
       for i:=i to k2 do
         begin
          a[k]:=v[i];
          inc(k);
         end;
    if j < veg+1 then
       for j:=j to veg do
         begin
          a[k]:=v[j];
          inc(k);
         end;
    for i:=k1 to veg do v[i]:=a[i];
  end;

  procedure rendez_r(k,veg:integer);
  var s:longint;
  begin
   if veg - k < 11 then
      begin
       insertsort(k,veg);
       exit;
      end;
   s:=(k+veg) div 2;
   rendez_r(k,s);
   rendez_r(s+1,veg);
   fesu(k,s+1,veg);
  end;

begin
 assign(be,'algsort.in');
 assign(ki,'algsort.out');
 reset(be);
 rewrite(ki);
 readln(be,n);
 getmem(v,sizeof(longint)*(n+1));
 for i:=1 to n do
    read(be,v[i]);
 shellsort;
 for i:=1 to n do
  write(ki,v[i],' ');
 close(ki);
end.