Cod sursa(job #273979)

Utilizator floorinelfloorinel floorinel Data 9 martie 2009 12:06:52
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.59 kb
var d,i,n,nr,j:integer; a,b:real;
    f,g:text;
    v:array [1..100] of integer;
BEGIN
assign(f,'fractii.in');reset(f);assign(g,'fractii.out');rewrite(g);d:=0;nr:=0;
readln(f,n);
if n>=1 then
        begin
          nr:=n;
          for i:=2 to n do
          for j:=1 to n do
                begin
                  if j=1 then nr:=nr+1;
                  if (i>j) and (j>1) then
                        begin
                        a:=i; b:=j;
                        if (a / b <2) and (a/(i-j)<>1.5)
        or (a / b>2) and (i mod j<>0) and(i mod (i div j)<>0) then nr:=nr+1;
                        end;
                        if (j>i) and (j mod i<>0) and ((j div i)*i<>j) then
                        nr:=nr+1;
                end;
        writeln(g,nr);
        end;

while n>0 do
      BEGIN
      readln(f,n);
      if n>0 then
                   BEGIN
                      if n>=1 then
        begin
          nr:=n;
          for i:=2 to n do
          for j:=1 to n do
                begin
                  if j=1 then nr:=nr+1;
                  if (i>j) and (j>1) then
                        begin
                        a:=i; b:=j;
                        if (a / b <2) and (a/(i-j)<>1.5)
        or (a / b>2) and (i mod j<>0) and(i mod (i div j)<>0) then nr:=nr+1;
                        end;
                        if (j>i) and (j mod i<>0) and ((j div i)*i<>j) then
                        nr:=nr+1;
                end;

        end;

                    writeln(g,nr);
                   END;
      
      END;



close(f);close(g);
END.