34.Prednaska

34. Prednáška

späť | ďalej

---

úlohy | cvičenie

Backtracking na grafoch

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

procedure 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
        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 pripravený projekt, v ktorom je (v unite GrafUnit.pas) zadefinovaná trieda TGraf:

type
  TVrchol = class
    X, Y: Integer;
    F: TColor;
    Num: Integer;
    Sus: array of Integer;
    constructor Create(XX, YY: Integer);
    procedure Kresli(C: TCanvas);
  end;
   
  TGraf = class
  public
    G: array of TVrchol;
    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;
    procedure Start(V1, V2: Integer);
  private
    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;
 
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;
    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;
 
  Backtracking(V1, V2);
 
  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];
 
  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);
 
        Backtracking(I, V2);
 
        KresliHranu(V1, I, clLtGray);
        Dec(Sucet, G[V1].Sus[I]);
      end;
 
  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;
  NajSucet := 20;
 
  Backtracking(V1, V2);
 
  if Pocet = 0 then
    Image.Canvas.TextOut(0, 0, 'nenašiel žiadnu cestu');
 
  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];
 
  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;
 
        if Sucet <= NajSucet then
          Backtracking(I, V2);
 
        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];
 
  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;
 
        if Sucet <= NajSucet then
          Backtracking(I, V2);
 
        if Pocet > 0 then
          Exit;
 
        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];
 
  if (V1 = V2) and (Sucet > 0) then
    OK := True
  else
    for I := 0 to High(G) do
      if JeHrana(V1, I) and (((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;
 
        if Sucet <= NajSucet then
          Backtracking(I, V2);
 
        if OK then
          Exit;
 
        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;
  NajSucet := 20;
 
  Backtracking(V1);
 
  if Pocet = 0 then
    Image.Canvas.TextOut(0, 0, 'nevyhovujú žiadne vrcholy');
 
  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];
 
  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;
 
        if Sucet <= NajSucet then
          Backtracking(I);
 
        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];
 
  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;
 
        if Sucet <= NajSucet then
          Backtracking(I);
 
        // 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;
    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];
  SetLength(Cesta, Length(Cesta) + 1);
  Cesta[High(Cesta)] := V1;
 
  if V1 = V2 then
  begin
    if Sucet > NajSucet then
    begin
      NajSucet := Sucet;
      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;
 
        Backtracking(I, V2);
 
        KresliHranu(V1, I, clLtGray);
        Dec(Sucet, G[V1].Sus[I]);
      end;
  Visited := Visited - [V1];
  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;
  Cesta := nil;
  NajCesta := nil;
 
  Backtracking(V1, V2);
 
  if NajCesta = nil then
    Image.Canvas.TextOut(0, 0, 'nenašiel žiadnu cestu')
  else
    for I := 0 to High(NajCesta) - 1 do
      KresliHranu(NajCesta[I], NajCesta[I + 1], clBlue);
 
  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;
 
  function Test: Boolean;
  var
    mVisited: set of Byte;
 
    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;
 
  begin
    mVisited := Visited;
    DoHlbky(I);
    Result := V2 in mVisited;
  end;
 
begin
  Visited := Visited + [V1];
  SetLength(Cesta, Length(Cesta) + 1);
  Cesta[High(Cesta)] := V1;
 
  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;
 
        if Test then
          Backtracking(I, V2);
 
        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;
 
  ...
 
begin
  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)];
    H := G[V0].Sus[V1];
    G[V0].Sus[V1] := 0;
    G[V1].Sus[V0] := 0;
  end;
  SetLength(Cesta, Length(Cesta) + 1);
  Cesta[High(Cesta)] := V1;
 
  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
    if JeHrana(V1, I) then
    begin
      KresliHranu(V1, I, clRed);
      Inc(Sucet, G[V1].Sus[I]);
      Image.Parent.Repaint;
 
      Backtracking(I, V2);
 
      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
    G[V0].Sus[V1] := H;
    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í

späť | ďalej