Zobrazenie zdroja stránky 34.Prednaska

{{Nadpis0nu|34. Prednáška|33.Prednaska|35.Prednaska}}

<!-- -->

== Backtracking na grafoch ==


Použijeme takúto schému backrackingu na grafe:

 procedure {{Blue|Backtracking(V1: Integer);}}
 var
   I: Integer;
 begin
   ''// zaznač jeden krok''
   Visited := Visited + [V1];
   if ''{som v cieli}'' then
     ''// zaznač riešenie
   else
     for I := ''{všetky susediace vrcholy, t.j. platí JeHrana(V1, I)}'' do
       if not (I in Visited) then
       begin
         ''// zvýrazni hranu''
         {{Blue|Backtracking(I);}}
         ''// prekresli ako obyčajnú hranu''
       end;
   ''// odznač jeden krok''
   Visited := Visited - [V1];
 end;

Pri takto zapísanom algoritme Backtracking, predpokladáme, že začíname v nejakom zadanom vrchole grafu '''V1''' a pokračujeme na susediacich vrcholoch tak, aby sa neprešlo viackrát cez jeden vrchol.

Použijeme čiastočne [[Media:P34.zip|'''pripravený projekt''']], v ktorom je (v unite GrafUnit.pas) zadefinovaná trieda '''TGraf''':
 type
   TVrchol = class
     X, Y: Integer;
     F: TColor;
     Num: Integer;
     {{Blue|Sus: array of Integer;}}
     constructor Create(XX, YY: Integer);
     procedure Kresli(C: TCanvas);
   end;
   &nbsp;
   TGraf = class
   public
     G: array of TVrchol;
     {{Blue|Visited: set of Byte;}}
     Image: TImage;
     constructor Create(Im: TImage; N, H1, H2: Integer);
     procedure Kresli;
     procedure KresliHranu(V1, V2: Integer; F: TColor);
     function JeHrana(V1, V2: Integer): Boolean;
     {{Blue|procedure Start(V1, V2: Integer);}}
   private
     {{Blue|procedure Backtracking(V1, V2: Integer);}}
   end;

Môžete vidieť, že pre graf sme použili reprezentáciu ''tabuľka susedností'', pri ktorej je v každom prvku matice celé číslo, t.j. '''váha''' príslušnej hrany. Zadefinovali sme aj metódu '''Start''', ktorá bude slúžiť na volanie backtrackingu - tú ale bude treba neskôr dopísať.

Vo formulári v unite '''Unit1''' sme zadefinovali dve tlačidlá a jeden vstupný riadok '''Edit1''':
* '''Button1''' - vygeneruje nový ohodnotený graf v štvorcovej sieti NxN, kde '''N''' je celé číslo v '''Edit1'''
* '''Button2''' - vygeneruje nový ohodnotený graf v štvorcovej sieti NxN, pričom niektoré hrany s istou pravdepodobnosťou chýbajú

Kliknutie na dva vrcholy v grafe tieto zafarbí a zavolá metódu '''Start''':
 var
   Graf: TGraf;
   Prvy: Integer = -1;
 &nbsp;
 procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
   Shift: TShiftState; X, Y: Integer);
 var
   I: Integer;
 begin
   I := High(Graf.G);
   while (I >= 0) and (Sqr(Graf.G[I].X - X) + Sqr(Graf.G[I].Y - Y) > 100) do
     Dec(I);
   if I < 0 then
     Exit;
   if Prvy < 0 then
   begin
     Prvy := I;
     Graf.G[I].F := clRed;
     Graf.Kresli;
   end
   else
   begin
     Graf.G[I].F := clGreen;
     Graf.Kresli;
     {{Blue|Graf.Start(Prvy, I);}}
     Prvy := -1;
   end;
 end;

V ďalších častiach tejto prednášky budeme vytvárať rôzne verzie backtrackingu, ktoré budú vychádzať z tejto schémy a riešiť rôzne úlohy.

<!-- -->

== Najdlhšia cesta ==


Napíšeme algoritmus, ktorý nájde najdlhšiu cestu medzi dvoma zadanými vrcholmi v grafe. Vrcholy zadávame kliknutím v grafickej ploche: prvé kliknutie označí štartový vrchol, druhé kliknutie označí cieľový vrchol.

