Cod sursa(job #176588)

Utilizator DiaconuDiaconu Loredana Diaconu Data 11 aprilie 2008 14:41:33
Problema Factoriale Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.42 kb
var     f,g:text;
        ok:array[1..100] of boolean;
        b,a:array[1..100] of integer;
        i,j,ci,nr,z,y,x,n,k,p,res,l:integer;
        num,v,xx:array[0..200] of integer;
begin
assign(f,'factoriale.in');reset (f);
assign(g,'factoriale.out');rewrite (g);
readln (f,n,k);
for i:=1 to n do
read (f,xx[i]);
fillchar(ok,sizeof(ok),true);
for i:=2 to 100 do
 if ok[i] then begin
  ci:=i;
  while ci<=100 do begin
   ci:=ci+i;
   ok[ci]:=false;
  end;
 end;
nr:=0;
for i:=2 to 100 do
 if ok[i] then begin
  inc(nr);
  a[nr]:=i;
  b[nr]:=0;
end;
for i:=1 to n do begin
 x:=xx[i];
 for j:=1 to nr do begin
  y:=a[j];
  while y<=x do begin
   b[j]:=b[j]+(x div y);
   y:=y*a[j];
  end;
 end;
end;
num[0]:=1;
num[1]:=1;
for i:=1 to nr do begin
 z:=b[i] mod k;
 for j:=1 to z do begin
  res:=0;
  v:=num;
  for l:=1 to num[0] do begin
   p:=num[l]*a[i];
   v[l]:=(p+res) mod 10;
   res:=(p+res)div 10;
  end;
  num:=v;
  if res<>0 then begin
   inc(num[0]);
   num[num[0]]:=res;
  end;
 end;
end;
for i:=num[0] downto 1 do
 write (g,num[i]);
close(f);close(g);
end.