Cod sursa(job #29771)

Utilizator salgau_catalinSalgau Mihai-Catalin salgau_catalin Data 9 martie 2007 22:07:24
Problema Factorial Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.01 kb
{$I-,OBJECTCHECKS-,Q-,R-,S-}
program factorial;
const v:array[1..13] of longint=
              (5,
              25,
             125,
             625,
            3125,
           15625,
           78125,
          390625,
         1953125,
         9765625,
        48828125,
       244140625,
      1220703125);
var r,k,a,b,c,p,s,i:longint;
function f(n:longint):longint;
begin
 k:=0;
 for i:=1 to s do
  inc(k,trunc(n/v[i]));
 f:=k;
end;
begin
 assign(input,'fact.in');
 reset(input);
 readln(p);
 close(input);
 assign(output,'fact.out');
 rewrite(output);
 if p=0 then begin writeln(1); close(output); exit; end;
 b:=p*5+1;
 a:=1;
 s:=13;
 while (b/v[s])<1 do dec(s);
 //function
 c:=(a+b) div 2;
 r:=f(c);
 while r<>p do
  begin
   if a=b then begin writeln(-1); close(output); halt; end;
   if r<p then a:=c+1 else b:=c-1;
   c:=a div 2+b div 2;
   r:=f(c);
  end;
 c:=c-(c mod 5);
 while f(c)>p do dec(c,5);
 if f(c)<p then writeln(-1) else writeln(c);
 close(output);
end.