Cod sursa(job #124316)

Utilizator Data 18 ianuarie 2008 20:20:36
Problema Sarpe Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.89 kb
const nmax=1000001;
      cifre:array['0'..'9']of byte=(0,1,2,3,4,5,6,7,8,9);
type vector=array[1..nmax]of byte;
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 a:vector; var nr:longint; b,c:vector; n1,n2:longint);
var poz,aux,uc,j,i:longint;
begin
  poz:=0; aux:=0;
  for i:=nmax downto nmax-n1+1 do
    begin
      for j:=nmax downto nmax-n2+1 do
        begin
          uc:=(c[j]*b[i]+aux) mod 10;
          if uc+a[j-poz]>9 then
            begin
              inc(a[j-1-poz],(uc+a[j-poz]) div 10);
              a[j-poz]:=(a[j-poz]+uc) mod 10;
            end
          else
            a[j-poz]:=a[j-poz]+uc;
            aux:=(c[j]*b[i]+aux) div 10;
        end;
        j:=nmax-n1+1;
        while aux<>0 do
          begin
            uc:=aux mod 10;
            dec(j);
            a[j-poz]:=a[j-poz]+uc;
            aux:=aux div 10;
          end;
        inc(poz);
    end;
    nr:=nmax-(j-poz+1)+1;
    if a[nmax-nr]<>0 then inc(nr);
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;
begin
  assign(fi,'sarpe.in'); reset(fi);
  assign(fo,'sarpe.out'); rewrite(fo);
  read(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);
        aduna(rez,nrelem,4);
        for i:=nmax-nrelem+1 to nmax do
          write(fo,rez[i]);
     end;
  close(fi);
  close(fo);
end.