33.Prednaska

Z Pascal
Prejsť na: navigácia, hľadanie
33. Prednáška
úlohy | cvičenie


Generovanie štvoríc

Napíšme program, ktorý vypíše všetky 4-ciferné čísla zložené len z cifier 1..N a pritom žiadna cifra sa neopakuje viackrát. Takéto štvoríce budeme generovať štyrmi vnorenými for-cyklami. Zapíšme to ako konzolovú aplikáciu: 

const
  N = 4;
var
  I, J, K, L, Pocet: Integer;
begin
  Pocet := 0;
  for I := 1 to N do
    for J := 1 to N do
      for K := 1 to N do
        for L := 1 to N do
          if (I <> J) and (I <> K) and (J <> K) and (I <> L) and (J <> L) and (L <> K) then
          begin
            WriteLn(I, J, K, L);
            Inc(Pocet);
          end;
  WriteLn('pocet = ', Pocet);
  ReadLn;
end.

Program okrem všetkých vyhovujúcich štvoríc vypíše aj ich počet (zrejme pre N=4 ich bude 24).

Môžeme ho aj trochu vylepšiť: vnútorné cykly nebudú zbytočne skúšať rôzne možnosti napr. vtedy, keď I=J: 

const
  N = 4;
var
  I, J, K, L, Pocet: Integer;
begin
  Pocet := 0;
  for I := 1 to N do
    for J := 1 to N do
      if I <> J then
        for K := 1 to N do
          if (I <> K) and (J <> K) then
            for L := 1 to N do
              if not (L in [I, J, K]) then
              begin
                WriteLn(I, J, K, L);
                Inc(Pocet);
              end;
  WriteLn('pocet = ', Pocet);
  ReadLn;
end.

Takýto spôsob riešenia však nie je najvhodnejší. Ak by sme napr. potrebovali nie štvorice, ale N-tice číslic, ak by sme chceli komplikovanejšiu podmienku (cifry sa môžu raz opakovať) a pod., budeme musieť použiť nejaký iný spôsob riešenia.

Ďalšie námety:

  • vygenerujte všetky štvorice čísel z intervalu 3..9
  • vygenerujte všetky pätice čísel z intervalu 1..N
  • vygenerujte všetky štvorice písmen z intervalu 'a'..'d'
  • vygenerujte všetky štvorice písmen z intervalu 'e'..'j'


Prehľadávanie s návratom (backtracking)

Budeme riešiť generovanie štvoríc čísel pomocou rekurzívnej procedúry. Začnime s úlohou, v ktorej generujeme všetky štvorice čísel z 1..N, pričom čísla sa môžu aj opakovať, Úlohu budeme riešiť pre ľubovoľné N: 

const
  N = 4;
 
var
  Pole: array [1..N] of Integer;
 
procedure VypisRiesenie;
var
  I: Integer;
begin
  for I := 1 to N do
    Write(Pole[I]);
  WriteLn;
end;
 
procedure Generuj(I: Integer);
var
  J: Integer;
begin
  for J := 1 to N do
  begin
    Pole[I] := J;
    if I = N then
      // máme riešenie - treba ho vypísať
      VypisRiesenie
    else
      Generuj(I + 1);
  end;
end;
 
begin
  Generuj(1);
  ReadLn;
end.

Toto riešenie generuje všetky N-tice čísel a nielen tie, v ktorých sú všetky čísla rôzne. Pridáme teraz test na to, či je vygenerovaná N-tica naozaj správne riešenie (žiadne dva prvy nesmú byť rovnaké): 

const
  N = 4;
 
var
  Pole: array [1..N] of Integer;
 
procedure VypisRiesenie;
var
  I: Integer;
begin
  for I := 1 to N do
    Write(Pole[I]);
  WriteLn;
end;
 
function Vyhovuje: Boolean;
var
  I, J: Integer;
begin
  Result := False;
  for I := 1 to N do
    for J := I + 1 to N do
      if Pole[I] = Pole[J] then
        Exit;
  Result := True;
end;
 
procedure Generuj(I: Integer);
var
  J: Integer;
begin
  for J := 1 to N do
  begin
    Pole[I] := J;
    if I = N then
    begin
      if Vyhovuje then
        VypisRiesenie
    end
    else
      Generuj(I + 1);
  end;
end;
 
begin
  Generuj(1);
  ReadLn;
