How to remove those rectangle within another rectangle

Question

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]

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

Answer 1

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!

Answer 2

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