Cod sursa(job #137212)

Utilizator cristy_marin2006Marin Ionut Cristian cristy_marin2006 Data 17 februarie 2008 10:17:52
Problema Factoriale Scor 0
Compilator fpc Status done
Runda preONI 2008, Runda 4, Clasele 5-8 Marime 2.26 kb
program factoriale;
type vector=array[1..1000]of shortint;
var x,b,p:vector;
    f,g:text;
    n,m,i,k,nr:shortint;
function prim(x:word):boolean;
var d:word;
    p:boolean;
begin
     if (x=2) or (x=3) then p:=true
            else
            if x mod 2=0 then p:=false
               else
               begin
                    d:=3;
                    p:=true;
                    while (d<=x div 2) and p do
                          begin
                               if x mod d=0 then p:=false;
                               d:=d+2;
                          end;
               end;
     prim:=p;
end;
function apartine(y:word):boolean;
var i:word;
    ap:boolean;
begin
     ap:=false;
     for i:=1 to m do
         if b[i]=y then
                   begin ap:=true;
                         i:=m;
                   end;
     apartine:=ap;

end;
function poz(y:word):word;
var i:word;
begin
     for i:=1 to m do
         if b[i]=y then poz:=i;
end;

procedure descompune(i:shortint);
var d,pp,j,y:word;
begin
     for j:=2 to x[i] do
     begin
          y:=j;
          d:=2;
          while d<=y do
           begin
                while y mod d=0 do
                   begin
                        y:=y div d;
                        if apartine(d) then
                        begin
                             pp:=poz(d);
                             p[pp]:=p[pp]+1;
                        end
                           else
                           begin
                                m:=m+1;
                                b[m]:=d;
                                p[m]:=p[m]+1;
                           end;
                   end;
                repeat d:=d+1 until prim(d);
           end;
     end;
     if i<n then descompune(i+1);
end;
begin
     assign(f,'factoriale.in');reset(f);
     assign(g,'factoriale.out');rewrite(g);
     read(f,n);readln(f,k);
     for i:=1 to n do
         read(f,x[i]);
     i:=1; m:=0;nr:=1;
     descompune(i);
     for i:=1 to m do
         if p[i] mod k<>0 then
                 repeat
                        nr:=nr*b[i];
                        p[i]:=p[i]+1;
                 until p[i] mod k=0;
     write(g,nr);
     close(f);close(g);
end.