2
$\begingroup$

Suppose I have some rectangle rects:

rects = Uncompress[FromCharacterCode[
   Flatten[ImageData[Import["http://i.stack.imgur.com/BCEEZ.png"],"Byte"]]]]

This is current method for remove those rectangle within another

result=GraphComputation`SourceVertexList[
 RelationGraph[
  RegionWithin[Rectangle @@ #, Rectangle @@ #2] && UnsameQ[##] &, 
  rects]]

{{{21., 150.}, {31., 167.}}, {{306., 149.}, {317., 167.}}...}

This is the result

Graphics[Rectangle @@@ result]

Mathematica graphics

But I have to say it is too slow.Is there any faster method to do this?

$\endgroup$
3
$\begingroup$

The rectangle within a rectangle predicate can be turned into a partial order question. First, let's consider the simpler 1-dimensional equivalent. Let:

$$\begin{array}{l} i_1=(l_1,u_1) \\ i_2=(l_2,u_2) \\ \end{array}$$

be 2 intervals. If $l_1 \leq l_2$ and $u_2 \leq u_1$ then $i_2$ is contained in $i_1$. This means the interval inclusion predicate can be answered by using the usual component-wise partial order on $(l, -u)$.

Returning to the rectangle problem, for the rectangle:

Rectangle[{{x0, y0}, {x1, y1}}]

we want to use the component-wise partial order on $(x0, -x1, y0, -y1)$, or equivalently, $(x0, y0, -x1, -y1)$. Now, we just need a function that prunes elements based on a component-wise partial order, namely, Internal`ListMin. So, your problem can be answered by:

pruneRects[r_] := Module[{p},
    p = Replace[r, {{a_, b_}, {c_, d_}} :> {a, b, -c, -d}, {1}];
    Replace[
        Internal`ListMin @ p,
        {a_, b_, c_, d_} :> {{a, b}, -{c, d}},
        {1}
    ]
]

Let's compare (yode is @yode's answer, and coolwater is @Coolwater's answer):

r1 = pruneRects[rects]; //AbsoluteTiming

yode = GraphComputation`SourceVertexList[
    RelationGraph[
        RegionWithin[Rectangle @@ #, Rectangle @@ #2] && UnsameQ[##] &, 
        rects
    ]
]; //AbsoluteTiming

coolwater = Delete[rects, Transpose[{Mod[Complement[Catenate[Position[Transpose[MapThread[
 Apply[#, #2, {2}] &, {{Greater, Less}, Transpose[Tuples[rects, 2], {2, 4, 1, 3}]}]],
 {{False, False}, {False, False}}, {1}]], Range[1, #^2, # + 1]], #, 1] &[Length[rects]]}]]; //AbsoluteTiming

Sort @ r1 === Sort @ yode === Sort @ coolwater

{0.000562, Null}

{1.81791, Null}

{0.064145, Null}

True

Using Internal`ListMin is quite a bit faster!

$\endgroup$
0
$\begingroup$

This is still brute force, but evaluates faster

result === Delete[rects, Transpose[{Mod[Complement[Catenate[Position[Transpose[MapThread[
 Apply[#, #2, {2}] &, {{Greater, Less}, Transpose[Tuples[rects, 2], {2, 4, 1, 3}]}]],
 {{False, False}, {False, False}}, {1}]], Range[1, #^2, # + 1]], #, 1] &[Length[rects]]}]]

True

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.