Cod sursa(job #51819)

Utilizator M@2Te4iMatei Misarca M@2Te4i Data 16 aprilie 2007 22:02:25
Problema Factorial Scor 15
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.51 kb
program fact;

type sir=array[1..100000]of integer;

var a,b,w:sir;
    m,n,p:int64;

procedure citire;
begin
assign(input,'fact.in');
reset(input);
read(p);
close(input);
end;

procedure inmultire(var b:sir;m:integer);
var t,i,j:integer;
begin
fillchar(a,sizeof(a),0);
t:=0;
i:=1;
while i<=m do
      begin
      t:=0;
      j:=i-1;
      while (j<n) or (t>0) do
            begin
            inc(j);
            t:=t+w[j]*b[i];
            a[i+j-1]:=a[i+j-1]+t mod 10;
            t:=t div 10;
            end;
      inc(i);
      end;
w:=a;
n:=j;
end;

procedure prelucrare;
var i,j:longint;
    q,k:int64;
    gasit:boolean;
begin
if p=0 then
   write(1)
   else begin
        w[1]:=1;
        n:=1;
        i:=0;
        //q:=2;
        for i:=2 to 10000 do
            begin
            q:=i;
            k:=0;
            while q>0 do
                  begin
                  inc(k);
                  b[k]:=q mod 10;
                  q:=q div 10;
                  end;
            m:=k;
            inmultire(b,m);
            gasit:=true;
            for j:=1 to p do
                if w[j]<>0 then
                   begin
                   gasit:=false;
                   break;
                   end;
            if gasit then
               begin
               write(i);
               break;
               end;
            end;
        end;
end;

begin
citire;
assign(output,'fact.out');
rewrite(output);
prelucrare;
close(output);
end.