I am looking for a method to extract rectangular areas from an image. The image is divided up into rectangular problem spaces like the image shown below. Each numbered problem is given with some text and some graphics.

Mathematica graphics

I tried to use ImageCorners, FindClusters but they did not work.

img = Import["http://i.imgur.com/hcQZ85F.jpg"];
pts = ImageCorners[img, 5, 0.01];
HighlightImage[img, pts];
ListPlot[FindClusters[pts], AspectRatio -> Automatic]

This is my bad result.

Mathematica graphics

The result I want is would look like this, but I don't know how to get it.

Mathematica graphics

  • $\begingroup$ Could you please elaborate this problem a little bit further. Right now I cannot really see what the characteristic elements that make up your regions are because your desired output is from a different page than the input example. $\endgroup$
    – Wizard
    Aug 16, 2015 at 0:29
  • $\begingroup$ @Wizard These text are written by Korean language. but the text is just an image. I want to find the region coordinates around text retangular using the numbered problem or others with image processing skill. $\endgroup$
    – Junho Lee
    Aug 16, 2015 at 1:01
  • $\begingroup$ I would definitely analyse the image for whitespace between the different regions you want to extract or find some other characteristic elements in your image to look out for. Once those are found it should be a simple ImageTake on the remaining bounding box. $\endgroup$
    – Wizard
    Aug 16, 2015 at 11:46
  • $\begingroup$ @Wizard yes I would like to find the coordinate for the ImageTake automatically using image processing skill because the pages are thousand. $\endgroup$
    – Junho Lee
    Aug 16, 2015 at 12:35
  • $\begingroup$ it seems to me doing text recognition on the problem numbers would be helpfull $\endgroup$
    – george2079
    Aug 16, 2015 at 16:35

3 Answers 3



But with a bit of creative cheating, I can get close:

First, load the image and binarize it:

img = Import["http://i.imgur.com/qAZBdFb.jpg"];    
bin = MorphologicalBinarize[ColorNegate@img, {.1, .5}]

enter image description here

I invert the image for two reasons: First, MorphologicalBinarize takes a lower and an upper threshold, i.e. it assumes bright blobs on dark background. Second, the next function ComponentMeasurements looks for connected bright components:

