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.