Ośmiu hetmanów

RafalS

Program do wyszukiwania pozycji 8-miu hetmanów na szachownicy. Figury powinny być tak ustawione, aby żaden hetman nie szachował innego. Pozycja pierwszego hetmana jest wczytywana z klawiatury i nie może się zmienić.

Program działa w sposób rekurencyjny. W jednym stopniu rekurencji znajdowana jest pozycja jednego hetmana. Zgodnie z regułami szachowymi każdy hetman powinien znajdować w osobnej kolumnie i w osobnym wierszu, dlatego w jednym stopniu rekurencji przeszukiwana jest tylko jedna kolumna. Przeszukiwanie trwa do momentu znalezienia pierwszego bezpiecznego pola w kolumnie. Wybrane rozwiązanie jest przykładem algorytmu rekurencyjnego z powrotami. Gdy dla kolejnego hetmana zostanie przeszukana cała kolumna i bezpieczna pozycja nie zostanie znaleziona, następuje powrót do poprzedniego stopnia rekurencji, usunięcie poprzedniego hetmana z bezpiecznej pozycji i poszukiwanie kolejnego bezpiecznego położenia w tej kolumnie. Próby trwają do momentu aż znaleziona zostanie bezpieczna pozycja dla wszystkich hetmanów. Kolumna w której został ustawiony hetman ,którego pozycja została wczytana z klawiatury, nigdy nie jest przeszukiwana ponieważ pozycja tego hetmana nie może się zmienić. Zatem głębokość rekurencji wynosi siedem co powoduje przyśpieszenie znalezienia rozwiązania. Przy ustawieniu hetmana na określonym polu zadanym z klawiatury zawsze znajdowane jest to samo rozwiązanie. Nie jest to jedyne rozwiązanie ,ale jest pierwsze znalezione rozwiązanie. Dalsze poszukiwania nie są przeprowadzane.

Program Osmiu_hetmanow;

{kompilowany w srodowisku Turbo Pascal 7.0}

{****************************************************************************}
{Program wyszukuje pozycje osmiu hetmanow na szachownicy. Figury powinny byc}
{tak ustawione, aby zaden hetman nie szachowal innego. Pozycja pierwszego}
{hetmana jest wczytywana z klawiatury i nie moze sie zmienic.}
{****************************************************************************}

uses crt2;

type Tdane_wejsciowe=1..8;

 var nr_wier,nr_kol:Tdane_wejsciowe;{przechowuja dane wczytane z klawiatury}
     znaleziono_roz:boolean;        {informuje o znalezieniu rozwiazania}
     Brak_het_przek_G_D:array[-7..7]of boolean;
{Tablica przekatnych biegnacych z gory na dol-wartosc true w komorce tablicy}
{o numerze=nr_kol-nr_wier oznacza brak hetmana na tej przekatnej}
     Brak_het_przek_D_G:array[2..16]of boolean;
{Tablica przekatnych biegnacych z dolu na gore-wartosc true w komorce tablicy}
{o numerze=nr_kol+nr_wier oznacza brak hetmana na tej przekatnej}
     Brak_het_w_wier:array[1..8]of boolean;
{Tablica wierszy-wartosc true oznacza brak hetmana w wierszu o nr=nr_wier}
     Poz_het_w_kol:array[1..8]of Tdane_wejsciowe;
{Tablica pozycji hetmanow-nr komorki w tablicy oznacza nr kol.,wartosc tam}
{zapisana to nr wier. gdzie znajduje sie hetman po znalezieniu rozwiazania}

{****************************************************************************}

