Cod sursa(job #139344)
Utilizator | Data | 19 februarie 2008 23:30:27 | |
---|---|---|---|
Problema | Factoriale | Scor | 100 |
Compilator | fpc | Status | done |
Runda | Arhiva de probleme | Marime | 1.9 kb |
const fi='factoriale.in';
fo='factoriale.out';
nmax=30000;
p:array[1..25] of byte=
( 2,3,5,7,11,13,17,19,23,29,
31,37,41,43,47,53,59,61,67,71,
73,79,83,89,97 );
type
vec=array[1..25] of longint;
vect=array[0..nmax] of integer;
var f:text;
r,t,i,x,N,k,j,y,L:longint;
Ap:vec;
A:vect;
Begin
assign(f,fi); reset(f);
Readln(f,N,K);
For i:=1 To N do
begin
Read(f,x);
j:=0;
repeat
j:=j+1;
t:=p[j];
while x div t<>0 do
begin
Ap[j]:=Ap[j]+(x div t);
t:=t*p[j];
end;
until p[j]>=x;
end;
close(f);
L:=1;A[1]:=1;
For i:=1 to 25 do
if Ap[i]>0 then begin
r:=Ap[i] Mod k;
if r<>0 then
for j:=1 to k-r do
begin
for y:=1 to L do
A[y]:=A[y]*p[i];
for y:=1 to L-1 do
begin
A[y+1]:=A[y+1]+(A[y] div 10);
A[y]:=A[y] mod 10;
end;
while A[L]>10 do
begin
L:=L+1;
A[L]:=A[L-1] div 10;
A[L-1]:=A[L-1] mod 10;
end;
end;
end;
assign(f,fo);rewrite(f);
for i:=L downto 1 do
write(f,A[i]);
close(f);
End.