Cod sursa(job #177727)

Utilizator luigiPacala luigi Data 13 aprilie 2008 15:28:57
Problema Factorial Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.73 kb
var f:text;
    p,r,fac,facc,q,n:longint;

begin
assign(f ,'fact.in');
reset(f);
read(f,p);
close(f);
r:=0;
fac:=1;
while r<p do
 begin
  r:=r+fac;
  fac:=fac*5;
  q:=r-(fac div 5);
  facc:=fac div 5;
 end;
assign(f ,'fact.out');
rewrite(f);
if r=p then
write(f,fac)
 else
begin
 if p-q<r-q then
  Begin
   while q<p do
    begin
     n:=facc;
     while n mod 5=0 do
      begin
       n:=n div 5;
       q:=q+1;
      end;
     facc:=facc+5;
    end;
  End
   else
   while r>p do
    begin
    n:=fac;
     while n mod 5=0 do
      begin
      n:=n div 5;
      r:=r+1;
      end;
     fac:=fac-5;
    end;
 if (r=p) or (q=p) then
  write(f,fac)
   else
  write(f,'-1');
end;
close(f);
end.