Cod sursa(job #194048)

Utilizator AndreiDDiaconeasa Andrei AndreiD Data 7 iunie 2008 23:14:19
Problema Nunta Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.29 kb
const baza=10000;
      nrc=4;
type numar=array[0..10000]of longint;
var f,g:text;
n:integer;
rez:numar;

procedure aduna(v1,v2:numar; var rez:numar);
var i,t,aux:longint;
begin
if v1[0]>v2[0] then rez[0]:=v1[0]
               else rez[0]:=v2[0];
t:=0;
for i:=1 to rez[0] do begin
		  aux:=v1[i]+v2[i]+t;
		  if aux>baza then begin
                              rez[i]:=aux-baza;
			      t:=1;
		                    end
		              else begin
			      rez[i]:=aux;
			      t:=0;
		                   end;
end;
if t>0 then begin
       inc(rez[0]);
       rez[rez[0]]:=t;
            end;
end;

procedure rezolva(var rez:numar);
var v1,v2:numar;
    i:longint;
begin
v1[0]:=1;
v1[1]:=1;
v2[0]:=1;
v2[1]:=2;
if n=1 then rez:=v1
       else if n=2 then rez:=v2
                   else for i:=1 to n-2 do
   begin
 		  aduna(v1,v2,rez);
 		  v1:=v2;
                  v2:=rez;
   end;
end;

procedure afisare(v:numar);
var i:longint;
    ss:string;
begin
write(g,v[v[0]]);
for i:=v[0]-1 downto 1 do begin
		  str(v[i],ss);
		  while length(ss)<nrc do
		  ss:='0'+ss;
        write(g,ss);
  end;
writeln(g);
end;

begin
assign(f,'nunta.in');reset(f);
assign(g,'nunta.out');rewrite(g);
read(f,n);
rezolva(rez);
afisare(rez);
close(g);
end.

end.