Cod sursa(job #137601)

Utilizator ProtomanAndrei Purice Protoman Data 17 februarie 2008 12:47:04
Problema Factoriale Scor 100
Compilator fpc Status done
Runda preONI 2008, Runda 4, Clasele 5-8 Marime 1.83 kb
var f1,f2:text;
    i,j,n,k,h,x,r:longint;
    ok:boolean;
    v,f,el:array[0..110] of longint;
    rz:array[0..100000] of longint;

procedure calcpr;
var i:longint;
begin
        for i:=2 to 100 do
        begin
                ok:=true;
                for j:=2 to trunc(sqrt(i)) do
                        if i mod j=0 then
                                ok:=false;
                if ok=true then
                begin
                        inc(v[0]);
                        v[v[0]]:=i;
                end;
        end;
end;

procedure inmultire(x:longint);
var i:longint;
begin
        for i:=1 to h do
        begin
                rz[i]:=rz[i]*x+r;
                r:=rz[i] div 10;
                rz[i]:=rz[i] mod 10;
        end;
        while r>0 do
        begin
                inc(h);
                rz[h]:=r mod 10;
                r:=r div 10;
        end;
end;

begin
        assign(f1,'factoriale.in');
        reset(f1);
        assign(f2,'factoriale.out');
        rewrite(f2);
        read(f1,n,k);
        for i:=1 to n do
                read(f1,f[i]);
        calcpr;
        for i:=1 to v[0] do
        begin
                x:=v[i];
                while x<=100 do
                begin
                        for j:=1 to n do
                                el[v[i]]:=el[v[i]]+f[j] div x;
                        x:=x*v[i];
                end;
        end;
        for i:=1 to 100 do
        begin
                if el[i] mod k>0 then
                        el[i]:=k-(el[i] mod k)
                else el[i]:=0;
        end;
        h:=1;
        rz[1]:=1;
        for i:=1 to 100 do
                for j:=1 to el[i] do
                        inmultire(i);
        for i:=h downto 1 do
                write(f2,rz[i]);
        close(f1);
        close(f2);
end.