Cod sursa(job #2133367)

Utilizator dinugaftonGafton Dinu dinugafton Data 16 februarie 2018 20:47:37
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.94 kb
Program fractii;
                var n,k,i,j,k1,k2:longint;
                    a,b:array[1..1000000]of real;
                    fi,fo:text;
begin
     assign(fi,'fractii.in');reset(fi);
     assign(fo,'fractii.out');rewrite(fo);
     read(fi,n);
     k1:=1;k2:=1;
     for i:=1 to n do
                     for j:=1 to n do
                                     begin
                                          if k1<=1000000 then
                                                             begin
                                                                  a[k1]:=i/j;
                                                                  inc(k1);
                                                             end else begin
                                                                           b[k2]:=i/j;
                                                                           inc(k2);
                                                                           end;
                                     end;
     i:=1;
     while i<=sqr(n)-1 do
                     begin
                     if a[i]=0 then inc(i);
                     for j:=i+1 to sqr(n) do
                                    if a[i]=a[j]then
                                                    a[j]:=0;
                                    if a[i]=b[i]then b[i]:=0;
                                    inc(I);
                                    end;
      i:=1;
     while i<=sqr(n)-1 do
                     begin
                     if b[i]=0 then inc(i);
                     for j:=i+1 to sqr(n) do
                                    if b[i]=b[j]then
                                                    b[j]:=0;
                                    inc(I);
                                    end;
     k:=0;
     for i:=1 to sqr(n) do
                          if (a[i]<>0)or(b[i]<>0) then inc(k);
     write(fo,k);
     close(fo);
end.