Využijeme pripravený projekt, do ktorého doplníme telo metódy '''Backtracking''' a do metódy '''Start''' pridáme inicializáciu premenných '''Sucet''', '''NajSucet''' a '''Pocet''':
 procedure TGraf.Start(V1, V2: Integer);
 var
   I: Integer;
 begin
   Visited := [];
   Pocet := 0;
   Sucet := 0;
   NajSucet := 0;
 &nbsp;
   Backtracking(V1, V2);
 &nbsp;
   for I := 0 to High(G) do
     G[I].F := clWhite;
 end;

Tieto tri premenné budú mať v algoritme tento význam:
* '''Sucet''' - momentálna dĺžka cesty, t.j. súčet ohodnotení hrán, z ktorých sa skladá momentálna cesta
** vždy, keď sa cesta predĺži o ďalšiu hranu, táto premenná sa zvýši o hodnotu tejto hrany
* '''NajSucet''' - momentálne najdlhšia nájdená cesta
** na začiatku má hodnotu 0, preto aj test, ktorý zisťuje najlepšiu cestu, musí s tým počítať
* '''Pocet''' počet všetkých nájdených ciest z '''V1''' do '''V2'''

Algoritmus prehľadávania bude postupne generovať všetky možné cesty, ktoré začínajú vo vrchol '''V1''' a končia vo vrchole '''V2'''. Vždy, keď nejaké takéto riešenie nájde a jeho dĺžka je väčšia, ako doteraz najlepšia, tak si ju zapamätá:
 procedure TGraf.Backtracking(V1, V2: Integer);
 var
   I: Integer;
 begin
   Visited := Visited + [V1];
 &nbsp;
   if V1 = V2 then
   begin
     if (NajSucet = 0) or (Sucet > NajSucet) then
       NajSucet := Sucet;
     Inc(Pocet);
     Image.Canvas.TextOut(0, 0, IntToStr(Pocet) + ' ' + IntToStr(NajSucet));
   end
   else
     for I := 0 to High(G) do
       if not (I in Visited) and JeHrana(V1, I) then
       begin
         KresliHranu(V1, I, clRed);
         Inc(Sucet, G[V1].Sus[I]);
         Image.Parent.Repaint;
         Sleep(100);
 &nbsp;
         {{Blue|Backtracking(I, V2);}}
 &nbsp;
         KresliHranu(V1, I, clLtGray);
         Dec(Sucet, G[V1].Sus[I]);
       end;
 &nbsp;
   Visited := Visited - [V1];
 end;

Algoritmus nám neukáže túto nájdenú najdlhšiu cestu, len vie zistiť túto dĺžku. Tiež vie zistiť počet všetkých ciest z jedného vrcholu do druhého.

Po kliknutí na dva vrcholy sa rozbehne algoritmus prehľadávania - postupne sa zobrazuje vytváraná cesta. Keď táto cesta dorazí do druhého vrcholu, zvýši sa počítadlo '''Pocet''' a aktualizuje sa dĺžka najdlhšej cesty (zobrazia sa v ľavom hodnom rohu grafickej plochy). Po skončení algoritmu prehľadávania, bude graf zobrazený v pôvodnom stave (bez zvýraznených hrán), v ktorom budeme vidieť len zafarbené dva vrcholy: štartový a koncový. Teraz môžeme zvoliť nejakú inú dvojicu vrcholov a backtracking sa odštartuje odznovu. Ak by sme z programu odstránili (alebo zakomentovali) dva riadky: '''Image.Parent.Repaint; Sleep(100);''', program by sa výrazne urýchlil a hneď po kliknutí na nejaké dva vrcholy by sa zobrazila dĺžka najdlhšej cesty a počet všetkých ciest.


Ďalšie námety:
* Upravte program tak, aby našiel najkratšiu cestu medzi dvoma vrcholmi
* Upravte program tak, aby vypísal nielen dĺžku najdlhšej (najkratšej) cesty, ale aj počet takýchto najdlhších (najkratších) ciest
* Upravte program tak, aby našiel najdlhší (resp. najkratší) cyklus

<!-- -->

== Cesta zadanej dĺžky ==


Malou zmenou predchádzajúceho prehľadávania s návratom, budem riešiť takúto úlohu:
* potrebujeme nájsť cestu z '''V1''' do '''V2''', ktorej dĺžka (súčet hodnôt hrán) je presne zadané číslo

Procedúra '''Start''', ktorá inicializuje premenné pred zavolaním backtrackingu, musí byť zmenená napr. takto:
 procedure TGraf.Start(V1, V2: Integer);
 var
   I: Integer;
 begin
   Visited := [];
   Pocet := 0;
   Sucet := 0;
   {{Blue|NajSucet :{{=}} 20;}}
 &nbsp;
   Backtracking(V1, V2);
 &nbsp;
   if Pocet = 0 then
     Image.Canvas.TextOut(0, 0, 'nenašiel žiadnu cestu');
 &nbsp;
   for I := 0 to High(G) do
     G[I].F := clWhite;
 end;

