Cod sursa(job #202814)

Utilizator Cristian_BBerceanu Cristian Cristian_B Data 11 august 2008 17:34:28
Problema Factorial Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.88 kb
var f,g: text;
    i,p,n:longint;
    a:array[1..1000000000] of longint;
function p_5(x:longint):longint;
var cnt:longint;
begin
if x=0 then p_5:=0
else
begin
cnt:=0;
while x mod 5=0 do
 begin
  cnt:=cnt+1;
  x:=x div 5;
 end;
P_5:=cnt;
end;
end;
procedure gen_a;
begin
a[1]:=0;a[2]:=0;a[3]:=0;a[4]:=0;a[5]:=1;
 for i:=6 to 1000 do
 if i mod 5=0 then
  a[i]:=a[i-1]+p_5(i)
  else
  a[i]:=a[i-1];


end;
procedure c{aut_binar}(p:longint;var n:longint);
var m,a1,b:longint;
begin
a1:=1;b:=1000;
m:=a1+(b-a1) div 2;
while (p<>a[m]) and (a1<=b) do
begin
 if p<a[m] then
  b:=m-1
  else
  a1:=m+1;
m:=a1+(b-a1) div 2;
end;
if p=a[m] then
 begin
 i:=m;
 while a[i]=p do
 i:=i-1;
 n:=i+1;
 end
 else
 n:=-1;
end;

BEGIN
assign(f,'fact.in'); reset(f);
assign(g,'fact.out'); rewrite(g);
read(f,p);
gen_a;
c(p,n);
write(g,n);
close(f);close(g);
end.