Cod sursa(job #137300)

Utilizator CezarMocanCezar Mocan CezarMocan Data 17 februarie 2008 11:07:21
Problema Factoriale Scor 100
Compilator fpc Status done
Runda preONI 2008, Runda 4, Clasele 5-8 Marime 1.53 kb
type nr_mare=array[0..10000] of longint;
var n,k,i,j:longint;
    v,x,y:array[0..120] of longint;
    rez:nr_mare;

procedure desc(t:longint);
var d:longint;
begin
while t mod 2=0 do
        begin
        inc(v[2]);
        t:=t div 2;
        end;
d:=3;
while t>1 do
        begin
        while t mod d<>0 do
                inc(d,2);
        while t mod d=0 do
                begin
                inc(v[d]);
                t:=t div d;
                end;
        end;
end;

procedure mult(var v:nr_mare;x:longint);
var i:longint;
begin
for i:=1 to v[0] do
        v[i]:=v[i]*x;
for i:=1 to v[0] do
        begin
        inc(v[i+1],v[i] div 10);
        v[i]:=v[i] mod 10;
        end;
if v[v[0]+1]>0 then
        inc(v[0]);
while v[v[0]]>9 do
        begin
        v[v[0]+1]:=v[v[0]] div 10;
        v[v[0]]:=v[v[0]] mod 10;
        inc(v[0]);
        end;
end;

begin
assign(input,'factoriale.in');reset(input);
assign(output,'factoriale.out');rewrite(output);
readln(n,k);
for i:=1 to n do
        read(x[i]);
for i:=1 to n do
        for j:=2 to x[i] do
                desc(j);
for i:=2 to 100 do
        if v[i]<>0 then
                begin
                y[i]:=k-(v[i] mod k);
                if y[i]=k then
                        y[i]:=0;
                end;
//tre sa calculez produsu i^y[i]
rez[0]:=1;rez[1]:=1;
for i:=1 to 100 do
        for j:=1 to y[i] do
                mult(rez,i);
for i:=rez[0] downto 1 do
        write(rez[i]);
writeln;
close(input);close(output);
end.