Cod sursa(job #137997)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 17 februarie 2008 19:07:01
Problema Factoriale Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.24 kb
program alex;
const p:array[1..25]of longint=
(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);
var f:text;
    j,i,t,k,x,n,r,y:longint;
    c:array[1..25]of longint;
    pr:array[1..30000]of integer;
begin
assign(f,'factoriale.in');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
          c[j]:=c[j]+(x div t);
          t:=t*p[j];
          end;
    until p[j]>=x;
    end;
close(f);
pr[1]:=1;
x:=1;
for i:=1 to 25 do
    if c[i]<>0 then begin
                    r:=c[i] mod k;
                    if r<>0 then for j:=1 to k-r do
                                     begin
                                     for y:=1 to x do
                                         begin
                                         pr[y]:=(pr[y]*p[i])mod 10;
                                         pr[y+1]:=pr[y+1]+(pr[y]*p[i])div 10;
                                         end;
                                     if pr[y+1]<>0 then x:=x+1;
                                     end;
                    end;
assign(f,'factoriale.out');rewrite(f);
for i:=x downto 1 do
    write(f,pr[i]);
close(f);
end.