end.

Takéto riešenie už dáva správny výsledok. Treba si ale uvedomiť, že algoritmus zbytočne generuje dosť veľa štvoríc (256), z ktorých cez výstupnú kontrolu prejde len niekoľko (24).

Ukážeme riešenie, v ktorom sa vnárame do rekurzie len vtedy, keď doterajšia vygenerová časť riešenia vyhovuje podmienkam. Pripravili sme pomocnú funkciu Moze(I, J), ktorá otestuje, či momentálna hodnota J môže byť priradená na I-tu pozíciu výsledného poľa: 

const
  N = 4;
 
var
  Pole: array [1..N] of Integer;
 
procedure VypisRiesenie;
var
  I: Integer;
begin
  for I := 1 to N do
    Write(Pole[I]);
  WriteLn;
end;
 
function Moze(I, J: Integer): Boolean;
begin
  while (I > 1) and (Pole[I - 1] <> J) do
    Dec(I);
  Result := I = 1;
end;
 
procedure Generuj(I: Integer);
var
  J: Integer;
begin
  for J := 1 to N do
    if Moze(I, J) then
    begin
      Pole[I] := J;
      if I = N then
        VypisRiesenie
      else
        Generuj(I + 1);
    end;
end;
 
begin
  Generuj(1);
  ReadLn;
end.

Elegantnejšie riešenie tejto úlohy dostaneme, keď použijeme pomocnú množinu hodnôt, ktoré sa už v N-tici nachádzajú: 

const
  N = 4;
 
var
  Pole: array [1..N] of Integer;
  UzBolo: set of 1..N;
 
procedure VypisRiesenie;
var
  I: Integer;
begin
  for I := 1 to N do
    Write(Pole[I]);
  WriteLn;
end;
 
function Moze(J: Integer): Boolean;
begin
  Result := not (J in UzBolo);
end;
 
procedure Generuj(I: Integer);
var
  J: Integer;
begin
  for J := 1 to N do
    if Moze(J) then
    begin
      Pole[I] := J;
      UzBolo := UzBolo + [J];
      if I = N then
        VypisRiesenie
      else
        Generuj(I + 1);
      UzBolo := UzBolo - [J];
    end;
end;
 
begin
  UzBolo := [];
  Generuj(1);
  ReadLn;
end.

alebo použijeme počítadlo výskytov jednotlivých čísel: 

const
  N = 4;
 
var
  Pole: array [1..N] of Integer;
  Vyskyt: array [1..N] of Integer;
 
procedure VypisRiesenie;
var
  I: Integer;
begin
  for I := 1 to N do
    Write(Pole[I]);
  WriteLn;
end;
 
function Moze(J: Integer): Boolean;
begin
  Result := Vyskyt[J] = 0;
end;
 
procedure Generuj(I: Integer);
var
  J: Integer;
begin
  for J := 1 to N do
    if Moze(J) then
    begin
      Pole[I] := J;
      Inc(Vyskyt[J]);
      if I = N then
        VypisRiesenie
      else
        Generuj(I + 1);
      Dec(Vyskyt[J]);
    end;
end;
 
var
  I: Integer;
begin
  for I := 1 to N do
    Vyskyt[I] := 0;
  Generuj(1);
  ReadLn;
end.

Pomocou tohto zápisu vieme veľmi jednoducho riešiť podobné úlohy len zmenou podmienky vo funkcii Moze. Napr. 

function Moze(J: Integer): Boolean;
begin
  Result := Vyskyt[J] <= 1;
end;

bude generovať N-tice, v ktorých sa každá cifra môže vyskytovať maximálne dvakrát. Tiež 

function Moze(J: Integer): Boolean;
begin
  Result := Vyskyt[J] < J;
end;

bude generovať N-tice, v ktorých bude cifra 1 maximálne raz, cifra 2 maximálne 2-krát, cifra 3 maximálne 3-krát, atď.

Všimnite si rekurzívnu procedúru Generuj: postupne generuje N-ticu do poľa - najprv pre I=1, potom pre I=2, ... Jej schému by sme mohli zapísať 

procedure Generuj(I: Integer);
begin
  for I-ty prvok vyskúšaj všetky možnosti do
    if vhodný prvok then
    begin
      // zaznač tento prvok
      if I = N then
        // máme riešenie - môžeme ho vypísať
        VypisRiesenie
      else
        // rekurzívne sa vnoríme pre nasledujúci prvok
        Generuj(I + 1);
      // odznač tento prvok
    end;
