Cod sursa(job #67978)

Utilizator mihaelams1Mihaela Rusu mihaelams1 Data 26 iunie 2007 11:04:04
Problema Factorial Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.55 kb
type pt=record
x,y:longint;
end;
var a:array[1..15] of pt;
f:text;
n,p,i,j,t:longint;

procedure gen;
begin
if i=1 then a[i].y:=25
else a[i].y:=a[i-1].y*5;
if i=1 then a[i].x:=6
else a[i].x:=a[i-1].x*5+1;
end;

begin
assign(f,'fact.in');
reset(f);
read(f,p);
close(f);
assign(f,'fact.out');
rewrite(f);
n:=p;
i:=0;
repeat
inc(i);
gen;
until a[i].x>p;
for j:=i-1 downto 1 do
n:=n-(n div a[j].x);
t:=5*n;
for j:=1 to i do
n:=n+t div a[j].y;
if n<>p then write(f,-1)
else if p<>0 then write(f,t)
else write(f,1);
close(f);
end.