Cod sursa(job #35957)

Utilizator Adrian001Vladulescu Adrian Adrian001 Data 22 martie 2007 19:15:46
Problema Pascal Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.21 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;
b[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;
            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 in [2,4,5] then If a[r]-a[r-c]-a[c]>0 then inc(nr);
 If (d=6) and (a[r]-a[r-c]-a[c]>0) and (b[r]-b[r-c]-b[c]>0) then
  Begin
   If  (a[r]-a[r-c]-a[c])>(b[r]-b[r-c]-b[c]) then inc(nr,b[r]-b[r-c]-b[c])
                                             else inc(nr,a[r]-a[r-c]-a[c]);
  end; }
 end;
If d<>4 then Write(g,-1)
        else      Writeln(g,nr);
Close(f);
Close(g);
end.