Samotný backtracking sa zmení veľmi málo:
 procedure TGraf.Backtracking(V1, V2: Integer);
 var
   I: Integer;
 begin
   Visited := Visited + [V1];
 &nbsp;
   if V1 = V2 then
   begin
     {{Blue|if Sucet {{=}} NajSucet then}}
     begin
       Inc(Pocet);
       Image.Canvas.TextOut(0, 0, 'počet riešení je ' + IntToStr(Pocet));
     end;
   end
   else
     for I := 0 to High(G) do
       if not (I in Visited) and JeHrana(V1, I) then
       begin
         KresliHranu(V1, I, clRed);
         Inc(Sucet, G[V1].Sus[I]);
         Image.Parent.Repaint;
 &nbsp;
         {{Blue|if Sucet <{{=}} NajSucet then}}
           Backtracking(I, V2);
 &nbsp;
         KresliHranu(V1, I, clLtGray);
         Dec(Sucet, G[V1].Sus[I]);
       end;
   Visited := Visited - [V1];
 end;

Tento program opäť nenájde konkrétnu aspoň jednu cestu, ktorá by vyhovovala riešeniu, ale zistí počet takýchto ciest. Všimnite si, že pred rekurzívne volanie sme pridali test '''if Sucet <= NajSucet then'''. Vďaka nemu sa nebude zbytočne hľadať riešenie v situácii, keď už momentálna dĺžky prejdenej cesty je viac ako hľadané '''NajSucet'''. Algoritmus by správne fungoval aj bez tohto testu, len by mu to mohlo trvať výrazne dlhšie. Programátori sa často snažia nájsť čo najlepšie obmedzenia, ktoré by mohli pomôcť nájsť riešenie čo najrýchlejšie. Backtracking je veľmi často skoro nepoužiteľne pomalý.


V mnohých situáciách ale nepotrebujeme poznať počet všetkých riešení, ale stačí nám hocijaké jedno riešenie. Napr. v našej úlohe by sme mohli byť spokojní, keby backtracking vykreslil jedno ľubovoľné riešenie a skončil. Potom by sme mohli zvoliť nejaké iné dva vrcholy a hľadať ďalšie riešenie.

Upravíme predchádzajúci program tak, že po nájdení prvého riešenia (t.j. '''Pocet > 0''') algoritmus už nebude hľadať ďalšie možnosti a hneď skončí. Keďže backtracking je rekurzívny algoritmus, príkaz '''Exit''' nespôsobí okamžité ukončenie prehľadávania, ale skončí len jedno posledné rekurzívne volanie. Z tohto dôvodu pridáme do programu test na vyskočenie z podprogramu:
 procedure TGraf.Backtracking(V1, V2: Integer);
 var
   I: Integer;
 begin
   Visited := Visited + [V1];
 &nbsp;
   if V1 = V2 then
   begin
     if Sucet = NajSucet then
     begin
       Inc(Pocet);
       ''// Image.Canvas.TextOut(0, 0, 'počet riešení je ' + IntToStr(Pocet));''
     end;
   end
   else
     for I := 0 to High(G) do
       if not (I in Visited) and JeHrana(V1, I) then
       begin
         KresliHranu(V1, I, clRed);
         Inc(Sucet, G[V1].Sus[I]);
         ''// Image.Parent.Repaint;''
 &nbsp;
         if Sucet <= NajSucet then
           Backtracking(I, V2);
 &nbsp;
         {{Blue|if Pocet > 0 then}}
           {{Blue|Exit;}}
 &nbsp;
         KresliHranu(V1, I, clLtGray);
         Dec(Sucet, G[V1].Sus[I]);
       end;
   Visited := Visited - [V1];
 end;

Takto zapísaný algoritmus skončí po prvom nájdenom riešení. Keďže z procedúry vyskakuje už pred zmazaním kreslenej hrany, pre túto nájdenú cestu ostane nakreslená celá trasa.

Namiesto celočíselnej premennej '''Pocet''' by sme tu mohli použiť logickú premennú (napríklad '''OK'''), v ktorej by bolo na začiatku '''False''' (nastavili by sme ju v procedúre '''Start'''), po nájdení prvého riešenia by sme do nej priradili '''True''' a namiesto testov '''if Pocet > 0 then''' by sme testovali '''if OK then'''.

