Cod sursa(job #137338)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 17 februarie 2008 11:20:11
Problema Factoriale Scor 50
Compilator fpc Status done
Runda preONI 2008, Runda 4, Clasele 5-8 Marime 2.25 kb
program factoriale;
var f,g:text;
    v:array[0..102]of integer;
    p,a,s:array[0..1000]of integer;
    y3,k,k2,o2,t,y2,y,o,cv,h,n,i,d,x,ci,lp,cx,max,ok,j:longint;
begin
assign(f,'factoriale.in');
assign(g,'factoriale.out');
reset(f);
rewrite(g);
read(f,n,k2);
for i:=1 to n do
  begin
    read(f,h);
    for cx:=2 to h do
      begin
        d:=1;
        x:=cx;
        while (x>1)do
          begin
            d:=d+1;
            ok:=0;
            while (x mod d=0)do
              begin
                v[d]:=v[d]+1;
                ok:=1;
                x:=x div d;
              end;
            if (ok=1)then
              if (d>max)then max:=d;
          end;
      end;
  end;
lp:=1;
p[1]:=1;
for i:=1 to max do
  if (v[i] mod k2<>0)then
      begin
        ci:=i;
        o2:=0;
        while (ci<>0)do
          begin
            o2:=o2+1;
            a[o2]:=ci mod 10;
            ci:=ci div 10;
          end;
        for j:=1 to k2-(v[i] mod k2) do
          begin
            k:=0;
            for y:=1 to lp do s[y]:=0;
            o:=0;
            for y2:=1 to o2 do
              begin
                t:=0;
                k:=y2-1;
                for y3:=1 to lp do
                  begin
                    k:=k+1;
                    cv:=s[k];
                    s[k]:=a[y2]*p[y3]+t;
                    t:=s[k] div 10;
                    s[k]:=s[k] mod 10;
                    s[k]:=cv+s[k]+o;
                    o:=s[k] div 10;
                    s[k]:=s[k] mod 10;
                  end;
                if (o>0)then
                  begin
                    k:=k+1;
                    s[k]:=o;
                    o:=0;
                  end;
                if (t>0)then
                  begin
                    k:=k+1;
                    s[k]:=s[k]+t;
                    o:=s[k] div 10;
                    s[k]:=s[k] mod 10;
                  end;
                if (o>0)then
                  begin
                    k:=k+1;
                    s[k]:=o;
                  end;
              end;
            for y2:=1 to k do
              p[y2]:=s[y2];
            lp:=k;
          end;
    end;
for i:=lp downto 1 do write(g,p[i]);
close(f);
close(g);
end.