Cod sursa(job #388506)

Utilizator mimarcelMoldovan Marcel mimarcel Data 30 ianuarie 2010 12:45:51
Problema Factorial Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.23 kb
const max5=13;
var p5:array[0..max5]of longint;
    p,p2,p3:longint;
    i:byte;

procedure crearep5;
begin
p5[0]:=1;
for i:=1 to max5 do p5[i]:=p5[i-1]*5;
end;

function verifica(n:longint):longint;
begin
p2:=0;
i:=1;
while i<=max5 do
  begin
  p3:=n div p5[i];
  if p3=0 then break;
  p2:=p2+p3;
  i:=i+1;
  end;
verifica:=p2;
end;

procedure sol;
var n1,n2,n,r:longint;
begin
if p=0 then begin
            write('1');
            exit;
            end;
n1:=1;
if(maxlongint-7) div p>=5then n2:=p*5
                         else n2:=maxlongint-7;
n:=1;
r:=p;
while n1<=n2 do
  begin
  n:=n1+(n2-n1)div 2;
  while n mod 5<>0 do dec(n);
  r:=verifica(n);
  if r=p then break
         else if r<p then begin
                          n1:=n+1;
                          while n1 mod 5<>0 do inc(n1);
                          end
                     else begin
                          n2:=n-1;
                          while n2 mod 5<>0 do dec(n2);
                          end;
  end;
if r<>p then write('-1')
        else write(n);
end;

begin
assign(input,'fact.in');
reset(input);
assign(output,'fact.out');
rewrite(output);
read(p);
crearep5;
sol;
close(output);
close(input);
end.