Cod sursa(job #389593)

Utilizator Gabbby93Gabbby93 Gabbby93 Data 1 februarie 2010 21:13:19
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.72 kb
program fractii;

var f,g:text;
    n,t,min:longint;
    p,q:array[1..100000000] of longint;
    k,i,j,o:longint;
    ok:0..1;


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 sqr(n)<i;
until k=n;
t:=0;
for i:=1 to sqr(n) do
   begin
   min:=p[i];
   if min<q[i] then min:=q[i];
   ok:=1;
   for j:=2 to min do
      if (p[i] mod j=0) and (q[i] mod j=0) then ok:=0;
   if ok=1 then t:=t+1;
   end;
write(g,t);
close(f);
close(g);    exitcode:=0;
end.