Cod sursa(job #35941)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 22 martie 2007 18:26:59
Problema Pascal Scor 70
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.99 kb
Program cel;
Type vector=array[0..5000000] of longint;
var f,g:text;
    a,b: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;d: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;
If d=4 then f1:=2
       else f1:=d;
If d=6 then Begin
             For i:=1 to r do
              Begin
               a[i]:=a[i-1]+fact(i,2);
               b[i]:=b[i-1]+fact(i,3);
              end;
             For i:=1 to r do
              If a[i]>b[i] then a[i]:=b[i];
            end
       else For i:=1 to r do a[i]:=a[i-1]+fact(i,f1);

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); }
Begin
 If d=4 then If a[r]-a[r-c]-a[c]>1 then inc(nr);
 If d<>4 then If a[r]-a[r-c]-a[c]>0 then inc(nr);
end;
Writeln(g,nr);
Close(f);
Close(g);
end.