Cod sursa(job #139344)

Utilizator eugen.nodeaEugen Nodea eugen.nodea 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.