Cod sursa(job #333065)

Utilizator Gabbby93Gabbby93 Gabbby93 Data 21 iulie 2009 13:29:40
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.73 kb
program fractii;
var f,g:text;
    p,q:array[1..1001] of 1..1000000;
    n,min:1..1000000;
    k,i,j,o,t:longint;
    ok:boolean;


begin
assign(f,'fractii.in'); reset(f);
assign(g,'fractii.out'); rewrite(g);

read(f,n);
k:=0;
t:=1;
o:=n;

repeat
   k:=k+1;
   for i:=t to o do
      p[i]:=k;
   t:=o+1;
   o:=o+n;
until k=n;

k:=0;
t:=0;

repeat
   k:=k+1;
   t:=t+1;
   i:=t;
   repeat
      q[i]:=k;
      i:=i+n;
   until i>n*n;
until k=n;

t:=0;

for i:=1 to n*n do
   begin
   min:=p[i];
   if min<q[i] then min:=q[i];
   ok:=true;
   for j:=2 to min do
      if (p[i] mod j=0) and (q[i] mod j=0) then ok:=false;
   if ok then t:=t+1;
   end;

write(g,t);

close(f);
close(g);

end.