IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Конь Аттилы
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 4
Пол: Мужской

Репутация: -  0  +


На шахматной доске стоят белый конь(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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Автооответчик
*****

Группа: Пользователи
Сообщений: 1 188
Пол: Мужской
Реальное имя: Александр

Репутация: -  16  +


твое решение не смотрел (коментарии к переменным стоит, все-таки, использовать;) ).
я вижу решение проблемы в следующем:

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

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

по идее, конь должен вернуться в начальную точку если это вообще возможно.


--------------------
Неадекватная чушь может быть адекватным ответом на неадекватный вопрос. Понятно или разжевать?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





Группа: Пользователи
Сообщений: 4
Пол: Мужской

Репутация: -  0  +


Про коменты извинюсь, не приучен...
Про 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.



Вообщем работает!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 20.04.2025 7:27
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name