Cod sursa(job #598784)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 27 iunie 2011 02:14:40
Problema Pascal Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.29 kb
Program pasc;
 var a:array [1..3000000] of int64;
   i,j,r,d,k:longint;
   n:int64;
   fi,fo:text;
  function factorial(k:integer):longint;
   var p:longint;
       i:integer;
   begin
   p:=1;
   if k=0 then factorial:=1
    else begin
    for i:=2 to k do
     p:=p*i;
     factorial:=p;
     end;
     end;
begin
 assign(fi,'pascal.in');
  reset(fi);
   read(fi,r,d);
 assign(fo,'pascal.out');
  rewrite(fo);
   inc(r);
  n:=factorial(r-1);
 if r mod 2<>0 then begin
                     for i:=0 to (r div 2) do
                      a[i+1]:=trunc((n)/(factorial(r-1-i)*factorial(i)));
                      for i:=1 to (r div 2) do
                       if a[i] mod d=0 then inc(k);
                       if a[(r div 2)+1] mod d=0 then
                                                  write(fo,2*k-1)
                                                  else write(fo,2*k);
                         close(fo)
                          end
  else begin
        for i:=0 to (r div 2)-1 do
                      a[i+1]:=trunc((n)/(factorial(r-1-i)*factorial(i)));
                      for i:=1 to (r div 2) do
                       if a[i] mod d=0 then inc(k);
                        write(fo,2*k);
                         close(fo)
                         end;
 end.