Cod sursa(job #43003)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 29 martie 2007 18:43:48
Problema 12-Perm Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.21 kb
Program cel;
Type vector=array[0..5000] of integer;
var f,g:text;
    a,b,c,d,e,ee:vector;
    n,i:longint;
procedure transformare(var x:vector;y:longint);
Begin
x[0]:=0;
While y<>0 do
 Begin
  inc(x[0]);
  x[x[0]]:=y mod 10;
  y:=y div 10;
 end;
end;

procedure adunare(x,y:vector;var z:vector);
var i,t:longint;
Begin
i:=1;
t:=0;
While (i<=x[0]) or (i<=y[0]) or (t>0) do
 Begin
  t:=t+x[i]+y[i];
  z[i]:=t mod 10;
  t:=t div 10;
  inc(i);
 end;
z[0]:=i-1;
end;

Begin
Assign(f,'12perm.in');Reset(f);
Assign(g,'12perm.out');Rewrite(g);
Read(f,n);
If n=1 then write(g,1);
If n=2 then Write(g,2);
If n=3 then Write(g,5);
If n=4 then Write(g,12);
If n>4 then Begin
             transformare(a,2);
             transformare(c,5);
             transformare(b,12);
             For i:=5 to n do
              Begin
               If i mod 2=1 then adunare(a,b,d)
                            else adunare(b,c,d);
               transformare(e,2*(i-2));
               adunare(d,e,ee);
               If i mod 2=1 then a:=b
                            else c:=b;
               b:=ee;
              end;
             end;
For i:=ee[0] downto 1 do Write(g,ee[i]);
Close(f);
Close(g);
end.