Cod sursa(job #78419)

Utilizator tebanadrianteban adrian tebanadrian Data 17 august 2007 17:59:30
Problema Factorial Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.73 kb
program factorial1;
var p:byte;
 procedure citire;
 var f:text;
 begin
 assign(f,'fact.in');
 reset(f);
 read(f,p);
 close(f);
 end;
 function unu(p:byte):byte;
 var n,c,s,i:integer;
 begin
 n:=1;
 repeat
 c:=0;
 s:=1;
 for i:= 1 to n do
 begin
 s:=s*i;
 if s mod 10=0 then
 begin
 inc(c);
 s:= s div 10;
 end;
 if s>2000 then
 s:=s mod 1000;
 end;
 inc(n);
 until p=c;
 if p=c then
 unu:=n-1;
 end;

 function det(p:byte):integer;
 var i,n,c:byte;
     s:word;
 begin
 if p>1 then
 det:=unu(p);
 if p=1 then
 det:=5;
 if p=0 then
 det:=1;
 end;
 procedure afisare;
 var f:text;
 begin
 assign(f,'fact.out');
 rewrite(f);
 write(f,det(p));
 close(f);
 end;
 begin
 citire;
 afisare;
 end.