|
ru.algorithms
- RU.ALGORITHMS ----------------------------------------------------------------
From : Andrew Perevodchik 2:5020/400 15 Jan 2003 00:42:31
To : Dmitry Petanin
Subject : Re: Японские кроссворды
--------------------------------------------------------------------------------
Привет!
DP> А не встречали ли кто какой-нибудь теории или алгоритма по решению
DP> сабжа, желательно PAS, но можно СPP, нужно для лабораторной ...
Hе знаю, для лабораторной вряд ли подойдет, но на досуге пробовал
сымитировать "человеческую" логику мышления при решении сабжей.
Получившаяся радость, оттестированная в Delphi6, прилагается.
Это процедура решения одной строки (или столбца) в кроссворде. Если
выполнить несколько проходов по строкам и столбцам, классические
кроссворды (не "поисковые") решаются.
Hа входе имеем Descr -- массив целых чисел с указанием длин
закрашенных блоков, Have -- массив, представляющий клетки в
рассматриваемой строке (или столбце). Одна клетка -- один байт. Если
не известно, что там -- 0, если наверняка закрашена -- 1, если
наверняка не закрашена -- 2.
Работает так: перебирает все возможные расположения блоков при
заданной длине строки и Descr. Если рассматриваемая комбинация не
противоречит уже отмеченным клеткам, она побитно накладывается на
массив-результат, который изначально инициализируется троечками, по
правилу AND. В итоге получаем массив, представляющий строку, с
некоторыми "закрашенными" или "отминусованными" клетками.
Такое поэтапное решение использует человек, так что этим способом
можно проверять кроссворды на "решабельность".
----- Windows Clipboard -----
procedure Solve(Descr: array of Byte; var Have: array of Byte);
var
Total, Len, Vary: Integer;
I, J, K, N: Integer;
Addons, Test, Final: array of Byte;
begin
Total:=Length(descr);
Len:=Length(have);
Vary:=Len+1;
for I:=0 to Total - 1 do
Vary:=Vary-descr[I]-1;
if Vary < 0 then begin
raise Exception.Create('Invalid input data.');
Exit;
end;
if Len <= 0 then begin
raise Exception.Create('Invalid size of input data.');
Exit;
end;
SetLength(Addons, Total);
SetLength(Test, Len);
SetLength(Final, Len);
for I:=0 to Total - 1 do
Addons[I]:=0;
for I:=0 to Len - 1 do
Final[I]:=3;
I:=1;
while I >= 0 do begin
J:=0;
for K:=0 to Total - 1 do begin
for N:=Ord(K = 0) to Addons[K] do begin
Test[J]:=1;
Inc(J);
end;
for N:=1 to descr[K] do begin
Test[J]:=2;
Inc(J);
end;
end;
while J < Len do begin
Test[J]:=1;
Inc(J);
end;
K:=0;
for J:=0 to Len - 1 do
if (Test[J] or Have[J]) = 3 then begin
K:=1;
Break;
end;
if K = 0 then
for J:=0 to Len - 1 do
Final[J]:=Final[J] and Test[J];
I:=Total-1;
while I >= 0 do begin
Addons[I]:=Addons[I]+1;
Dec(Vary);
if Vary < 0 then begin
Vary:=Vary+Addons[I];
Addons[I]:=0;
Dec(I);
end
else
Break;
end;
end;
if Final[0] = 3 then begin
raise Exception.Create('Value doesn''t match numbers.');
Exit;
end;
for J:=0 to Len - 1 do
Have[J]:=Final[J];
end;
-----------------------------
Андрей Переводчик
--- ifmail v.2.15dev5
* Origin: Navigator Online Internet News Server (2:5020/400)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