<!-- -->

== Cyklus zadanej dĺžky ==


Niekedy potrebujeme nájsť cestu, ktorá začína aj končí v tom istom vrchole, tzv. cyklus. Doterajšie verzie backtrackingu (najdlhšia cesta alebo cesta presnej dĺžky) s tým nepočítali a pomocou nich sa nedá nájsť žiaden cyklus. V doterajších backtrackingoch označíme '''V1''' ako už navštívený vrchol a preto bude robiť problém nielen test '''if V1 = V2 then''', ale aj ''' if not (I in Visited) ...'''.

Upravme preto predchádzajúci algoritmus (hľadal cestu presnej dĺžky '''NajSucet''') tak, aby hľadal cyklus presnej dĺžky:
 procedure TGraf.Backtracking(V1, V2: Integer);
 var
   I: Integer;
 begin
   Visited := Visited + [V1];
 &nbsp;
   {{Blue|if (V1 {{=}} V2) and (Sucet > 0) then}}
     OK := True
   else
     for I := 0 to High(G) do
       if JeHrana(V1, I) and ({{Blue|((I {{=}} V2) and (Sucet + G[V1].Sus[I] {{=}} NajSucet) or}} not (I in Visited))) then
       begin
         KresliHranu(V1, I, clRed);
         Inc(Sucet, G[V1].Sus[I]);
         Image.Parent.Repaint;
 &nbsp;
         if Sucet <= NajSucet then
           Backtracking(I, V2);
 &nbsp;
         if OK then
           Exit;
 &nbsp;
         KresliHranu(V1, I, clLtGray);
         Dec(Sucet, G[V1].Sus[I]);
       end;
   Visited := Visited - [V1];
 end;

Tento program budeme teraz štartovať dvojklikom na nejaký vrchol, lebo potrebujeme aby '''V1 = V2'''.

V algoritme sme museli opraviť tieto dva testy:
* v prvom prípade '''if (V1 = V2) and (Sucet > 0) then''' sme zabezpečili, aby algoritmus neskončil ešte skôr ako začal
* v druhom prípade sme pridali '''if ((I = V2) and (Sucet + G[V1].Sus[I] = NajSucet) or ...''' aby sme umožnili stúpiť na '''V2''' ale len vtedy, keď tým získame dobrú dĺžku cesty

Všimnite si, že namiesto počítadla počtu riešení '''Pocet''' sme tu použili logickú premennú '''OK'''. Táto by mala byť v procedúre '''Start''' inicializovaná na '''False'''.


Ďalšie námety:
* upravte algoritmus tak, aby hľadal najkratší, resp. najdlhší cyklus v grafe z vrcholu '''V1'''
* upravte algoritmus tak, aby hľadal ľubovoľný cyklus, ktorý prechádza cez nejaký zadaný vrchol (napr. '''V3''')

<!-- -->

== Vrcholy v zadanej vzdialenosti ==


Teraz upravíme algoritmus prehľadávania tak, aby farebne vyznačil všetky vrcholy, ku ktorým existuje cesta nejakej presnej vzdialenosti. To znamená, že nepoznáme cieľový vrchol '''V2''', ale všetky potenciálne cieľové vrcholy (vrcholy, ktoré vyhovujú zadaniu) nejako označíme. Na to nám bude stačiť procedúra '''Backtracking''' s jedným parametrom - momentálnym vrcholom. Na farebné označovanie vrcholov využijeme to, že každý vrchol má svoj atribút '''Farba''', ktorý označuje farbu výplne pri kreslení vrcholu.

Procedúra '''Start''' bude volať backtracking len s jedným parametrom:
 procedure TGraf.Start(V1, V2: Integer);
 var
   I: Integer;
 begin
   Visited := [];
   Pocet := 0;
   Sucet := 0;
   {{Blue|NajSucet :{{=}} 20;}}
 &nbsp;
   Backtracking(V1);
 &nbsp;
   if Pocet = 0 then
     Image.Canvas.TextOut(0, 0, 'nevyhovujú žiadne vrcholy');
 &nbsp;
   for I := 0 to High(G) do
     G[I].F := clWhite;
 end;

Do premennej '''NajSucet''' priradíme hodnotu, ktorá bude označovať očakávanú vzdialenosť hľadaných vrcholov, napr. 20.

