Deprecated: Function set_magic_quotes_runtime() is deprecated in /DISK2/WWW/lokiware.info/mff/wakka.php on line 35
program Grafy;

uses Crt;

{ Maximalni mozny pocet vrcholu grafu. }
const MaxN = 20;

var

  { Ovladani menu. }
	Volba : char;

  { Pocet vrcholu. }
  N : integer;

	{ Stupne kazdeho vrcholu. Hodnoty nastavuje NactiGraf. }
  Stupne : array [1..MaxN] of integer;

  { Sousedi[i][1] az Sousedi[i][Stupne[i]] je seznam vrcholu sousedicich
    s vrcholem 'i'. Hodnoty nastavuje procedura NactiGraf. }
  Sousedi : array [1..MaxN, 1..MaxN] of integer;

  { Komponenty[i] udava cislo komponenty, do ktere patri vrchol 'i'.
    Hodnoty nastavuje procedura NajdiKomponenty. }
  Komponenty : array [1..MaxN] of integer;

  { Pocet komponent v grafu. Nastavuje procedure NajdiKomponenty. }
  PocetKomponent : integer;

	{ Uz mame nacteny nejaky graf? }
	NactenGraf : boolean;

{ ======================================================================== }
{ ======================================================================== }
{ ======================================================================== }

procedure Intro;
begin
  ClrScr;
	NactenGraf := False;
end;

{ ======================================================================== }

{ Nacte novy graf. Nejdrive se dopta na pocet vrcholu, pak se
  zadavaji jednotlive hrany. }

procedure NactiGrafZKonzole;
var
  i : integer;
  v1, v2 : integer;

begin
  Write('Pocet vrcholu: '); ReadLn(N);
  for i := 1 to N do Stupne[i] := 0;

  WriteLn('Hrany (dvojice cisel na radek, ukoncete dvojici 0 0): ');

  repeat
    Read(v1); ReadLn(v2);

    if (v1 > 0) and (v1 <= N) and (v2 > 0) and (v2 <= N) and (v1 <> v2) then
    begin
      Inc(Stupne[v1]);
      Inc(Stupne[v2]);
      Sousedi[v1][Stupne[v1]] := v2;
      Sousedi[v2][Stupne[v2]] := v1;
    end;
  until (v1=0) and (v2=0);

	NactenGraf := True;
end;

{ ======================================================================== }

{ Nacte graf ze souboru. Soubor ma nasledujici format: na prvnim radku je 
	pocet vrcholu, na dalsich radcich jsou pak dvojice cisel udavajicich hrany. 
	
	Pokud je JmenoSouboru prazdny string, zobrazi funkce vyzvu k zadani jmena
	souboru, ktery se ma nacist. }

procedure NactiGrafZeSouboru ( JmenoSouboru : string );
var
	Soubor : Text;
	v1, v2 : integer;
	i : integer;

begin
	while JmenoSouboru = '' do
	begin
		Write('Zadejte soubor k nacteni: ');
		ReadLn(JmenoSouboru);
	end;

	Assign(Soubor, JmenoSouboru);
	Reset(Soubor);

	ReadLn(Soubor, N);
	for i := 1 to N do Stupne[i] := 0;

	while not EOF(Soubor) do
	begin
		Read(Soubor, v1); ReadLn(Soubor, v2);

    if (v1 > 0) and (v1 <= N) and (v2 > 0) and (v2 <= N) and (v1 <> v2) then
    begin
      Inc(Stupne[v1]);
      Inc(Stupne[v2]);
      Sousedi[v1][Stupne[v1]] := v2;
      Sousedi[v2][Stupne[v2]] := v1;
    end;
	end;

	Close(Soubor);

	NactenGraf := True;
	
	WriteLn('Soubor ', JmenoSouboru, ' nacten.');
end;

{ ======================================================================== }

{ Vypise pocet vrcholu grafu a seznam jeho hran. }

procedure VypisGraf;
var
  i, j : integer;

begin
  WriteLn('Graf ma ', N, ' vrcholu a nasledujici hrany:');

  for i := 1 to N do
    for j := 1 to Stupne[i] do
      if Sousedi[i][j] > i then
        WriteLn(i, '-', Sousedi[i][j]);

  WriteLn;
end;

{ ======================================================================== }

{ Ulozi graf do souboru. Soubor ma nasledujici format: na prvnim radku je 
	pocet vrcholu, na dalsich radcich jsou pak dvojice cisel udavajicich hrany. 
	
	Pokud je JmenoSouboru prazdny string, zobrazi funkce vyzvu k zadani jmena,
 	pod kterym se ma soubor ulozit. }

procedure UlozGraf ( JmenoSouboru : string );
var
	Soubor : Text;
	i, j : integer;

