Cod sursa(job #77223)

Utilizator tebanadrianteban adrian tebanadrian Data 13 august 2007 20:09:07
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.85 kb
 program fractii;
 var n,a:byte;
 procedure citire;
 var f:text;
 begin
 assign(f,'fractii.in');
 reset(f);
 read(f,n);
 close(f);
 end;
 function scadere(n:byte):byte;
 var k,s,i,j:byte;
     gata:boolean;
 begin
 s:=0;
 for i:= 1 to n do
 for j:= 1 to n do
 begin
 gata:=false;
 for k:= 2 to n do
 if (i mod k=0)and(j mod k=0)and(i<>j)and(i<>k)and(j<>k)and(i mod j <>0)then
 begin
 inc(s);
 gata:=true;
 end;
 if(j mod i=0)and(i<>1)and(i<>j)and not gata then
 inc(s);
 end;
 scadere:=s;
 end;



 procedure fractie;
 var i,j:byte;
     gata:boolean;
 begin
 a:=0;
 for i:= 1 to n do
 for j:= 1 to n do
 if (i mod j<>0)or(j=1) then
 inc(a);
 a:=a-scadere(n);
 end;
 procedure afisare;
 var f:text;
 begin;
 assign(f,'fractii.out');
 rewrite(f);
 write(f,a);
 close(f);
 end;
 begin
 citire;
 fractie;
 afisare;
 end.