Rambler's Top100

Скачать программы    Все программы автора

СОРЕВНОВАНИЕ

В спортивном турнире принимает участие 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.

Белорусский рейтинг MyMinsk.com Сайты беларуси Регистр "ЗУБР" Каталог на TIGA.BY, а также  новости, работа, объявления, фото и многое другое Рейтинг@Mail.ru Rambler's Top100 Белорусский каталог программ
Hosted by uCoz