34. Prehľadávanie s návratom


posledná zmena: 26.4.2002

Banner Text 23.4.2002

     
    čo sme sa doteraz naučili

    • algoritmy prehľadávania grafu do hĺbky a do šírky

    čo sa budeme dnes učiť

    • hľadanie riešenia nejakej úlohy postupným konštruovaním tohoto riešenia
    • pritom sa snažíme, čím skôr odhadnúť, či zatiaľ konštruované riešenie má perspektívu alebo to treba skúsiť inak

Prehladávanie s návratom (backtracking)

Riešime úlohy typu

  • matematické hlavolamy (8 dám na šachovnici, domček jedným ťahom, 6 tiav, kôň na šachovnici)
  • rôzne problémy na grafoch (nájsť cestu s najmenším ohodnotením z A do B, vyhodiť max. počet hrán, aby...)

Podobne ako prehľadávanie grafu do hĺbky:

  • evidujeme, kde sme už boli (možno postupne konštruujeme riešenie)
  • čím skôr treba rozpoznať, že sme sa vydali zlým smerom a vrátiť sa na najbližšiu odbočku => vyskúšať iný smer
  • pri návrate v prehľadávaní, treba vrátiť zaevidovaný stav do pôvodného stavu (akoby sme ani nevošli do slepej uličky)

Vo všeobecnosti je to veľmi neefektívny algoritmus (hrubá sila), pomocou ktorého sa dá vyriešit skoro všetko (postupne vyskúšam všetky možnosti) – v praxi sa mnoho problémov dá vyriešiť oveľa efektívnejšie (backtracking = exp(n)).

Úlohy budeme riešiť tak, že kompletné údajové štruktúry a všetky algoritmy uzavrieme do triedy (napr. TUloha) a oddelíme od formulára do samostatného unitu (napr. unitUloha).

8 dám na šachovnici 8x8

  • úlohou je rozostaviť dámy tak, aby sa navzájom neohrozovali (vodorovne, zvislo ani uhlopriečne). Zrejme v každom riadku a stĺpci bude práve jedna dáma

algoritmus prehladávania:

 
procedure hladaj(tah:...);
begin
  zaznac_tah;
  if koniec then vypis
  else
    // vyskúšaj nasledujúci ťah – všetky možnosti
    hladaj(nasledujúci_ťah);
  odznac_tah;
end;

upresníme pre úlohu N dám:

 
procedure hladaj(riad,stlp:integer);
var
  s:integer;      // !!!! s musí byť lokálna - častá chyba, ťažko sa ladí !!!!
begin
  zaznac_tah;     // napr. d[riad,stlp]:=true;
  if riad=N then vypis
  else            // pre riad+1 riadok všetky možnosti stĺpca
    for s:=1 to N do
      if moze(riad+1,s) then hladaj(riad+1,s);
  odznac_tah;     // napr. d[riad,stlp]:=false;
end;
  • operácia moze(...), ktorá zisťuje, či sa môže urobiť nový ťah, môže byť dosť zložitá – závisí od toho, ako evidujeme ťahy

Vylepšíme evidovanie ťahov:

  • hlavný problém je evidovanie uhlopriečok (v 2-rozmernom poli je to zbytočne komplikované)
  • vytvoríme logické polia - voľný stĺpec, voľné šikmé uhlopriečky, voľné opačné uhlopriečky
  • uhlopriečkové polia:
    • dve políčka ležia na jednej uhlopriečke, ak súčet (rozdiel) súradníc je rovnaký (riad+stlp, resp. riad-stlp)
    • u1 - súčtové uhlopriečky array[2..2*n]
    • u2 – rozdielové uhlopriečky array[-n+1..n-1]
  • stĺpcové pole (voľných stĺpcov) je jasné:
    • st:array[1..n] of integer;

program:

 
unit Unit8dam;

interface

uses
  Graphics;

const
  n=8;

type
  TUloha = class
  private
    st:array[1..n] of boolean;        // voľné stĺpce
    u1:array[2..2*n] of boolean;      // voľné uhlopriečky 1. typu
    u2:array[-n+1..n-1] of boolean;   // voľné uhlopriečky 2. typu
    riesenie:array[1..n] of integer;  // riešením je n-tica čísel
    c:TCanvas;
    procedure hladaj(riad,stlp:integer);
    procedure vypis;
  public
    constructor Create(cc:TCanvas);
    procedure ries;
  end;

implementation

uses
  Types, SysUtils;

constructor TUloha.Create(cc:TCanvas);
var
  i:integer;
