Помощь - Поиск - Пользователи - Календарь
Полная версия: все таже про коня((
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
alecsandr
я скачал задачу пр коня в FAQ , но сам я до сих пор не понял как она работает, и что там делает какая строка. Не могли вы мне написать коменты по-подробней, потому что сам даж не понял как она это все вытворяет?????
{$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q+,R+,S+,T-,V+,X+}
{$M 16384,0,655360}
program kon_in_nm_matr_one_variant;
const _maxnm=8;
dx:array[1..8]of integer=(-2,-1,1,2,2,1,-1,-2);
dy:array[1..8]of integer=(1,2,2,1,-1,-2,-2,-1);
var a:array[-1.._maxnm+2,-1.._maxnm+2]of integer;
n,m,i,j:integer;

procedure solve(x,y,l:integer);
var w:array[1..8]of integer;
xn,yn,i,j,m1:integer;
begin
a[x,y]:=l;
if l=n*m then
begin
writeln;
for i:=1 to n do
begin
for j:=1 to m do write(a[i,j],' ');
writeln;
end;
halt;
end else
begin
for i:=1 to 8 do
begin
w[i]:=0;
xn:=x+dx[i];
yn:=y+dy[i];
if a[xn,yn]=0 then
begin
for j:=1 to 8 do
if a[xn+dx[j],yn+dy[j]]=0 then inc(w[i]);
end else w[i]:=-1;
end;
i:=1;
while i<=8 do
begin
m1:=1;
for j:=2 to 8 do
if w[j]<w[m1] then m1:=j;
if (w[m1]>=0) and (w[m1]<maxint) then
solve(x+dx[m1],y+dy[m1],l+1);
w[m1]:=maxint;
inc(i);
end;
end;
a[x,y]:=0;
end;

begin
readln(n,m);
for i:=-1 to n+2 do a[i,-1]:=-1;
for i:=-1 to n+2 do a[i,0]:=-1;
for i:=-1 to n+2 do a[i,m+1]:=-1;
for i:=-1 to n+2 do a[i,m+2]:=-1;
for j:=1 to m do a[-1,j]:=-1;
for j:=1 to m do a[0,j]:=-1;
for j:=1 to m do a[n+1,j]:=-1;
for j:=1 to m do a[n+2,j]:=-1;
for i:=1 to n do
for j:=1 to m do
a[i,j]:=0;
for i:=1 to n do
for j:=1 to m do
begin
solve(i,j,1);
end;
end.
alecsandr
ну обьясните кто может, пожалуйсто((
TarasBer
Какое именно место непонятно?
Гость
Я понял лишь что за 2 масива, но что все остольное, включая те ключи вначале проги я не понял(
Ozzя
Цитата
те ключи вначале проги

Borland Pascal 7. Руководство Программиста
Глава 2. Директивы компилятора
http://www.sources.ru/pascal/docs/bp7-pg.zip
alecsandr
Я так понял 8 циклов в главной проге, это ходы коня. Ключи я тож узнал. Можете подробней о процедуре?
Lapp
Уступая твоей настойчивости, досточтимый alecsandr, я тут сейчас состряпал прожку. Посмотри ее, плз. Мне кажется, она нагляднее той, из FAQа (хотя я могу и ошибаться). В любом случае, по ней можешь задавать вопросы, и я отвечу. Это мне проще, чем разбираться в чужой.. ))

Кстати, вопрос оказался довольно интересным.. smile.gif Я всем рекомендую прочесть статью в Вики по этому поводу.

Итак, код. Весомую его часть составляет процедура Show для вывода позиции - ее можно без особого ущерба выкинуть..
код, вариант для квадратной доски фиксированного размера (Показать/Скрыть)

Метод простой: я выбираю абсолютную величину сдвига по Х (скажем, m). Она равна либо 1, либо 2. При этом абс.вел. сдвига по Y составит 3-m (проверь). Дальше я всячески перемешиваю (в двух циклах) знаки этих сдвигов, получая ходы во всех возможных направлениях. Эту процедуру приходится повторить дважды: один раз при выборе возможного хода (в головной проге), второй - при подсчете возможных ходов из новой позиции (функция MovNum).
Собсно, все smile.gif.
Lapp
Решил исправить недочет: сделал неквадратную доску с возможностью ввода размера (как в проге virt'а)). Публикую новый вариант - старый оставлю, но скрою.

alecsandr, к тебе просьба.. Когда будешь вникать (если будешь)), переведи комменты на русский. Мне всегда в лом переключать раскладку клавы, у меня от этого крыша едет. Но совесть грызет, что не все поймут. Опубликуй, пожалуйста, вариант с русскими комментами - я проверю и подправлю, если нужно. Идет? smile.gif
// ****** Knight Tour trough a Board
// ****** Warnsdorff's algorithm
// ****** non-square board edition
// ****** by Lapp, forum.pascal.net.ru

uses
CRT;

const
max=100; // max board size

var
m,n: integer; // real board sizes, x & y
b: array[1..max,1..max]of byte; // board (1=clear, 0=marked)


procedure Show(x,y: integer);
var
c: char;
i,j: integer;
begin
Write('+');
for i:=1 to m do Write('-+');
WriteLn;
for j:=n downto 1 do begin
Write('|');
for i:=1 to m do begin
if (i=x)and(j=y) then c:='K' else if b[i,j]=0 then c:='+' else c:=' ';
Write©;
if i<m then Write(' ')
end;
Write('|');
WriteLn
end;
Write('+');
for i:=1 to m do Write('-+');
WriteLn;
end;


function MovNum(x,y: integer): integer; // counts a number of possible moves
var
s,i,j,d,u,v: integer;
begin
s:=0; // summ of possible moves
for d:=1 to 2 do // x-shift abs ( y-shift=3-d )
for u:=0 to 1 do // x-shift sign
for v:=0 to 1 do begin // y-shift sign
i:=x+d*(2*u-1); // new x
j:=y+(3-d)*(2*v-1); // new y
if (0<i)and(i<=m)and(0<j)and(j<=n) then s:=s+b[i,j] // check the move and add to summ
end;
MovNum:=s
end;


var
i,j,d,x,y,mx,my,u,v,min,moves: integer;

begin
Write('Type in board size (two numbers, space separated): ');
ReadLn(m,n);
Randomize;
x:=Random(m)+1;
y:=Random(n)+1;
for i:=1 to m do for j:=1 to n do b[i,j]:=1; // board init
repeat
b[x,y]:=0; // mark the cell
WriteLn(Chr(Ord('a')-1+x),y); // move output
Show(x,y); // extended output
ReadKey;
min:=9; // minimum init
for d:=1 to 2 do // same as in MovNum ..
for u:=0 to 1 do
for v:=0 to 1 do begin
i:=x+d*(2*u-1);
j:=y+(3-d)*(2*v-1);
if (0<i)and(i<=m)and(0<j)and(j<=n)and(b[i,j]>0) then begin
moves:=MovNum(i,j);
if moves<min then begin // search for minimum
mx:=i;
my:=j;
min:=moves
end
end
end;
x:=mx; // accept the new move
y:=my;
until b[x,y]=0; // stop when no moves left
Write('Done');
ReadKey
end.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.