Cod sursa(job #189472)

Utilizator luigiPacala luigi Data 14 mai 2008 17:35:44
Problema Factorial Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.76 kb
var  f:text;
     p,r,fac,facc,b,rr:int64;
begin
assign(f ,'fact.in');
reset(f);
read(f,p);
close(f);
r:=1;
fac:=5;
while r<p do
begin
r:=r+fac;
fac:=fac*5;
end;
b:=fac div 5;
rr:=r-b;
assign(f ,'fact.out');
rewrite(f);
if r=p then
write(f,fac)
else
begin
if r-p>p-rr then
 begin
  while (p<>r) and (p<r) do
   begin
    facc:=fac;
    while facc mod 5=0 do
     begin
      facc:=facc div 5;
      r:=r-1;
     end;
    fac:=fac-5;
   end;
 end
  else
 begin
  while (p<>rr) and (rr<p) do
   begin
    facc:=b;
    while facc mod 5=0 do
     begin
      facc:=facc div 5;
      rr:=rr+1;
     end;
    b:=b+5;
   end;
 end;
if r=p then
write(f,fac)
 else
if rr=p then
write(f,b)
else
write(f,'-1');
close(f);
end;
end.