Cod sursa(job #688894)

Utilizator vasi30Axinte Vasilica vasi30 Data 23 februarie 2012 22:24:11
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.36 kb
Program fractii;
var n,i,j,nr:longint;
    f,g:text;
Function sim(x,y:longint):boolean;
var k:boolean;i:longint;
begin
  k:=true;
  if x<y then
    for i:=2 to x do
    begin
      if (x mod i=0) and (y mod i=0) then k:=false;
    end
         else
    for i:=2 to y do
    begin
      if (x mod i=0) and (y mod i=0) then k:=false;
    end;
  sim:=k;
end;
{Procedure fract(n:longint);
begin
  nr:=0;
  for i:=1 to n do
  begin
     for j:=1 to i do
       if sim(i,j) then
        begin
          {write(j,'/',i,' ');}
          inc(nr);
        end;
  end;
  for i:=1 to n do
  begin
     for j:=1 to i do
       if sim(i,j) then
        begin
          {write(i,'/',j,' ');}
          inc(nr);
        end;
  end;
  writeln(g,nr-1);
end;}
begin
  assign(f,'fractii.in');
  assign(g,'fractii.out');
  reset(f);
  rewrite(g);
  while not eof(f) do
      begin
        read(f,n);
        nr:=0;
        for i:=1 to n do
          begin
            for j:=1 to i do
              if sim(i,j) then
               begin
                 inc(nr);
               end;
          end;
        for i:=1 to n do
          begin
            for j:=1 to i do
              if sim(i,j) then
               begin
                 inc(nr);
               end;
           end;
        writeln(g,nr-1);
     end;
  close(f);close(g);
end.