Cod sursa(job #104785)

Utilizator deleted_64d853f2e2bbccbeDELETED deleted_64d853f2e2bbccbe Data 16 noiembrie 2007 17:57:51
Problema Fractii Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.91 kb
{infoarena.ro fractii}
var f:text;
    j,q:longint;
    k,n:longint;
function ireductibile(x,y:longint):boolean;
var w,min:longint;
    sem:boolean;
begin
     sem:=true;
     w:=2;
     if x>y then min:=y
            else min:=x;
     if (x=y) and (x<>1) then
                             begin
                                  sem:=false;
                                  min:=0;
                             end;
     if (x=1) and (y=1) then sem:=true;
     while ((w<=min) and sem) do
     begin
         if (x mod w=0) and (y mod w=0) then sem:=false;
         w:=w+1;
     end;
     ireductibile:=sem;
end;

begin
     assign (f,'fractii.in');
     reset (f);
     readln (f,n);
     close (f);
     assign (f,'fractii.out');
     rewrite (f);
     k:=0;
     for j:=1 to n do
         for q:=1 to n do
             if ireductibile(j,q) then k:=k+1;
     writeln(f,k);
     close (f);
end.