comp = ComponentMeasurements[
   bin, {"Centroid", "ConvexVertices", "ConvexArea", 
    "EnclosingComponentCount"}, #3 < 10000 && #4 == 0 &];

This is the "cheating" part I've mentioned above: I can't separate the two "boxes" labeled "04" and "05" cleanly from the other components, because the boxes are closer to the blocks below them than some of the answers. So I cheated by removing the boxes: I ignore components that have a convex hull area > 10000 (the boxes) or are enclosed by another component (the stuff inside the boxes).

Next, I calculate the distances between all the components:

points = comp[[All, 2, 1]];
convexHulls = comp[[All, 2, 2]];

My first try was to use the centroid distance. Very cheap to calculate, but it "penalizes" large components:

(*distances = Outer[EuclideanDistance, points, points, 1];*)

So instead, I calculate the distances between the convex hulls of each pair of components:

convexHullDist = 
    With[{nf = Nearest[hull]}, Norm[nf[#][[1]] - #] &]], convexHulls];
distances = Outer[Min[#1 /@ #2] &, convexHullDist, convexHulls, 1];

...convert that distance matrix to a graph:

g = WeightedAdjacencyGraph[distances];

...and find the minimal spanning tree for that distance graph:

spanningTree = 
 FindSpanningTree[g, VertexCoordinates -> points, EdgeStyle -> Red]

 Graphics[{Red, Point[points]}]

enter image description here

As expected, the minimum spanning tree has most of its edges inside each "box", and few links between boxes.

Here's a plot of the edge lengths in the spanning tree:

maxDistances = 
  Sort[distances[[#[[1]], #[[2]]]] & /@ EdgeList[spanningTree]];    
threshold = Mean[maxDistances[[{-7, -6}]]];    
ListPlot[maxDistances, PlotRange -> All, 
 GridLines -> {{}, {threshold}}]

enter image description here

The obvious idea is now to remove the longest edges from this graph:

splitGraph = 
 EdgeDelete[spanningTree, i_ <-> j_ /; distances[[i, j]] > threshold]

enter image description here

This looks promising. Let's draw the bounding rectangles for each of the connected components in this graph:

 Graphics[{EdgeForm[{Thick, Red}], Transparent, 
   Rectangle @@ 
      Transpose[MinMax /@ Transpose[Flatten[convexHulls[[#]], 1]]] & /@

enter image description here

And let's extract the image areas:

 Framed[ImageTrim[img, Flatten[convexHulls[[#]], 1]]] & /@ 

enter image description here

Close. The 7/5-component (I'm guessing this is a multiple choice answer?) is farther from the box it belongs to than the distance between some of the other blocks.

If you want to get better results for this specific layout, you could probably split the image into columns first, then process each column separately and look for good "row dividers". This is much simpler, because you have two 1d problems instead of one 2d problem. But I like the spanning tree approach better, because it makes fewer assumptions about the layout. For example, it should work for column-major, chessboard or hexagonal layouts just as well.


For completeness sake (and because I was curious), here's the simpler way to do it mentioned in the last paragraph:

imgGrey = ColorConvert[img, "Grayscale"];

Take the columnwise mean of the image grey values, and look for extended peaks in that profile:

peaksX = Round@FindPeaks[Mean[ImageData[imgGrey]], 25][[All, 1]];
ListLinePlot[Mean[ImageData[imgGrey]], PlotRange -> All, 
 GridLines -> {peaksX, {}}]

enter image description here

Then, do more or less the same for the row-wise mean for each column:

    column = ImageTake[imgGrey, All, xRange];
    peaksY = 
     Round@FindPeaks[Mean /@ ImageData[Opening[column, 5]], 20][[All, 
    Framed[Image[ImageTake[column, #], ImageSize -> All]] & /@ 
     Partition[peaksY, 2, 1]] /@ 
   Partition[peaksX, 2, 1]] // Multicolumn

enter image description here

Quick and dirty. No idea how well this would work for different images.

  • $\begingroup$ Great thanks a lot. Your discription is a my first guide for the study of image processing. $\endgroup$
    – Junho Lee
    Aug 17, 2015 at 4:25
img = Import["http://i.imgur.com/qAZBdFb.jpg"];
bin = MorphologicalBinarize[ColorNegate@img, {.1, .5}]

enter image description here

closbin = FillingTransform[Closing[bin, {Array[1 &, 10]}]]

enter image description here

twolargerbox = 
   Values@ComponentMeasurements[closbin, {"Count", "BoundingBox"}], 
   First, 2][[All, -1]]

{{{196., 265.}, {375., 389.}}, {{6., 265.}, {183., 370.}}}

twolargercom = ImageTrim[img, #] & /@ twolargerbox

enter image description here

smallcombox = 
    ImageSubtract[closbin, SelectComponents[closbin, "Count", -2]], 
    "BoundingBoxes", Infinity], 7], "BoundingBoxes", Infinity]

enter image description here

smallcomcom = 
 ImageTrim[img, #] & /@ 
  Values@ComponentMeasurements[smallcom, "BoundingBox"]

enter image description here

Multicolumn[Flatten[{twolargercom, smallcomcom}], 2, Frame -> All, 
 FrameStyle -> Red, Alignment -> {Center, Center}]

enter image description here


A improved version based on Graph Theory and cluster:

Get a binarize image firstly by nike's method

img = Import["http://i.imgur.com/qAZBdFb.jpg"];
bin = MorphologicalBinarize[ColorNegate@img, {.1, .5}]

Create a graph use NearestNeighborGraph,I find $2$ nearest vertices for every vertex here:

com = ComponentMeasurements[bin, "Centroid"];
g = NearestNeighborGraph[Values[com], 2]

Connect those connected commponent by shortest line(long of edge).

ConnectSeparateGraph[graph_] := 
 Module[{rule, pts, f, var1, var2, nearePoint, completeGraph}, 
  rule = Dispatch[
    MapThread[Rule, {VertexList[graph], GraphEmbedding[graph]}]];
  pts = WeaklyConnectedComponents[graph] /. rule;
  f = Nearest /@ Most[pts];
  var2 = Drop[pts, #] & /@ Range[Length[pts] - 1];
  var1 = MapThread[Catenate /@ # /@ #2 &, {f, var2}];
  nearePoint = 
    Map[First[MinimalBy[#, EuclideanDistance @@ # &]] &, 
     Flatten[{var1, var2}, List /@ {2, 3, 4, 1, 5}], {2}]];
  completeGraph = 
    EdgeWeight -> EuclideanDistance @@@ nearePoint];
   UndirectedEdge @@@ (nearePoint[[EdgeIndex[completeGraph, #] & /@ 
         EdgeList[FindSpanningTree[completeGraph]]]] /. 
      Reverse /@ Normal[rule])]]
graph = ConnectSeparateGraph[g]

Set a weight for every edges

weightGraph = 
  EdgeWeight -> 
   Thread[EdgeList[graph] -> EuclideanDistance @@@ (EdgeList[graph])]];

Find $8$ clusters for the graph and show the partition effect

clusters = 
  FindClusters[VertexList[weightGraph], 8, 
   DistanceFunction -> (EuclideanDistance[#1, #2] + 
       GraphDistance[weightGraph, #, #2] + 
       If[VertexConnectivity[weightGraph, #, #2] == 1, 
        EuclideanDistance[#1, #2], 0.] &), Method -> "KMedoids"];
 VertexStyle -> 
  Catenate[Thread /@ Tuples[clusters -> {Unevaluated@RandomColor[]}]],
  VertexSize -> {"Scaled", 0.02}]

Creating a connected binarize image based on the cluster you have partitioned

{show, conBin} = 
   Function[{image, color}, 
     Subgraph[weightGraph, #, VertexCoordinates -> #, 
        BaseStyle -> Directive[Thick, color]] & /@ clusters]], {{img, 
     bin}, {Unevaluated[RandomColor[]], White}}];show

Find BoundingBox for every component,and trim out of the rectangle from your original image

  ImageTrim[img, #] & /@ 
   Values[ComponentMeasurements[conBin, "BoundingBox"]], 2, 
  Frame -> All, ItemSize -> All, FrameStyle -> Red], 
 ImageSizeMultipliers -> {1}]


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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