Зададим нумерацию карточек с помощью массива F. Пусть на i-ой
карточке написана пара: "черный" номер i, "красный" - F[i].
Пусть C[i] - счетчик, показывающий, сколько раз число i встреча-
ется среди "красных".
Если какого-то числа i нет среди "красных" (т.е. C[i]=0), то
его нет и в искомом множестве. Следовательно, можно не рассматри-
вать далее (выбросить) карточку с соответствующим "черным" числом
i (и "красным" F[i]). Удаляем i из множества "черных" чисел и
уменьшаем соответствующий счетчик С[F[i]] на 1. Если число C[F[i]]
стало равно 0, то числа C[F[i]] нет среди "красных", и мы можем не
рассматривать далее карточку с "черным" номером C[F[i]], и т.д.
const N1=10;
type mas=array[1..N1] of integer;
var F: mas;
N,i: integer;
procedure mapping(F: mas);
var C: mas;
j: integer;
Stack: array [0..N1] of integer;
begin
Stack[0]:=0;
for j:=1 to N do C[j]:=0;
for j:=1 to N do C[F[j]]:=C[F[j]]+1;
for j:=1 to N do
if C[j]=0
then begin Stack[0]:=Stack[0]+1;
Stack[Stack[0]]:=j
end;
while Stack[0]<>0 do { while Stack is not empty }
begin
j:=Stack[Stack[0]]; { remove i from the top of Stack }
Stack[0]:=Stack[0]-1;
C[F[j]]:=C[F[j]]-1; { decrease counter }
if C[F[j]]=0 then begin Stack[0]:=Stack[0]+1;
Stack[Stack[0]]:=F[j]
end;
end;
for i:=1 to N do
if C[i]<>0 then writeln(i,' in set');
end;
begin
write('N='); readln(N);
for i:=1 to N do
begin
write('"чеpный" номеp ',i,', "кpасный" -');
readln(F[i]);
end;
mapping(F);
end.
(По материалам журнала "Communications of the ACM")