begin
  for i:=1 to n do st[i]:=true;
  for i:=2 to n+n do u1[i]:=true;
  for i:=-n+1 to n-1 do u2[i]:=true;
  c:=cc;
end;

procedure TUloha.ries;
var
  i:integer;
begin
  for i:=1 to n do hladaj(1,i);
end;

procedure TUloha.hladaj(riad,stlp:integer);
var
  s:integer;
begin
    // zapamätám si ťah kvôli výpisu
  riesenie[riad]:=stlp;
    // zaznačím obsadené políčka
  st[stlp]:=false; u1[riad+stlp]:=false; u2[riad-stlp]:=false;
  if riad=N then vypis
  else
    // pre riad+1 riadok všetky možnosti stĺpca
    for s:=1 to n do
      // if môže then
      if st[s] and u1[riad+1+s] and u2[riad+1-s] then
        hladaj(riad+1,s);
  // uvoľním stĺpec a uhlopriečky => odznačím ťah
  st[stlp]:=true; u1[riad+stlp]:=true; u2[riad-stlp]:=true;
end;

procedure TUloha.vypis;
const
  sir=30;
var
  i,j:integer;
begin
  with c do begin
    Brush.Color:=clWhite;
    Brush.Style:=bsSolid;
    FillRect(Rect(0,0,600,600));
    Brush.Style:=bsClear;
    Pen.Color:=clBlack;
    for i:=1 to n do begin
      Rectangle(i*sir,sir,i*sir+sir,n*sir+sir);
      Rectangle(sir,i*sir,n*sir+sir,i*sir+sir);
    end;
    Brush.Style:=bsSolid;
    Brush.Color:=clRed;
    for i:=1 to n do begin
      j:=riesenie[i];
      Ellipse(j*sir+3,i*sir+3,j*sir+sir-3,i*sir+sir-3);
    end;
  end;
end;

a z formulára to naštartujeme, napr. takto:

 
procedure TForm1.Button1Click(Sender: TObject);
begin
  DoubleBuffered:=true;
  with TUloha.Create(Image1.Canvas) do begin
    ries;
    Free;
  end;
end;
  • často budeme potrebovať zobrazovať priebeh backtrackingu:
    • pomocná metóda kresliDamu vie nakresliť, resp. zmazať dámu na šachovnici
    • po každom nakreslení dámy, sa výpočet na chvíľu zdrží pomocnou procedúrou cakaj
    • po nájdení prvého riešenia sa nastaví premenná ok na true - toto nám umožní vyskočiť z rekurzívneho backtrackingu

zobrazovanie priebehu backtrackingu:

 
unit Unit8dam;

interface

uses
  Graphics;

const
  n=8;

type
  TUloha = class
  private
    st:array[1..n] of boolean;
    u1:array[2..2*n] of boolean;
    u2:array[-n+1..n-1] of boolean;
    riesenie:array[1..n] of integer;    
    c:TCanvas;
    ok:boolean;
    procedure hladaj(riad,stlp:integer);
    procedure kresliDamu(i,j:integer; b:boolean);
  public
    constructor Create(cc:TCanvas);
    procedure ries;
  end;

implementation

uses
  Types, SysUtils, Forms;

procedure cakaj(MilliSec:Longint);
var
  potom:TDateTime;
begin
  potom:=Now + EncodeTime(0,MilliSec div 60000,
                          (MilliSec div 1000) mod 60,MilliSec mod 1000);
  while Now < potom do Application.ProcessMessages;
end;

constructor TUloha.Create(cc:TCanvas);
var
  i:integer;
begin
  for i:=1 to n do st[i]:=true;
  for i:=2 to n+n do u1[i]:=true;
  for i:=-n+1 to n-1 do u2[i]:=true;
  c:=cc;
end;

const
  sir=30;

procedure TUloha.ries;
var
  i:integer;
begin
  ok:=false;
  with c do begin          // pripravíme prázdnu šachovnicu
    Brush.Color:=clWhite;
    Brush.Style:=bsSolid;
    FillRect(Rect(0,0,600,600));
    Brush.Style:=bsClear;
    Pen.Color:=clBlack;
    for i:=1 to n do begin
      Rectangle(i*sir,sir,i*sir+sir,n*sir+sir);
      Rectangle(sir,i*sir,n*sir+sir,i*sir+sir);
    end;
  end;
  for i:=1 to n do hladaj(1,i);
end;

procedure TUloha.hladaj(riad,stlp:integer);
var
  s:integer;