Backtracking môže vyzerať takto:
 procedure TGraf.Backtracking(V1: Integer);
 var
   I: Integer;
 begin
   Visited := Visited + [V1];
 &nbsp;
   if Sucet = NajSucet then
   begin
     {{Blue|G[V1].F :{{=}} clYellow;}}
     {{Blue|G[V1].Kresli(Image.Canvas);}}
     Inc(Pocet);
     Image.Canvas.TextOut(0, 0, 'počet vrcholov je ' + IntToStr(Pocet));
   end
   else
     for I := 0 to High(G) do
       if not (I in Visited) and JeHrana(V1, I) then
       begin
         KresliHranu(V1, I, clRed);
         Inc(Sucet, G[V1].Sus[I]);
         Image.Parent.Repaint;
 &nbsp;
         if Sucet <= NajSucet then
           Backtracking(I);
 &nbsp;
         KresliHranu(V1, I, clLtGray);
         Dec(Sucet, G[V1].Sus[I]);
       end;
   Visited := Visited - [V1];
 end;

Keďže pre väčšiu hodnotu '''NajSucet''' a tiež pre väčšie grafy tento algoritmus môže dosť dlho trvať, môžeme ho urýchliť tak, že zablokujeme vykresľovanie hrán, napr.
 procedure TGraf.Backtracking(V1: Integer);
 var
   I: Integer;
 begin
   Visited := Visited + [V1];
 &nbsp;
   if Sucet = NajSucet then
   begin
     G[V1].F := clYellow;
     G[V1].Kresli(Image.Canvas);
     Inc(Pocet);
     Image.Canvas.TextOut(0, 0, 'počet vrcholov je ' + IntToStr(Pocet));
   end
   else
     for I := 0 to High(G) do
       if not (I in Visited) and JeHrana(V1, I) then
       begin
         ''// KresliHranu(V1, I, clRed);''
         Inc(Sucet, G[V1].Sus[I]);
         ''// Image.Parent.Repaint;''
 &nbsp;
         if Sucet <= NajSucet then
           Backtracking(I);
 &nbsp;
         ''// KresliHranu(V1, I, clLtGray);''
         Dec(Sucet, G[V1].Sus[I]);
       end;
   Visited := Visited - [V1];
 end;

Všimnite si, že v niektorých prípadoch sa vypíše iný počet cieľových vrcholov, ako ich môžeme spočítať na grafe. Premenná '''Pocet''' sa zvyšuje vždy, keď prídeme do niektorého vrcholu, ktorý je v zadanej vzdialenosti. Lenže k niektorým vrcholom môže existovať aj viac rôznych ciest a preto sa počítadlo '''Pocet''' zvýši viackrát ako treba. Mohli by sme napr. pred zvyšovaním počítadla skontrolovať farbu vrcholu:
   if Sucet = NajSucet then
   begin
     if G[V1].F = clWhite then
       Inc(Pocet);
     G[V1].F := clYellow;
     G[V1].Kresli(Image.Canvas);
     ...

<!-- -->

== Zapamätávanie cesty ==


Často sa pri hľadaní cesty v grafe s nejakou vlastnosťou stretáme s takou požiadavkou, že si potrebujeme túto najlepšiu cestu nejako zapamätávať. Asi najvhodnejšie je použiť dynamické pole celých čísel, do ktorého si budeme postupne ukladať navštevované vrcholy grafu. Do triedy '''TGraf''' pridáme nové atribúty:
 type
   TGraf = class
     G: array of TVrchol;
     Visited: set of Byte;
     Image: TImage;
     Pocet, Sucet, NajSucet: Integer;
     {{Blue|Cesta, NajCesta: array of Integer;}}
     ...

Použitie uloženej cesty ukážeme na príklade, v ktorom hľadáme najdlhšiu cestu medzi dvoma zadanými vrcholmi. Samotný backtracking bude do premennej '''Cesta''' pridávať prechádzané vrcholy, pri návrate z procedúry ich bude z tohto poľa vyhadzovať. Vždy, keď príde do cieľového vrcholu, skontroluje, či je nájdená cesta dlhšia ako doteraz najlepšia a ak áno, zapamätá si toto riešenie:
 procedure TGraf.Backtracking(V1, V2: Integer);
 var
   I: Integer;
 begin
   Visited := Visited + [V1];
   {{Blue|SetLength(Cesta, Length(Cesta) + 1);}}
   {{Blue|Cesta[High(Cesta)] :{{=}} V1;}}
 &nbsp;
   if V1 = V2 then
   begin
     if Sucet > NajSucet then
     begin
       NajSucet := Sucet;
       {{Blue|NajCesta :{{=}} Cesta;}}
       Image.Canvas.TextOut(0, 0, 'najdlhšia je ' + IntToStr(NajSucet));
     end;
   end
   else
     for I := 0 to High(G) do
       if not (I in Visited) and JeHrana(V1, I) then
       begin
         KresliHranu(V1, I, clRed);
         Inc(Sucet, G[V1].Sus[I]);
         Image.Parent.Repaint;
 &nbsp;
         Backtracking(I, V2);
 &nbsp;
         KresliHranu(V1, I, clLtGray);
         Dec(Sucet, G[V1].Sus[I]);
       end;
   Visited := Visited - [V1];
   {{Blue|SetLength(Cesta, Length(Cesta) - 1);}}
 end;