Procedure wczytaj_dane(var nr_wier,nr_kol:Tdane_wejsciowe);
var licz_gwd:integer;   {licznik gwiazdek}
  begin
    writeln('                          *Program_Osmiu hetmanow* ');
    writeln;

      for licz_gwd:=1 to 80 do
        write('*');
    writeln;

    write('Opis:Program wyszukuje pozycje osmiu hetmanow na szachownicy,');
    write('figury powinny byc tak ustawione, aby zaden hetman nie szachowal');
    write(' innego.Pozycja pierwszego hetmana jest wczytywana z klawiatury');
    writeln(' i nie moze sie zmienic.');
    writeln;

      for licz_gwd:=1 to 80 do
       write('*');
    writeln;

 {$I-}  {dyrektywa(polecenie) kompilatora wylaczajaca sprawdzanie}
        {poprawnosci I/O,funkcja IOresult zwraca 0 gdy operacja I/O poprawna}

    writeln('Podaj pozycje pierwszego hetmana.');
    writeln('Podaj nr wiersza gdzie zostanie ustawiony hetman-lb. od 1 do 8:');
    readln(nr_wier);
      while (IOresult <> 0) or (not (nr_wier in [1..8]) ) do
        begin
          writeln('Numer wiersza powinien byc lb. calkowita z zakresu od 1 do 8');
          writeln('Podaj ponownie numer wiersza:');
          readln(nr_wier);
        end;

    writeln('Podaj nr kolumny gdzie zostanie ustawiony hetman-lb. od 1 do 8:');
    readln(nr_kol);
      while (IOresult <> 0) or (not (nr_kol in [1..8]) ) do
        begin
          writeln('Numer kolumny powinien byc lb.calkowitĄ z zakresu od 1 do 8:');
          writeln('Podaj ponownie numer kolumny');
          readln(nr_kol);
        end;

  end;

{****************************************************************************}

{Procedura zapisuje do tablic poczatkowe wartosci oznaczjace czy w danym}
{wierszu,przekatnej wystepuje hetman,hetman bedzie wystepowal tylko na }
{pozycji wczytanej z klawiatury,na tych pozycjach w tablicach wartosc false}

Procedure inicjuj_szachownice(nr_wier,nr_kol:Tdane_wejsciowe);
      var i:integer;      {zmienna uzywana jako licznik petli}
  begin
    for i:=-7 to  7 do
      Brak_het_przek_G_D[i]:=true;
    for i:= 2 to 16 do
      Brak_het_przek_D_G[i]:=true;
    for i:= 1 to  8 do
      Brak_het_w_wier[i]:=true;

    Brak_het_przek_G_D[nr_kol-nr_wier]:=false;
    Brak_het_przek_D_G[nr_kol+nr_wier]:=false;
    Brak_het_w_wier[nr_wier]:=false;
    Poz_het_w_kol[nr_kol]:=nr_wier;{zapisanie pierwszego wyniku do tablicy}
  end;                             {przechowujacej wyniki}

{****************************************************************************}

{Procedura wyszukuje bezpieczne polozenia hetmanow i zapisuje wyniki do      }
{tablicy o nazwie Poz_het_w_kol,indeks tablicy to nr kol,a wartosc tam       }
{zapisana to numer wiersza                                                   }

Procedure wyszukaj_poz_het(akt_kol:integer; var znaleziono_roz:boolean);
      var akt_wier:integer;

  begin
    akt_wier:=0;
    repeat
      inc(akt_wier);
      znaleziono_roz:=false;
      if ((Brak_het_przek_G_D[akt_kol-akt_wier]) and {jezeli pozycja bezp.}
          (Brak_het_przek_D_G[akt_kol+akt_wier]) and
          (Brak_het_w_wier[akt_wier]))                then



        begin
          Poz_het_w_kol[akt_kol]:=akt_wier;         {ustaw hetmana}
          Brak_het_przek_G_D[akt_kol-akt_wier]:=false;
          Brak_het_przek_D_G[akt_kol+akt_wier]:=false;
          Brak_het_w_wier[akt_wier]:=false;

          if ( not ( ( akt_kol = 7 ) and ( nr_kol = 8 ) ) ) and
             ( akt_kol < 8 )            then         {jezeli jest to 7 kol.}
                                                      {i w 8 jest ustawiony}
                                             {hetman lub  jest to 8 kolumna}
                           {to warunek nie spelniony,nie zaglebiamy sie do }
                                {kolejnego stopnia rekurencj-"skok" do else}
                                                   {znalezlismy rozwiazanie}

                begin             {tutaj omijany jeden stopien rekurencji}
                  if akt_kol+1 = nr_kol then   {jeseli w nastepnej kolumnie}
                    begin                        {jest juz ustawiony hetman}
                      wyszukaj_poz_het(akt_kol+2,znaleziono_roz);
                      if not( znaleziono_roz ) then           {usun hetmana}
                        begin
                          Brak_het_przek_G_D[akt_kol-akt_wier]:=true;
                          Brak_het_przek_D_G[akt_kol+akt_wier]:=true;
                          Brak_het_w_wier[akt_wier]:=true;
                        end;
                    end

                  else                  {w nastepnej kolumnie nie ma hetmana}
                    begin            {wiec ja przeszukujemy -kolejny stopien}
                      wyszukaj_poz_het(akt_kol+1,znaleziono_roz);{rekurencji}
                      if not( znaleziono_roz ) then            {usun hetmana}
                        begin
                          Brak_het_przek_G_D[akt_kol-akt_wier]:=true;
                          Brak_het_przek_D_G[akt_kol+akt_wier]:=true;
                          Brak_het_w_wier[akt_wier]:=true;
                        end;
                    end;

              end





          else  znaleziono_roz:=true; {Nie byl wykonywany kolejny stopien}
        end;                          {rekurencji a ustawilismy ostatniego}
                                      {hetmana na bezp. pozycji wiec }
                                      {ustawianie zakonczone sukcesem}

    until znaleziono_roz or ( akt_wier=8 ); {powrot do poprzedniego stopnia}
  end;                                      {rekurencji}