end;

Postupne pre každý prvok v poli vyskúša všetky možnosti a pre všetky, ktoré zatiaľ vyhovujú, sa rekurzívne zavolá pre nasledujúcu pozíciu. Toto celé sa opakuje, kým nezaplní všetky prvky poľa.

Takémuto spôsobu hľadania riešenia nejakej úlohy hovoríme prehľadávanie s návratom (pripravíme jeden krok riešenia, vnoríme sa do rekurzie a po návrate z rekurzívneho volanie vrátime stav pred prípravou tohto jedného kroku)

Všimnite si aj trochu inak organizovanú schémú prehľadávania: 

procedure Generuj(I: Integer);
begin
  if I > N then
  begin
    // máme riešenie - môžeme ho vypísať
    VypisRiesenie;
    Exit;
  end;
  for I-ty prvok vyskúšaj všetky možnosti do
    if vhodný prvok then
    begin
      // zaznač tento prvok
      // rekurzívne sa vnoríme pre nasledujúci prvok
      Generuj(I + 1);
      // odznač tento prvok
    end;
end;

Neskôr uvidíme aj ďalšie schémy backtrackingu.

Pomocou backtrackingu vyriešme úlohu, v ktorej budeme generovať slová (N-tice písmen), ktoré obsahujú písmená z nejakej množiny písmen: 

const
  N = 4;
  Znaky = 'ahjo';
 
var
  Pole: array [1..N] of Char;
  UzBolo: set of Char;
 
procedure VypisRiesenie;
begin
  WriteLn(Pole);
end;
 
function Moze(Z: Char): Boolean;
begin
  Result := not (Z in UzBolo);
end;
 
procedure Generuj(I: Integer);
var
  J: Integer;
begin
  for J := 1 to Length(Znaky) do
    if Moze(Znaky[J]) then
    begin
      Pole[I] := Znaky[J];
      UzBolo := UzBolo + [Znaky[J]];
      if I = N then
        VypisRiesenie
      else
        Generuj(I + 1);
      UzBolo := UzBolo - [Znaky[J]];
    end;
end;
 
begin
  UzBolo := [];
  Generuj(1);
  ReadLn;
end.


Pomocou backtrackingu môžeme riešiť ú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 platila nejaká podmienka)

Prehľadávanie s návratom funguje podobne ako prehľadávanie grafu do hĺbky, ale robí aj niektoré činnosti navyše:

  • eviduje, kde sme už boli (postupne pritom konštruujeme riešenie)
  • čím skôr sa snaží rozpoznať, že sme sa vydali zlým smerom a treba sa vrátiť na najbližšiu odbočku, t.j. treba vyskúšať iný smer
  • pri návrate z rekurzie, treba vrátiť zaevidovaný stav do pôvodného stavu (akoby sme ani nevošli do slepej uličky)


Vo všeobecnosti je to ale veľmi neefektívny algoritmus (tzv. hrubá sila), pomocou ktorého sa dajú vyriešiť veľké množstvo úloh (postupne vyskúšam všetky možnosti) – v praxi sa mnoho problémov dá vyriešiť oveľa efektívnejšie (pre backtracking platí, že jeho zložitosť je exp(n); pripomeňme si, že tzv. zložitosť quicksortu bola približne n log n).


Ďalšie námety:

  • v N-tici číslic striedať párne nepárne
  • v N-tici písmen z nejakej množiny písmen (napr. {'a', 'h', 'o', 'j'}) striedať samohlásky a spoluhlásky
  • v N-tici písmen napr. z {'a', 'b', 'c'} sa písmená môžu aj viackrát opakovať, ale rovnaké písmená by nemali ísť tesne za sebou


8 dám na šachovnici

Budeme riešiť takýto hlavolam: na šachovnicu s 8x8 treba umiestniť 8 dám tak, aby sa navzájom neohrozovali (vodorovne, zvislo ani uhlopriečne). Zrejme v každom riadku a tiež v každom stĺpci musí byť práve jedna dáma. Dámy očíslujeme číslami od 1 do 8 tak, že I-ta dáma sa bude nachádzať v I-tom riadku. Potom každé rozloženie dám na šachovnici môžeme reprezentovať osmicou čísel - I-te číslo potom určuje číslo stĺpca I-tej dámy.