Musíme ešte inicializovať obe tieto premenné a tiež na záver vykresliť nájdené riešenie. Robíme to v procedúre '''Start''':
 procedure TGraf.Start(V1, V2: Integer);
 var
   I: Integer;
 begin
   Visited := [];
   Pocet := 0;
   Sucet := 0;
   NajSucet := 0;
   {{Blue|Cesta :{{=}} nil;}}
   {{Blue|NajCesta :{{=}} nil;}}
 &nbsp;
   Backtracking(V1, V2);
 &nbsp;
   if {{Blue|NajCesta {{=}} nil}} then
     Image.Canvas.TextOut(0, 0, 'nenašiel žiadnu cestu')
   else
     for I := 0 to {{Blue|High(NajCesta) - 1}} do
       KresliHranu({{Blue|NajCesta[I], NajCesta[I + 1]}}, clBlue);
 &nbsp;
   for I := 0 to High(G) do
     G[I].F := clWhite;
 end;

Ďalší námet:
* počas priebehu backtrackingu si nemusíme priebežne počítať dĺžku cesty v premennej '''Sucet''', ale túto môžeme vypočítať z cesty uloženej v poli '''Cesta''' - toto musíme robiť tesne pred testovaním '''if Sucet > NajSucet then'''

<!-- -->

== Dosiahnuteľnosť vrcholu ==


Keď pozorujeme priebeh backtrackingu na grafe - ako sa vykresľujú prechádzané hrany - niekedy vidíme, že algoritmus sa dostal do stavu, keď veľmi dlho prehľadáva nejakú slepú vetvu. My vidíme, že zbytočne, lebo do cieľa sa z tohto miesta aj tak dostať nemôže. Tu by sa zišlo zabezpečiť, keby to vedel zistiť aj algoritmus prehľadávania. My už vieme veľmi jednoducho zistiť, či nejaké dva vrcholy v grafe sú v tom istom komponente - napr. pomocou obyčajného algoritmu do hĺbky. Ak by sme vedeli zabezpečiť, že do niektorých vrcholov v grafe sa už nesmie stúpiť (sú vo '''Visited''' bežiaceho algoritmu backtracking), tak algoritmus do hĺbky vlastne odpovie, či existuje cesta z momentálneho vrcholu (v ktorom je backtracking) do cieľového vrcholu. Ak cesta neexistuje, nemá zmysel v backtrackingu pokračovať.

Dopíšme do backtrackingu testovanie po každom kroku, či sa stále dá dostať do cieľa:
 procedure TGraf.Backtracking(V1, V2: Integer);
 var
   I: Integer;
 &nbsp;
   {{Blue|function Test: Boolean;}}
   var
     mVisited: set of Byte;
 &nbsp;
     procedure DoHlbky(V: Integer);
     var
       J: Integer;
     begin
       mVisited := mVisited + [V];
       for J := 0 to High(G) do
         if not (J in mVisited) and JeHrana(V, J) then
           DoHlbky(J);
     end;
 &nbsp;
   begin
     mVisited := Visited;
     DoHlbky(I);
     Result := V2 in mVisited;
   end;
 &nbsp;
 begin
   Visited := Visited + [V1];
   SetLength(Cesta, Length(Cesta) + 1);
   Cesta[High(Cesta)] := V1;
 &nbsp;
   if V1 = V2 then
   begin
     if Sucet > NajSucet then
     begin
       NajSucet := Sucet;
       NajCesta := Cesta;
       Image.Canvas.TextOut(0, 0, 'najdlhšia je ' + IntToStr(NajSucet));
       Image.Parent.Repaint;
       Sleep(1000);
     end;
   end
   else
     for I := 0 to High(G) do
       if not (I in Visited) and JeHrana(V1, I) then
       begin
         KresliHranu(V1, I, clRed);
         Inc(Sucet, G[V1].Sus[I]);
         Image.Parent.Repaint;
 &nbsp;
         {{Blue|if Test then}}
           Backtracking(I, V2);
 &nbsp;
         KresliHranu(V1, I, clLtGray);
         Dec(Sucet, G[V1].Sus[I]);
       end;
   Visited := Visited - [V1];
   SetLength(Cesta, Length(Cesta) - 1);
 end;

