Cod sursa(job #202015)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 5 august 2008 16:24:49
Problema Factoriale Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.31 kb
var v:array[1..10000]of longint;
    p,t:array[1..100]of longint;
    n,i,j,k,a,q,l,o,x,u:longint;
    f:text;
begin
   assign(f,'factoriale.in');
   reset(f);
   read(f,n,k);
   for i:=2 to 100 do
   begin
   x:=0;
   for j:=1 to trunc(sqrt(i)) do
   if i mod j=0 then x:=x+1;
   if x=1 then begin u:=u+1;
                     p[u]:=i;
               end;
   end;
   for i:=1 to n do
   begin
   read(f,a);
   for l:=1 to a do
   begin
   q:=l;
   j:=1;
   while q>1 do
   begin
   while q mod p[j]>0 do
   j:=j+1;
   q:=q div p[j];
   t[j]:=t[j]+1;
   end;
   end;
   end;
   close(f);
   v[1]:=1;
   o:=1;
   for i:=1 to u do
   if t[i] mod k>0 then begin for j:=1 to k-t[i] mod k do
                              begin
                              q:=0;
                              a:=0;
                              repeat
                              a:=a+1;
                              v[a]:=v[a]*p[i]+q;
                              q:=v[a] div 10;
                              v[a]:=v[a] mod 10;
                              until(q=0)and(a>=o);
                              o:=a;
                              end;
                        end;
   assign(f,'factoriale.out');
   rewrite(f);
   for i:=o downto 1 do
   write(f,v[i]);
   writeln(f);
   close(f);
end.