Na riešenie úlohy využime schému backtrackingu: 

const
  N = 8;
 
procedure Hladaj(I: Integer);   // hľadaj stĺpec I-tej dámy
var
  J: Integer;
begin
  for J := 1 to N do
    if Moze(I, J) then          // či môžeme položíť dámu na pozíciu (I, J)
    begin
      zaznač položenie dámy
      if I = N then             // úspešne sme položili poslednú dámu
        VypisRiesenie
      else
        Hladaj(I + 1);          // hľadaj všetky ďalšie dámy
      odznač položenú dámu
    end;
end;

Teraz je veľmi dôležité sa správne rozhodnúť, ako si budeme ukladať dámy na šachovnici, aby sa nám čo najjednoduchšie zisťovalo, či je nejaké políčko voľné (nie je ohrozované inými dámami) ale tiež, aby sa nám čo najjednoduchšie zaznačovalo aj odznačovalo položenie dámy. My tu navrhujeme takéto riešenie:

  • šachovnicu si nebudeme značiť v nejakom dvojrozmernom poli, ale vytvoríme si 3 pomocné logické polia - v nich si budeme pamätať či je voľný príslušný stĺpec a tiež či sú voľné obe uhlopriečky
  • premenná VolnyStlpec si pre každý stĺpce pamätá, či je ešte voľný
    • VolnyStlpec: array [1..N] of Boolean;
    • pole bude treba inicializovať na True
  • premenné VolnaUhlopriecka1 a VolnaUhlopriecka2 si budú pre každú uhlopriečku pamätať, či je ešte voľná
  • máme dva typy uhlopriečok:
    • 1. uhlopriečky vľavo hore - vpravo dole: dve políčka na šachovnici ležia na tej istej uhlopriečke, ak majú rovnaký rozdiel svojich súradníc, napr. políčka (1, 2), (2, 3), (3, 4), ... ležia na jednej takejto uhlopriečke
      • na šachovnici NxN je takýchto uhlopriečok 2N-1 a zadeklarujeme ich
      • VolnaUhlopriecka1: array [1-N..N-1] of Boolean;
    • 2. uhlopriečky vpravo hore - vľavo dole: dve políčka na šachovnici ležia na tej istej uhlopriečke, ak majú rovnaký súčet svojich súradníc, napr. políčka (1, 6), (2, 5), (4, 3), ... ležia na jednej takejto uhlopriečke
      • na šachovnici NxN je takýchto uhlopriečok 2N-1 a zadeklarujeme ich
      • VolnaUhlopriecka2: array [2..2*N] of Boolean;
    • obe polia bude treba inicializovať na True

Vďaka tomuto, bude zaznačovanie dámy na pozícii (riadok, stĺpec) takto jednoduché: 

 VolnyStlpec[ stĺpec ] := False;
 VolnaUhlopriecka1[ riadok - stĺpec ] := False;
 VolnaUhlopriecka2[ riadok + stĺpec ] := False;

Podobne bude vyzerať odznačovanie dámy na pozícii (riadok, stĺpec): 

 VolnyStlpec[ stĺpec ] := True;
 VolnaUhlopriecka1[ riadok - stĺpec ] := True;
 VolnaUhlopriecka2[ riadok + stĺpec ] := True;

Otestovanie, či môžeme položiť dámu na pozíciu (riadok, stĺpec) potom vyzerá takto: 

 Result := VolnyStlpec[ stĺpec ] and
           VolnaUhlopriecka1[ riadok - stĺpec ] and
           VolnaUhlopriecka2[ riadok + stĺpec ];

Zapíšme kompletný program (v konzolovom režime): 

const
  N = 8;
var
  Pole: array [1..N] of Integer;
  VolnyStlpec: array [1..N] of Boolean;
  VolnaUhlopriecka1: array [1 - N..N - 1] of Boolean;
  VolnaUhlopriecka2: array [2..2 * N] of Boolean;
  Pocet: Integer;
  OK: Boolean;
  I: Integer;
 
procedure VypisRiesenie;
var
  I: Integer;
begin
  Inc(Pocet);
  for I := 1 to N do
    Write(Pole[I], ' ');
  WriteLn;
end;
 
