Cod sursa(job #524183)

Utilizator gicu_01porcescu gicu gicu_01 Data 20 ianuarie 2011 16:29:54
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.34 kb
var a:array[1..1000,1..1000]of integer;
    b:array[1..1000]of boolean;
    n,s:integer; f:text;
procedure ciur;
var i,j:integer;
begin
 for i:=1 to n do b[i]:=true;
 b[1]:=false;
 for i:=1 to n do
  if b[i] then
   begin
    j:=i*2;
    while j<=n do
     begin
      b[j]:=false;
      j:=j+i;
     end;
   end;
end;

function linie(k,p:integer):integer;
var i,l:integer;
begin
 l:=0;
 for i:=k to n do
  if i mod p=0 then begin a[k,i]:=1;inc(l);end;
 linie:=l
end;

procedure coloana(k,p:integer);
var i:integer;
begin
 for i:=k to n do
  if i mod p=0 then a[i,k]:=1;
end;

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

procedure mat;
var i,j,k:integer;
begin
 for i:=2 to n do
  begin
   for j:=2 to i do
    if (b[j])and(i mod j=0) then
     begin
      k:=linie(i,j);
      writeln(k);
      s:=s-2*k+1;
     end;
  end;
end;

procedure afis;
var i,j:integer;
begin
 for i:=1 to n do
  begin
   for j:=1 to n do write(a[i,j]);
   writeln;
  end;
end;

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

begin
{ assign(f,'fractii.in');
 reset(f);   }
 readln(n);
 s:=n*n;
 init;
 ciur;
 mat;
 afis;
{ assign(f,'fractii.out');
 rewrite(f);      }
 writeln(s);
 readln;
end.