Az alábbi letöltési lehetőségek közül választhatsz: (
segítség)
Típus: text/plain
Tartalmaz szöveget
Karakterkódolás: us-ascii
Méret: 1 KB
uses crt, strings;
CONST id = '8';
var db:longint;
n:byte;
darab:longint;
szomszed: array[1..100] of array[1..100] of boolean;
hivasok: array[1..100] of longint;
jartunk: array[1..100] of boolean;
procedure beolvas;
var i,j:byte;
s,q:string;
be:text;
idx:integer;
code:integer;
begin
assign(be, strcat(strcat('osztaly',id),'.be'));
reset(be);
readln(be, n);
for i:=1 to n do begin
readln(be, s);
q:='';
for j:= 1 to (length(s)) do begin
if( s[j] <> ' ' ) then q:= q+s[j] else begin
val(q, idx, code);
q := '';
szomszed[i][idx] := true;
end;
end;
end;
close(be);
end;
procedure beallit;
var i,j : byte;
begin
for i:=1 to 100 do
for j:=1 to 100 do
szomszed[i][j] := false;
end;
procedure sehol_sem_jartunk;
var i:byte;
begin
for i:=1 to 100 do jartunk[i] := false;
end;
procedure rek( i:byte );forward;
procedure szomszedok(i:byte);
var j:byte;
begin
for j:=1 to n do begin
if szomszed[i][j] then rek(j);
end;
end;
procedure rek( i:byte );
begin
if not jartunk[i] then begin
inc(darab);
jartunk[i] := true;
szomszedok(i);
end;
end;
function bejar( i:byte ):longint;
begin
sehol_sem_jartunk;
darab:=0;
rek(i);
bejar := darab;
end;
function legkisebb:longint;
var max:longint;
i:byte;
begin
max:=1;
for i:=2 to n do
if( hivasok[i] > hivasok[max] ) then max := i;
legkisebb := max;
end;
procedure fajlba( legkisebb:longint );
var ki:text;
begin
assign(ki, strcat(strcat('osztaly',id),'.ki'));
rewrite(ki);
writeln(ki, legkisebb);
close(ki);
end;
procedure main;
var i:byte;
begin
for i:=1 to n do hivasok[i] := bejar(i);
fajlba( legkisebb );
end;
begin
clrscr;
beallit;
beolvas;
main;
end.
