Cod sursa(job #5002)

Utilizator bogdan315Popescu Bogdan-Ionut bogdan315 Data 9 ianuarie 2007 13:39:00
Problema Fractii Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.74 kb
var n,i,j,nr,t,l:longint;
    f,g:text;
    a:array[1..100]of integer;
function cmmdc(x,y:longint):longint;
begin
while y<>0 do
      begin
      if x>y then x:=x-y
             else y:=y-x;
      end;
cmmdc:=x;
end;
begin
assign(f,'fractii.in');reset(f);
assign(g,'fractii.out');rewrite(g);
readln(f,n);
nr:=0;
for i:=1 to n do
    begin
    a[i]:=0;
    end;   t:=1;
for i:=1 to n do
    for j:=1 to n do
        begin
        if cmmdc(i,j)=1 then
           begin
           a[t]:=a[t]+1;
           if a[t]=0 then inc(t);
           end;
        end;
t:=0;
for i:=n downto 1 do
    begin
    if a[i]=0 then inc(T) else break;
    end;
for i:=1 to n-t do
    begin
    write(g,a[i]);
    end;
close(F);close(G);
end.