Ход конём

← →
Ezhik (2004-10-12 01:31) [0]

Уважаемые мастера, я в отчаянии. Пишу широкоизвестную прогу "Ход конём"(есть поле 10*10, и надо начиная с любой клетки порйти все 100 ходов побывав в каждой из них единажды). Алгоритм я понимаю и все казалось бы прозрачно (рекурсия), но что-то не то.:( Уже 2-а дня сижу за отладкой, надпись на клавише ф7 уже стерлась :). Через ф7, я наблюдаю, что все идеально, вродеб-то. Умоляю, посмотрите что в этом алгоритме не так... Спасибо за внимание

var
Hodu: array of array of byte; //сюда пишем сделаные ходы
Masiv: array[1..10,1..10] of Boolean; //Помечаем ечейку занетой
VariantListXXX: array of byte; //
VariantListYYY: array of byte; //списки возможных ходов
Variantu: array[1..100,1..2] of byte; //пишем число вариантов ходов и под каким вариантом мы зашли в даный момент
x,y,FreeCount,move_num: integer;

x:=0;
y:=0;

procedure Recors();
var
i,a,b: byte;
begin
CheckHodCount(x,y); //проверяем число возможных ходов
if FreeCount <> 0 then
begin
SetLength(Hodu,move_num+1,2);

Masiv[x,y]:= True;
Hodu[move_num,0]:= x;
Hodu[move_num,1]:= y;

Variantu[move_num+1,1]:= FreeCount;
Inc(move_num);

if move_num >= 100 then begin ShowMessage("100!!!"); draw; exit end;

X:= VariantListXXX[Variantu[move_num,2]]; //первый раз мы берём из списка возможных ходов первый, при неудаче - 2-й, и т.д.
Y:= VariantListYYY[Variantu[move_num,2]];

// Form1.Caption:= Inttostr(move_num);
Recors;
end
else
begin
// ShowMessage("000");
repeat
a:= Variantu[move_num,1];
b:= Variantu[move_num,2];
Masiv[(Hodu[move_num-1,0]),(Hodu[move_num-1,1])]:= False;
if a <= b+1 then
begin
Variantu[move_num,1]:=0;
Variantu[move_num,2]:=0;
end;
inc(move_num,-1);
until a > b+1;

x:= Hodu[move_num,0];
y:= Hodu[move_num,1];
Variantu[move_num+1,2]:= Variantu[move_num+1,2] + 1;
Recors
end;
end;

CheckHodCount(x,y); - это порцедура мне возврашает число вариантов ходовю

← →
Defunct © (2004-10-12 02:01) [1]

можно уточнить: ходить можно только буквой Г?

← →
Defunct © (2004-10-12 04:08) [2]

Если ходить можно только бугвой Г, то задача не имеет решения, невозможно покрыть даже 90 клеточек не говоря уж о всех 100:

unit Unitxx; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids; type TForm3 = class(TForm) SG: TStringGrid; Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } function Move(Location:TPoint; Direction: Word; History:Integer):Integer; end; var Form3: TForm3; implementation {$R *.dfm} const d_ur = $FE01; // вверх на 2, вправо на 1 d_ul = $FEFF; // вверх на 2, влево на 1 d_dr = $0201; // вниз на 2, вправо на 1 d_dl = $02FF; // вниз на 2, влево на 1 d_ru = $FF02; // вверх на 1, вправо на 2 d_lu = $FFFE; // вверх на 1, влево на 2 d_rd = $0102; // вниз на 1, вправо на 2 d_ld = $01FE; // вниз на 1, влево на 2 AllDirections : Array[1..8] of word = (d_ur, d_ul, d_dr, d_dl, d_ru, d_lu, d_rd, d_ld); function InBound(var Location: TPoint; Direction: Word):Boolean; Var XD, YD: Integer; Begin XD := Byte(Direction And $FF); If XD> 127 Then XD := XD or $FFFFFF00; YD := Byte(Direction Shr 8); If YD> 127 Then YD := YD or $FFFFFF00; Location.X := Location.X + XD; Location.Y := Location.Y + YD; Result := (Location.X>=0) And (Location.Y>=0) And (Location.X<=9) And (Location.Y<=9); End; function TForm3.Move(Location:TPoint; Direction: Word; History:Integer):Integer; Var NH : Integer; I : Integer; Begin Result := History; If History>90 Then ShowMessage("Found"); { выполнение движения } If InBound(Location, Direction) Then Begin Inc(History); If SG.Cells[Location.X, Location.Y] <> "P" Then Begin SG.Cells[Location.X, Location.Y] := "P"; For I:=1 To 8 Do Begin NH := Move(Location, AllDirections[i], History); If NH > Result Then Result := NH; End; SG.Cells[Location.X, Location.Y] := "c"; Button1.Caption := IntToStr( Result ); Application.ProcessMessages; End End; End; procedure TForm3.Button1Click(Sender: TObject); Var P:TPoint; S: Integer; begin P.X := 5; P.Y := 5; S := 0; Move(P, d_rd, S); end; end.

