Cod sursa(job #202941)

Utilizator Andrei200Andrei200 Andrei200 Data 12 august 2008 12:57:58
Problema Factoriale Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.91 kb
var prim:array[0..30000]of longint;
    r,m,p,x,n,mm,k:int64;
    q,w,i,j:longint;
    vec:array[1..10000] of longint;
    rez:int64;
    f:text;
begin
 assign(f,'factoriale.in');reset(f);
 readln(f,mm,k);
 for w:=1 to mm do begin
 read(f,n);
 prim[1] := 2; m := 1; p := 3;
 while p <=n do begin
  i := 1;
  while i <= m do
    if p mod prim[i] = 0 then i := n
      else i := i + 1;
   if i <> n then begin
    m := m + 1; prim[m] := p;
   end;
  p := p + 2;
 end;
 for i := 1 to m  do begin
  q := prim[i];
  r := 0; x := n div q;
  while x > 0 do begin
     r := r + x; x := x div q;
  end;
  if r > 0 then
  vec[q]:=vec[q]+r;
  //writeln(q,' ', r);
 end;
 end;
 close(f);
 assign(f,'factoriale.out');rewrite(f);
 rez:=1;
 for i:=2 to 100 do
 if vec[i]>0 then //writeln(i,' ',vec[i]);
 //rez:=1;
  for q:=2 to (k-k mod vec[i]) do
  rez:=rez*i;
  writeln(f,rez);
 close(f);
end.