Question

我有一些大的2D数组，如：

   1   2  3  4  5
   --------------
1 | 0  1  1  1  0
2 | 0  1  1  1  0
3 | 0  1  0  1  1
4 | 0  1  0  1  1

因此，满足==1的最大矩形块（按区域）从（1,2）开始，其尺寸为（2,3）。

如何在没有明确迭代的情况下使用Mathematica找到它？

NB：

为了简化您的测试，这是我的一个样本：

matrix = ImageData@Binarize@Import@"http://i.stack.imgur.com/ux7tA.png"

Answer 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}}} *)

从好的方面来看，这段代码似乎比David和Sjoerd的代码更快，但由于某种原因它会返回一个矩形，它在两个维度上都比它们的结果小。由于差异恰好是一个我怀疑在某个地方出现计数错误但我现在找不到它。

Answer 2

嗯，只是为了证明使用函数式编程是可能的，这是我非常非常低效的蛮力方法：

首先，我生成一个所有可能正方形的列表，按照下降区域的顺序排序：

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

对于给定的矩形，我执行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}

Answer 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}}}

Daniel Lichtblau

Answer 4

我无法与Heike的逻辑竞争，但我可以稍微重构她的代码。

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

我相信这更清洁，并且运行速度提高了约20％。

Answer 5

您认为卷积是明确迭代的吗？如果没有，那么它可以用来做你想要的。使用一个简单的内核，比如说3x3 1s，你可以快速将那些非连续的1清零。

编辑：

Mathematica具有内置的卷积功能，您可以使用它，或自己酿造：

这是伪代码（当然未经测试:)：

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的连续方形区域。您可以进行连通区域分析并确定最大区域。

找到满足某些条件的最大矩形块，无需显式迭代

5 个答案: