Cod sursa(job #124494)

Utilizator Data 19 ianuarie 2008 14:29:35
Problema Sarpe Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.83 kb
const nmax=2002;
      cifre:array['0'..'9']of byte=(0,1,2,3,4,5,6,7,8,9);
type vector=array[1..nmax]of integer;
var fi,fo:text;
    s:ansistring;
    nr,a,rez:vector;
    i,j:longint;
    n1,n2,nrelem,c:longint;
    e:integer;
procedure aduna(var a:vector; var n:longint; valoare:longint);
var aux,rest:longint;
begin
  rest:=valoare;
  for i:=nmax downto nmax-n+1 do
     begin
       aux:=a[i]+rest;
       a[i]:=aux mod 10;
       rest:=aux div 10;
       if rest=0 then exit;
     end;
  if rest<>0 then
    begin
      inc(n);
      a[nmax-n+1]:=rest;
    end;
end;
procedure scade(var a:vector; var n:longint; valoare:longint);
var aux,rest,poz:longint;
    j:longint;
begin
  rest:=valoare;
  for i:=nmax downto nmax-n+1 do
    begin
      if a[i]<rest then
        begin
          poz:=i-1;
          while a[poz]=0 do
            dec(poz);
          dec(a[poz]);
          for j:=poz+1 to i-1 do
            a[j]:=9;
          a[i]:=a[i]+10-rest;
          if a[nmax-n+1]=0 then dec(n);
          exit;
        end
      else
        begin
          a[i]:=a[i]-rest;
          exit;
        end;
    end;
end;
procedure inmultire(var rez:vector; var n:longint; a,b:vector; n1,n2:longint);
var i,j,t,poz:longint;
begin
  poz:=0;
  t:=0;
  for i:=nmax downto nmax-n1+1 do
    begin
      for j:=nmax downto nmax-n2+1 do
        begin
          rez[j-poz]:=rez[j-poz]+(a[i]*b[j]+t) mod 1000;
          t:=(a[i]*b[j]+t) div 1000;
        end;
      j:=nmax-n2+1;
      while t<>0 do
        begin
          dec(j);
          rez[j-poz]:=rez[j-poz]+ (t mod 1000);
          t:=t div 1000;
        end;
      inc(poz);
    end;
  n:=nmax-(j-poz+1)+1;
end;
procedure inmultire2(var a:vector; var n:longint; valoare:longint);
var aux,rest:longint;
begin
  rest:=0;
  for i:=nmax downto nmax-n+1 do
    begin
      aux:=a[i] shl 1+rest;
      a[i]:=aux mod 10;
      rest:=aux div 10;
    end;
  while rest<>0 do
    begin
      inc(n);
      a[nmax-n+1]:=rest mod 10;
      rest:=rest div 10;
    end;
end;
procedure solv(var rez:vector; n:longint);
var t,i,j,rest:longint;
begin
  t:=0; rez[nmax]:=rez[nmax]+4;
  for i:=nmax downto nmax-n+1 do
    begin
      rest:=rez[i]+t;
      rez[i]:=rest mod 10;
      t:=rest div 10;
    end;
  for i:=nmax-n+1 to nmax do
    write(fo,rez[i]);
end;
begin
  assign(fi,'sarpe.in'); reset(fi);
  assign(fo,'sarpe.out'); rewrite(fo);
  readln(fi,s);
  c:=length(s);
  for i:=1 to c do
    begin
      nr[nmax-c+i]:=cifre[s[i]];
      a[nmax-c+i]:=nr[nmax-c+i]; end;
  if (length(s)=1)and(a[nmax]=1) then write(fo,'2')
    else
      begin
        n1:=length(s); n2:=length(s);
        scade(a,n2,1);
        inmultire2(a,n2,2);
        inmultire(rez,nrelem,a,nr,n2,n1);
        solv(rez,nrelem);
     end;
  close(fi);
  close(fo);
end.