Найти самый большой прямоугольный блок, удовлетворяющий некоторому условию без явного

Ответ 1

Это моя попытка с помощью BitAnd

maxBlock[mat_] := Block[{table, maxSeq, pos},

  maxSeq[list_] := 
   Max[Length[#] & /@ Append[Cases[Split[list], {1 ..}], {}]];

  table = 
   Flatten[Table[
     MapIndexed[{#2[[1]], maxSeq[#1]} &, 
      FoldList[BitAnd[#1, #2] &, mat[[k]], Drop[mat, k]]], {k, 1, 
      Length[mat]}], 1];

  pos = Ordering[(Times @@@ table), -1][[1]];

  {Times[##], {##}} & @@ table[[pos]]]

Результат для изображения belisarius:

Timing[maxBlock[Unitize[matrix, 1.]]]

(* {1.13253, {23433, {219, 107}}} *)

На стороне плюса этот код выглядит быстрее, чем код Дэвида и Сьюдерда, но по какой-то причине он возвращает прямоугольник, размер которого меньше по размеру, чем их результат. Поскольку разница в точности одна, я подозреваю, что ошибка подсчета где-то, но я не могу ее найти в данный момент.

Ответ 2

Ну, просто чтобы доказать, что это возможно, используя функциональное программирование здесь, мой ужасно, ужасно неэффективный подход грубой силы:

Сначала я создаю список всех возможных квадратов, отсортированных в порядке убывающей области:

rectangles = Flatten[
               Table[{i j, i, j}, 
                     {i, Length[matrix]}, 
                     {j, Length[matrix[[1]]]}
               ],1 
             ] // Sort // Reverse;

Для данного прямоугольника я делаю a ListCorrelate. Если в матрице может быть найден свободный прямоугольник такого размера, в результате должно быть по крайней мере одно число, соответствующее площади этого прямоугольника (при условии, что матрица содержит только 1 и 0). Мы проверяем, что с помощью Max. Пока мы не находим совпадение, мы ищем меньшие прямоугольники (LengthWhile позаботится об этом). В итоге получим наибольшее число прямоугольников, которое вписывается в матрицу:

LengthWhile[
   rectangles, 
   Max[ListCorrelate[ConstantArray[1, {#[[2]], #[[3]]}], matrix]] != #[[1]] &
]

На моем ноутбуке, используя изображение belisarius, потребовалось 156 секунд, чтобы обнаружить, что 11774 + 1-й прямоугольник (+1, потому что LengthWhile возвращает номер последнего прямоугольника, который не подходит) является самым большим, будет соответствовать

In[70]:= rectangles[[11774 + 1]]

Out[70]= {23760, 220, 108}

Ответ 3

Жизнеспособным вариантом является игнорировать изречение, чтобы избежать итерации.

Сначала выполните процедуру поиска наибольшей длины с фиксированной шириной. Используйте его на транспонированной матрице для изменения этих размеров. Он работает путем разделения и завоевания, так что разумно быстро.

maxLength[mat_, width_, min_, max_] := Module[
  {len = Floor[(min + max)/2], top = max, bottom = min, conv},
  While[bottom <= len <= top,
   conv = ListConvolve[ConstantArray[1, {len, width}], mat];
   If[Length[Position[conv, len*width]] >= 1,
    bottom = len;
    len = Ceiling[(len + top)/2],
    top = len;
    len = Floor[(len + bottom)/2]];
   If[len == bottom || len == top, Return[bottom]]
   ];
  bottom
  ]

Вот более медленный код развертки. Мы находим максимальные размеры, и для одного из них мы сместим вниз, максимизируя другое измерение, пока не узнаем, что мы не можем улучшить максимальную площадь. Единственная эффективность, с которой я столкнулся, заключалась в том, чтобы увеличить нижние границы на основе предыдущих нижних границ, чтобы сделать maxLength несколько быстрее.

maxRectangle[mat_] := Module[
  {min, dims = Dimensions[mat], tmat = Transpose[mat], maxl, maxw, 
   len, wid, best},
  maxl = Max[Map[Length, Cases[Map[Split, mat], {1 ..}, 2]]];
  maxw = Max[Map[Length, Cases[Map[Split, tmat], {1 ..}, 2]]];
  len = maxLength[tmat, maxw, 1, maxl];
  best = {len, maxw};
  min = maxw*len;
  wid = maxw - 1;
  While[wid*maxl >= min,
   len = maxLength[tmat, wid, len, maxl];
   If[len*wid > min, best = {len, wid}; min = len*wid];
   wid--;
   ];
  {min, best}
  ]

Это лучше, чем Sjoerd на порядок, будучи только ужасным и не страшным ^ 2.

In[364]:= Timing[maxRectangle[matrix]]

Out[364]= {11.8, {23760, {108, 220}}}

Даниэль Лихтблау

Ответ 4

Я не могу конкурировать с логикой Хайке, но я могу немного реорганизовать ее код.

maxBlock[mat_] := Module[{table, maxSeq, pos, i},
  maxSeq = Max[0, Length /@ [email protected]# ~Cases~ {1 ..}] &;
  table = Join @@
    Table[
       {i++, [email protected]},
       {k, [email protected]},
       {j, i = 1; FoldList[BitAnd, mat[[k]], mat~Drop~k]}
    ];
  pos = Ordering[Times @@@ table, -1][[1]];
  {# #2, {##}} & @@ table[[pos]]
]

Я считаю, что это чище, и он работает на 20% быстрее.

Ответ 5

Считаете ли вы свертку как явную итерацию? Если нет, то его можно использовать, чтобы делать то, что вы хотите. С простым ядром, скажем, 3x3 1s, вы можете быстро обнулить эти несмежные 1s.

Edit:

Mathematica имеет встроенную функцию свертки, вы можете использовать ее или brew свой собственный:

Здесь псевдокод (непроверенный, конечно:)

kernel = [ [1,1,1], [1,1,1], [1,1,1] ]

for row = 1, row <= image_height - 1, row++
  for col = 1, col <= image_width - 1, col++
    compare kernel with the 3x3 matrix at image(row, col):
      if there is 0 on left AND right of the center column, OR
      if there is 0 on top AND bottom of center row, THEN
         zero out whole area from image(row-1, col-1) to image(row+1, col+1)
         # The above may need refinement
  end
end

После этого то, что осталось, является смежной квадратной площадью 1s. Вы можете провести анализ области и определить самую большую область оттуда.