Помощь - Поиск - Пользователи - Календарь
Полная версия: Конь Аттилы
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Ipse
На шахматной доске стоят белый конь(44, позиция h[5,7]) и черный король(77, позиция h[6,2]). Некоторые поля доски считаются "горящими", на них конь не может наступать (в моем решение они обозначены 99). Конь должен дойти до короля, повергнуть его и вернуться на свое место.При этом ему запрещается становиться на поля, которые уже пройдены.
У меня получается дойти до короля, но как поставить условие чтобы вернуться обратно додумать пока не получается... Прошу подсказать.
 Program aaa;uses crt;
var i,j,n,n2,a,b,c:integer;
    q:boolean;
    dx,dy:array[1..8] of integer;
    h:array[1..8,1..8] of integer;
  s:longint;
procedure try(i,x,y:integer;var q:boolean);
  var k,u,v:integer;q1:boolean;
  BEGIN  k:=0;
  repeat k:=k+1; q1:=false;
    u:=x+dx[k];v:=y+dy[k];s:=s+1;
    if(1<=u)and(u<=n)and(1<=v)and(v<=n)and((h[u,v]=0)or(h[u,v]=77)or(h[u,v]=22)) then
     begin
           if (h[u,v]<>77)then
               h[u,v]:=i else h[u,v]:=77;

         if (h[u,v]<>77) then 
           begin
            try(i+1,u,v,q1);
            if (q1=false) then h[u,v]:=0;  
           end
         else q1:=true;
     end;
  until q1 or (k=8);
  q:=q1;
  END;

begin  clrscr; s:=0;t:=false;
     dx[1]:=2;dx[2]:=1;dx[3]:=-1;dx[4]:=-2;
     dx[5]:=-2;dx[6]:=-1;dx[7]:=1;dx[8]:=2;
     dy[1]:=1;dy[2]:=2;dy[3]:=2;dy[4]:=1;
     dy[5]:=-1;dy[6]:=-2;dy[7]:=-2;dy[8]:=-1;
writeln('Razmer doski:');
readln(n);
  for i:=1 to n do
   for j:=1 to n do
    h[i,j]:=0;
    h[2,1]:=99;h[1,2]:=99;h[2,2]:=99;h[1,3]:=99;h[2,3]:=99;h[1,4]:=99;
    h[2,4]:=99;h[1,7]:=99;h[1,8]:=99;h[2,8]:=99;{}h[8,1]:=99;h[4,3]:=99;
    h[4,4]:=99;h[4,5]:=99;h[4,6]:=99;h[4,7]:=99;h[4,8]:=99;
    h[5,3]:=99;h[5,4]:=99;h[5,5]:=99;h[5,6]:=99;h[5,8]:=99;
    h[6,3]:=99;h[6,4]:=99;h[6,6]:=99;
    h[7,3]:=99;h[7,8]:=99;{}h[8,3]:=99;h[8,6]:=99;
    h[6,2]:=77;
    for i:=1 to n do
         begin
          for j:=1 to n do
           if (h[i,j]<10) then
           write('  ',h[i,j],' ')
           else write(' ',h[i,j],' ');
           writeln;writeln;
         end;
writeln('Poziciya konya:');
   read(i);read(j);writeln;
   n2:=n*n;h[i,j]:=44;
   try(2,i,j,q);
      if q then
        for i:=1 to n do
         begin
          for j:=1 to n do
           if (h[i,j]<10) then
           write('  ',h[i,j],' ')
           else write(' ',h[i,j],' ');
           writeln;writeln;
         end
      else writeln('no path');writeln;
      for i:=1 to n do
         begin
          for j:=1 to n do
           if (h[i,j]<10) then
           write('  ',h[i,j],' ')
           else write(' ',h[i,j],' ');
           writeln;writeln;
         end;
     write(s);
  readkey;
end.
GoodWind
твое решение не смотрел (коментарии к переменным стоит, все-таки, использовать;) ).
я вижу решение проблемы в следующем:

1. после того как конь поверг короля переместить клетку, к которой стремится конь в начальную позицию коня (позиция h[5,7]). Т.е. если раньше конь стремился попасть в h[6,2], то после свержения короля он должен стремиться в h[5,7], я правильно понял?

2. при перемещении коня "поджигать" (ставить значение 99) клетки, на которые конь наступал.