begin
	while JmenoSouboru = '' do
	begin
		Write('Zadejte jmeno souboru: ');
		ReadLn(JmenoSouboru);
	end;

	Assign(Soubor, JmenoSouboru);
	Rewrite(Soubor);

	WriteLn(Soubor, N);
	
	for i := 1 to N do
		for j := 1 to Stupne[i] do
			if i < Sousedi[i,j] then WriteLn(Soubor, i, ' ', Sousedi[i,j]);

	Close(Soubor);
	WriteLn('Graf ulozen do souboru ', JmenoSouboru, '.');
end;

{ ======================================================================== }

{ Priradi StartovniVrchol do komponenty Komponenta. Zaroven priradi
  do teto komponenty take vsechny jeho sousedy a rekurzivne na tyto
  sousedy zavola sama sebe. }

procedure KomponentyDFS ( StartovniVrchol : integer; Komponenta : integer );
var
  i : integer;

begin
  Komponenty[StartovniVrchol] := Komponenta;

  for i := 1 to Stupne[StartovniVrchol] do
    if Komponenty[Sousedi[StartovniVrchol,i]] = 0 then
      KomponentyDFS(Sousedi[StartovniVrchol,i], Komponenta);
end;

{ ======================================================================== }

{ Naplni pole Komponenty a nastavi promennou PocetKomponent. }

procedure NajdiKomponenty;
var
  i : integer;

begin
  PocetKomponent := 0;
  for i := 1 to N do Komponenty[i] := 0;

  for i := 1 to N do
    if Komponenty[i] = 0 then
    begin
      Inc(PocetKomponent);
      KomponentyDFS(i, PocetKomponent);
    end;
end;

{ ======================================================================== }

{ Vypise seznam komponent a ke kazde z nich seznam jejich vrcholu. }

procedure VypisKomponenty;
var
  k, i : integer;

begin
  WriteLn('Graf ma ', PocetKomponent, ' komponent.');

  for k := 1 to PocetKomponent do
  begin
    Write('Komponenta ', k, ':');
    for i := 1 to N do
      if Komponenty[i] = k then Write(' ', i);
    WriteLn;
  end;

end;

{ ======================================================================== }

procedure Vzdalenost;
var
	{ Body, mezi kterymi hledame vzdalenost. }
  x, y : integer;

	{ VzdalenostOdX[i] je vzdalenost bodu 'i' od bodu 'x' vyjadrena
		poctem hran nejkratsi cesty. }
  VzdalenostOdX : array [1..MaxN] of integer;

	{ Jakmile vrchol 'i' poprve zpracujeme, nastavime Prozkouman[i]
	  na 'true', abychom vedeli, ze znovu ho zkoumat nemame. }
	Prozkouman : array [1..MaxN] of boolean;

	{ Fronta vrcholu k navstiveni, pomocna promenna pro metodu DBS. }
	Fronta : array [1..MaxN] of integer;

	{ FrontaW urcuje prvni volny index ve fronte, FrontaR urcuje
	  index k pristimu cteni. }
	FrontaW, FrontaR : integer;

	{}
	i, v, w : integer;

begin
  Write('Najit cestu mezi body: ');
	Read(x); ReadLn(y);

  for i := 1 to N do
 	begin
		VzdalenostOdX[i] := -1;
		Prozkouman[i] := False;
	end;

	VzdalenostOdX[x] := 0;

	FrontaR := 1; FrontaW := 2;
	Fronta[1] := x;

  while (FrontaR < FrontaW) and (VzdalenostOdX[y] = -1) do
	begin
		v := Fronta[FrontaR]; Inc(FrontaR);
    for i := 1 to Stupne[v] do
    begin
			w := Sousedi[v,i];
      if not Prozkouman[w] then
			begin
				VzdalenostOdX[w] := VzdalenostOdX[v]+1;
        Prozkouman[v] := True;
				Fronta[FrontaW] := w; Inc(FrontaW);
			end;
		end;
	end;

	if VzdalenostOdX[y] = -1 then
	  WriteLn('Mezi vrcholy ', x, ' a ', y, ' nevede zadna cesta.')
	else
  	WriteLn('Vzdalenost mezi vrcholy ', x, ' a ', y, ' je ', VzdalenostOdX[y], '.');
end;

{ ======================================================================== }
{ ======================================================================== }
{ ======================================================================== }

BEGIN
  Intro;

	Volba := ' ';
	while Volba <> 'x' do
	begin
    WriteLn('Tak co to bude?');
		WriteLn('(n) Nacist novy graf z konzole.');
		WriteLn('(m) Nacit novy graf ze souboru.');
		if NactenGraf then
		begin
			WriteLn('(k) Rozbor komponent.');
			WriteLn('(v) Vzdalenost dvou vrcholu.');
			WriteLn('(s) Ulozit graf.');
			WriteLn('(x) Konec programu.');
		end;

		ReadLn(Volba);
    WriteLn;

		case Volba of
			'n': NactiGrafZKonzole;
			'm': NactiGrafZeSouboru('');
			'k': begin
           NajdiKomponenty;
			     VypisKomponenty;
           end;
			'v': Vzdalenost;
			's': UlozGraf('')
		end;

    WriteLn;
	end;
END.