Cod sursa(job #138077)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 17 februarie 2008 20:30:22
Problema Factoriale Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.52 kb
program factoriale;
var f,g:text;
    v:array[0..10002]of integer;
    p,a,s,u:array[0..100000]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;
if (max=0)then write(g,k2)else
begin
lp:=1;
p[1]:=1;
for i:=2 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;
            for y:=1 to lp do u[y]:=0;
            o:=0;
            for y2:=1 to o2 do
              begin
                o:=0;
                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;
                    u[k]:=u[k]+s[k];
                  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;
                    u[k]:=u[k]+s[k];
                  end;
                {if (o>0)then
                  begin
                    k:=k+1;
                    s[k]:=o;
                  end;  }
              end;
            t:=0;
            for y2:=1 to k do
              begin
                u[k]:=u[k]+t;
                t:=u[k] div 10;
                u[k]:=u[k] mod 10;
              end;
            for y2:=1 to k do
              p[y2]:=u[y2];
              lp:=k;
          end;
    end;
for i:=lp downto 1 do write(g,p[i]);
end;
close(f);
close(g);
end.