function Moze(I, J: Integer): Boolean;
begin
  Result := VolnyStlpec[J] and
            VolnaUhlopriecka1[I - J] and
            VolnaUhlopriecka2[I + J];
end;
 
procedure Dalsi(I: Integer);          // I je riadok
var
  J: Integer;                         // J je stĺpec
begin
  for J := 1 to N do
    if Moze(I, J) then
    begin
      // zaznač 1 krok riešenia
      Pole[I] := J;
      VolnyStlpec[J] := False;
      VolnaUhlopriecka1[I-J] := False;
      VolnaUhlopriecka2[I+J] := False;
 
      if I = N then
        VypisRiesenie
      else
        Dalsi(I + 1);
 
      // odznač 1 krok riešenia
      VolnyStlpec[J] := True;
      VolnaUhlopriecka1[I - J] := True;
      VolnaUhlopriecka2[I + J] := True;
    end;
end;
 
begin
  FillChar(VolnyStlpec, SizeOf(VolnyStlpec), True);
  FillChar(VolnaUhlopriecka1, SizeOf(VolnaUhlopriecka1), True);
  FillChar(VolnaUhlopriecka2, SizeOf(VolnaUhlopriecka2), True);
  Pocet := 0;
  Dalsi(1);
  WriteLn('pocet rieseni je ', Pocet);
  ReadLn;
end.

Poznámky:

  • riešenie ukladáme do poľa Pole: I-ty prvok poľa označuje pozíciu I-tej dámy na šachovnici (riadok I, stĺpec Pole[I])
  • všimnite si, že na inicializáciu logických polí sme použili štandardnú procedúru FillChar:
    • procedúra má tri parametre: premennú, počet bajtov a jednobajtovú hodnotu, ktorou inicializuje celú premennú


Backtrackingovú procedúru Dalsi môžeme organizovať aj trochu inak:

  • parametrom bude konkrétna pozícia I-tej dámy
  • procedúra najprv zaznačí ťah
  • potom, ak ešte nie je koniec, vyskúša všetky možnosti nasledujúceho ťahu
  • na záver odznačí ťah

Zapíšme túto novú schému backtrackingu: 

procedure Dalsi(I, J: Integer);     // I je riadok, J je stĺpec
var
  K: Integer;
begin
  // zaznač 1 krok riešenia
  Pole[I] := J;
  VolnyStlpec[J] := False;
  VolnaUhlopriecka1[I - J] := False;
  VolnaUhlopriecka2[I + J] := False;
 
  if I = N then
    VypisRiesenie
  else
    for K := 1 to N do
      if Moze(I + 1, K) then
        Dalsi(I + 1, K);
 
  // odznač 1 krok riešenia
  Pole[I] := 0;
  VolnyStlpec[J] := True;
  VolnaUhlopriecka1[I - J] := True;
  VolnaUhlopriecka2[I + J] := True;
end;

Potom treba pozmeniť aj časť hlavného programu: 

var
  I: Integer;
begin
  FillChar(VolnyStlpec, SizeOf(VolnyStlpec), True);
  FillChar(VolnaUhlopriecka1, SizeOf(VolnaUhlopriecka1), True);
  FillChar(VolnaUhlopriecka2, SizeOf(VolnaUhlopriecka2), True);
  Pocet := 0;
  for I := 1 to N do
    Dalsi(1, I);
  WriteLn('pocet rieseni je ', Pocet);
  ReadLn;
end.

Tento zápis backtrackingu nám dá úplne rovnaké výsledky ako pôvodný zápis. Preštudujte ho, lebo pre niektoré úlohy práve tento zápis môže byť vhodnejší.


Ďalšie námety:

  • prepíšte program s použitím triedy
  • upravte program tak, aby zistil počet riešení, ale vypísal len jedno z nich (napr. prvé)
  • vykreslite riešenie do grafickej plochy: šachovnica, na ktorej sú farebnými krúžkami znázornené pozície dám

Domček jedným ťahom

{{{3}}}

Budeme riešiť takúto úlohu: potrebujeme zistiť, koľkými rôznymi spôsobmi sa dá nakresliť takýto domček jedným ťahom. Pri kreslení môžeme po každej čiare prejsť len raz. Obrázok domčeka je vlastne neorientovaný graf s 5 vrcholmi. Každé nájdené riešenie vypíšeme v tvare postupnosti vrcholov, cez ktoré sa prechádza pri kreslení domčeka. Keďže hrán je v grafe 8, tak táto postupnosť bude obsahovať presne 9 vrcholov: jeden štartový a 8 nasledovných vrcholov.

