Cod sursa(job #24357)

Utilizator ScrazyRobert Szasz Scrazy Data 2 martie 2007 09:48:46
Problema Factorial Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.93 kb
var  p,n,b,i,f,x:longint;
     be,ki:text;
     igaz:boolean;

function binker(e,u,mit:longint):longint;
var k,x,f:longint;
begin
  if e>u then binker:=0
    else begin
      k:=(e+u) div 2;
      x:=1;
      f:=0;
      while trunc(k/x)<>0 do begin
        x:=x*5;
        f:=f+trunc(k/x);

      end;


      if mit=f then
        binker:=k
      else if mit<f then binker:=binker(e,k-1,mit)
           else binker:=binker(k+1,u,mit);
    end;
end;


begin
  assign(be,'fact.in');
  reset(be);
  readln(be,p);
  close(be);
  b:=binker(1,5000000,p);
  i:=b;
  igaz:=true;
  while (i>1)and igaz do begin
    i:=i-1;
    x:=5;
    f:=0;
    while trunc(i/x)<>0 do begin
        f:=f+trunc(i/x);
        x:=x*x;
    end;
    if p<>f then igaz:=false;
  end;
  assign(ki,'fact.out');
  rewrite(ki);



  if p=0 then writeln(ki,'1');
  if i=0 then writeln(ki,'-1')
   else writeln(ki,i+1);
  close(ki);
end.