Cod sursa(job #124367)

Utilizator Data 18 ianuarie 2008 23:01:47
Problema Sarpe Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.14 kb
const nmax=2002;
type vector=array[1..nmax]of byte;
const v:array['0'..'9']of byte=(0,1,2,3,4,5,6,7,8,9);
var fi,fo:text;
    cifre:array[1..nmax]of byte;
    st,dr,c,rez1,rez2,rez3:array[1..nmax]of byte;
    i,j:longint;
    ct,ok:longint;
    s:string;
function max(a,b:longint):longint;
begin
  if a>b then max:=a
         else max:=b;
end;
procedure adunare(var c:vector; var nrelem:int64; a,b:vector; nr1,nr2:int64);
var uc,aux:int64;
    nrel:int64;
begin
  nrel:=max(nr1,nr2);
  aux:=0;
  for i:=nmax downto nmax-nrel+1 do
    begin
      uc:=(a[i]+b[i]+aux) mod 10;
      c[i]:=uc;
      aux:=(a[i]+b[i]+aux) div 10; end;
  nrelem:=nmax-nrel+1;
  while aux<>0 do
    begin
      dec(nrelem);
      c[nrelem]:=aux mod 10;
      aux:=aux div 10;
    end;
  nrelem:=nmax-nrelem+1;
end;
procedure scadere(var c:vector; var nrelem:int64; a,b:vector; nr1,nr2:int64);
var nrel,uc,poz:int64;
begin
  nrel:=nr1;
  for i:=nmax-nr1+1 to nmax-nr2 do
    b[i]:=0;
  for i:=nmax downto nmax-nrel+1 do
    if b[i]>a[i] 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;
          uc:=(a[i]+10-b[i])mod 10;
          c[i]:=uc;
       end
    else
       begin
          uc:=(a[i]-b[i]) mod 10;
          c[i]:=uc;
       end;
  nrelem:=nrel;
  if c[nmax-nrelem+1]=0 then dec(nrelem);
  if nrelem=0 then inc(nrelem);
end;
procedure inmultire(var c:vector; var nrelem:int64; a,b:vector; nr1,nr2:int64);
var poz,aux,uc:int64;
    i:longint;
begin
  if ok=1 then
    for i:=nmax-nrelem+1 to nmax do
      c[i]:=0
  else ok:=1;
  poz:=0; aux:=0; nrelem:=maxint;
  for i:=nmax downto nmax-nr2+1 do
    begin
      for j:=nmax downto nmax-nr1+1 do
         begin
           uc:=(a[j]*b[i]+aux) mod 10;
           if uc+c[j-poz]>9 then
             begin
               inc(c[j-1-poz],(uc+c[j-poz]) div 10);
               c[j-poz]:=(c[j-poz]+uc) mod 10;
             end
         else
           c[j-poz]:=c[j-poz]+uc;
           aux:=(a[j]*b[i]+aux) div 10;
         end;
      j:=nmax-nr1+1;
      while aux<>0 do
        begin
          uc:=aux mod 10;
          dec(j);
          c[j-poz]:=c[j-poz]+uc;
          aux:=aux div 10;
        end;
      inc(poz);
    end;
  nrelem:=nmax-(j-poz+1)+1;
  if c[nmax-nrelem]<>0 then inc(nrelem);
end;
procedure calc;
var n1,n2,nn1,nn2,nn3:int64;
begin
  dr[nmax]:=1; n1:=1; st[nmax]:=2; n1:=1;
  scadere(rez1,nn1,cifre,dr,length(s),n1);
  scadere(rez2,nn2,cifre,st,length(s),n2);
  inmultire(rez3,nn3,rez1,rez2,nn1,nn2);
  dr[nmax]:=2; n1:=1;
  inmultire(rez3,nn3,rez3,dr,nn3,n1);
  dr[nmax]:=4; n1:=1;
  inmultire(rez2,nn2,cifre,dr,length(s),n1);
  adunare(rez1,n2,rez3,rez2,nn3,nn1);
  for i:=nmax-n2+1 to nmax do
     write(fo,rez1[i]);
end;
begin
  assign(fi,'sarpe.in'); reset(fi);
  assign(fo,'sarpe.out'); rewrite(fo);
  read(fi,s); ok:=0;
  ct:=nmax-length(s)+1;
  for i:=1 to length(s) do
    begin
      cifre[ct]:=v[s[i]];
      inc(ct);
    end;
  if (length(s)=1)and(cifre[nmax]=1) then writeln(fo,'2')
    else calc;
  close(fi);
  close(fo);
end.