Cod sursa(job #524416)

Utilizator ion_calimanUAIC Ion Caliman ion_caliman Data 21 ianuarie 2011 13:05:58
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.96 kb
var a:array[1..10000,1..10000] of boolean;
        n,nr:longint;

procedure citire;
var f:text;
begin
  assign(f,'fractii.in');
  reset(f);
  read(f,n);
  close(f);
end;

procedure afis;
var f:text;
begin
  assign(f,'fractii.out');
  rewrite(f);
  write(f,nr);
  close(f);
end;

procedure init;
var i,j:longint;
begin
  for i:=1 to n do
  for j:=1 to n do
  a[j,i]:=true;
end;

procedure exclude(i,k:longint);
var j:longint;
begin
  if k<=n then
  begin
    j:=k;
    while j<=n do
      begin
        a[j,k]:=false;
        inc(j,i);
      end;
    j:=k;
    while j<=n do
      begin
        a[k,j]:=false;
        inc(j,i);
      end;
    exclude(i,k+i);
  end;
end;

procedure exe;
var i:longint;
begin
  for i:=2 to n do
  exclude(i,i);
end;

procedure numara;
var i,j:longint;
begin
  nr:=0;
  for i:=1 to n do
  for j:=1 to n do
    if a[j,i] then inc(nr);
end;

begin
citire;
init;
exe;
numara;
afis;
end.