Cod sursa(job #185340)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 25 aprilie 2008 09:06:05
Problema Sarpe Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.73 kb
type nr=array[0..1000000] of integer;

var a,b,rez,aux:nr;
    f,g:text;
    i,w:longint;
    ch:char;

procedure inm(a,b:nr; var c:nr);
 var j,i,t:longint;
 begin
  for i:=0 to c[0] do
   c[i]:=0;
  i:=1;
  while (i<=a[0]) do begin
   t:=0; j:=1;
   while (j<=b[0]) or (t<>0) do begin
    t:=t+c[i+j-1]+a[i]*b[j];
    c[i+j-1]:=t mod 10;
    inc(j);
    t:=t div 10;
   end;
   if (i+j-2)>c[0] then
    c[0]:=i+j-2;
   inc(i);
  end;
 end;

procedure adun(a,b:nr; var c:nr);
 var i,t:longint;
 begin
  i:=1; t:=0;
  while (i<=a[0]) or (i<=b[0]) or (t<>0) do begin
   t:=t+a[i]+b[i];
   c[i]:=t mod 10;
   inc(i);
   t:=t div 10;
  end;
  c[0]:=i-1;
 end;

procedure inm2(var a:nr; b:longint);
 var i,t:longint;
 begin
  i:=1; t:=0;
  while (i<=a[0]) or (t<>0) do begin
   t:=t+a[i] shl b;
   a[i]:=t mod 10;
   inc(i);
   t:=t div 10;
  end;
  a[0]:=i-1;
 end;

procedure scad(a,b:nr; var c:nr);
 var i,t:longint;
 begin
  t:=0; i:=1;
  while (i<=a[0]) do begin
   a[i]:=a[i]-b[i]-t;
   t:=a[i];
   if t<0 then
    t:=1
   else
    t:=0;
   c[i]:=t*10+a[i];
   inc(i);
  end;
  c[0]:=a[0];
  while (c[0]>=1) and (c[c[0]]=0) do
   dec(c[0]);
 end;

begin
 assign(f,'sarpe.in'); reset(f);
 assign(g,'sarpe.out'); rewrite(g);
 a[0]:=0;
 while not(eoln(f)) do begin
  inc(a[0]);
  read(f,ch);
  a[a[0]]:=ord(ch)-ord('0');
 end;
 for i:=1 to a[0]  shr 1 do begin
  w:=a[i];
  a[i]:=a[a[0]-i+1];
  a[a[0]-i+1]:=w;
 end;
 b[0]:=1;
 b[1]:=1;
 scad(a,b,rez);
 scad(rez,b,aux);
 inm2(rez,1);
 inm(rez,aux,rez);
 inm2(a,2);
 adun(rez,a,rez);
 if (a[1]=4) and (a[0]=1) then begin
  rez[0]:=1;
  rez[1]:=2;
 end;
 for i:=rez[0] downto 1 do
  write(g,rez[i]);
 close(f); close(g);
end.