Dr.*_*ius 10 wolfram-mathematica
我有几个大的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
Run Code Online (Sandbox Code Playgroud)
因此,最大的矩形块(按区域)满足==1 从(1,2)开始,其尺寸为(2,3).
如何在没有显式迭代的情况下使用Mathematica找到它?
注意:
只是为了简化您的测试,这是我的一个样本:
matrix = ImageData@Binarize@Import@"http://i.stack.imgur.com/ux7tA.png"
Run Code Online (Sandbox Code Playgroud)
这是我尝试使用的 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]]]
Run Code Online (Sandbox Code Playgroud)
belisarius图片的结果:
Timing[maxBlock[Unitize[matrix, 1.]]]
(* {1.13253, {23433, {219, 107}}} *)
Run Code Online (Sandbox Code Playgroud)
从好的方面来看,这段代码似乎比David和Sjoerd的代码更快,但由于某种原因,它返回的矩形在两个维度上都比它们的结果小.由于差异恰好是一个我怀疑在某个地方有计数错误但我现在找不到它.
好吧,只是为了证明使用函数式编程是可能的,这是我非常非常低效的强力方法:
首先,我生成一个所有可能的正方形的列表,按降序区域的顺序排序:
rectangles = Flatten[
Table[{i j, i, j},
{i, Length[matrix]},
{j, Length[matrix[[1]]]}
],1
] // Sort // Reverse;
Run Code Online (Sandbox Code Playgroud)
对于给定的矩形,我做了一个ListCorrelate.如果在矩阵中可以找到这个大小的自由矩形,则结果中应该至少有一个数字对应于该矩形的区域(假设矩阵仅包含1和0).我们检查一下使用Max.只要我们找不到匹配项,我们就会寻找更小的矩形(LengthWhile照顾它).我们最终得到了适合矩阵的最大矩形数:
LengthWhile[
rectangles,
Max[ListCorrelate[ConstantArray[1, {#[[2]], #[[3]]}], matrix]] != #[[1]] &
]
Run Code Online (Sandbox Code Playgroud)
在我的笔记本电脑上,使用belisarius的图像,花了156秒才发现11774 +第1个矩形(+1因为LengthWhile返回不适合的最后一个矩形的数量)是最适合的
In[70]:= rectangles[[11774 + 1]]
Out[70]= {23760, 220, 108}
Run Code Online (Sandbox Code Playgroud)
| 归档时间: |
|
| 查看次数: |
1064 次 |
| 最近记录: |