{****************************************************************************}

Procedure wyswietl_wyniki;
var i,j,k:integer;                 {zmienne uzywane jako liczniki petli}
    nie_byl_het:boolean;           {okresla,czy w danym polu na szachownicy}
                                   {byl hetman}
  begin

    writeln;
    writeln('*Rozwiazanie*');
    writeln;
    for i:=1 to 8 do
      writeln('Nr wiersza: ',Poz_het_w_kol[i],'  Nr kolumny: ',i);
    writeln;


    write('Nacisnij Enter aby zobaczyc rozwiazanie w trybie');
    writeln(' pseudo-graficznym:');
    readln;
     for j:=0 to 17 do           {dlugosc szachow. w znakach}
       for i:=1 to 80 do

         if ( i < 20 ) or ( i > 60 ) then
           begin
              if ( i = 19 ) and (( j mod 2 ) = 0) and ( j <> 0 ) then
                  write( j div 2 ) {wyswietlanie cyfr z lewj strony szachow.}
              else
                  write(' ');    {Spacje z lewej i prawej strony szachownicy}
           end

         else
           begin
             if ( j = 0 ) and ( ( (i-3) mod 5 ) = 0 )      then
                 write( ( (i-23) div 5 )+1 );    {wyswietlanie cyfr}
                                                 {ponad szachownicĄ}
             if ( i = 20 ) and ( j = 1 )                   then
                write('É');
             if ( i = 20 ) and ( j = 17 )                  then
                write('Č');
             if ( i = 60 ) and ( j = 1 )                   then
                write('?');
             if ( i = 60 ) and (j = 17 )                   then
                write('Ľ');
             if ( i <> 20 ) and ( i <> 60 ) and
                ( (i mod 5) = 0 ) and ( j = 1 )            then
                write('Ë');
             if ( i <> 20 ) and ( i <> 60 ) and
                ( (i mod 5) = 0 ) and ( j = 17 )           then
                write('Ę');
             if ( i = 20 ) and ( j <> 1 ) and
                ( j <> 17 ) and ( (j mod 2) = 1 )          then
                write('Ě');
             if ( i = 60 ) and ( j <> 1 ) and
                ( j <> 17 ) and ( (j mod 2) = 1 )          then
                write('ą');
             if ( i <> 20 ) and ( i <> 60 ) and
                ( j <> 1 ) and ( j <> 17 ) and
                ( (i mod 5) = 0 ) and ( (j mod 2) = 1 )    then
                write('Î');
             if ( (i mod 5) <> 0 ) and ( (j mod 2) <> 0 )  then
                write('Í');
             if ( (i mod 5) = 0 ) and ( (j mod 2) = 0 ) and
                ( j <> 0 )                                 then
                write('ş');
             if ( (i mod 5) <> 0 ) and ( (j mod 2) = 0 ) and
                ( ( (i-3) mod 5 ) <> 0 )                   then
                write(' '); {Pola znakowe wewnatrz szachownicy}
                            {na ktorych nie moze pojawic sie znaczek hetmana}
             if ( (i mod 5) <> 0 ) and ( (j mod 2) = 0 ) and
                ( ( (i-3) mod 5 ) = 0 )                    then
                                           {Pola znakowe wewnatrz szachownicy}
                                                 {na ktorych nie moze pojawic}
                                                         {sie znaczek hetmana}
               begin
                 for k:=1 to 8 do             {Przeszukujemy tablice z}
                  if ( (j div 2) = Poz_het_w_kol[k] )and
                     ( ( ( (i-23) div 5 ) + 1 ) = k )   then
                                              {wynikami,jezeli znajdziemy}
                                              {wynik odpowiadajacy aktualnemu}
                      begin                   {polu na szachownicy wypisujemy}
                        write(#1);            {znaczek hetmana}
                        nie_byl_het:=false;
                      end;
                                            {Po  przeszukaniu calej tablicy}
                  if  nie_byl_het                       then
                      write(' ');           {wynikowej,jezli nie bylo}
                      nie_byl_het:=true;    {takiego wyniku wypisujemy ' '}
               end;

           end;

    writeln;
    writeln('Nacicnij Enter aby zakonczyc:');
    readln;

  end;

{****************************************************************************}
{*****************************Program glowny*********************************}

begin
    clrscr;
    wczytaj_dane(nr_wier,nr_kol);
    inicjuj_szachownice(nr_wier,nr_kol);
    if nr_kol=1 then                           {Kolumna,ktorej numer zostal}
       wyszukaj_poz_het(2,znaleziono_roz)    {wprowadzony z klawiatury jest}
    else                              {omijana przy wywolaniu rekurencyjnym}
       wyszukaj_poz_het(1,znaleziono_roz);   {nie jest przeszukiwana,jezeli}
    wyswietl_wyniki;                      {jest to kol. o nr 1 to ominiecie}
end.                          {wystepuje tutaj,jezeli nie to przy kolejnych}
                                               { wywolaniach rekurencyjnych}

6 komentarzy

% Ukonkretnia liste
c_list(0,[],[]):-!.
c_list(N,[A|As],[A|Bs]) :- N1 is N-1,c_list(N1,As,Bs).

gen_constraints([]):-!.
gen_constraints([A|As]) :- gen2(A,As,1), gen_constraints(As).

gen2(,[],) :- !.
gen2(A,[B|As],N) :-
A #= B+N,
A #= B-N,
N1 is N+1,
gen2(A,As,N1).

%
queens(N,L) :-
c_list(N,L,L1), % Ukonkretnienie listy zmiennych
fd_set_vector_max(N),
fd_domain(L1,1,N), % Ustalenie dziedziny zmiennych
fd_all_different(L1), % Ograniczenie dziedziny
gen_constraints(L1),
fd_labeling(L1,[variable_method(ff),value_method(middle)]). % Znajdowanie jakiegoś rozwiązania

To samo co poprzednie, tylko że:

  • w GNU-Prologu
  • działa kilka rzędów wielkości szybciej (dla 300 hetmanów drukuje wynik szybciej niż zdążę zdjąć palec z klawisza ENTER)

hetmany(N, P) :-
numlist(1, N, L),
permutation(L, P),
+ bicie(P).

bicie(P) :-
append(_, [X | P1], P),
append(P2, [Y | _], P1),
length(P2, D),
abs(X-Y) =:= D+1.

To samo w Swi-prologu dla n hetmanow na szachownicy n X n. Mozna wyszukac wszytkie rozwiazania. Troche krotsze:).

Nie czepiam sie tylko dziele się swoimi spostrzerzeniami, a pozatym to dobry kawłek kodu i nie twierdze wcale ze został on przepisany programu kogos innego.

Jedyne materiały z jakich korzystałem przy pisaniu tego kodu to książka "Algorytmy i struktury danych"-N.Wirth gdzie ten i kilka podobnych algorytmów jest dokładnie opisanych- polecam.

No to jeżeli nawet to przepisał z c++ to i tak dobrze zrobił, więc co się czepiasz?

kiedys wydziałem bardzo podobny kod na www.planet-source-code.com tyle tylko ze w c++.