Všimnite si, že procedúra '''Test''' vo svojom tele využíva tieto premenné:
* '''Visited''' - doteraz navštívené vrcholy, ktoré musí algoritmus ignorovať
* '''V2''' - cieľový vrchol
* '''I''' - momentálny vrchol backtrackingu - pre algoritmus do hĺbky je to štartový vrchol
Tento algoritmus do hĺbky musí mať svoju vlastnú množinu navštívených vrcholov ('''mVisited'''), aby nepoškodil množinu '''Visited''' pre backtracking.


Ďalšie námety:
* testovať po každom kroku nemusí byť vždy najvhodnejšie, lebo aj algoritmus do hĺbky niečo trvá; zmeňte algoritmus tak, aby sa testovanie naštartovalo až vtedy, keď vytvorená cesta (premenná '''Cesta''') je aspoň nejakej konkrétnej dĺžky (napr. 10) a samotné testovanie sa robí pri každom 3 predĺžení cesty
** otestujte, či sa teraz algoritmus časovo skrátil alebo predĺžil

<!-- -->

== Prerušenie prehľadávania ==


V niektorých situáciách samotné prehľadávanie trvá tak dlho, že by sme ho radi prerušili a boli by sme spokojní aj s tým riešením, ktoré sa mu podarilo dovtedy nájsť. Síce asi nebude najlepšie možné, ale niekedy nám môže postačovať. Jednoduché vloženie tlačidla do formuláru, ktoré by zastavilo vykonávanie bežiaceho algoritmu, nebude fungovať. Keď totiž spustíme prehľadávanie, celá aplikácia "zamrzne" a nedá sa nielen zastaviť, ale ani zatvoriť, nefungujú vtedy ani klikania myšou a ani vstup z klávesnice.

Možností, ako toto riešiť je niekoľko. Asi najsprávnejšie a programátorsky najčistejšie by bolo samotný algoritmus prehľadávania vložiť do samostatného vlákna (thread). Ak je to naprogramované korektne, vtedy by mali reagovať všetky prvky vo formulári a môžeme zabezpečiť aj ukončenie behu rekurzie (napr. pomocnou logickou premennou OK, ktorá sa kontroluje v rekurzii a keď treba, vyskočí z nej). Tento spôsob riešenia si môžete vyskúšať - je časovo náročnejší na realizáciu a tiež organizáciu vykreslovania (treba využiť synchronizáciu), ale veľa sa na ňom naučíte.

My si tu ukážeme jeden veľmi jednoduchý spôsob. Bežiaca aplikácia, aj keď je veľmi intenzívne zaneprázdnená náročným výpočtom, môže testovať, či sa nestlačil nejaký kláves, resp. či sa nekliklo myšou niekde v aplikácii. Niekde do aplikácie - na miesto, cez ktoré sa ale často prechádza, napr. do tela backtrackingu, vložíme test na zatlačenie niektorého konkrétneho klávesu (napr. '''ESC'''). V prípade, že bol tento kláves zatlačený, nastavíme backtrackingu stav, že ho treba čo najskôr ukončiť.

Využijeme funkciu '''GetAsyncKeyState''', ktorá sa nachádza v unite '''Windows''' (do musíme ju pripísať do '''uses''' unitu '''GrafUnit.pas'''). Funkcia má jeden parameter - virtuálny kód klávesu a vráti informáciu o zatlačení tohto klávesu. V programe to môžeme testovať napr. takto
 if GetAsyncKeyState(VK_ESCAPE) < 0 then
   OK := True;

Ďalšie virtuálne kódy sú napr.
* '''VK_SHIFT'''
* '''VK_CONTROL''' - kláves Ctrl
* '''VK_MENU''' - kláves Alt
* '''VK_RETURN''' - kláves Enter

Backtracking pozmeníme napr. takto
 procedure TGraf.Backtracking(V1, V2: Integer);
 var
   I: Integer;
 &nbsp;
   ...
 &nbsp;
 begin
   {{Blue|if GetAsyncKeyState(VK_ESCAPE) < 0 then}}
     OK := True;
   if OK then
     Exit;
   Visited := Visited + [V1];
   ...

