Скачать программы Все программы автора
СОРЕВНОВАНИЕ
В спортивном турнире принимает участие N человек, с номерами от 1 до N. Турнир проходит по круговой системе: каждый участник должен сыграть с каждым другим участником по одной партии, которая заканчивается победой одного из игроков. Считается, что по окончании турнира участник занимает место P, если:
у него выиграли (P-1) участников, и ему проиграли все остальные;
все участники, которые победили его, выиграли свои партии у всех участников,
которые ему проиграли.
Для остальных участников итоговое место определить нельзя.
Задание
Напишите программу CONTEST, которая получает на вход число N и результаты сыгранных на данный момент партий турнира, и определяет количество участников, для которых по окончании турнира нельзя будет определить итоговое место, в независимости от результатов тех партий, которые еще будут сыграны.
Входные данные
В первой строке CONTEST.DAT задаются два натуральных числа: N — количество участников турнира (1£N£100) и M — количество сыгранных партий. Следующие M строк описывают сыгранные партии. В строке задается два числа: номер победителя и номер проигравшего.
Выходные данные
В единственной строке выходного файла CONTEST.SOL должно быть целое число — искомое количество участников.
Пример входных и выходных данных
CONTEST.DAT |
CONTEST.SOL |
6 8 1 5 1 4 5 2 5 6 3 2 2 6 6 4 4 3 |
4 |
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P-,Q+,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
program contest;
const
FileIn = 'contest.dat';
FileOut = 'contest.sol';
MaxN = 100;
type
PList = ^TList;
TList = record
Vert : integer;
Next : PList;
end;
var
N, M : integer;
A : array[1..MaxN] of PList;
B : array[1..MaxN] of boolean;
Ans : array[1..MaxN] of integer;
Answer : integer;
Storage : array[1..MaxN] of integer;
RecFlag : boolean;
Curr : integer;
procedure EmptyGraph;
var
i : integer;
begin
for i:=1 to MaxN do
A[i] := nil;
end;
procedure AddEdge(x, y : integer);
var
p : PList;
begin
New(P);
P^.Vert := y;
P^.Next := A[x];
A[x] := p;
end;
procedure Init;
var
Fi : Text;
i, Winner, Loser : integer;
begin
FillChar(Ans, SizeOf(Ans), 0);
EmptyGraph;
Assign(Fi, FileIn);
Reset(Fi);
ReadLn(Fi, N, M);
for i:=1 to m do
begin
ReadLn(Fi, Winner, Loser);
AddEdge(Winner, Loser);
end;
Close(Fi);
Answer := 0;
end;
procedure AddCycle(CurrVert, PrevVert : integer);
var
x : integer;
begin
x:=PrevVert;
while x<>CurrVert do
begin
Ans[x]:=2;
x:=Storage[x];
end;
Ans[CurrVert]:=2;
end;
procedure Search(Vert, Prev : integer);
var
p : PList;
begin
Storage[Vert] := Prev;
B[Vert] := true;
if Ans[Vert]=0 then Ans[Vert]:=1;
p:=A[Vert];
while p<>nil do
begin
if Storage[p^.Vert]=0 then
begin
Search(p^.Vert, Vert);
end else
begin
if B[p^.Vert] then AddCycle(p^.Vert, Vert);
end;
p:=p^.Next;
end;
B[Vert] := false;
end;
procedure Run;
begin
for Curr:=1 to n do
if Ans[Curr]<2 then
begin
FillChar(Storage, SizeOf(Storage), 0);
FillChar(B, SizeOf(B), false);
Search(Curr, -1);
end;
end;
procedure Done;
var
Fo : Text;
i : integer;
begin
for i:=1 to n do
if Ans[i]=2 then Inc(Answer);
Assign(Fo, FileOut);
Rewrite(Fo);
WriteLn(Fo, Answer);
Close(Fo);
end;
begin
Init;
Run;
Done;
end.