Cod sursa(job #137183)

Utilizator 7RaduRadu Antohi 7Radu Data 17 februarie 2008 09:46:31
Problema Factoriale Scor 10
Compilator fpc Status done
Runda preONI 2008, Runda 4, Clasele 5-8 Marime 1.78 kb
program Factoriale;
var
   Fl : text;
   prim : array[1..100] of char;
   a : array[1..100] of longint;
   b : array[1..100] of longint;
   n, i, s, j, k, p, m, pr, pr_k, l_k : longint;

procedure Gen_prime;
var
   i : integer;
begin
   for i := 1 to 100 do
     begin
        prim[i] := '1';
        a[i] := 0;
        b[i] := 0;
     end;

   i := 4;
   while i <= 100 do
      begin
         prim[i] := '0';
         i := i + 2;
      end;

   i := 3;
   while i <= 50 do
      begin
         j := 3;
         while j <= 100 div i do
            begin
               prim[i*j] := '0';
               j := j + 2;
            end;
          i := i + 2;
      end;

   prim[2] := '1';
   prim[1] := '0';

   k := 0;
   for i := 1 to 100 do
      if prim[i] = '1' then
         begin
            k := k + 1;
            a[k] := i;
         end;
   pr := k;
end;
begin
   Gen_prime;

   assign(fl,'factoriale.in');
   reset(fl);
   readln(fl,n,k);
   l_k := 1;
   for i := 1 to n do
      begin
         read(fl,p);
         for j := 2 to p do
           begin
              m := j;
              pr_k := 1;
              while m > 1 do
                 begin
                    if (m mod a[pr_k]  = 0) then
                        begin
                           m := m div a[pr_k];
                           b[pr_k] := b[pr_k] + 1;
                        end
                     else
                        pr_k := pr_k + 1;
                     if pr_k > l_k then
                        l_k := pr_k;
                    end;
            end;
      end;


   s := 1;
  for i := 1 to l_k do
     for j := 1 to (b[i] mod k) do
        s := s * a[i];

  assign(fl,'factoriale.out');
  rewrite(fl);
  writeln(fl,s);
  close(Fl);
end.