Premennú '''OK''' inicializujeme na '''False''' ešte pred volaním backtrackingu v procedúre '''Start'''.


Po spustení takto upravenej aplikácie backtracking normálne beží až do momentu, keď stlačíme kláves '''Esc'''. Vtedy sa už backtracking prestane "zarekurzívňovať", ale z rekurzívnych volaní sa korektne "vymotá". Riadenie sa teda vráti na miesto, kde bol backtracking zavolaný, t.j. do procedúry '''Start'''. Ak sa stihlo nájsť nejaké riešenie (uložilo sa do premennej '''NajCesta'''), toto sa vykreslí ako hľadané riešenie. My ale vieme, že keďže bol backtracking prerušený, toto nemusí byť najlepšie riešenie.

<!-- -->

== Backtracking s hranami ==


Ukážeme, ako môžeme pomocou backtrackingu riešiť úlohy, v ktorých nie je dôležité to či cez nejaký vrchol prechádzame viackrát. Obmedzením na vytváranie cesty môže byť len to, že po každej hrane prechádzame maximálne raz. V takýchto prípadoch si nepotrebujeme pamätať, ktoré vrcholy sme už navštívili (premenná '''Visited'''), ale musíme nejako zabezpečiť to, že po hrane prechádzame len raz. Jednou z možností je dočasné odstránenie hrany z grafu: vždy keď po nej prejdeme, tak ju odstránime a keď sa z rekurzívneho volania vraciame, hranu vrátime. Samozrejme, že pre ohodnotené grafy si musíme pri odstraňovaní hrany zapamätať jej hodnotu, aby sme ju mohli vrátiť späť.

Vyriešme úlohu, v ktorej hľadáme medzi vrcholmi '''V1''' a '''V2''' najdlhšiu cestu v grafe, pričom cesta môže prechádzať cez vrcholy aj viackrát. Môže prejsť viackrát aj cez vrchol '''V1''' aj '''V2'''. Preto, keď sa príde do vrcholu '''V2''', nemusí to ešte nutne znamenať koniec cesty - je možné, že existuje ešte dlhšia, ktorá ešte pokračuje ďalej a znovu sa vráti do vrcholu '''V2'''. Backtracking môžeme zapísať napr. takto
 procedure TGraf.Backtracking(V1, V2: Integer);
 var
   I: Integer;
   V0, H: Integer;
 begin
   ''// označ ťah - odstráň hranu''
   if Cesta <> nil then
   begin
     V0 := Cesta[High(Cesta)];
     {{Blue|H :{{=}} G[V0].Sus[V1];}}
     {{Blue|G[V0].Sus[V1] :{{=}} 0;}}
     {{Blue|G[V1].Sus[V0] :{{=}} 0;}}
   end;
   SetLength(Cesta, Length(Cesta) + 1);
   Cesta[High(Cesta)] := V1;
 &nbsp;
   if V1 = V2 then
   begin
     if (NajSucet = 0) or (Sucet > NajSucet) then
       begin
         NajSucet := Sucet;
         NajCesta := Cesta;
       end;
     Inc(Pocet);
     Image.Canvas.TextOut(0, 0, IntToStr(Pocet) + ' ' + IntToStr(NajSucet));
     Image.Parent.Repaint;
   end;
   ''// else''
   for I := 0 to High(G) do
     {{Blue|if JeHrana(V1, I) then}}
     begin
       KresliHranu(V1, I, clRed);
       Inc(Sucet, G[V1].Sus[I]);
       Image.Parent.Repaint;
 &nbsp;
       Backtracking(I, V2);
 &nbsp;
       KresliHranu(V1, I, clGray);
       Dec(Sucet, G[V1].Sus[I]);
     end;
   ''// odznač ťah - vráť hranu''
   SetLength(Cesta, Length(Cesta) - 1);
   if Cesta <> nil then
   begin
     {{Blue|G[V0].Sus[V1] :{{=}} H;}}
     {{Blue|G[V1].Sus[V0] :{{=}} H;}}
   end;
 end;

Ďalšie námety:
* algoritmus nájde najdlhší cyklus v grafe, v ktorom sa prejde po každej hrane max. raz
* algoritmus sa pokúsi prejsť všetky hrany grafu "jedným ťahom" - hrany nie sú ohodnotené
** backtracking skončí po prvom nájdenom riešení
** program zistí počet riešení


<!-- -->

{{nav|33.Prednaska|35.Prednaska}}