задача про посвящение первокурсников (вывести три ответа)

[P®o©omp@s]

Думаю что по-человечески это выглядело бы так:

uses crt,math;
var i,j,x1,x2,n,m,p1,p2,p,k:word;
    x:array[1..100] of byte;
    y:array[1..50] of byte;
    inp:text;
begin
assign(inp,'input.dat');
reset(inp);
readln(inp, n, m);
  for i:=1 to m do 
   begin
    readln(inp, x1, x2);
     if (x[x1]=0) and (x[x2]=0) then 
        begin
          inc(k);
          x[x1]:=k;
          x[x2]:=k;
        end;
     if (x[x1]=0) and (x[x2]>0) then x[x1]:=x[x2];
     if (x[x2]=0) and (x[x1]>0) then x[x2]:=x[x1];
     if (x[x1]>0) and (x[x2]>0) and (x[x1]<>x[x2]) then
        begin
           p1:=max(x[x1],x[x2]);
           p2:=min(x[x1],x[x2]);
            for j:=1 to n do
              if x[j]=p1 then x[j]:=p2;
        end;

    end;
close(inp);
p1:=x[1];
p2:=0;
  for i:=2 to n do 
    begin
      if (p1<x[i]) then p1:=x[i];
      if x[i]=0 then inc(p2);
      end;
p:=p1+p2;
   if p=1 then writeln('‚ᥠбв㤥вл §Є®¬л')
    else
      begin
      writeln
         for i:=2 to n do
            if x[i]=0 then writeln('1 ',i)
                else if (y[x[i]]=0) and (x[i]<>x[1]) then
                begin
                  writeln('1 ',i);
                   y[x[i]]:=1;
                  end;
      end;
readln;
end.