Cod sursa(job #600720)

Utilizator Buzu_Tudor_RoCont vechi Buzu_Tudor_Ro Data 2 iulie 2011 22:13:04
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.14 kb
Program Fractii;
const okupat=5;
var fi, fo : text;
    i,j,n,k,nr : longint;
    i1,j1:longint;
    a : array[1..1000,1..1000] of byte;
    label 1;

Function CMMDC(a,b : longint):longint;
begin
      if a mod b = 0 then cmmdc:=b
                     else cmmdc:=cmmdc(b,a mod b);
end;

begin
     assign(fi,'fractii.in'); reset(fi); readln(fi,n); close(fi);
     assign(fo,'fractii.out'); rewrite(fo);
     for i:=1 to 1000 do
                    for j:=1 to 1000 do a[i,j]:=0;
     for i:=1 to n do
                       for j:=1 to n do begin
                                        if i>=j then nr:=CMMDC(i,j)
                                                else nr:=CMMDC(j,i);
                                        if nr=1 then if a[i,j]=0 then begin a[i,j]:=okupat; k:=k+1; end
                                                                 else goto 1
                                                else begin i1:=i div nr; j1:=j div nr; if a[i1,j1]=0 then begin a[i,j]:=okupat; k:=k+1; end; end;
                                        1 : a[i,j]:=a[i,j];  end;
     writeln(fo,k);
     close(fo);
end.