Cod sursa(job #137757)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 17 februarie 2008 14:22:16
Problema Factoriale Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.18 kb
var f,g:text;
x:array[1..100]of byte;
a:array[1..40] of record
                     x,y:byte;
                     end;
n,m,i,k,j,l,p1,p,r,k1:integer;
q:boolean;
s:longint;
begin
assign(f,'factoriale.in');
reset(f);
readln(f,n,k1);
for i:=1 to n do
read(f,x[i]);
a[1].x:=2;r:=1;
for i:=3 to 97 do
begin
q:=true;
for j:=2 to trunc(sqrt(i)) do
if i mod j =0 then q:=false;
if q then begin inc(r); a[r].x:=i; end;
end;
{}
for i:=1 to n do
   for j:=2 to x[i] do
      begin
      l:=j;
      for k:=1 to r do
          if l mod a[k].x=0 then
                                   while l mod a[k].x=0 do
                                        begin
                                        inc(a[k].y);
                                        l:=l div a[k].x;
                                        end;
      end;
s:=1;
for i:=1 to r do
   if a[i].y mod k1 >0 then
                       begin
                        p1:=(a[i].y div k1)+1;
                        p:=(k1*p1)-a[i].y;
                        for j:=1 to p do
                              s:=s*a[i].x;
                        end;
assign(g,'factoriale.out');
rewrite(g);
writeln(g,s);
close(g);
end.