1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
я скачал задачу пр коня в 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, я тут сейчас состряпал прожку. Посмотри ее, плз. Мне кажется, она нагляднее той, из FAQа (хотя я могу и ошибаться). В любом случае, по ней можешь задавать вопросы, и я отвечу. Это мне проще, чем разбираться в чужой.. ))
Кстати, вопрос оказался довольно интересным.. Я всем рекомендую прочесть статью в Вики по этому поводу.
Итак, код. Весомую его часть составляет процедура Show для вывода позиции - ее можно без особого ущерба выкинуть..
код, вариант для квадратной доски фиксированного размера(Показать/Скрыть)
// ****** Knight Tour trough a Board // ****** Warnsdorff's algorithm // ****** by Lapp, forum.pascal.net.ru
uses CRT;
const n=8; // board size (square edition)
var b: array[1..n,1..n]of byte; // board (1=clear, 0=marked)
function MovNum(x,y: integer): integer; // counts a number of possible moves var s,i,j,m,u,v: integer; begin s:=0; // summ of possible moves for m:=1 to 2 do // x-shift abs ( y-shift=3-m ) for u:=0 to 1 do // x-shift sign for v:=0 to 1 do begin // y-shift sign i:=x+m*(2*u-1); // new x j:=y+(3-m)*(2*v-1); // new y if (0<i)and(i<=n)and(0<j)and(j<=n) then s:=s+b[i,j] // check the move and add summ end; MovNum:=s end;
var i,j,m,x,y,mx,my,u,v,min,moves: integer;
begin Randomize; x:=Random(n)+1; y:=Random(n)+1; for i:=1 to n 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, can be dropped ReadKey; min:=9; // minimum init for m:=1 to 2 do // same as in MovNum .. for u:=0 to 1 do for v:=0 to 1 do begin i:=x+m*(2*u-1); j:=y+(3-m)*(2*v-1); if (0<i)and(i<=n)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; y:=my; until b[x,y]=0; Write('Done') end.
Метод простой: я выбираю абсолютную величину сдвига по Х (скажем, m). Она равна либо 1, либо 2. При этом абс.вел. сдвига по Y составит 3-m (проверь). Дальше я всячески перемешиваю (в двух циклах) знаки этих сдвигов, получая ходы во всех возможных направлениях. Эту процедуру приходится повторить дважды: один раз при выборе возможного хода (в головной проге), второй - при подсчете возможных ходов из новой позиции (функция MovNum). Собсно, все .
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой
Решил исправить недочет: сделал неквадратную доску с возможностью ввода размера (как в проге virt'а)). Публикую новый вариант - старый оставлю, но скрою.
alecsandr, к тебе просьба.. Когда будешь вникать (если будешь)), переведи комменты на русский. Мне всегда в лом переключать раскладку клавы, у меня от этого крыша едет. Но совесть грызет, что не все поймут. Опубликуй, пожалуйста, вариант с русскими комментами - я проверю и подправлю, если нужно. Идет?
// ****** 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)
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.
--------------------
я - ветер, я северный холодный ветер я час расставанья, я год возвращенья домой