Pagini recente » Cod sursa (job #1119291) | Cod sursa (job #2344231) | Cod sursa (job #2004886) | Cod sursa (job #533908) | Cod sursa (job #138724)
Cod sursa(job #138724)
const fi='factoriale.in';
fo='factoriale.out';
nmax=10000;
type
vec=array[2..nmax] of longint;
vect=array[0..nmax] of shortint;
var f:text;
i,x,N,k,j,y:integer;
A,B,C:vect;
Ap:vec;
Procedure mul(A:vect;var B:vect);
var k,i,j,n,m:integer;
begin
m:=B[0]; n:=A[0];
For i:=0 to m+n do
C[i]:=0;
k:=0;
For j:=m downto 1 do
begin
for i:=n downto 1 do
C[n-i+1+k]:=C[n-i+1+k]+A[i]*B[j];
k:=k+1;
end;
For i:=1 to m+n-1 do
if C[i]>=10 then begin
C[i+1]:=C[i+1]+C[i] Div 10;
C[i]:=C[i] Mod 10;
end;
if C[n+m]<>0 then C[0]:=n+m
else C[0]:=n+m-1;
For i:=C[0] downto 1 do
B[C[0]-i+1]:=C[i];
B[0]:=C[0];
end;
Procedure desc(x:byte;var A:vec);
var e,d:byte;
begin
d:=2;
repeat
e:=0;
while x Mod d=0 do
begin
e:=e+1;
x:=x Div d;
end;
if e>0 then A[d]:=A[d]+e;
d:=d+1;
until x=1;
end;
Begin
assign(f,fi); reset(f);
Readln(f,N,K);
For i:=1 To N do
begin
Read(f,x);
for j:=2 to x do
desc(j,Ap);
end;
close(f);
B[0]:=1; B[1]:=1;
For i:=2 to nmax do
if Ap[i]>0 then
if Ap[i] Mod k<>0 then
begin
x:=1;
For j:=1 to k-(Ap[i] Mod k) do
x:=x*i;
y:=x; j:=0;
while y>0 do
begin
j:=j+1;
y:=y Div 10;
end;
A[0]:=j;
while x>0 do
begin
A[j]:=x Mod 10;
j:=j-1;
x:=x Div 10;
end;
mul(A,B);
end;
assign(f,fo);rewrite(f);
for i:=1 to B[0] do
write(f,B[i]);
close(f);
End.