Cod sursa(job #35896)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 22 martie 2007 17:49:39
Problema Pascal Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.61 kb
Program cel;
Type vector=array[0..5000000] of longint;
var f,g:text;
    a:vector;
    r,i,nr,c,d,f3,f1,f2:longint;
{function putere(a:longint;b:longint):longint;
var fm:longint;
Begin
fm:=0;
a:=a div b;
While a>0 do
 Begin
  inc(fm,a);
  a:=a div b;
 end;
putere:=fm;
end; }


function fact(x:longint):longint;
var nr:longint;
Begin
nr:=0;
While x mod d=0 do
 Begin
  inc(nr);
  x:=x div d;
 end;
fact:=nr;
end;

Begin
Assign(f,'pascal.in');Reset(f);
Assign(g,'pascal.out');Rewrite(g);
Read(f,r,d);
a[0]:=0;
For i:=1 to r do
 Begin
  a[i]:=a[i-1]+fact(i);
 end;

For c:=1 to r-1 do
 { If d in [2,3,4,5] then Begin
                          f2:=putere(r-c,d);
                          f3:=putere(c,d);
                          If d=4 then If f1-f2-f3>=2 then inc(nr,2);
                          If d in [2,3,5] then If f1-f2-f3>=1 then inc(nr,2);
                         end
                     else Begin
                           f1:=putere(r,2);
                           f2:=putere(r-c,2);
                           f3:=putere(c,2);
                           If f1-f2-f3>=1 then Begin
                                                f1:=putere(r,3);
                                                f2:=putere(r-c,3);
                                                f3:=putere(c,3);
                                                If f1-f2-f3>=1 then inc(nr,2);
                                               end;
                               end;
If ((r+1) mod 2=1) and (nr>0) then dec(nr); }
 If a[r]-a[r-c]-a[c]>0 then inc(nr);
Writeln(g,nr);
Close(f);
Close(g);
end.