Cod sursa(job #47995)

Utilizator radu_voroneanuVoroneanu Radu Stefan radu_voroneanu Data 4 aprilie 2007 12:15:28
Problema Zero 2 Scor 34
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.57 kb
var v:array[1..1000000] of integer;
    x:array[0..1000000] of longint;
    i,exp,exp2,n,b,j,z,q:longint;
    f,g:text;
procedure ciur(b:longint);
 var i,j:longint;
 begin
  i:=1;
  while ((i*i) shl 1)+(i shl 1)<=b do
        begin
         if v[i shr 3] and (1 shl (i and 7))=0 then begin
                                                j:=((i*i)shl 1)+(i shl 1);
                                                while 2*j+1<=b do
                                                      begin
                                                      v[j shr 3]:=v[j shr 3]or(1 shl(j and 7));
                                                      j:=j+(i shl 1)+1;
                                                      end;
                                                end;
        inc(i);
        end;
  i:=0;
  x[1]:=2;
  x[0]:=1;
  while 2*i+1<=n do begin
    inc(i);
      if v[i shr 3] and (1 shl (i and 7))=0 then begin
                                         inc(x[0]);
                                         x[x[0]]:=2*i+1;
                                         end;
  end;
 end;
begin
 assign(f,'zero2.in'); reset(f);
 assign(g,'zero2.out'); rewrite(g);
 for i:=1 to 10 do begin
  read(f,n,b);
  ciur(b);
  for j:=x[0] downto 1 do
   if b mod x[j]=0 then begin
    z:=x[j];
    break;
   end;
  exp:=0;
  while b mod z=0 do begin
   inc(exp);
   b:=b div z;
  end;
  exp2:=0;
  for q:=1 to n do begin
   j:=z;
   while j<=q do begin
    exp2:=exp2+q div j;
    j:=j*z;
   end;
  end;
  writeln(g,exp2 div exp);
 end;
 close(f); close(g);
end.