Cod sursa(job #137763)

Utilizator andreivFMI - vacaroiu andrei andreiv Data 17 februarie 2008 14:27:39
Problema Factoriale Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.65 kb
var x,n,k,d,p,i,j,max,h,j1:longint;
    f,g:text;
    ct:array[1..100] of longint;
    a:array[1..100] of longint;
begin
assign(f,'factoriale.in'); reset(f);
assign(g,'factoriale.out'); rewrite(g);
readln(f,n,k);  p:=1;
for i:=1 to n do  begin
read(f,x); if max<x then max:=x;
 for j:=2 to x do   begin
 j1:=j;
  for h:=2 to trunc(sqrt(j1)) do
  while j1 mod h=0 do  begin
  ct[h]:=ct[h]+1;
  j1:=j1 div h;
  end;
 if j1>=2 then ct[j1]:=ct[j1]+1;
  end;
end;
for i:=2 to max do
if ct[i]>0 then while ct[i] mod k<>0 do  begin
                      p:=p*i;
                      ct[i]:=ct[i]+1;         end;
write(g,p);
close(f); close(g);
end.