Эта запись является продолжением записи Варианты
И так, всё поле хранится в массиве 16x16.
Для того, чтобы можно было как-то зафиксировать полученное решение, нужно организовать запись всех ходов. Каждый ход может начинаться в одной какой-то клетке и происходить в одном из четырёх направлений. Для экономии, можно занумеровать все клетки числами от 0 до 255 - это займёт 1 байт. На запись направления достаточно 2 бита, но смысла заморачиваться с битами нет, так-что пусть на направление тоже будет выделен 1 байт, но значения в этом байте будут только от 0 до 3. Вверх - 0. Вниз - 1. Влево - 2. Вправо - 3.
Для определения, на какой глубине мы сейчас находимся нужна ещё одна переменная. Т.к. максимальная глубина не может превышать количество фишек на поле, то для этой переменной достаточно одного байта. И, для того, чтобы понять, что мы выиграли, нужна переменная, в которой будет храниться выигрышная глубина. Её надо рассчитать перед вызовом функции, посчитав количество фишек на поле и вычтя единицу.
Ниже, вариант рекурсивной функции, которая ищет решение. К сожалению, у меня не сохранилось оригинала, так-что пришлось написать её заново специально для блога.
| Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
| unit PoleWork_Function;
interface
Type
TSteps=record
p:byte; // стартовая позиция
n:byte; // направление
end;
Var
Pole:array[0..15,0..15] of byte; // поле
Steps:array[0..222] of TSteps; // запись пути
StepsCount:byte; // текущая глубина
WinSteps:byte; // глубина, при достижении которой происходит выигрыш
// WinSteps := (<исходное количество фишек> - 1)
function PoleWork:boolean;
implementation
function PoleWork:boolean;
var
x,y:byte; // координаты позиции, с которой делается ход
begin
for x:=1 to 14 do
for y:=1 to 14 do
if Pole[x,y]=1 then
begin
if (Pole[x,y-1]=1) and (Pole[x,y-2]=0) then
begin // Если оба условия выполняются, значит возможен ход ВВЕРХ. Сделать этот ход:
Pole[x,y]:=0; // взять фишку с текущей позиции
Pole[x,y-1]:=0; // убрать перепрыгиваемую фишку
Pole[x,y-2]:=1; // поставить фишку в новое место
Steps[StepsCount].p:=x*16+y;// cохранить позицию, с которой сделан последний ход
Steps[StepsCount].n:=0; // и направление хода (ВВЕРХ)
inc(StepsCount); // увеличить глубину
if PoleWork then
begin // если более глубокий вызов PoleWork вернёт TRUE, значит решение найдено
Result:=true; // нужно вернуть TRUE внешней функции
exit; // и просто закончить
end else
begin // если более глубокий вызов PoleWork вернёт FALSE, значит это тупиковая ветка
// и нужно вернуться на ход назад
Pole[x,y-2]:=0; // взять фишку с нового места
Pole[x,y-1]:=1; // вернуть перепрыгнутую фишку
Pole[x,y]:=1; // вернуть взятую фишку в текущую позицию
dec(StepsCount); // вернутся в цепочке на прежнюю глубину
end;
end;
if (Pole[x,y+1]=1) and (Pole[x,y+2]=0) then
begin // Если оба условия выполняются, значит возможен ход ВНИЗ. Сделать этот ход:
Pole[x,y]:=0;
Pole[x,y+1]:=0;
Pole[x,y+2]:=1;
Steps[StepsCount].p:=x*16+y;
Steps[StepsCount].n:=1; // направление хода: ВНИЗ
inc(StepsCount);
if PoleWork then
begin
Result:=true;
exit;
end else
begin
Pole[x,y+2]:=0;
Pole[x,y+1]:=1;
Pole[x,y]:=1;
dec(StepsCount);
end;
end;
if (Pole[x-1,y]=1) and (Pole[x-2,y]=0) then
begin // Если оба условия выполняются, значит возможен ход ВЛЕВО. Сделать этот ход:
Pole[x,y]:=0;
Pole[x-1,y]:=0;
Pole[x-2,y]:=1;
Steps[StepsCount].p:=x*16+y;
Steps[StepsCount].n:=2; // направление хода: ВЛЕВО
inc(StepsCount);
if PoleWork then
begin
Result:=true;
exit;
end else
begin
Pole[x-2,y]:=0;
Pole[x-1,y]:=1;
Pole[x,y]:=1;
dec(StepsCount);
end;
end;
if (Pole[x+1,y]=1) and (Pole[x+2,y]=0) then
begin // Если оба условия выполняются, значит возможен ход ВПРАВО. Сделать этот ход:
Pole[x,y]:=0;
Pole[x+1,y]:=0;
Pole[x+2,y]:=1;
Steps[StepsCount].p:=x*16+y;
Steps[StepsCount].n:=3; // направление хода: ВПРАВО
inc(StepsCount);
if PoleWork then
begin
Result:=true;
exit;
end else
begin
Pole[x+2,y]:=0;
Pole[x+1,y]:=1;
Pole[x,y]:=1;
dec(StepsCount);
end;
end;
end;
Result:=(StepsCount>=WinSteps); // Если StepsCount=WinSteps, то на поле осталась 1 фишка и мы победили
// решение будет записано в массив Steps
end;
end. |
|
Всё прекрасно работает, решения находятся. Но есть большая проблема со скоростью. Даже с 17-ю начальными фишками решение ищется несколько минут. А у нас в исходной задаче 80 фишек. А в обобщённом варианте вообще может быть 224.
Под спойлером простенькая консольная программа для поиска решений, использующая функцию PoleWork.
Кликните здесь для просмотра всего текста
| Delphi | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
| program PoleWork_Delphi_program;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, PoleWork_Function;
Const
StateFileName='state_m1616.bgs000';
LogFileName='PW.log';
function Load0State(fn:string):boolean;
var
inputFile:file of byte;
x,y:byte;
begin
Result:=false;
assign(inputFile,fn);
try
reset(inputFile);
for x:=0 to 15 do for y:=0 to 15 do read(inputFile,Pole[x,y]);
closefile(inputFile);
Result:=true;
except
on E: Exception do Writeln(E.ClassName, ': ', E.Message);
end;
end;
function SaveFinishLog(t:int64;r:boolean):boolean;
var
logFile:textfile;
h:byte;
begin
Result:=false;
assign(logFile,LogFileName);
try
if not fileexists(LogFileName) then rewrite(logFile) else append(logFile);
writeln(logfile,DateTimeToStr(Now));
writeln(logfile,inttostr(t));
if r then
begin
writeln(logfile,'Решение:');
for h:=0 to WinSteps-1 do writeln(logfile,inttostr(Steps[h].p div 16)+#32+inttostr(Steps[h].p mod 16)+#32+inttostr(Steps[h].n));
end else writeln(logfile,'решений нет');
writeln(logfile);
closefile(logFile);
Result:=true;
except
on E: Exception do Writeln(E.ClassName, ': ', E.Message);
end;
end;
Var
res:boolean;
t1,t2:TDateTime;
ms:int64;
x,y,fsh:byte;
Begin
writeln('Enter = Загрузить файл '+StateFileName);
readln;
if Load0State(StateFileName) then
begin
fsh:=0;
for x:=0 to 16 do for y:=0 to 15 do if Pole[x,y]=1 then inc(fsh);
WinSteps:=fsh-1;
StepsCount:=0;
writeln('Файл загружен. Количество фишек: '+inttostr(fsh)+'. Enter - начать поиск');
readln;
write('Поиск запущен '+DateTimeToStr(Now)+' ...');
t1:=Now;
res:=PoleWorkAsm(StepsCount,WinSteps,addr(Pole[0,0]),addr(Steps[0]));
t2:=Now;
ms:=round((t2-t1)*86400*1000);
writeln;
writeln('Времени потрачено (мс): '+inttostr(ms));
if res then writeln('РЕШЕНИЕ НАЙДЕНО!') else writeln('нет решений');
if not SaveFinishLog(ms,res) then writeln('Ошибка при сохранении в лог');
writeln('Enter = Выход из программы');
readln;
end else
begin
writeln('Ошибка при загрузке файла '+StateFileName);
readln;
end;
end. |
|
Начальное состояние берётся из файла с именем state_m1616.bgs000. Размер файла должен быть не меньше 256 байт. Пример файла Вложение 3472:
Решение, если оно есть, записывается прямо в лог PW.log.
Вложение 3473
Ассемблерный вариант PoleWork - PoleWorkAsm:
| Assembler | 1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
| function PoleWorkAsm(aSC,aWS:uint64;aPole,aSteps:pointer):boolean;
asm
// RCX = aSC
// RDX = aWC
// R8 = aPole
// R9 = aSteps
// R10 = x
// R11 = y
// RBX, R12 - временные
PUSH RBX
PUSH R12
CALL @PW
JMP @finish
@PW:
MOV R10,1
@loop_x:
MOV R11,1
@loop_y:
LEA R12,[4*R10]
LEA R12,[4*R12+R11]
LEA RBX,[R12+aPole]
MOV AL,[RBX]
CMP AL,1
JNE @not_checker
// up
MOV AL,[RBX-1]
CMP AL,1
JNE @skip_up
MOV AL,[RBX-2]
CMP AL,0
JNE @skip_up
MOV byte ptr [RBX],0
MOV byte ptr [RBX-1],0
MOV byte ptr [RBX-2],1
LEA RAX,[2*aSC+aSteps]
MOV byte ptr [RAX],R12b
MOV byte ptr [RAX+1],0
INC aSC
PUSH RBX
PUSH R10
PUSH R11
PUSH R12
CALL @PW
POP R12
POP R11
POP R10
POP RBX
CMP AL,1
JE @win
MOV byte ptr [RBX-2],0
MOV byte ptr [RBX-1],1
MOV byte ptr [RBX],1
DEC aSC
@skip_up:
// dn
MOV AL,[RBX+1]
CMP AL,1
JNE @skip_dn
MOV AL,[RBX+2]
CMP AL,0
JNE @skip_dn
MOV byte ptr [RBX],0
MOV byte ptr [RBX+1],0
MOV byte ptr [RBX+2],1
LEA RAX,[2*aSC+aSteps]
MOV byte ptr [RAX],R12b
MOV byte ptr [RAX+1],1
INC aSC
PUSH RBX
PUSH R10
PUSH R11
PUSH R12
CALL @PW
POP R12
POP R11
POP R10
POP RBX
CMP AL,1
JE @win
MOV byte ptr [RBX+2],0
MOV byte ptr [RBX+1],1
MOV byte ptr [RBX],1
DEC aSC
@skip_dn:
// lt
MOV AL,[RBX-16]
CMP AL,1
JNE @skip_lt
MOV AL,[RBX-32]
CMP AL,0
JNE @skip_lt
MOV byte ptr [RBX],0
MOV byte ptr [RBX-16],0
MOV byte ptr [RBX-32],1
LEA RAX,[2*aSC+aSteps]
MOV byte ptr [RAX],R12b
MOV byte ptr [RAX+1],2
INC aSC
PUSH RBX
PUSH R10
PUSH R11
PUSH R12
CALL @PW
POP R12
POP R11
POP R10
POP RBX
CMP AL,1
JE @win
MOV byte ptr [RBX-32],0
MOV byte ptr [RBX-16],1
MOV byte ptr [RBX],1
DEC aSC
@skip_lt:
// rt
MOV AL,[RBX+16]
CMP AL,1
JNE @skip_rt
MOV AL,[RBX+32]
CMP AL,0
JNE @skip_rt
MOV byte ptr [RBX],0
MOV byte ptr [RBX+16],0
MOV byte ptr [RBX+32],1
LEA RAX,[2*aSC+aSteps]
MOV byte ptr [RAX],R12b
MOV byte ptr [RAX+1],3
INC aSC
PUSH RBX
PUSH R10
PUSH R11
PUSH R12
CALL @PW
POP R12
POP R11
POP R10
POP RBX
CMP AL,1
JE @win
MOV byte ptr [RBX+32],0
MOV byte ptr [RBX+16],1
MOV byte ptr [RBX],1
DEC aSC
@skip_rt:
@not_checker:
INC R11
CMP R11,14
JBE @loop_y
INC R10
CMP R10,14
JBE @loop_x
CMP aSC,aWS
SETE AL
@win:
RET
@finish:
POP R12
POP RBX
end; |
|
| Delphi | 1
| res:=PoleWorkAsm(StepsCount,WinSteps,addr(Pole[0,0]),addr(Steps[0])); |
|
PoleWork - 125-130 секунд
PoleWorkAsm - 93-96 секунд
|
