Cod sursa(job #41740)

Utilizator savimSerban Andrei Stan savim Data 28 martie 2007 15:32:45
Problema Order Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.48 kb
var a:array[1..30000] of integer;
    f1,f2:text;
    gas,h,p,d,n,i:integer;
begin
assign(f1,'order.in');
assign(f2,'order.out');
reset(f1);
rewrite(f2);
readln(f1,n);
for i:=1 to n do
 a[i]:=i;
d:=0;p:=1;
repeat
 gas:=0;
 d:=d+1;
 h:=0;
 while h<d do
  begin
   if p=n then p:=1
          else p:=p+1;
   if a[p]<>0 then h:=h+1;
  end;
 writeln(f2,a[p]);a[p]:=0;
 for i:=1 to n do
  if a[i]>0 then begin gas:=1;break;end;
until gas=0;

close(f1);
close(f2);
end.