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}
% 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:
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++.