Cod sursa(job #404007)

Utilizator zseeZabolai Zsolt zsee Data 25 februarie 2010 17:43:06
Problema Sortare prin comparare Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 0.99 kb
program shells;
type vektor=^longint;
var n,i:longint;
    be,ki:text;
    v:vektor;
    
procedure shellsort2;
var lepes, i, j : longint;
    tempr : longint;
begin
 lepes := n;
 while lepes > 1 do //amig 1nel nagyobbakat lepunk
  begin
   if lepes < 5 then
     lepes := 1 else
        lepes := trunc( lepes / 2.2 );
   //5nel kevesebbeket mar nem lepunk...
   {*** Do linear insertion sort in steps size d ***}
   for i:=n-lepes downto 1 do
      begin
       tempr := v[i];
       j := i + lepes;
       while j <= n do
        if tempr > v[j] then
         begin
          v[j - lepes] := v[j];
          j := j + lepes
         end
          else break; {*** break ***}
       v[j - lepes] := tempr
      end
  end
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]);
 shellsort2;
 for i:=1 to n do
  write(ki,v[i],' ');
 close(ki);
end.