Cod sursa(job #357707)

Utilizator VladAkeeeVlad Raduta VladAkeee Data 20 octombrie 2009 13:08:28
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.87 kb
type vector=array[1..100]of integer;
var f,g:text;
    n,i,j:longint;
    nr:longint;
function cmmdc(i,j:longint):longint;
begin
while i<>j do begin
      if i>j then
       i:=i-j
       else
        j:=j-i;
 end;
 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;
          i:=100;
          while (a[i]>=10) and(i>1) do
                begin
                     a[i-1]:=a[i-1]+1;
                     a[i]:=a[i] mod 10;
                     dec(i);
                 end;
           end;
for i:=1 to n do
 if a[i]<>0 then
    write(g,a[i]);

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