Cod sursa(job #210344)

Utilizator gabisabadacdswefwegzcv gabisabadac Data 27 septembrie 2008 13:21:55
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.59 kb
program swastika;
var i,j,n,p,q,fractii,cmmdc:integer;
    f,g:text;
 begin
  assign(f,'fractii.in'); reset(f);
  assign(g,'fractii.out'); rewrite(g);
  while not eof(f) do
   begin
    readln(f,n); fractii:=1;
    for i:=1 to n do
     for j:=1 to n do
      if (i<>j) then
       begin
        p:=i; q:=j;
        while (p<>q) do
         if (p>q) then
          begin
           p:=p-q; cmmdc:=p;
          end
         else
          begin
           q:=q-p; cmmdc:=q;
          end;
        if cmmdc=1 then fractii:=fractii+1;
       end;
    writeln(g,fractii);
   end;
  close(g); close(f);
 end.