Советую уточнить условие.

← →
Defunct © (2004-10-12 04:30) [3]

[2]
хотя вру 94 клеточки покрыло, но ждать пришлось очень долго.
Возможно покроет и 100.. правда 8^100 вариантов, кто вам дал такое задание?

← →
wnew © (2004-10-12 04:48) [4]

Стандартная задача по программированию. Смотри по этой ссылке http://www.gymnasium-odenthal.de/download/iflk_abi03_material/_pdfs/Klausur_LK_12_1_N.pdf четвёртую страницу в PDF-файле. Или скачай этот исходник http://www.salvator.net/salmat/info/springer.zip

← →
wnew © (2004-10-12 04:53) [5]

Есть две таких задачи: по условию первой - конь должен стартовать из угла и побывать в каждой клетке один раз, а по условию второй - конь должен стартовать из угла, побывать в каждой клетке один раз и вернуться на клетку с которой стартовал.

← →
wnew © (2004-10-12 04:55) [6]

Здесь решение для первой задачи на Си:
#include <iostream.h> //#include <stdlib.h> int xsize=0,ysize=0,*feld=0; int springer(int x, int y, int pos) { if(feld[y*xsize+x]) return(0); feld[y*xsize+x]=pos; if(pos!=((xsize-4)*(ysize-4))) if(!springer(x+1,y-2,pos+1)) if(!springer(x+2,y-1,pos+1)) if(!springer(x+2,y+1,pos+1)) if(!springer(x+1,y+2,pos+1)) if(!springer(x-1,y+2,pos+1)) if(!springer(x-2,y+1,pos+1)) if(!springer(x-2,y-1,pos+1)) if(!springer(x-1,y-2,pos+1)) { feld[y*xsize+x]=0; return(0); } return(1); } void main(void) { int x,y,z,xstart,ystart; cout << "Breite des Feldes :"; cin >> xsize; cout << "Hцhe des Feldes :"; cin >> ysize; xsize+=4; ysize+=4; if(feld=new(int[xsize*ysize])) { for(x=0;x<xsize;x++) for(y=0;y<ysize;y++) feld[y*xsize+x]=0; for(x=0;x<xsize;x++) { feld[x]=-1; feld[xsize+x]=-1; feld[((ysize-1)*xsize)+x]=-1; feld[((ysize-2)*xsize)+x]=-1; } for(y=0;y<ysize;y++) { feld[xsize*y]=-1; feld[xsize*y+1]=-1; feld[xsize*y+x-1]=-1; feld[xsize*y+x-2]=-1; } do { cout << "X-Position des Springers ( 1-" << xsize-4 << ") :"; cin >>xstart; } while((xstart<1)||(xstart>(xsize-4))); do { cout << "Y-Position des Springers ( 1-" << ysize-4 << ") :"; cin >> ystart; } while((ystart<1)||(ystart>(ysize-4))); cout << "\nBerechne Loesung fuer Feldgroesse (" << xsize-4 << "," << ysize-4 << ") "; cout << "und Startposition (" << xstart << "," << ystart << "...\n\n"; if(!springer(xstart+1,ystart+1,1)) cout << "Es gibt keine Lцsung!!\n\n"; else { for(z=1;z<=(ysize-4)*(xsize-4);z++) for(y=2;y<ysize-2;y++) for(x=2;x<xsize-2;x++) if(feld[y*xsize+x]==z) cout << "(" << x-1 << "," << y-1 << ")\n"; } delete(feld); } }

