algorytm.org

Implementacja w Delphi/Pascal



Baza Wiedzy
wersja offline serwisu przeznaczona na urządzenia z systemem Android
Darowizny
darowiznaWspomóż rozwój serwisu
Nagłówki RSS
Artykuły
Implementacje
Komentarze
Forum
Bookmarki






Sonda
Implementacji w jakim języku programowania poszukujesz?

Problem 8 hetmanów - Implementacja w Delphi/Pascal
Ocena użytkownikóww: *****  / 4
SłabyŚwietny
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.


Dodaj komentarz