Cod sursa(job #689151)

Utilizator vasi30Axinte Vasilica vasi30 Data 24 februarie 2012 10:26:47
Problema Factorial Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.77 kb
Program factorial;
var n,i1:word;f,g:text;aux,p1:longint;
    p:longint;k:boolean;
Function fact(x:longint):longint;
var prod:longint;i:byte;
begin
  prod:=1;
  for i:=1 to x do
    prod:=prod*i;
  fact:=prod;
end;
Function count(x:longint):longint;
var c:byte;s:longint;m:boolean;
begin
  m:=true;
  s:=0;
  while (x<>0) and (m=true) do
    begin
      c:=x mod 10;
      if c<>0 then m:=false
              else
      if c=0 then inc(s);
      x:=x div 10;
    end;
  count:=s;
end;
begin
  assign(f,'fact.in');
  assign(g,'fact.out');
  reset(f);rewrite(g);
  read(f,p);
  k:=false;
  i1:=0;
  while k=false do
  begin
    inc(i1);
    aux:=fact(i1);
    if count(aux)=p then
    begin
      write(i1);
      k:=true;
    end;
  end;
end.