Graf budeme reprezentovať čo najjednoduchšie, napr. pomocou poľa množín. Pre každý z vrcholov si treba pamätať množinu jeho susedov, napr. 

 G[1] := [2, 3, 4];
 G[2] := [1, 3, 4];
 G[3] := [1, 2, 4, 5];
 G[4] := [1, 2, 3, 5];
 G[5] := [3, 4];


Riešenie budeme zapisovať do 9-prvkového celočísleného poľa Pole. V konzolovom režime program vyzerá takto: 

var
  Pole: array [1..9] of Integer;
  G: array [1..5] of set of 1..5 =
    ([2, 3, 4], [1, 3, 4], [1, 2, 4, 5], [1, 2, 3, 5], [3, 4]);
  Pocet: Integer = 0;
 
procedure VypisRiesenie;
var
  I: Integer;
begin
  Inc(Pocet);
  for I := 1 to 9 do
    Write(Pole[I], ' ');
  WriteLn;
end;
 
procedure Hladaj(Krok, V1: Integer);
var
  V2: Integer;
begin
  for V2 := 1 to 5 do
    if V2 in G[V1] then     // či môže urobiť nasledujúci krok riešenia
    begin
       // zaznač jeden krok riešenia
      Pole[Krok] := V2;
      G[V1] := G[V1] - [V2];
      G[V2] := G[V2] - [V1];
      if Krok = 9 then
        VypisRiesenie
      else
        Hladaj(Krok + 1, V2);
      // odznač jeden krok riešenia
      G[V1] := G[V1] + [V2];
      G[V2] := G[V2] + [V1];
    end;
end;
 
var
  I: Integer;
begin
  for I := 1 to 5 do
  begin
    Pole[1] := I;
    Hladaj(2, I);
  end;
  WriteLn('pocet rieseni je ', Pocet);
  ReadLn;
end.

Poznámky:

  • graf ako pole množín sme inicializovali priamo pri deklarácii
  • backtrackingová procedúra Hladaj má dva parametre:
    • Krok - koľký vrchol riešenia momentálne hľadáme - na začiatku je 2, lebo prvý vrchol riešenia sme priradili v hlavnom programe
    • V1 - momentálne posledný vrchol riešenia - na neho bude nadväzovať nasledujúci


Tento istý algoritmus teraz zapíšeme aj pomocou triedy: celé riešenie prepíšeme do triedy TDomcek. Trochu pritom vylepšíme backtrackingovú metódu Hladaj, ktorá má teraz už iba jeden parameter. Druhý parameter - momentálny vrchol - vieme zistiť z poľa Pole, kde si skladáme riešenie.

Triedu zadefinujeme v samostatnom unite: 

unit DomcekUnit;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils;
 
type
 
  { TDomcek }
 
  TDomcek = class
  private
    Pole: array [1..9] of Integer;
    G: array [1..5] of set of 1..5;
    procedure Hladaj(Krok: Integer);
    procedure VypisRiesenie;
  public
    Pocet: Integer;
    constructor Create;
    procedure Start;
  end;
 
implementation
 
{ TDomcek }
 
constructor TDomcek.Create;
begin
  G[1] := [2, 3, 4];
  G[2] := [1, 3, 4];
  G[3] := [1, 2, 4, 5];
  G[4] := [1, 2, 3, 5];
  G[5] := [3, 4];
end;
 
procedure TDomcek.Start;
var
  I: Integer;
begin
  for I := 1 to 5 do
  begin
    Pole[1] := I;
    Hladaj(2);
  end;
end;
 
procedure TDomcek.Hladaj(Krok: Integer);
var
  V1, V2: Integer;
begin
  V1 := Pole[Krok - 1];
  for V2 := 1 to 5 do
    if V2 in G[V1] then     // či môže urobiť nasledujúci krok riešenia
    begin
       // zaznač jeden krok riešenia
      Pole[Krok] := V2;
      G[V1] := G[V1] - [V2];
      G[V2] := G[V2] - [V1];
      if Krok = 9 then
        VypisRiesenie
      else
        Hladaj(Krok + 1);
      // odznač jeden krok riešenia
      Pole[Krok] := 0;
      G[V1] := G[V1] + [V2];
      G[V2] := G[V2] + [V1];
    end;
