Cod sursa(job #137565)

Utilizator vanila_CPPIonescu Victor Cristian vanila_CPP Data 17 februarie 2008 12:41:27
Problema Factoriale Scor 80
Compilator fpc Status done
Runda preONI 2008, Runda 4, Clasele 5-8 Marime 3.33 kb
program factoriale;
type vector=array[0..1001] of integer;
var f,g:text;
        n,k:longint;
        rez:vector;
        nrprime:longint;
        ex:array[1..101] of longint;
        prime:array[1..101] of longint;






procedure iofile;
var i,x,y,ind,xx:longint;
begin
        assign(f,'factoriale.in');reset(f);
        assign(g,'factoriale.out');rewrite(g);
        fillchar(ex,sizeof(ex),0);
        readln(f,n,k);
        for i:=1 to n do
                begin
                        read(f,y);
                        for xx:=2 to y do
                        begin
                        ind:=1;
                        x:=xx;
                        while (x<>1)and(prime[ind]<=trunc(sqrt(x)))and(ind<=nrprime) do
                                begin
                                        while (x mod prime[ind]=0) do
                                                begin
                                                        x:=x div prime[ind];
                                                        inc(ex[prime[ind]]);
                                                end;
                                        inc(ind);
                                end;
                        if x<>1 then
                                begin
                                        inc(ex[x]);
                                        x:=1;
                                end;
                        end;
                end;
        close(f);
end;

function prim(x:longint):boolean;
var d:longint;
begin
        if (x=1)or(x=0) then prim:=false else
        begin
                prim:=true;
                for d:=2 to trunc(sqrt(x)) do
                        if x mod d=0 then
                                begin
                                        prim:=false;
                                        exit;
                                end;
        end;
end;


procedure inmultire(var v:vector;nr:longint);
var i,x,t:longint;
begin
        t:=0;
        for i:=1 to v[0] do
                begin
                        x:=v[i]*nr+t;
                        v[i]:= x mod 10;
                        t:=x div 10;
                end;
        while t<>0 do
                begin
                        inc(v[0]);
                        v[v[0]]:=t mod 10;
                        t:= t div 10;
                end;
end;



procedure preprocesare;
var i:longint;
begin
        nrprime:=0;
        for i:=2 to 100 do
                if (i mod 2=1)or(i=2) then
                        if prim(i) then
                                begin
                                        inc(nrprime);
                                        prime[nrprime]:=i;
                                end;
end;


procedure solve;
var i,j:longint;
begin
        rez[0]:=1;
        rez[1]:=1;
        for i:=1 to 100 do
                if ex[i]<>0 then
                        begin
                                if ex[i] mod k<>0 then
                                        for j:=1 to (k-ex[i] mod k) do
                                                inmultire(rez,i);
                        end;
        for i:=rez[0] downto 1 do
                write(g,rez[i]);
        writeln(g);
        close(g);
end;


begin
        preprocesare;
        iofile;
        solve;
end.