← →
wnew © (2004-10-12 04:56) [7]

А здесь решение для второй, тоже на Си:
#include <iostream.h> //#include <stdlib.h> int xsize=0,ysize=0,*feld=0; int springer(int x, int y) { static int pos=1; if((feld[y*xsize+x]==1)&&(pos==((xsize-4)*(ysize-4)+1))) return(1); if(feld[y*xsize+x]) return(0); feld[y*xsize+x]=pos; pos++; if(!springer(x+1,y-2)) if(!springer(x+2,y-1)) if(!springer(x+2,y+1)) if(!springer(x+1,y+2)) if(!springer(x-1,y+2)) if(!springer(x-2,y+1)) if(!springer(x-2,y-1)) if(!springer(x-1,y-2)) { feld[y*xsize+x]=0; pos--; return(0); } return(1); } void main(void) { int x,y,z,xstart,ystart; cout << "Breite des Feldes :"; cin >> xsize; cout << "Hцhe des Feldes :"; cin >> ysize; xsize+=4; ysize+=4; if(feld=new(int[xsize*ysize])) { for(x=0;x<xsize;x++) for(y=0;y<ysize;y++) feld[y*xsize+x]=0; for(x=0;x<xsize;x++) { feld[x]=-1; feld[xsize+x]=-1; feld[((ysize-1)*xsize)+x]=-1; feld[((ysize-2)*xsize)+x]=-1; } for(y=0;y<ysize;y++) { feld[xsize*y]=-1; feld[xsize*y+1]=-1; feld[xsize*y+x-1]=-1; feld[xsize*y+x-2]=-1; } do { cout << "X-Position des Springers ( 1-" << xsize-4 << ") :"; cin >>xstart; } while((xstart<1)||(xstart>(xsize-4))); do { cout << "Y-Position des Springers ( 1-" << ysize-4 << ") :"; cin >> ystart; } while((ystart<1)||(ystart>(ysize-4))); cout << "\nBerechne Loesung fuer Feldgroesse (" << xsize-4 << "," << ysize-4 << ") "; cout << "und Startposition (" << xstart << "," << ystart << "...\n\n"; if(!springer(xstart+1,ystart+1)) cout << "Es gibt keine Lцsung!!\n\n"; else { for(z=1;z<=(ysize-4)*(xsize-4);z++) for(y=2;y<ysize-2;y++) for(x=2;x<xsize-2;x++) if(feld[y*xsize+x]==z) cout << "(" << x-1 << "," << y-1 << ")\n"; } delete(feld); } }

← →
Defunct © (2004-10-12 05:16) [8]

[5]
Не каждое поле можно обскакать, например, поля 2x2, 3x3, 4x4 обойти нельзя, неисключено что и 10x10 тоже.

[4]
Задача интересна для вас, поэтому и решать ее вам. Все что мог я и так уже сделал (на этом чисто академический интерес с моей стороны заканчивается, соответственно больше мне предложить нечего, по ссылкам лазить - увы нет желания). Простой рекурсивный обход [2] требует времени.

← →
wnew © (2004-10-12 05:19) [9]

Defunct © (12.10.04 5:16) [8]
Да нет, это не мне она интересна, вопрос же не я задавал:) Я эту задачу решал 10 лет назад, когда на курсах по C++ учился :)

← →
Defunct © (2004-10-12 05:27) [10]

wnew © (12.10.04 05:19) [9]

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

> Я эту задачу решал 10 лет назад, когда на курсах по C++ учился

для шахматного поля задача решается, а для 10x10 не знаю, [2] показывает - что нет.

← →
wnew © (2004-10-12 05:59) [11]

Да, а я и не догадывался ввести поле больше, чем 8X8, сейчас попробовал - комп. уже пять минут перебирает по решению [6]. Хотя с полем 8X8 справляется мгновенно:) Пошёл курить:)

← →
lehich © (2004-10-12 09:09) [12]

2Defunct как это для 10х10 не решается? еще 15 лет назад сидя на уроках от нечего делать рисовали такие поля и заполняли их целиком

