Cod sursa(job #191931)

Utilizator DiaconuDiaconu Loredana Diaconu Data 29 mai 2008 20:30:33
Problema Factoriale Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.07 kb
var     f,g:text;
        i,j,l,uc,b,y,n,k,cj,ci,max,z:longint;
        nr,v,a:array[1..10000] of longint;
        ok:array[1..1000] of boolean;
begin
assign (f,'factoriale.in');reset (f);
assign (g,'factoriale.out');rewrite (g);
readln (f,n,k);
max:=0;
for i:=1 to n do begin
 read (f,v[i]);
 if v[i]>max then max:=v[i];
end;
fillchar (a,sizeof(a),0);
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;
for i:=1 to n do
 for j:=2 to max do begin
  cj:=j;
  if ok[j] then begin
  while v[i]>=cj do begin
   a[j]:=a[j]+(v[i] div cj);
   cj:=cj*j;
  end;
  end;
 end;
fillchar(nr,sizeof(nr),0);
nr[1]:=1;
y:=1;
for i:=1 to 100 do begin
  z:=a[i] mod k;
  if z<>0 then z:=k-z;
  for j:=1 to z do begin
   uc:=0;
   for l:=1 to y do begin
    b:=nr[l]*i+uc;
    uc:=b div 10;
    nr[l]:=b mod 10;
   end;
   if uc<>0 then begin
    inc (y);
    nr[y]:=uc;
   end;
  end;
end;
for i:=y downto 1 do
 write (g,nr[i]);
close(f);close(g);
end.