Nadesłany przez Michał Walenciak, 23 sierpnia 2006 01:00
Kod przedstawiony poniżej przedstawia główną część rozwiązania problemu.Pobierz pełne rozwiązanie.
Jeżeli nie odpowiada Ci sposób formatowania kodu przez autora skorzystaj z pretty printer'a i dostosuj go automatycznie do siebie.
hetman.pas:
// Problem 8 hetmanów - implementacja w Delphi
// www.algorytm.org
// author Michał Walenciak (c) 2006
program Hetman;
{$APPTYPE CONSOLE}
var col:array[1..8] of boolean; {tablica z zajętymi kolumnami}
dia_r:array[0..255] of boolean;
dia_l:array[0..255] of boolean; {tablice z zajętymi prawymi i lewymi przekątnymi}
chart:array[1..8,1..8] of boolean; {tablica z ustawieniami hetmanów}
found:byte; {licznik znalezionych pozycji}
F:text;
procedure add_hetman(row:byte);
var i,x,y:byte;
begin
for i:=1 to 8 do {sprawdzamy kolejna każdą kolumne w wierszu w poszukiwaniu czystego pola}
begin
if not ( (col[i]=true) or (dia_r[i-row+128]=true) or (dia_l[row+i+128]=true) )
then {jesli w kolumnie x ani odpowiednich przekątnych nie ma jeszcze hetmana to warunek jest prawdziwy}
begin
dia_r[i-row+128] := true; {dodaj przekątne}
dia_l[row+i+128] := true;
col[i]:=true; {dodaj kolumnę}
chart[i,row]:=true; {postaw hetmana w tablicy}
if row<8 then
add_hetman(row+1) {analizuj nastepny wiersz (tylko jesli nie jestesmy juz w ostatnim)}
else {to jest ostatni hetman - zapisz wynik}
begin
inc(found);
writeln(F,'kombinacja: ',found);
writeln(F,' ABCDEFGH');
writeln(F);
for y:=8 downto 1 do
begin
write(F,y,' ');
for x:=1 to 8 do if chart[x,y] then
write(F,'H')
else
write(F,' ');
writeln(F);
end;
writeln(F);
writeln(F);
end;
{ po wyjsciu z procedury rekurencyjnej (add_hetman(row+1)) usun hetmana i szukaj dla niego nastepnego pola}
dia_r[i-row+128] := false;
dia_l[row+i+128] := false;
col[i]:=false;
chart[i,row]:=false;
end;
end;
{nie można juz postawic w tym rzędzie hetmana - wyjdź i próbuj przestawic poprzedniego}
end;
begin
Assign(F,'kombinacje.txt');
rewrite(F);
add_hetman(1); {postaw pierwszego hetmana}
close(F);
end.