← →
Defunct © (2004-10-12 17:22) [13]

lehich © (12.10.04 09:09) [12]

приведите ваше решение.
лет 10-15 назад не было машин способных "на уроке решить такую задачу (пересмотреть 2^103 вариантов)".

← →
Defunct © (2004-10-12 17:36) [14]

Defunct © (12.10.04 17:22) [13]

> (пересмотреть 2^103 вариантов)

ошибся 2^300 вариантов.

← →
lehich © (2004-10-12 17:39) [15]

2Defunct вручную решали! вручную! может пари на что-нибудь что я в течении 3-4 дней вручную решу задачу (на бумажке) по ходу конем на поле 10х10 клеток? и оно будет ВСЁ заполнено? и пришлю отсканированный рисунок

← →
Defunct © (2004-10-12 17:43) [16]

lehich © (12.10.04 17:39) [15]

вы что издеваетесь? или совсем не представляете сложности задачи?

← →
Sha © (2004-10-12 18:29) [17]

Defunct © (12.10.04 17:43) [16]

Задача несложная.
Для малых досок - перебор, для больших - по частям.

← →
Defunct © (2004-10-12 21:01) [18]

Sha © (12.10.04 18:29) [17]

Задача не решается.
Поле 5x5 покрыть нельзя, соотв нельзя покрыть 4x5x5

← →
Sha © (2004-10-12 21:07) [19]

Defunct © (12.10.04 21:01) [18]

Надо уметь разрезать :)
У меня есть решение для досок сколь угодно большого размера.
В свое время писал для DelphiChallenge. Был такой сайт. Умер.

← →
Defunct © (2004-10-12 21:11) [20]

> Sha

вопрос ведь не в размере доски, а в кратности.
8x8, 12x12, 16x16 и т.п. покрываются.

Как бы мы ни резали 10x10, получаются поля которые невозможно покрыть.

← →
Ezhik (2004-10-12 21:41) [21]

Точно утверждать не буду, но я видел эту игру уже написаную, тока там надо самому заполнять эти поля. Так вот там было поле именно 10*10. И в таблице рекордов были люди заполнившие все поле. Значит же можно какнибуть такое поле заполнить.

← →
Sha © (2004-10-12 22:20) [22]

> Defunct © (12.10.04 21:11) [20]

> вопрос ведь не в размере доски, а в кратности.
> 8x8, 12x12, 16x16 и т.п. покрываются.
> Как бы мы ни резали 10x10, получаются поля которые невозможно покрыть.

Выбираются несколько фиксированных типоразмеров досок (не обязательно квадрадных, даже большинство не квадратных).
Затем для них отыскиваются решения кольцевого обхода.
Затем доказывается, что прямоугольные доски произвольного размера, большего m*n, можно разрезать на доски фиксированных типоразмеров с сохранением решения. Затем для ВСЕХ досок меньшего размера, для которых решение есть, отыскивается решение при помоши известных или оригинальных алгоритмов.
Все.

← →
Defunct © (2004-10-12 22:37) [23]

> Sha

Просто скажи, 10x10 имеет решение или нет?
У меня получается, что нет. Может быть я заблуждаюсь.

← →
Sha © (2004-10-12 22:39) [24]

Defunct © (12.10.04 22:37) [23]

Имеет

← →
DDA © (2004-10-12 22:50) [25]

> Defunct © (12.10.04 22:37) [23]

на поле 10x10 решение есть,также как и на 9x9 8x8 7x7 6x6 5x5 6x5 7x5
всё это у меня на листочке который составил в шкеле га уроках

Нужен отсканеный рисунок? с этими полями

← →
Sha © (2004-10-12 22:59) [26]

27 24 1 50 41 22 43 48 39 20 2 51 26 23 66 49 40 21 44 47 25 28 67 0 57 42 65 46 19 38 52 3 56 89 68 87 58 77 64 45 29 84 53 86 99 90 69 62 37 18 4 55 98 91 88 61 76 59 78 63 83 30 85 54 97 80 95 70 17 36 8 5 92 81 94 75 60 79 14 71 31 82 7 10 33 96 73 12 35 16 6 9 32 93 74 11 34 15 72 13