по идее, конь должен вернуться в начальную точку если это вообще возможно.
Ipse
Про коменты извинюсь, не приучен...
Про 2) пункту: я просто нумерую шаги коня и пишу их в клетках...
По 1) пункту ты правильо понял, я уже пробовал так, только там используется алгоритм возврата и все надо связать вместе, ты и подтолкнул меня на возвращение к этому варианту, посмотрел, подумал, вот что получилось:


Program Kon_Attili;uses crt;
var i,j,n,n2:integer;
    q,t:boolean;
    dx,dy:array[1..8] of integer;{vozmozhnie xodi konem}
    h:array[1..8,1..8] of integer; {doska}
    s:longint;

  {**********procedura vozvraweniya konya na isxodnoe mesto*********}
  procedure try1(i,x,y:integer;var t:boolean);
  var k,u,v:integer;t1:boolean;
  BEGIN  k:=0;
  repeat k:=k+1; t1:=false;
    u:=x+dx[k];v:=y+dy[k];
    s:=s+1;
    if(1<=u)and(u<=n)and(1<=v)and(v<=n)and((h[u,v]=0)or(h[u,v]=44)) then
     begin
           if (h[u,v]<>44)then
               h[u,v]:=i else h[u,v]:=44;
         if (h[u,v]<>44) then
           begin
            try1(i+1,u,v,t1);
            if (t1=false) then h[u,v]:=0;
           end
         else t1:=true;
     end;
  until t1 or (k=8);
  t:=t1;
  END;

  {************  procedura naxozhdeniya korolya  *************}
procedure try(i,x,y:integer;var q:boolean);
  var k,u,v:integer;q1:boolean;
  BEGIN  k:=0;
  repeat k:=k+1; q1:=false;
    u:=x+dx[k];v:=y+dy[k];
    if(1<=u)and(u<=n)and(1<=v)and(v<=n)and((h[u,v]=0)or(h[u,v]=77)) then
     begin   s:=s+1;
           if (h[u,v]<>77)then
               h[u,v]:=i else h[u,v]:=77;
         if (h[u,v]<>77) then
           begin
            try(i+1,u,v,q1);
            if (q1=false) then h[u,v]:=0;
           end
         else
          begin try1(i+1,u,v,t);
                 if t then
                   q1:=true
                 else q1:=false;
          end;
     end;
  until q1 or (k=8);
  q:=q1;
  END;
  {*************  Osnovnaya programma   **************}
begin  clrscr; s:=0;t:=false;
     dx[1]:=2;dx[2]:=1;dx[3]:=-1;dx[4]:=-2;
     dx[5]:=-2;dx[6]:=-1;dx[7]:=1;dx[8]:=2;
     dy[1]:=1;dy[2]:=2;dy[3]:=2;dy[4]:=1;
     dy[5]:=-1;dy[6]:=-2;dy[7]:=-2;dy[8]:=-1;
readln(n);
 {obnylenie matrici}
  for i:=1 to n do
   for j:=1 to n do
    h[i,j]:=0;
    {Prisvaenie polyam statysa 'goryawie'}
    h[2,1]:=99;h[1,2]:=99;h[2,2]:=99;h[1,3]:=99;h[2,3]:=99;h[1,4]:=99;
    h[2,4]:=99;h[1,7]:=99;h[1,8]:=99;h[2,8]:=99;{}
    h[8,1]:=99;h[4,3]:=99;{}
    h[4,4]:=99;h[4,5]:=99;h[4,6]:=99;h[4,7]:=99;h[4,8]:=99;
    h[5,3]:=99;h[5,4]:=99;h[5,5]:=99;h[5,6]:=99;h[5,8]:=99;
    h[6,3]:=99;h[6,4]:=99;h[6,6]:=99;
    h[7,3]:=99;h[7,8]:=99;h[8,3]:=99;h[8,6]:=99;{}
    h[6,2]:=77;h[5,7]:=44;
    for i:=1 to n do
         begin
          for j:=1 to n do
           if (h[i,j]<10) then
           write('  ',h[i,j],' ')
           else write(' ',h[i,j],' ');
           writeln;writeln;
         end;
   read(i);read(j);writeln;
   n2:=n*n;h[i,j]:=44;
   try(2,i,j,q);

      if q then
        for i:=1 to n do
         begin
          for j:=1 to n do
           if (h[i,j]<10) then
           write('  ',h[i,j],' ')
           else write(' ',h[i,j],' ');
           writeln;writeln;
         end
      else writeln('no path');writeln;
   writeln(s);
  readkey;
end.



Вообщем работает!
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.