Cod sursa(job #269511)

Utilizator hominiduBirsan Dragos hominidu Data 2 martie 2009 23:09:02
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.07 kb
var d,i,n,nr,j:integer;
    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 nr:=nr+1;
     if n>1 then
        for i:=1 to n do
        for j:=1 to n do
           begin
                if i=1 then nr:=nr+1;
                if (j=1) and (i<>1) then nr:=nr+1;
                if (i>1) and (j>1) and (i<>j) and (i>i-j) and (i-j>1) then
                        begin
                         d:=i; d:=i-j;
                         
                         if (d-j=1) and (d>j) then
                            begin
                            d:=d-j;
                            nr:=nr+1;
                            end;
                         while (d>d-j) and (d-j>1) do
                               d:=d-j;
                         if (d mod j=0) and (d>j) then nr:=nr+1;
                        if (j mod d > 0) and (j mod 2<>0) or
                          (j mod d > 0) and (d mod 2=0) then nr:=nr+1;
                        end;
                if (j>1) and (i>1) and (i<>j) and (j>j-i) and (j-i>1) then
                        begin
                         d:=j; d:=j-i;
                         if (d-i=1) and (d>i) then
                            begin
                            d:=d-i;
                            nr:=nr+1;
                            end;
                         while (d>d-i) and (d-i>1) do
                               d:=d-i;
                         if (d mod i=0) and (d>i) then nr:=nr+1;
                        if (i mod d > 0) and (d mod 2<>0) or
                           (i mod d > 0) and (i mod 2<>0) then nr:=nr+1;
                        end;
if (i>1) and (j>1) and (i<>j) and (i-j=1) or
(i>1) and (j>1) and (i<>j) and (j-i=1) then nr:=nr+1;
if d>j then if (i>1) and (j>1) and (i<>j) and (d-j=1) then nr:=nr+1;
if j>d then if (i>1) and (j>1) and (i<>j) and (j-d=1) and (i-j<>1) and (d>i-j) then nr:=nr+1;
            end;
writeln(g,nr);



{while n>0 do
begin
readln(f,n);nr:=0;
     if n=1 then nr:=nr+1;
     if n>1 then
        for i:=1 to n do
        for j:=1 to n do
           begin
                if i=1 then nr:=nr+1;
                if (j=1) and (i<>1) then nr:=nr+1;
                if (i>1) and (j>1) and (i<>j) and (i>i-j) and (i-j>1) then
                        begin
                         d:=i; d:=i-j;
                         while (d>d-j) and (d-j>1) do
                               d:=d-j;
                        if j mod d > 0 then nr:=nr+1;
                        end;
                if (j>1) and (i>1) and (i<>j) and (j>j-i) and (j-i>1) then
                        begin
                         d:=j; d:=j-i;
                         while (d>d-i) and (d-i>1) do
                               d:=d-i;
                        if i mod d > 0 then nr:=nr+1;
                        end;
if (i>1) and (j>1) and (i<>j) and (i-j=1) or(i>1) and (j>1) and (i<>j) and (j-i=1) then nr:=nr+1;
            end;
if n>0 then writeln(g,nr);
end;}

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