begin
  if ok then exit;
  riesenie[riad]:=stlp;
  st[stlp]:=false; u1[riad+stlp]:=false; u2[riad-stlp]:=false;
  kresliDamu(riad,stlp,true); cakaj(100);    // nakreslí dámu
  if riad=N then ok:=true
  else
    for s:=1 to n do
      if st[s] and u1[riad+1+s] and u2[riad+1-s] then
        hladaj(riad+1,s);
  if ok then exit;
  st[stlp]:=true; u1[riad+stlp]:=true; u2[riad-stlp]:=true;
  kresliDamu(riad,stlp,false);               // zmaže dámu
end;

procedure TUloha.kresliDamu(i,j:integer; b:boolean);
begin
  with c do begin
    Brush.Style:=bsSolid;
    Pen.Color:=clBlack;
    if b then begin
      Brush.Color:=clRed;
      Ellipse(j*sir+3,i*sir+3,j*sir+sir-3,i*sir+sir-3);
    end
    else begin
      Brush.Color:=clWhite;
      Rectangle(j*sir,i*sir,j*sir+sir,i*sir+sir);
    end;
  end;
end;

NDÚ:

  • všetkých riešení pre 8x8 je 92, ale z nich sú mnohé len otočenie šachovnice, resp. zrkadlo - nájdite všetky rôzne riešenia
  • rozostavte minimálny počet dám na šachovnici NxN, aby ohrozovali všetky políčka šachovnice

Druhý variant riešenia 8 dám pomocou backtrackingu

  • backtrackingová procedúra nedostane presnú pozíciu, kde položiť dámu, ale len riadok a sama ju vyskúša položiť do všetkých stĺpcov (je to skoro to isté ako predtým)
  • najprv vo všeobecnosti: parametrom hladaj bude nie nový ťah, ale len "úroveň", v ktorej hľadáme nový ťah, hladaj postupne skúša všetky možné ťahy v danej úrovni

všeobecne:

 
procedure hladaj(úroven);
var ...
begin
  for tah := v momentálnej úrovni do
    if moze(tah) then begin
      zaznac_tah;
      if koniec then vypis
      else hladaj(nasledujúca_úroveň);
      odznac_tah;
    end;
end;

a pre problém 8 dám:

 
procedure TUloha.hladaj(riad:integer);
var
  stlp:integer;
begin
  for stlp:=1 to n do
    if st[stlp] and u1[riad+stlp] and u2[riad-stlp] then begin
      riesenie[riad]:=stlp;
      st[stlp]:=false; u1[riad+stlp]:=false; u2[riad-stlp]:=false;
      if riad=n then vypis
      else hladaj(riad+1);
      st[stlp]:=true; u1[riad+stlp]:=true; u2[riad-stlp]:=true;
    end;
end;

procedure TUloha.ries;
begin
  hladaj(1);
end;

...
  • riešenie doplníme o toto:
    • najprv sa všetky riešenia vypíšu do ListBoxu
    • potom kliknutie na niektoré riešenie v ListBoxe ho zobrazí do grafickej plochy (Image1.Canvas)

triedu zadefinujeme do unitu:

 
unit Unit8dam;

interface

uses
  Graphics, StdCtrls;

const
  n=8;

type
  TUloha = class
  private
    st:array[1..n] of boolean;
    u1:array[2..2*n] of boolean;
    u2:array[-n+1..n-1] of boolean;
    riesenie:array[1..n] of integer;
    l:TListBox;
    pocet:integer;
    procedure hladaj(riad:integer);
    procedure noveRiesenie;
  public
    constructor Create(ll:TListBox);
    procedure ries;
    procedure vypis(c:TCanvas; s:string);
  end;

implementation

uses
  Types, SysUtils;

constructor TUloha.Create(ll:TListBox);
var
  i:integer;
begin
  for i:=1 to n do st[i]:=true;
  for i:=2 to n+n do u1[i]:=true;
  for i:=-n+1 to n-1 do u2[i]:=true;
  l:=ll;
end;

procedure TUloha.ries;
begin
  pocet:=0; l.Items.Clear;
  hladaj(1);
end;

procedure TUloha.hladaj(riad:integer);
var
  stlp:integer;
begin
  for stlp:=1 to n do
    if st[stlp] and u1[riad+stlp] and u2[riad-stlp] then begin
      riesenie[riad]:=stlp;
      st[stlp]:=false; u1[riad+stlp]:=false; u2[riad-stlp]:=false;
      if riad=n then noveRiesenie
      else hladaj(riad+1);
      st[stlp]:=true; u1[riad+stlp]:=true; u2[riad-stlp]:=true;
    end;
end;

procedure TUloha.noveRiesenie;
var
  i:integer;
  s:string;
