Вітаю Вас, Гість

Задача A
var
  n,k,s,i,j : longint;
  a: array[0..20000] of longint;
begin
  readln(n,k);
  for i:=1 to n do read(a[i]);
  s:=0;
  for i:=1 to n do
   for j:=1 to n do
   if (i<>j) and (abs(a[i]-a[j])<=k) then s:=s+1;
  writeln(s);
end.

Задача B
var
 n,i,x:longint;
 begin
   readln(n);
   x:=1;
   for i:=1 to n-1 do
   begin
     x:=(x+i-1) mod n + 1;
     write(x, ' ');
   end;
   writeln;
  end.

Задача C
var
i,n,d,k:integer;
a:array[1..100] of integer;
Begin
   readln(n); k:=0;
   for i:=1 to n do
   begin
     read(d); inc(a[d]);
   end;
   for i:=1 to 100 do
     k:=k+a[i] div 2;
  writeln(k div 2)
End.

Задача D
var
 aud,grup,grupnom,audnom,rasp : array[1..10000] of longint;
 i,j,n,m,grkl,st:longint;
Begin
 readln(n,m);
 for i:=1 to n do
   begin
     read(grup[i]); grupnom[i]:=i;
   end;
 for i:=1 to m do
  begin
    read(aud[i]); audnom[i]:=i
  end;
  for i:=1 to n-1 do
   for j:=i+1 to n do
    if grup[i]<grup[j] then
       begin
         st:=grup[i]; grup[i]:=grup[j]; grup[j]:=st;
         st:=grupnom[i]; grupnom[i]:=grupnom[j]; grupnom[j]:=st;
       end;
  for i:=1 to m-1 do
   for j:=i+1 to m do
   if aud[i]<aud[j] then
     begin
      st:=aud[i]; aud[i]:=aud[j]; aud[j]:=st;
      st:=audnom[i]; audnom[i]:=audnom[j]; audnom[j]:=st;
     end;
  i:=1;
  for j:=1 to m do
  begin
   while (i<=n) and (aud[j]<grup[i]) do i:=i+1;
   if i>n then break;
   rasp[grupnom[i]]:=audnom[j];
   grkl:=grkl+1;
   i:=i+1
  end;
  writeln(grkl);
  for i:=1 to n do write(rasp[i],' ')
end.

Задача E
var
    a:array[1..100,0..100]of longint;
    b:array[0..100] of longint;
    n,m,i,j,res,x,y:longint;

begin
    readln(n,m);
    for i:=1 to m do begin
        readln(x,y);
        inc(a[x,0]);
        a[x,y]:=1;
        inc(a[y,0]);
        a[y,x]:=1;
    end;

    while true do begin
        b[0] := 0;
        for i:=1 to n do if a[i,0]=1 then begin
            for j:=1 to n do if (a[i,j]=1) then begin
                inc(b[0]);
                b[b[0]]:=i;
            end;
        end;

        if b[0]=0 then break;
        inc(res);

        for i:=1 to b[0] do begin
            for j:=1 to n do if a[b[i],j]=1 then begin
                a[b[i],j]:=0;
                dec(a[b[i],0]);
                a[j,b[i]]:=0;
                dec(a[j,0]);
            end;
        end;
    end;
    writeln(res);
end.