end;
 
procedure TDomcek.VypisRiesenie;
var
  I: Integer;
begin
  Inc(Pocet);
  for I := 1 to 9 do
    Write(Pole[I], ' ');
  WriteLn;
end;
 
end.

Hlavný program potom vyzerá takto: 

program project1;
 
{$mode objfpc}{$H+}
 
uses
  Classes, SysUtils, DomcekUnit;
 
var
  Uloha: TDomcek;
 
begin
  Uloha := TDomcek.Create;
  Uloha.Start;
  WriteLn('pocet rieseni je ', Uloha.Pocet);
  Uloha.Free;
  ReadLn;
end.


Ďalšie námety:

  • vyskúšajte inú reprezentáciu grafu, napr. pomocou tabuľky susedností
  • všetky riešenia vykreslite do grafickej plochy tak, že vyznačíte štartový vrchol a pri každej hrane zapíšete jej poradové číslo v riešení
  • nájdite všetky riešenia pre nejaký iný obrázok (graf)
    • pozor vrcholov s nepárnym stupňom (počtom hrán, ktoré z neho vychádzajú) nemôže byť viac ako 2


Šesť tiav

Matematický hlavolam 6 tiav na púšti:

  • 6 tiav pôjde v karaváne 6 dní
  • 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 Pole: array [1..6, 1..6] of Integer; (Pole[1] prvý deň, ...)
  • v poli Naucit[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)

Vytvoríme konzolovú aplikáciu: 

const
  N = 6;
 
type
  TUloha = class
  private
    Pole: array [1..N, 1..N] of Integer;
    Naucit: array [1..N, 1..N] of Boolean;
    VRiadku: set of 1..N;
    Pocet: Integer;       // počet nájdených riešení
    procedure Backtracking(Riadok, Stlpec: Integer);
    procedure VypisRiesenie;
  public
    procedure Ries;
  end;
 
procedure TUloha.Ries;
var
  I, J: Integer;
begin
  for I := 1 to N do
    for J := 1 to N do
      Naucit[I, J] := True;
  Pole[1, 1] := 1;
  for I := 2 to N do
  begin
    Pole[1, I] := I;
    Pole[I, 1] := I;
    Naucit[I-1, I] := False;
  end;
  Pocet := 0;
  Backtracking(2, 2);
end;
 
procedure TUloha.VypisRiesenie;
var
  I, J: Integer;
begin
  Inc(Pocet);
  WriteLn(Pocet, '. riesenie');
  for I := 1 to N do
  begin
    for J := 1 to N do
      Write(Pole[I, J]);
    WriteLn;
  end;
end;
 
procedure TUloha.Backtracking(Riadok, Stlpec: Integer);
var
  I: Integer;
begin
  if Stlpec = 2 then
    VRiadku := [Riadok];                            // začíname novú karavánu
  for I := 1 to N do
    if Naucit[Pole[Riadok, Stlpec-1], I] and not (I in VRiadku) then // ak môže
    begin
      Pole[Riadok, Stlpec] := I;                    // zapamätaj
      Naucit[Pole[Riadok, Stlpec-1], I] := False;   // zaznač ťah
      VRiadku := VRiadku + [I];
      if (Riadok = N) and (Stlpec = N) then         // ak koniec
        VypisRiesenie
      else if Stlpec = N then
        Backtracking(Riadok + 1, 2)
      else
        Backtracking(Riadok, Stlpec + 1);           // inak ďalšiu
      Naucit[Pole[Riadok, Stlpec - 1], I] := True;  // odznač ťah
      VRiadku := VRiadku - [I];
    end;
  if Stlpec = 2 then
    VRiadku := [1..N];                              // práve sme skončili karavánu
end;

Hlavný program: 

begin
  with TUloha.Create do
  begin
    Ries;
    Free;
  end;
  ReadLn;
end.

Ďalšie námety:

  • vylepšite algoritmus, tak aby si okrem VRiadku pamätal v poli Posledne, ktoré už boli posledné a teda posledné už byť nemôžu
  • dorobte zobrazovanie priebehu backtrackingu
  • zistite počet riešení pre N = 2, 3, 4, 5, 6, 7, ...


Sudoku

