Cod sursa(job #124304)

Utilizator Data 18 ianuarie 2008 20:04:58
Problema Sarpe Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.82 kb
const nmax=1000001;
type vector=array[1..nmax]of byte;
var fi,fo:text;
    s:ansistring;
    nr,a,rez:vector;
    i,j:longint;
    n1,n2,nrelem,c:int64;
    e:integer;
procedure aduna(var a:vector; var n:int64; valoare:int64);
var aux,rest:int64;
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;
     end;
  if rest<>0 then
    begin
      inc(n);
      a[nmax-n+1]:=rest;
    end;
end;
procedure scade(var a:vector; var n:int64; valoare:int64);
var aux,rest,poz:int64;
    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:int64; b,c:vector; n1,n2:int64);
var poz,aux,uc,j,i:int64;
begin
  poz:=0; aux:=0;
  i:=nmax;
  while i>=nmax-n1+1 do
    begin
      j:=nmax;
      while j>=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;
          dec(j);
        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);
      dec(i);
    end;
    nr:=nmax-(j-poz+1)+1;
    if a[nmax-nr]<>0 then inc(nr);
end;
procedure inmultire2(var a:vector; var n:int64; valoare:int64);
var aux,rest:int64;
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
      val(s[i],nr[nmax-c+i],e);
      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.