Cod sursa(job #1201810)

Utilizator Ysaika2Neacsu stefan Ysaika2 Data 26 iunie 2014 09:12:47
Problema Sortare prin comparare Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.29 kb
program multe_sortari;
type vector=array[1..50] of integer;
var v,w:vector; nr,n:integer;  f:text;
procedure citire(var v:vector; n,i,j:integer);
var m:integer;
begin

  if i=j then read(f,v[i])
  else
    begin m:=(i+j) div 2;
          citire(v,n,i,m);
          citire(v,n,m+1,j);
    end;

end;
procedure afisare(n:integer; var v:vector);
begin

  if n>0 then
    begin
      afisare((n-1),v);
      write(f,v[n],' ');
    end;

    end;

procedure pozitionare(var v:vector;n,p,u:integer; var poz:integer);
var i,j,aux,x,k:integer;
begin
  i:=p;
  j:=u;      x:=0;
  while i<j do
    begin nr:=nr+1;
          if v[i]>v[j] then
             begin aux:=v[i];
                   v[i]:=v[j];
                   v[j]:=aux;
                   x:=x+1;
             end;
             if x mod 2=0 then j:=j-1
             else i:=i+1;
      end;
      poz:=i;
end;
procedure quick_sort(var v:vector;p,u:integer);
var poz:integer;
begin

  if p<u then
    begin
       pozitionare(v,n,p,u,poz);
       quick_sort(v,p,poz-1);
       quick_sort(v,poz+1,u);
    end;
end;

begin
assign(f,'algsort.in'); reset(f);
 read(f,n);
    citire(v,n,1,n);
close(f);

    w:=v;
assign(f,'algsort.out'); rewrite(f);
    quick_sort(w,1,n);
    afisare(n,w);

close(f);
end.