čo sa budeme dnes učiť
- na troch príkladoch uvidíme
využitie backtracking aj pre úlohy s
grafmi
Prehľadávanie grafu s návratom budeme
ilustrovať
na príkladoch zo skúšok z minulých
rokov. Väčšina skúškových príkladov
má takúto schému:
- treba zadefinovať triedu TGraf, ktorá
bude často obsahovať metódu backtracking
- táto trieda musí byť definovaná
v samostatnom unite (napr. UnitGraf.pas), unit nesmie
obsahovať žiadne globálne premenné,
ani sa odvolávať na unit s formulárom
(napr. Unit1.pas)
- v triede TGraf sú všetky stavové
premenné súkromné (private)
a verejné môžu byť len niektoré
metódy (napr. Create a Start
na odštartovanie prehľadávania)
- väčšinou môžete použiť ľubovoľnú
vnútornú reprezentáciu grafu
- samozrejme musí spĺňať podmienky zadania,
napr. ohodnotený graf, graf s viac ako 256
vrcholmi a pod.
- popis grafu je v nejakom binárnom súbore,
ktorý treba čítať pomocou TStream
- graf bude treba vykresliť do grafickej plochy,
napr. do Image1.Canvas, preto pri jeho inicializovaní
sa často posiela tento Canvas ako parameter konštruktora
- graf sa najčastejšie vytvára počas FormCreate
ale prehľadávanie sa spúšťa buď cez
nejaké tlačidlo (napr. Button1) alebo kliknutím
do grafickej plochy (Image1MouseDown) - nie
je dobré spúšťať dlhotrvajúce
akcie vo FormCreate, lebo samotný formulár
sa ukáže, až keď tieto akcie dobehnú...
- na vizualizovanie priebehu backtrackingu sa
najčastejšie používa pomocná procedúra
cakaj (je dobré ju mať na ťaháku)
- často budeme potrebovať backtracking predčasne
ukončiť - uvedomte si, že je to rekurzívna
procedúra, z ktorej sa nedá jednoducho
vyskočiť pomocou exit - použite na to pomocné
logické premenné
1. Vytváranie ohodnotenia hrán grafu
Výskumný ústav dopravnej polície
vypracoval štúdiu preťaženosti niekoľkých
ulíc a križovatiek v meste. Ulice dostali celočíselné
kladné ohodnotenia a hodnoty križovatiek sa potom
vypočítali ako súčty hodnôt ulíc,
ktoré vchádzajú do križovatky.
Nedopatrením sa poškodili niektoré údaje
v centrálnom počítači, pričom sa z mapy
ohodnotení zachovali len hodnoty križovatiek.
Vašou úlohou bude napísať program, ktorý
sa pokúsi nájsť také ohodnotenie
ciest, z ktorého sa predtým mohli počítať
hodnoty križovatiek.
Predpokladáme, že plán mesta je ohodnotený
neorientovaný graf, v ktorom hrany sú
ulice a vrcholy sú križovatky. Tento graf je
zadaný v súbore krizovat.dat s premenlivou
dĺžkou viet, v ktorom každá veta popisuje jednu
križovatku:
- veta začína ohodnotením križovatky
(integer)
- ďalej nasledujú 2 celé čísla
(integer) x-ová a y-ová súradnica
(umiestnenie križovatky v ploche)
- za tým nasleduje zoznam poradových
čísel križovatiek, s ktorými je táto
priamo spojená ulicou (zoznam bajtov ukončený
nulovou hodnotou) – prvá križovatka v súbore
má poradové číslo 1.
Môžete predpokladať, že súbor je zadaný
korektne a neobsahuje viac ako 100 križovatiek. Súbor
načítajte pomocou TStream.
Graf v pamäti reprezentujte tak, aby sa Vám
s ním pracovalo čo najpohodlnejšie. Na obrazovke
ho vykreslite tak, že vrcholy sa nakreslia malým
krúžkom s číselným ohodnotením
a v strede hrán sa bude zapisovať číselné
ohodnotenie ulice. Hrany nakreslite šedou farbou. Vo
vašom programe zadefinujte triedu TGraf v samostatnej
programovej jednotke (napr. UnitGraf.pas), pričom sa
tento unit môže odvolávať (uses) len na
štandardné delphi-unity (nesmie sa v ňom použiť
napr. uses Unit1) a nesmú v ňom byť definované
žiadne globálne premenné. Všetky stavové
premenné triedy TGraf by mali byť privátne.
Úlohu riešte prehľadávaním s
návratom (backtracking), pričom priebeh
algoritmu zobrazujte na obrazovke. Backtracking sa bude
postupne snažiť ohodnocovať všetky hrany tak, aby bola
splnená podmienka úlohy. Zrejme sa bude
pokúšať na hrany dávať len také
číslo, pre ktoré oba vrcholy (spojené
touto hranou) sú ešte „riešiteľné“.
Ak program nájde riešenie, tak vypíše
o tom správu. Ak program nenájde žiadne
riešenie, tiež o tom vypíše správu.
Grafickú plochu môžete realizovať komponentom
TImage veľkosti minimálne 550x500. Okrem TImage
použite tlačidlo (komponent TButton), ktoré naštartuje
samotné riešenie úlohy.
Poznámky k riešeniu:
- ohodnotený graf budeme reprezentovať tabuľkou
susedností
- logická funkcia ok zisťuje, či existuje vrchol,
pre ktorý
- buď nemá voľnú hranu a hodnota vrcholu
<> 0
- alebo existuje voľná hrana a hodnota vrcholu
= 0
- vtedy vráti hodnotu false,
čo znamená, že to nevyhovuje riešeniu
- backtracking postupne prechádza všetky "voľné"
hrany grafu a pokúša sa ich ohodnocovať rôznymi
hodnotami
- používame funkciu min, ktorá
je v definovaná
unite Math
- všimnite si túto hrubú schému
prehľadávania s návratom:
základná schéma riešenia:
|
var
n:integer; // počet vrcholov grafu
g:array[1..100] of record
x,y:integer;
h:integer; // číslo vo vrchole
s:array[1..100] of integer; // čísla na hranách
end;
function ok:boolean;
var
i,j:integer;
begin
Result:=false;
for i:=1 to n do begin
j:=1; while (j<=n) and (g[i].s[j]<>volne) do inc(j);
if (j<=n) = (g[i].h=0) then exit;
end;
Result:=true;
end;
procedure backtracking;
var
i,j,k:integer;
begin
// hľadá ľubovoľnú ešte neohodnotenú hranu
i:=1; j:=1;
repeat
inc(j); if j>n then begin inc(i); j:=i+1; end;
until (i=n) or (g[i].s[j]=volne);
if i=n then begin // našiel riešenie
mam:=true; exit;
end;
// vyskúšaj všetky možnosti ohodnotenia tejto hrany
for k:=min(g[i].h,g[j].h) downto 1 do begin
// zaznač ťah
g[i].s[j]:=k; g[j].s[i]:=k;
dec(g[i].h,k); dec(g[j].h,k);
pis(i,j,k); cakaj(10); // napíš číslo k medzi vrcholy i a j
if ok then begin
backtracking;
if mam then exit; // stačí len prvé riešenie
end;
// odznač ťah
pis(i,j,0); // zmaž číslo na hrane medzi vrcholmi i a j
g[i].s[j]:=volne; g[j].s[i]:=volne;
inc(g[i].h,k); inc(g[j].h,k);
end;
end;
|
skoro kompletný UnitGraf.pas:
|
const
max=100;
type
TGraf = class
private
n:integer;
g:array[1..max] of record
h,x,y:integer;
s:array[1..max] of integer;
end;
c:TCanvas;
mam:boolean; // už mám riešenie
procedure kresli;
procedure backtracking;
public
constructor Create(m:string; cc:TCanvas);
procedure hladaj;
end;
/////////////////////////////////////////////////////
const
niejespoj=-1; volne=0;
constructor TGraf.Create(m:string; cc:TCanvas);
var
i,j:integer;
p:byte;
t:TStream;
begin
c:=cc;
for i:=1 to max do
for j:=1 to max do g[i].s[j]:=niejespoj;
n:=0;
t:=TFileStream.Create(m,fmOpenRead);
while t.Position < t.Size do begin
inc(n);
with g[n] do begin
t.Read(h,4); t.Read(x,4); t.Read(y,4);
repeat
t.Read(p,1);
if p<>0 then begin
s[p]:=volne; g[p].s[n]:=volne; // je hrana - zatiaľ bez hodnoty
end;
until p=0;
end;
end;
t.Free;
kresli;
end;
procedure TGraf.kresli;
var
i,j:integer;
begin
c.Pen.Color:=clLtGray;
for i:=1 to n do
for j:=i+1 to n do
if g[i].s[j]<>niejespoj then begin
with g[i] do c.MoveTo(x,y);
with g[j] do c.LineTo(x,y);
end;
c.Pen.Color:=clBlack;
c.Brush.Style:=bsSolid;
for i:=1 to n do
with g[i] do begin
c.Ellipse(x-12,y-12,x+12,y+12);
c.TextOut(x-8,y-6,IntToStr(h));
end;
end;
procedure TGraf.hladaj;
begin
mam:=false;
backtracking;
c.Font.Height:=20;
if mam then
c.TextOut(50,0,'Našiel som riešenie')
else
c.TextOut(50,0,'Nenašiel som riešenie');
end;
procedure cakaj(ms:integer);
var
potom:TDateTime;
begin
potom:=Now + EncodeTime(0,ms div 60000,(ms div 1000) mod 60,ms mod 1000);
while Now < potom do Application.ProcessMessages;
end;
procedure TGraf.backtracking;
procedure pis(i,j,cis:integer);
var
x,y:integer;
begin
x:=(g[i].x+g[j].x) div 2-6; y:=(g[i].y+g[j].y) div 2-3;
c.FillRect(Rect(x,y,x+20,y+11));
if cis<>0 then c.TextOut(x,y,IntToStr(cis));
end;
function ok:boolean;
var
i,j:integer;
begin
Result:=false;
for i:=1 to n do begin
j:=1; while (j<=n) and (g[i].s[j]<>volne) do inc(j);
if (j<=n) = (g[i].h=0) then exit;
end;
Result:=true;
end;
var
i,j,k:integer;
begin
i:=1; j:=1;
repeat
inc(j); if j>n then begin inc(i); j:=i+1; end;
until (i=n) or (g[i].s[j]=volne);
if i=n then begin mam:=true; exit; end;
for k:=min(g[i].h,g[j].h) downto 1 do begin
g[i].s[j]:=k; g[j].s[i]:=k; dec(g[i].h,k); dec(g[j].h,k);
pis(i,j,k); cakaj(10);
if ok then begin
backtracking; if mam then exit;
end;
pis(i,j,0);
g[i].s[j]:=volne; g[j].s[i]:=volne; inc(g[i].h,k); inc(g[j].h,k);
end;
end;
|
- stiahnite si testovacie údajové súbory
- môžete si stiahnuť kompletný projekt
2. Hľadanie čo najdlhšej cesty v grafe
Hala, v ktorej sú skladové priestory,
má obdĺžnikový pôdorys veľkosti
MxN jednotkových štvorcov. V tejto hale sa nachádzajú
rôzne skrine, police, stroje a iné prekážky,
ktoré vždy zaberajú nejakú obdĺžnikovú
oblasť v základnej sieti haly. Podnik kúpil
čistiaceho robota, ktorý má obchádzať
halu a pritom čistiť neobsadené časti haly. Keďže
robot je citlivý na vlhkú dlážku,
ktorú po sebe zanecháva pri čistení,
v podniku sa rozhodli, že kým sa táto
porucha neodstráni, pokúsia sa pre robota
navrhnúť takú trasu, aby vyčistil maximálny
priestor a pritom dvakrát nevstúpil na
ten istý štvorec.
Hala aj obsadené priestory sú popísané
v súbore hala.dat (môžete predpokladať,
že je zadaný korektne - súbor spracujte
pomocou TStream). Prvé dva bajty obsahujú
veľkosť haly: počet riadkov a stĺpcov štvorcovej siete
(nie sú väčšie ako 50). Za tým nasledujú
vety (až do konca súboru), ktoré popisujú
prekážky: v dvoch bajtoch "súradnica"
ľavého horného štvorca prekážky
(riadok, stĺpec) a v ďalších dvoch bajtoch veľkosť
prekážky (počet riadkov a stĺpcov).
Váš program najprv načíta a vykreslí
halu na obrazovku tak, že sa nakreslí štvorcová
sieť (veľkosť jednotkového štvorca je v konštante
programu V) a obsadené políčka sa vyfarbia
tmavošedou farbou. Ďalej sa čaká, že používateľ
myšou zadá štartovú pozíciu robota.
Pri kliknutí mimo siete alebo na obsadené
políčko, program čaká nové kliknutie.
Štartovú pozíciu nejako farebne vyznačte.
Trasu pre robota hľadajte metódou prehľadávania
s návratom (backtracking), pričom priebeh algoritmu
znázorňujte na obrazovke bodkami v strede štvorcov.
Po skončení algoritmu, resp. po prerušení
hľadania tlačidlom STOP, program vykreslí nájdenú
maximálnu trasu červenými čiarami, ktoré
spájajú stredy štvorcov nájdenej
trasy. T.j. tlačidlo STOP počas behu backtrackingu nezruší
beh programu, ale len hľadanie maximálnej trasy,
a teda momentálne maximálnu trasu bude
považovať za riešenie.
Labyrint v programe reprezentujte pomocou neorientovaného
grafu, v ktorom každý štvorec je jeden vrchol
grafu. Dva vrcholy sú spojené hranou,
ak príslušné políčka susedia. Nejako
si zaevidujte obsadené vrcholy, ktoré
budú obchádzané algoritmom hľadania.
Graf reprezentujte napr. poľom zoznamov susedov, kde
pole môže byť aj dvojrozmerné a zoznam
susedov môže byť realizovaný štvorprvkovým
poľom (každý vrchol má maximálne
4 susedov). Vo vašom programe zadefinujte triedu TGraf
v samostatnej programovej jednotke (napr. UnitGraf.pas),
pričom sa tento unit môže odvolávať (uses)
len na štandardné delphi-unity (nesmie sa v ňom
použiť napr. uses Unit1) a nesmú v ňom byť definované
žiadne globálne premenné. Všetky stavové
premenné triedy TGraf by mali byť privátne.
V je konštanta programu, napr. const V=30.
Poznámky k riešeniu:
- graf budeme reprezentovať metódou "pole
polí vrcholov", t.j. pre každý
vrchol (bude ich maximálne 50x50) si budeme
pamätať pole (maximálne 4-prvkové)
všetkých susedov - využijeme preddefinovanú
štruktúru TPoint (to je record x,y:integer)
- políčka s prekážkami zaznačíme
tak, že im nastavíme, že už boli navštívené
- budovanú cestu budeme ukladať do dynamického
poľa cesta a v poli maxcesta si budeme
pamätať momentálne najdlhšie riešenie
- backtracking budeme vizualizovať tak, že do
navštívených vrcholov grafu, t.j.
do stredov políčok štvorcovej siete dávame
čierne bodky - môže program vylepšiť tak,
že budete namiesto bodiek kresliť celú cestu
pomocou čiar
- všimnite si túto hrubú schému
prehľadávania s návratom:
základná schéma riešenia:
|
var
g:array[1..50,1..50] of record
ps:0..4; // počet susedov
sus:array[1..4] of TPoint;
vis:boolean; // navštívené políčko alebo prekážka
end;
procedure backtracking(x,y:integer);
var
k:integer;
begin
// ak máš riešenie, skonči
if stop or (Length(maxcesta)=maxdlzka) then exit;
// zaznač ťah
g[x,y].vis:=true; c.Pixels[x*v-v2,y*v-v2]:=clBlack;
SetLength(cesta,Length(cesta)+1); cesta[High(cesta)]:=Point(x,y);
if Length(cesta)>Length(maxcesta) then maxcesta:=cesta;
cakaj(10);
// vyskúšaj všetky možnosti pokračovania cesty
with g[x,y] do
for k:=1 to ps do
if not g[sus[k].x,sus[k].y].vis then
backtracking(sus[k].x,sus[k].y);
// odznač ťah
g[x,y].vis:=false; c.Pixels[x*v-v2,y*v-v2]:=clWhite;
SetLength(cesta,Length(cesta)-1);
end;
|
skoro kompletný UnitGraf.pas:
|
type
TGraf = class
private
maxy,maxx:byte;
g:array[1..50,1..50] of record
ps:0..4;
sus:array[1..4] of TPoint;
vis:boolean;
end;
maxcesta,cesta:array of TPoint;
maxdlzka:integer;
cakajMys:boolean;
stop:boolean;
c:TCanvas;
procedure kresli;
procedure backtracking(x,y:integer);
public
constructor Create(m:string; cc:TCanvas);
procedure start(x,y:integer);
procedure zastav;
end;
/////////////////////////////////////////////////////
const
v=30; v2=v div 2; // veľkosť políčka štvorcovej plochy
constructor TGraf.Create(m:string; cc:TCanvas);
procedure pridaj(i,j,ii,jj:integer);
begin
if (ii<1) or (ii>maxy) or (jj<1) or (jj>maxx) then exit;
with g[j,i] do begin
inc(ps); sus[ps]:=Point(jj,ii);
end;
end;
var
t:TStream;
x,y:integer;
xx,yy,vys,sir:byte;
begin
c:=cc;
// inicializuj graf
for y:=1 to maxy do
for x:=1 to maxx do
with g[x,y] do begin
ps:=0; vis:=false;
end;
t:=TFileStream.Create(m,fmOpenRead);
t.Read(maxy,1); t.Read(maxx,1);
// generuj "úplný graf"
for y:=1 to maxy do
for x:=1 to maxx do begin
pridaj(y,x,y+1,x);
pridaj(y,x,y-1,x);
pridaj(y,x,y,x+1);
pridaj(y,x,y,x-1);
end;
// "zakáž" zablokované políčka
while t.Position<t.Size do begin
t.Read(yy,1); t.Read(xx,1); t.Read(vys,1); t.Read(sir,1);
for y:=1 to vys do
for x:=1 to sir do
g[xx-1+x,yy-1+y].vis:=true;
end;
t.Free;
// zisti počet voľných políčok
maxdlzka:=0;
for y:=1 to maxy do
for x:=1 to maxx do
if not g[x,y].vis then inc(maxdlzka);
kresli;
cakajMys:=true;
end;
procedure TGraf.kresli;
var
i,j:integer;
begin
c.Brush.Style:=bsSolid;
for i:=1 to maxy do
for j:=1 to maxx do begin
if g[j,i].vis then
c.Brush.Color:=clGray
else
c.Brush.Color:=clWhite;
c.Rectangle(j*v-v,i*v-v,j*v+1,i*v+1);
end;
end;
procedure TGraf.backtracking(x,y:integer);
var
k:integer;
begin
// ak máš riešenie, skonči
if stop or (Length(maxcesta)=maxdlzka) then exit;
// zaznač ťah
g[x,y].vis:=true; c.Pixels[x*v-v2,y*v-v2]:=clBlack;
SetLength(cesta,Length(cesta)+1); cesta[High(cesta)]:=Point(x,y);
if Length(cesta)>Length(maxcesta) then maxcesta:=cesta;
cakaj(10);
// vyskúšaj všetky možnosti pokračovania cesty
with g[x,y] do
for k:=1 to ps do
if not g[sus[k].x,sus[k].y].vis then
backtracking(sus[k].x,sus[k].y);
// odznač ťah
g[x,y].vis:=false; c.Pixels[x*v-v2,y*v-v2]:=clWhite;
SetLength(cesta,Length(cesta)-1);
end;
procedure TGraf.start(x,y:integer);
var
i,xx,yy:integer;
begin
if not cakajMys then exit;
x:=x div v+1; y:=y div v+1;
if (x>maxx) or (y>maxy) or g[x,y].vis then exit;
cakajMys:=false;
stop:=false;
cesta:=nil; maxcesta:=nil;
xx:=x*v-v2; yy:=y*v-v2;
c.Pen.Color:=clRed;
c.MoveTo(xx-4,yy-4); c.LineTo(xx+5,yy+5);
c.MoveTo(xx-4,yy+4); c.LineTo(xx+5,yy-5);
backtracking(x,y);
// vykresli riešenie
c.MoveTo(x*v-v2,y*v-v2);
for i:=1 to High(maxcesta) do
with maxcesta[i] do c.LineTo(x*v-v2,y*v-v2);
end;
procedure TGraf.zastav;
begin // oznám backtrackingu, aby skončil
stop:=true;
end;
|
- stiahnite si testovacie údajové súbory
- môžete si stiahnuť kompletný projekt
3. Hľadanie izomorfizmu
V jednom priečinku (adresári) na disku sme
našli niekoľko údajových súborov,
ktoré popisujú nejaké neorientované
grafy. Radi by sme o dvoch grafoch zistili, či sú
to rôzne grafy alebo sú si navzájom
podobné (izomorfné). Napíšte program,
ktorý načíta dva binárne súbory
popisujúce dva grafy, vykreslí ich na
obrazovke a zistí o nich, či sú alebo
nie sú izomorfné. T.j. program sa pokúsi
nájsť také priradenie medzi vrcholmi týchto
grafov, že zodpovedajúce vrcholy majú
rovnakých susedov (zrejme by oba grafy mali mať
rovnaký počet vrcholov).
Na hľadanie jednoznačného priradenia medzi
vrcholmi grafu použite algoritmus prehľadávania
s návratom (backtracking), ktorý by mohol
pracovať napr. takto: pokúsime sa prvému
vrcholu G1 priradiť nejaký vrchol z G2 (musí
mať rovnaký počet susedov), potom druhému
vrcholu G1 nejaký z G2 (ktorý ešte nebol
priradený a má rovnaký počet susedov),
atď. Pritom po každom kroku backtrackingu, treba kontrolovať,
či podgrafy obsahujúce v G1 a v G2 už vybrané
vrcholy sú izomorfné (množiny ich susedov
sú zhodné).
Program najprv načíta dva súbory (ich
mená budú definované v konštantách
programu subor1 a subor2), vykreslí ich na obrazovku
a spustí algoritmus backtracking. Priebeh algoritmu
znázorňujte na obrazovke: momentálne priradené
vrcholy spojte navzájom úsečkami nejakej
farby. Po skončení algoritmu program vypíše
správu buď "Grafy sú izomorfné"
alebo "Grafy nie sú izomorfné".
V prípade, že program našiel izomorfizmus, ponechá
príslušné dvojice vrcholov spojené
úsečkami (stačí nájsť jedno riešenie).
Binárne súbory grafx.dat sú
s premenlivou dĺžkou viet a majú nasledovnú
štruktúru:
- každá veta popisuje jeden vrchol grafu;
- veta začína dvojicou celých čísel
(integer) - súradníc vrcholu na obrazovke;
- za tým nasleduje počet susedných vrcholov
(byte);
- veta končí postupnosťou čísel susediacich
vrcholov (postupnosť bytov), pričom predpokladáme,
že prvý vrchol grafu má číslo 1
a vrcholov nie je viac ako 255.
X-ové súradnice vrcholov grafov sú
menšie ako 320 a teda, ak bude grafická plocha
široká aspoň 640, celý obrázok
grafu vojde na polovicu plochy. Prvý načítaný
graf vykreslite na pôvodných súradniciach
vrcholov, druhý graf posuňte o 320 doprava. Vrcholy
grafov zobrazte malými kolieskami, hrany úsečkami
napr. bielej farby. Grafy reprezentujte v pamäti
tak, aby sa vám s nimi dobre pracovalo. Vo vašom
programe zadefinujte triedy TGraf a TUloha v samostatných
programových jednotkách (napr. UnitUloha.pas
a UnitGraf.pas), pričom sa tieto unity môžu odvolávať
(uses) len na štandardné delphi-unity (nesmie
sa v nich použiť napr. uses Unit1) a nesmú
v nich byť definované žiadne globálne
premenné. Všetky stavové premenné
triedy TUloha by mali byť privátne, môžete
ju zadefinovať napr. takto
type
TUloha = class
private
G1,G2:TGraf;
...
procedure backtracking(...);
public
constructor Create(m1,m2:string ...);
procedure start;
end;
V súbore nemusia byť všetky hrany uvedené
v oboch smeroch, a nakoľko má byť graf neorientovaný,
zabezpečte správnu reprezentáciu. Môžete
predpokladať, že súbory sú korektné.
Spracujte ich pomocou TStream.
Poznámky k riešeniu:
- grafy budeme reprezentovať "poľom množín
susedov", pričom do stavovej premennej stupen
pre každý vrchol predvypočítame jeho
stupeň, t.j. počet hrán, ktoré z neho
vychádzajú
- všimnite si túto hrubú schému
prehľadávania s návratom:
základná schéma riešenia:
|
var
n:integer;
G1,G2: ...
g:array[byte] of record
x,y:integer;
s:set of byte;
stupen:integer;
end;
// či sa pridaním i-teho vrcholu nepokazil "doterajší izomorfizmus"
function test(i,j:integer):boolean;
var
k:integer;
begin
Result:=false;
if j in v2 then exit;
if G1.g[i].stupen<>G2.g[j].stupen then // musí sedieť stupeň oboch vrcholov
exit;
for k:=1 to i-1 do
if (k in G1.g[i].s) <> (t[k] in G2.g[j].s) then exit;
Result:=true;
end;
procedure backtracking(i:integer); // i-vrcholu z G1 hľadáme j-vrchol z G2
var
j:integer;
begin
for j:=1 to n do
if test(i,j) then begin
// zaznač ťah
t[i]:=j; v2:=v2+[j];
ciara(i,j); // inverzná čiara medzi vrcholmi z G1 a G2
if i=n then mam:=true // mám riešenie
else backtracking(i+1);
if mam then exit; // ak mám riešenie - nechcem pokaziť výsledné čiary
// odznač ťah
ciara(i,j); // inverzná čiara medzi vrcholmi z G1 a G2
v2:=v2-[j];
end;
end;
|
skoro kompletný UnitGraf.pas:
|
type
TGraf = class
public
n:integer;
g:array[byte] of record
x,y:integer;
s:set of byte;
stupen:integer;
end;
c:TCanvas;
constructor Create(m:string; cc:TCanvas; posun:integer);
procedure kresli;
end;
/////////////////////////////////////////////////////
constructor TGraf.Create(m:string; cc:TCanvas; posun:integer);
var
t:TStream;
i,k:integer;
p:byte;
pole:array[byte]of byte;
begin
c:=cc;
t:=TFileStream.Create(m,fmOpenRead);
n:=0;
while t.Position<t.Size do
with g[n+1] do begin
inc(n);
t.Read(x,4); t.Read(y,4); inc(x,posun);
t.Read(p,1); t.Read(pole[1],p);
for i:=1 to p do begin
s:=s+[pole[i]]; g[pole[i]].s:=g[pole[i]].s+[n];
end;
end;
t.Free;
// pre každý vrchol vypočítaj stupeň
for i:=1 to n do
with g[i] do begin
stupen:=0;
for k:=1 to n do
if k in s then inc(stupen);
end;
kresli;
end;
procedure TGraf.kresli;
var
i,j:integer;
begin
c.Pen.Color:=clBlack;
c.Brush.Style:=bsClear;
for i:=1 to n do
with g[i] do begin
c.Ellipse(x-5,y-5,x+5,y+5);
for j:=i+1 to n do
if j in s then begin
c.MoveTo(x,y);
with g[j] do c.LineTo(x,y);
end;
end;
end;
|
skoro kompletný UnitUloha.pas:
|
type
TUloha = class
private
n:integer;
G1,G2:TGraf;
t:array[byte] of integer; // transformácia z G1 do G2
v2:set of byte; // množina už priradených vrcholov z G2
mam:boolean; // už mám riešenie
c:TCanvas;
procedure backtracking(i:integer);
public
constructor Create(m1,m2:string; cc:TCanvas; sirka:integer);
procedure start;
end;
/////////////////////////////////////////////////////
constructor TUloha.Create(m1,m2:string; cc:TCanvas; sirka:integer);
begin
c:=cc;
G1:=TGraf.Create(m1,c,0);
G2:=TGraf.Create(m2,c,sirka div 2);
c.Font.Color:=clRed;
c.Font.Height:=30;
n:=G1.n;
mam:=n<>G2.n;
if mam then
c.TextOut(0,0,'Nesedí počet vrcholov - Grafy nie sú izomorfné');
end;
procedure TUloha.start;
begin
if mam then exit;
v2:=[];
backtracking(1);
if mam then
c.TextOut(0,0,'Grafy sú izomorfné')
else
c.TextOut(0,0,'Grafy nie sú izomorfné');
end;
procedure TUloha.backtracking(i:integer);
function test(i,j:integer):boolean;
var
k:integer;
begin
Result:=false;
if j in v2 then exit;
if G1.g[i].stupen<>G2.g[j].stupen then exit;
for k:=1 to i-1 do
if (k in G1.g[i].s) <> (t[k] in G2.g[j].s) then exit;
Result:=true;
end;
procedure ciara(i,j:integer);
begin
c.Pen.Mode:=pmXor;
c.Pen.Color:=clRed;
c.MoveTo(G1.g[i].x,G1.g[i].y);
c.LineTo(G2.g[j].x,G2.g[j].y);
cakaj(10);
end;
var
j:integer;
begin
for j:=1 to n do
if test(i,j) then begin
t[i]:=j; v2:=v2+[j]; ciara(i,j);
if i=n then mam:=true
else backtracking(i+1);
if mam then exit;
ciara(i,j); v2:=v2-[j];
end;
end;
|
- stiahnite si testovacie údajové súbory
- môžete si stiahnuť kompletný projekt
|