Cod sursa(job #82284)

Utilizator MDanFMI - Dan Moldovan MDan Data 6 septembrie 2007 12:21:20
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.79 kb
var a:array [1..10000,1..10000] of boolean;
    jk,i,j,sumainv,cont,n:longint;
    f,g:text;
begin
assign (f,'fractii.in');
assign (g,'fractii.out');
reset(f);
rewrite(g);
readln (f,n);
for i:=2 to n do
    begin
    For j:=1 to n do
        begin
        if j mod i=0
        then
            begin
            a[i,j]:=true;
            jk:=i*2;
            while jk<=n do
                  begin
                  a[jk,j]:=true;
                  jk:=jk+i;
                  end;
            end;
        end;
    end;
j:=2;
sumainv:=0;
while j<=n do
begin
cont:=0;
if a[j,j]=true
then
    sumainv:=sumainv+1;
for jk:=j+1 to n do
if a[j,jk]=true
then
    cont:=cont+1;
sumainv:=sumainv+(2*cont);
j:=j+1;
end;
writeln (g,((n*n)-sumainv));
close(f);
close(g);
end.