Cod sursa(job #1181425)

Utilizator testtVasilica Ionica testt Data 2 mai 2014 18:55:34
Problema Principiul includerii si excluderii Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.32 kb
const max=1000005;
var t,ti,i:longint;
    ciur:array[0..max+5]of boolean;
    v:array[0..505]of longint;
    a,b,sum,h:int64;

procedure do_ciur;
var i,h,t,j:longint;
begin
  for i := 2 to max do ciur[i] := true;
  for i := 2 to max do
    if ciur[i] then
    begin
      t := max div i;
      for j := 2 to t do ciur[i*j] := false;
    end;
end;

procedure Rezolva(pas:longint;prod:int64;sel:longint);
var val:int64;
begin
  if pas <= v[0] then
  begin
    Rezolva(pas+1,prod,sel);
    Rezolva(pas+1,prod*v[pas],sel+1);
  end
  else
  begin
    if sel > 0 then
    begin
      if sel mod 2 = 1 then
        val := a div prod
      else
        val := -(a div prod);

      sum := sum + val;
    end;
  end;

end;

begin
  assign(input,'pinex.in'); reset(input);
  assign(output,'pinex.out'); rewrite(output);

  do_ciur();

  readln(t);
  for ti := 1 to t do
  begin
    readln(a,b); sum := 0;
    v[0] := 0;  h := trunc(sqrt(b))+1;
    for i := 1 to b do
    begin
      if ciur[i] then
      begin
        if b mod i = 0 then
        begin
          inc(v[0]);
          v[v[0]] := i;
        end;
      end;
    end;
    if v[0] = 0 then
    begin
      v[0] := 1; v[1] := b;
    end;

    Rezolva(1,1,0);

    writeln(a-sum);

  end;

  close(input);
  close(output);
end.