Cod sursa(job #357711)

Utilizator VladAkeeeVlad Raduta VladAkeee Data 20 octombrie 2009 13:17:26
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.89 kb
type vector=array[1..100]of integer;
var f,g:text;
    n,i,j,k:longint;
    nr:longint;
    a:vector;
function cmmdc(i,j:longint):longint;
begin
 while i<>j do
      if i>j then
       i:=i-j
       else
        j:=j-i;
 cmmdc:=i;
end;
begin
assign(f,'fractii.in');reset(f);
assign(g,'fractii.out');rewrite(g);
read(f,n);nr:=n;
fillchar(a,sizeof(a),0);
i:=100;
while nr<>0 do begin
 a[i]:=nr mod 10;
 nr:=nr div 10;
end;
  for i :=1 to n do
    for j:=1 to n do
       if (cmmdc(i,j)=1)and(i mod j<>0) then
         begin
          a[100]:=a[100]+1;
          k:=100;
          while (a[k]>=10) and(k>1) do
                begin
                     a[k-1]:=a[k-1]+1;
                     a[k]:=a[k] mod 10;
                     dec(k);
                 end;
           end;

i:=1;
 while a[i]=0 do inc(i);
 for j:=i to 100 do
    write(g,a[j]);

close(g);
close(f);
end.