Re: Японские кроссворды

From

Andrew Perevodchik ()

To

Dmitry Petanin

Date

2003-01-14T23:42:31Z

Area

RU.ALGORITHMS

From: Andrew Perevodchik <ok@naverex.kiev.ua>

Привет!

 DP> А не встречали ли кто какой-нибудь теории или алгоритма по решению
 DP> сабжа, желательно PAS, но можно СPP, нужно для лабораторной ...

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

Это процедура решения одной строки (или столбца) в кроссворде. Если
выполнить несколько проходов по строкам и столбцам, классические
кроссворды (не "поисковые") решаются.

На входе имеем 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)