← →
Sha © (2004-10-12 23:04) [27]

Так лучше.
27 24 1 50 41 22 43 48 39 20 2 51 26 23 66 49 40 21 44 47 25 28 67 0 57 42 65 46 19 38 52 3 56 89 68 87 58 77 64 45 29 84 53 86 99 90 69 62 37 18 4 55 98 91 88 61 76 59 78 63 83 30 85 54 97 80 95 70 17 36 8 5 92 81 94 75 60 79 14 71 31 82 7 10 33 96 73 12 35 16 6 9 32 93 74 11 34 15 72 13

Это выход из программы перебора. Она позволяет отыскивать решения для досок размером примерно до 500*500 и даже чуть выше.

Кроме того, доску 10*10 можно склеить из двух 5*10.

← →
DDA © (2004-10-12 23:14) [28]

ну вот всё и решилось

← →
Defunct © (2004-10-12 23:28) [29]

> Sha, DDA

Thnx,

procedure TForm3.Button1Click(Sender: TObject);
Var P:TPoint;
S: Integer;
begin
P.X := 2;
P.Y := 0;
S := 0;
Move(P, d_ld, S);
end;

С наглядным примером [26, 27] - перебор [2] нашел решение. Но у автора была оговорка:

> и надо начиная с любой клетки пройти все 100 ходов побывав в каждой из них единажды

IMHO одно отсюда можно точно вынести, высказывание неверно:
> Алгоритм я понимаю и все казалось бы прозрачно (рекурсия)

Простой рекурсией тут не обойтись.

← →
Ezhik (2004-10-12 23:42) [30]

>>Sha © (12.10.04 23:04) [27]
>>Это выход из программы перебора. Она позволяет отыскивать решения для досок размером примерно до 500*500 и даже чуть выше.

Я очень поршу, можна исходничек этой поги, я поанализирую все, что я нетак делаю.

← →
Sha © (2004-10-13 01:17) [31]

Ezhik (12.10.04 23:42) [30]

Прога исследовательская, там 90% кода тебе не потребуется.
В твоем случае поможет поиск в сети по слову Варнсдорф

Defunct © (12.10.04 21:01) [18]

> Поле 5x5 покрыть нельзя

Начиная с 4X5 все решаются. И код приведёный мной в [6] прекрасно это делает. Разумеется, начиная с 8X9 песня затягивается. Но 8X8 находит за пару секунд.

> Sha

просьба обновить анкету ;>

> wnew © (13.10.04 01:44) [32]

да, уже вижу. только в 5x5 не находит краевых решений (когда точкой старта выбирается угол).

Народ раз уж зашел вопрос о переборе, может кто подскажет, решается ли такое:

??? ? ? \|/ | / [2] [3]-?? | / / [1]-[4]-[6] \ \ [5]-? | \ ? ?
есть точки (на рисунке это 1-6 и ?) всего точек 17 каждая точка может быть связана с четырмя любыми другими точками. Можно ли так связать все эти точки, чтобы из любой точки в любую другую максимальный путь был не больше 2.

← →
Ezhik (2004-10-13 02:53) [35]

Уважаемые мастера, задачу я решил, но действительно только для поля 8*8, в этом же коде делаю поле 10*10 и все - бесконечная рекурсия, или может ответ и возможен, но нада долго ждать(я ждал около 5 мин, в то время как 8*8 нашло за 1 сек...).
Для поля 8*8 все легче чемк казалось:

procedure Recors; var i,nx,ny: integer; begin Xodu[Nom,0]:= x; Xodu[Nom,1]:= y; pole[x,y]:= 1; inc(Nom); for i:= 0 to 7 do begin if Nom >= 100 then begin if flag = 0 then draw; exit; end; nx:= x + NextX[i]; ny:= y + NextY[i]; if (nx < 0) or (nx > 9) or (ny < 0) or (ny > 9) then continue; if pole[nx,ny] = 1 then continue; x:= nx; y:= ny; Recors; end; pole[Xodu[Nom-1,0],Xodu[Nom-1,1]]:= 0; x:= Xodu[nom-2,0]; y:= Xodu[nom-2,1]; Inc(Nom,-1); end;

Так что всем огромное спасибо за расмотрение вопорса