begin
  inc(pocet);
  s:=IntToStr(pocet)+'. ';
  for i:=1 to n do s:=s+IntToStr(riesenie[i]);
  l.Items.Add(s);
end;

procedure TUloha.vypis(c:TCanvas; s:string);
const
  sir=30;
var
  i,j:integer;
begin
  delete(s,1,pos(' ',s));
  with c do begin
    Brush.Color:=clWhite;
    Brush.Style:=bsSolid;
    FillRect(Rect(0,0,600,600));
    Brush.Style:=bsClear;
    for i:=1 to n do begin
      Rectangle(i*sir,sir,i*sir+sir,n*sir+sir);
      Rectangle(sir,i*sir,n*sir+sir,i*sir+sir);
    end;
    Brush.Style:=bsSolid;
    Brush.Color:=clRed;
    for i:=1 to n do begin
      j:=ord(s[i])-ord('0');
      Ellipse(j*sir+3,i*sir+3,j*sir+sir-3,i*sir+sir-3);
    end;
  end;
end;

a formulár:

 
var
  u:TUloha;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DoubleBuffered:=true;
  u:=TUloha.Create(ListBox1);
  u.ries;
  ListBox1.Selected[0]:=true;
  u.vypis(Image1.Canvas,ListBox1.Items.Strings[0]);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  i:integer;
begin
  i:=ListBox1.Items.Count - 1;
  while (i>=0) and not ListBox1.Selected[i] do dec(i);
  if i>=0 then
    u.vypis(Image1.Canvas,ListBox1.Items.Strings[i]);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  u.Free;
end;

Pozn.

  • vygenerovanie všetkých riešení nie je najlepšie robiť vo FormCreate - v niektorých úlohách to potom môže trvať dosť dlho, kým sa objaví formulár
  • na vykreslenie riešenia využívame reťazce z ListBoxu - toto môže niekedy robiť problémy, napr. pre N väčšie ako 9 - prerobte to nejako...

Domček jedným ťahom

  • úlohou je nakresliť domček jedným ťahom a zistiť všetky možné riešenia (nakresliť na obrazovke)

  • domček je neorientovaný graf s 5 vrcholmi

budeme ho reprezentovať tabuľkou susedností - triedu zadefinujeme v samostatnom unite:

 
unit UnitDomcek;

interface

uses
  Graphics;

type
  TTabulka = array[1..5,1..5] of boolean;

  TUloha = class
  private
    b:TTabulka;                // graf ako tabuľka susedností
    d:array[0..8] of integer;  // postupnosť vrcholov - momentálne riešenie
    pocet:integer;             // počet riešení
    c:TCanvas;
    procedure kresli;
    procedure gener(p,i:integer);
  public
    constructor Create(cc:TCanvas);
    procedure start;
  end;

implementation

uses
  Types, SysUtils;

const
  t=true; f=false;

constructor TUloha.Create(cc:TCanvas);
const
  tab:TTabulka =
        ((f,t,t,t,f), (t,f,t,t,f), (t,t,f,t,t), (t,t,t,f,t), (f,f,t,t,f));
begin
  b:=tab; pocet:=0; c:=cc;
end;

procedure TUloha.start;
var
  i:integer;
begin
  with c do begin
    Brush.Color:=clWhite;
    Brush.Style:=bsSolid;
    FillRect(Rect(0,0,700,700));
  end;
  for i:=1 to 5 do begin              // začať môžeme v ľubovoľnom vrchole
    d[0]:=i;
    gener(1,i);
  end;
  // teraz už máme všetky riešenia
end;

procedure TUloha.gener(p,i:integer);  // p = koľká hrana, i = z ktorého vrcholu
var
  j:integer;
begin
  for j:=1 to 5 do
    if b[i,j] then begin
      b[i,j]:=f; b[j,i]:=f; d[p]:=j;
      if p=8 then kresli              // vykreslí pole d
      else gener(p+1,j);
      b[i,j]:=t; b[j,i]:=t
    end;
end;

procedure TUloha.kresli;
const
  xy:array[1..5] of TPoint =
       ((x:0; y:3), (x:2; y:3), (x:0; y:1), (x:2; y:1), (x:1; y:0));
begin
  inc(pocet);
  // nakreslenie domčeka do Canvasu
  // domčeky treba zväčšiť a každý nejako posunúť
  c.MoveTo(xy[d[0]].x...,xy[d[0]].y...);
  for i:=1 to 8 do begin
    ...
    c.LineTo(xy[d[i]].x...,xy[d[i]].y...);
  end;
  ...
