Cod sursa(job #185347)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 25 aprilie 2008 09:29:14
Problema Sarpe Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.89 kb
type nr=array[1..1000000] of byte;

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

procedure inm(a,b:nr; var c:nr; nra,nrb:longint;var nrc:longint);
 var j,i,t:longint;
 begin
  fillchar(c,sizeof(byte)*nrc,0);
  for i:=1 to nra do begin
   t:=0; j:=1;
   while (j<=nrb) 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)>nrc then
    nrc:=i+j-2;
  end;
 end;

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

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

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

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