Cod sursa(job #170139)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 2 aprilie 2008 14:01:08
Problema Factoriale Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.22 kb
var f,g:Text;
    v,p:array[1..1000]of longint;
    y,t,la,ci,l,s,max,n,k,x,ck,d,i,j:longint;
begin
assign(f,'factoriale.in');
assign(g,'factoriale.out');
reset(f);
rewrite(g);
read(f,n,s);
max:=2;
for i:=1 to n do
  begin
    read(f,x);
    for k:=2 to x do
      begin
        ck:=k;
        while (ck mod 2=0)do
          begin
            inc(v[2]);
            ck:=ck div 2;
          end;
        d:=3;
        while(d<=k) do
          begin
            while (ck mod d=0) do
              begin
                inc(v[d]);
                ck:=ck div d;
              end;
            if (d>max)then maX:=d;
            inc(d,2);
          end;
      end;
  end;

l:=1;
p[1]:=1;
for i:=2 to max do
  begin
  if (v[i] mod s<>0)then
    begin
      for j:=1 to s-(v[i]mod s)do
        begin
          t:=0;
          for y:=1 to l do
            begin
              p[y]:=p[y]*i+t;
              t:=p[y] div 10;
              p[y]:=p[y] mod 10;
            end;
          while (t>0)do
            begin
              inc(l);
              p[l]:=t mod 10;
              t:=t div 10;
            end;
        end;
    end;
  end;
for i:=l downto 1 do write(g,p[i]);
close(f);
close(g);
end.