Cod sursa(job #13082)

Utilizator floringh06Florin Ghesu floringh06 Data 5 februarie 2007 16:28:09
Problema Factorial Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.37 kb
{$IFDEF NORMAL}
  {$I-,Q-,R-,S-}
{$ENDIF NORMAL}
{$IFDEF DEBUG}
  {$I+,Q+,R+,S-}
{$ENDIF DEBUG}
{$IFDEF RELEASE}
  {$I-,Q-,R-,S-}
{$ENDIF RELEASE}


  var fi,fo               :text;
      i,j,p,n,st,dr,vl,mj :longword;
      ok                  :boolean;



  function power(x:integer):longword;
    var i,ct:longword;
     begin
       ct:=1;
       for i:=1 to x do
         ct:=ct*5;
       power:=ct;
     end;


  function Z(n:longword):longword;
     var i,j,kmax,sum:longword;
         ct:integer;
         int:longword;
       begin
         int:=5;
         ct:=1;
         while int<n do
          begin
            int:=int*5;
            inc(ct);
          end;
         kmax:=ct-1;
         sum:=0;
         for i:=1 to kmax do
             sum:=sum+trunc(n/power(i));
         Z:=sum;
       end;




begin
 assign(fi,'fact.in'); reset(fi);
 assign(fo,'fact.out'); rewrite(fo);
 read(fi,p);
 close(fi);
 st:=1; dr:=500000000;
 ok:=false;
 if p=0 then
   begin
     write(fo,'1');
     close(fo);
     halt
   end;
 while st<dr do
   begin
    mj:=(st+dr) div 2;
    vl:=Z(mj);
    if p=vl then
      begin
       ok:=true;
       write(fo,mj-mj mod 5);
       break;
      end;
    if p<vl then dr:=mj-1;
    if p>vl then st:=mj+1;
   end;
 if ok=false then write(fo,'-1');
close(fo);
end.