2Defunct пари? чтож вы боитесь? вы же уверены в сложности задачи и ее нерешаемости!!!

> Defunct © (13.10.04 02:21) [33]
> просьба обновить анкету ;>

Обновил

> только в 5x5 не находит краевых решений (когда точкой старта выбирается угол).

Вот тебе решение 5*5 с началом(концом) в центре и концом(началом) в углу
24 9 4 15 18 3 14 17 10 5 8 23 0 19 16 13 2 21 6 11 22 7 12 1 20

> Ezhik (13.10.04 02:53) [35]
> делаю поле 10*10 и все - бесконечная рекурсия,

Правило Варнсдорфа нашел?

> lehich © (13.10.04 09:23) [36]
> 2Defunct пари? чтож вы боитесь? вы же уверены в сложности задачи и ее нерешаемости!!!

Давай пари со мной для доски 1000*1000 - кто быстрее?

2Sha употею, яж не про компьютерный алгоритм говорю а про то что на бумаге это сделаю, тем более что в моем решении 10х10 сотая цифра почти в самом центре оказывается, следовательно 1000*1000 не разбить по десяткам...

> lehich © (13.10.04 11:00) [39]
> в моем решении 10х10 сотая цифра почти в самом центре
> оказывается, следовательно 1000*1000 не разбить по десяткам...

Как правило, для разбиения достаточно иметь замкнутый маршрут.
Если у тебя такой, то дело в шляпе.

у меня он замыкается в самом центре, а до него минимум по 3-4 замкнутых круга ВНЕШНИХ

> lehich © (13.10.04 12:34) [41]
> у меня он замыкается в самом центре, а до него минимум по 3-4 замкнутых круга ВНЕШНИХ

Маршрут коня называется замкнутым, если с конечного поля можно попасть в начальное одним ходом коня. По такому маршруту можно двигаться в любую сторону, начиная с любого поля.

Замечательное свойство многих замкнутых маршрутов состоит в том, что ими можно замостить поля большего размера.

Например, маршрут [27] - замкнутый:
27 24 1 50 41 22 43 48 39 20 2 51 26 23 66 49 40 21 44 47 25 28 67 0 57 42 65 46 19 38 52 3 56 89 68 87 58 77 64 45 29 84 53 86 99 90 69 62 37 18 4 55 98 91 88 61 76 59 78 63 83 30 85 54 97 80 95 70 17 36 8 5 92 81 94 75 60 79 14 71 31 82 7 10 33 96 73 12 35 16 6 9 32 93 74 11 34 15 72 13
Для того чтобы замостить поле 1000*1000 маршрутом [27] достаточно в нем разомкнуть некоторые из переходов: 10-11,30-31,40-41,71-72.
Для связи с соседями по горизонтали можно образовать переходы: 30-71,31-72.
Для связи с соседями по вертикали можно образовать переходы: 10-41,11-40.
Соседние паркетины соединим змейкой:
0 1 2 3 4 5 6 7 8 9 19 18 17 16 15 14 13 12 11 10 20 21 22 23 24 25 26 27 28 29 39 38 37 36 35 34 33 32 31 30 40 41 42 43 44 45 46 47 48 49 59 58 57 56 55 54 53 52 51 50 60 61 62 63 64 65 66 67 68 69 79 78 77 76 75 74 73 72 71 70 80 81 82 83 84 85 86 87 88 89 99 98 97 96 95 94 93 92 91 90
Мы снова получаем замкнутый маршрут.

Опять 27-ой уехал:
27 24 1 50 41 22 43 48 39 20 2 51 26 23 66 49 40 21 44 47 25 28 67 0 57 42 65 46 19 38 52 3 56 89 68 87 58 77 64 45 29 84 53 86 99 90 69 62 37 18 4 55 98 91 88 61 76 59 78 63 83 30 85 54 97 80 95 70 17 36 8 5 92 81 94 75 60 79 14 71 31 82 7 10 33 96 73 12 35 16 6 9 32 93 74 11 34 15 72 13

> 2Defunct пари? чтож вы боитесь? вы же уверены в сложности задачи и ее нерешаемости!!!

Был уверен, уже нет ;)

Ход конём Найти похожие ветки