č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,...
|