Cod sursa(job #680588)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 15 februarie 2012 19:19:44
Problema Principiul includerii si excluderii Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.47 kb
var erat:array [1..1000000] of boolean;
    prim:array [1..100000] of longint;
    i, ii, j, max:longint;
    n, a, b, m, r:int64;
    t:longint;
    v:array [1..100] of longint;
    w:array [1..100] of int64;
    f, g:text;
    buf1, buf2:array [1.. 1 shl 17] of char;

procedure tipar;
var fi:longint; fs:int64;
  begin
  fs:=1;
  for fi := 1 to max do fs:=fs*w[v[fi]];

  if max mod 2 = 1 then r:=r+(a div fs) else r:=r-(a div fs);
  end;

procedure bkt (fx, fy:longint);
var fi:longint;
  begin
  v[fx]:=fy;
  if fx=max then tipar else
    begin
    for fi := fy+1 to t do bkt(fx+1, fi);
    end;
  end;

begin
assign (f, 'pinex.in'); settextbuf (f, buf1); reset (f);
assign (g, 'pinex.out'); settextbuf (g, buf2); rewrite (g);

i:=3; m:=1; prim[1]:=2;
while i <= 1000000 do
  begin
  if erat[i]=false then
    begin
    inc (m); prim[m]:=i;
    j:=i*3;
    while j<=1000000 do begin erat[j]:=true; j:=j+i shl 1; end;
    end;
  inc (i, 2);
  end;


read (f, n);
for ii := 1 to n do
  begin
  readln (f, a, b);
  t:=0; i:=1;

  while (b <> 1) and (prim[i]<trunc(sqrt(b))) do
    begin
    if b mod prim[i]=0 then
      begin
      inc (t); w[t]:=prim[i];
      while b mod prim[i]=0 do b := b div prim[i];
      end;
    inc (i);
    end;

  if b <> 1 then begin inc (t); w[t]:=b; end;

  r:=0;
  for max := 1 to t do
    begin
    for j := 1 to t do bkt(1, j);
    end;
  writeln (g, a- r);
  end;

close (f); close (g);
end.