Pomocou prehľadávania do hĺbky vyriešime veľmi populárny hlavolam Sudoku. Hracia plocha sa skladá z 9x9 políčok. Na začiatku sú do niektorých políčok zapísané čísla z intervali 1..9. Úlohou je zapísať aj do zvyšných políčok čísla 1 až 9 tak, aby v každom riadku a tiež v každom stĺpci bolo každé z čísel práve raz. Okrem toho je celá plocha rozdelená na 9 menších štvorcov veľkosti 3x3 - aj v každom z týchto štvorcov musí byť každé z čísel práve raz.

Samotná "backtrackingová" rekurzívna procedúra najprv nájde prvé zatiaľ voľné políčko (je tam hodnota 0). Potom sa sem pokúsi zapísať všetky možnosti čísel 1 až 9. Zakaždým otestuje, či zapisované číslo sa v príslušnom riadku, stĺpci a tiež v malom 3x3 štvorci ešte nenachádza. 

procedure Backtracking;
begin
  // hľadaj voľnú pozíciu
  if nenašiel then
    VypisRiesenie
  else
    for K := 1 to 9 do
      if Moze then
      begin
        // označ políčko
        Backtracking;
        // odznač políčko
      end;
end;

Aby sa nám čo najjednoduchšie testovalo, či sa nejaké číslo už nenachádza v príslušnom riadku, stĺpci a 3x3 štvorci, pre každý riadok, stĺpec aj štvorec 3x3 zavedieme množinu (set of 1..9), v ktorej si budeme evidovať už zapísané čísla: 

  VStlpci: array [0..8] of set of 1..9;
  VRiadku: array [0..8] of set of 1..9;
  VTroj: array [0..2, 0..2] of set of 1..9;

Na riešenie úlohy zadefinujeme triedu TSudoku, ktorá v konštruktore prečíta textový súbor sudoku.txt, zaplní tieto polia a potom spustí backtracking, napr. vo vstupnom súbore 

0 6 0 9 0 0 0 7 0
0 4 0 8 0 0 0 0 0
0 0 0 0 5 0 3 0 0
0 0 0 0 0 0 0 0 0
0 9 0 0 4 0 0 6 0
8 0 5 0 6 0 0 0 0
7 0 8 3 0 0 0 0 4
3 0 0 0 2 1 0 0 8
0 0 0 0 0 0 0 0 2

nuly označujú voľné políčka.

Najdôležitejšie metódy Moze a Backtracking: 

type
  TSudoku = class
    Pole: array [0..8, 0..8] of Integer;
    Bolo: array [0..8, 0..8] of Boolean;
    VStlpci: array [0..8] of set of 1..9;
    VRiadku: array [0..8] of set of 1..9;
    VTroj: array [0..2, 0..2] of set of 1..9;
    C: TCanvas;
    constructor Create(CC: TCanvas);
    procedure KresliRiesenie;
    procedure Backtracking;
    function Moze(I, J, K: Integer): Boolean;
  end;
 
function TSudoku.Moze(I, J, K: Integer): Boolean;
begin
  Result := not (K in VRiadku[I]) and
            not (K in VStlpci[J]) and
            not (K in VTroj[I div 3, J div 3]);
end;
 
procedure TSudoku.Backtracking;
var
  I, J: Integer;
  K: Integer;
begin
  // hľadá voľné políčko (I, J)
  I := 0;
  J := 0;
  while (I < 9) and (Pole[I, J] <> 0) do
  begin
    Inc(J);
    if J = 9 then
    begin
      Inc(I);
      J := 0;
    end;
  end;
  if I = 9 then
    KresliRiesenie
  else
    for K := 1 to 9 do
      if Moze(I, J, K) then
      begin
        // zaznač
        Pole[I, j] := K;
        VStlpci[J] := VStlpci[J] + [K];
        VRiadku[I] := VRiadku[I] + [K];
        VTroj[I div 3, J div 3] := VTroj[I div 3, J div 3] + [K];
 
        Backtracking;
 
        // odznač
        Pole[I, j] := 0;
        VStlpci[J] := VStlpci[J] - [K];
        VRiadku[I] := VRiadku[I] - [K];
        VTroj[I div 3, J div 3] := VTroj[I div 3, J div 3] - [K];
      end;
end;

Môžete si stiahnuť kompletný projekt.



späť | ďalej
Zdroj: „http://pascal.input.sk/index.php?title=33.Prednaska&oldid=1590“