Помощь - Поиск - Пользователи - Календарь
Полная версия: все таже про коня((
Форум «Всё о Паскале» > 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(c);
      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.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.