Cod sursa(job #138571)

Utilizator eugen.nodeaEugen Nodea eugen.nodea Data 18 februarie 2008 21:02:17
Problema Factoriale Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.16 kb
const fi='factoriale.in';
      fo='factoriale.out';
type vect=array[0..101] of word;
var f:text;
    i,x,N,k,j:byte;
    A:vect;
    M,P:longint;
{
Procedure mul(A,B:vect;var C:vect;m,n:byte;var mn:byte);
var k,i,j:integer;
begin
      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;
end;
}
Procedure desc(x:byte;var A:vect);
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,A);
     end;
     close(f);
     M:=1;
     For i:=1 to 3 do
         if A[i]>0 then
                    if A[i] Mod k<>0 then
                             M:=M*Trunc(exp((k-A[i] Mod k)*Ln(i)));
     assign(f,fo);rewrite(f);
     Write(f,M);
     close(f);
End.