end;

riešenie úlohy môžeme z formulára zavolať, napr. takto:

 
procedure TForm1.Button1Click(Sender: TObject);
begin
  DoubleBuffered:=true;
  with TUloha.Create(Image1.Canvas) do begin
    start;
    Free;
  end;
end;

NDÚ:

  • procedúra kresli vykreslí postupne všetkých 88 riešení: farebne rozlíšte poradie hrán alebo vypisujte poradové číslo hrany
  • zobrazujte priebeh backtrackingu
  • zmeňte program tak, aby našiel len prvé riešenie a aby rekurzia korektne skončila (aby sa pokračovalo za gener v TUloha.start)

6 tiav na púšti

Hlavolam 6 tiav na púšti:

  • 6 tiav pôjde v karaváne 6 dní
  • vedecky sa ukázalo, že ak ťava pozerá na dopravnú značku celý deň, tak sa ju naučí
  • preto namaľovali na zadky tiav 6 rôznych značiek
  • úloha: navrhnúť rozloženie tiav do 6 karaván (pre každý deň) tak, aby sa každá naučila 5 rôznych značiek (každý deň je jedna ťava vedúca a tá sa nič neučí)
  • ťavy očíslujeme 1..6 a môžeme predpokladať, že prvý deň idú v poradí: 1 2 3 4 5 6 (1 je vedúca)
  • druhý deň môže byť druhá vedúca, atď.
  • ťavy v karavánach budeme značiť do poľa P:array[1..6,1..6] of integer; (P[1] prvý deň, ...)
  • v poli B[i,j] si zapamätáme, či sa j-ta ťava má ešte naučiť značku na zadku i-tej (true znamená, že ešte ju nevie a teda môže ísť za ňou)

unit, ktorý obsahuje definíciu triedy:

 
unit UnitTavy;

interface

uses
  Classes;

const
  N=6;

type
  TUloha = class
  private
    P:array[1..N,1..N] of integer;
    B:array[1..N,1..N] of boolean;
    BR:set of 1..N;
    pocet:integer;       // počet nájdených riešení
    m:TStrings;          // Memo, do ktorého zapisujeme nájdené riešenia
    procedure backtracking(r,s:integer);
    procedure vypis;
  public
    constructor Create(mm:TStrings);
    procedure ries;
  end;

implementation

uses
  SysUtils;

constructor TUloha.Create(mm:TStrings);  // budeme volať Create(Memo1.Lines)
begin
  m:=mm; 
end;

procedure TUloha.ries;
var
  i,j:integer;
begin
  for i:=1 to N do
    for j:=1 to N do
      B[i,j]:=true;
  P[1,1]:=1;
  for i:=2 to N do begin
    P[1,i]:=i; P[i,1]:=i; B[i-1,i]:=false;
  end;
  pocet:=0; m.Clear;
  backtracking(2,2);
end;

procedure TUloha.vypis;
var
  i,j:integer;
  s:string;
begin
  inc(pocet);
  m.Add(IntToStr(pocet)+'.');
  for i:=1 to N do begin
    s:='    '; for j:=1 to N do s:=s+IntToStr(P[i,j]);
    m.Add(s);
  end;
end;

procedure TUloha.backtracking(r,s:integer);         // riadok, stĺpec
var
  i:integer;
begin
  if s=2 then br:=[r];                              // začíname novú karavánu
  for i:=1 to N do
    if b[p[r,s-1],i] and not (i in br) then begin   // ak môže
      p[r,s]:=i;                                    // zapamätaj
      b[p[r,s-1],i]:=false; br:=br+[i];             // zaznač ťah
      if (r=N) and (s=N) then vypis                 // ak koniec
      else if s=N then backtracking(r+1,2)
      else backtracking(r,s+1);                     // inak ďalšiu
      b[p[r,s-1],i]:=true; br:=br-[i];              // odznač ťah
    end;
  if s=2 then br:=[1..N];                           // práve sme skončili karavánu
end;

a z formulára ju zavoláme napr. takto:

 
procedure TForm1.Button1Click(Sender: TObject);
begin
  with TUloha.Create(Memo1.Lines) do begin
    ries;
    Free;
  end;
end;

NDÚ:

  • vylepšite algoritmus, tak aby si okrem BR pamätal v BP, ktoré už boli posledné a teda už nemôžu byť posledné {test môže} => výrazne to urýchli program
  • dorobte zobrazovanie priebehu backtrackingu
  • zistite počet riešení pre N=2,3,4,5,6,7,...

© 2002 AB, KVI
blaho@fmph.uniba.sk