Cod sursa(job #138021)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 17 februarie 2008 19:46:31
Problema Factoriale Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.63 kb
program alex;
const p:array[1..25]of longint=
(2,3,5,7,11,13,17,19,23,29,
31,37,41,43,47,53,59,61,67,71,
73,79,83,89,97);
var f:text;
    j,i,t,k,x,n,r,y,h,tr,tu:longint;
    c:array[1..25]of longint;
    pr:array[1..30000]of integer;
begin
assign(f,'factoriale.in');reset(f);
readln(f,n,k);
for i:=1 to n do
    begin
    read(f,x);
    j:=0;
    repeat
    j:=j+1;
    t:=p[j];
    while x div t<>0 do
          begin
          c[j]:=c[j]+(x div t);
          t:=t*p[j];
          end;
    until p[j]>=x;
    end;
close(f);
pr[1]:=1;
h:=1;
for i:=1 to 25 do
    if c[i]<>0 then begin
                    r:=c[i] mod k;
                    if r<>0 then for j:=1 to k-r do
                                     begin
                                     for y:=1 to h do
                                         pr[y]:=(pr[y]*p[i]);
                                     for y:=1 to h-1 do
                                         begin
                                         pr[y+1]:=pr[y+1]+(pr[y] div 10);
                                         pr[y]:=pr[y] mod 10;
                                         end;
                                     while pr[h]>10 do
                                           begin
                                           h:=h+1;
                                           pr[h]:=pr[h-1] div 10;
                                           pr[h-1]:=pr[h-1] mod 10;
                                           end;
                                     end;
                    end;
assign(f,'factoriale.out');rewrite(f);
for i:=h downto 1 do
    write(f,pr[i]);
close(f);
end.