5
$\begingroup$

I cannot give the actual image (contains private information) but the results of

TextRecognize[
 ImageResize[img, Scaled[2]], "Word", "BoundingBox", 
 RecognitionPrior -> "Column"]

are the following set of rectangles; this being a small portion of the rectangles. (Note: I do not use "Line" as third argument as there is no white space in the returned text so no indication of the column the text falls under.)

recs =
  {Rectangle[{18, 1140}, {74, 1162}], 
   Rectangle[{622, 1140}, {713, 1162}], 
   Rectangle[{821, 1140}, {875, 1162}], 
   Rectangle[{134, 1088}, {208, 1110}], 
   Rectangle[{214, 1096}, {230, 1098}], 
   Rectangle[{238, 1088}, {284, 1110}], 
   Rectangle[{292, 1082}, {386, 1110}], 
   Rectangle[{623, 1088}, {703, 1110}], 
   Rectangle[{822, 1088}, {871, 1110}], 
   Rectangle[{1137, 1088}, {1201, 1110}], 
   Rectangle[{18, 1036}, {74, 1058}], 
   Rectangle[{134, 1036}, {204, 1058}], 
   Rectangle[{213, 1044}, {228, 1046}], 
   Rectangle[{237, 1036}, {283, 1058}], 
   Rectangle[{291, 1030}, {385, 1058}], 
   Rectangle[{623, 1036}, {703, 1058}], 
   Rectangle[{1137, 1036}, {1198, 1058}], 
   Rectangle[{17, 984}, {74, 1006}], 
   Rectangle[{133, 984}, {301, 1006}], 
   Rectangle[{311, 990}, {318, 992}], 
   Rectangle[{327, 984}, {421, 1006}], 
   Rectangle[{623, 984}, {658, 1006}], 
   Rectangle[{821, 984}, {875, 1006}], 
   Rectangle[{1138, 984}, {1201, 1006}]};

The layout of the "Words" in the image can be see with

Framed[
 Labeled[Graphics[{LightGray, EdgeForm[Blue], recs}], "Words", Top],
 FrameStyle -> Gray]

Mathematica graphics

From this example it can be seen that there are 5 columns; actual grids can contain more or less columns. This example also has one "sentence" column; a column made up of several closely spaced (in the x-axis) words; actual grids can contain more or less "sentence" columns.

I would like to cluster each cell of the grid into sublists. The "sentence" columns will have all of their rectangles in one sublist. The target is clustering is

recsByCell = {{Rectangle[{18, 1140}, {74, 1162}]},
   {Rectangle[{622, 1140}, {713, 1162}]},
   {Rectangle[{821, 1140}, {875, 1162}]},
   {Rectangle[{134, 1088}, {208, 1110}], 
    Rectangle[{214, 1096}, {230, 1098}], 
    Rectangle[{238, 1088}, {284, 1110}], 
    Rectangle[{292, 1082}, {386, 1110}]}, 
   {Rectangle[{623, 1088}, {703, 1110}]},
   {Rectangle[{822, 1088}, {871, 1110}]},
   {Rectangle[{1137, 1088}, {1201, 1110}]},
   {Rectangle[{18, 1036}, {74, 1058}]},
   {Rectangle[{134, 1036}, {204, 1058}], 
    Rectangle[{213, 1044}, {228, 1046}], 
    Rectangle[{237, 1036}, {283, 1058}], 
    Rectangle[{291, 1030}, {385, 1058}]}, 
   {Rectangle[{623, 1036}, {703, 1058}]},
   {Rectangle[{1137, 1036}, {1198, 1058}]},
   {Rectangle[{17, 984}, {74, 1006}]},
   {Rectangle[{133, 984}, {301, 1006}], 
    Rectangle[{311, 990}, {318, 992}], 
    Rectangle[{327, 984}, {421, 1006}]},
   {Rectangle[{623, 984}, {658, 1006}]},
   {Rectangle[{821, 984}, {875, 1006}]},
   {Rectangle[{1138, 984}, {1201, 1006}]}};

Framed[
 Labeled[Graphics[
   MapIndexed[{ColorData[109]@*First@#2, #} &, recsByCell]], 
  "Manual Clusters", Top],
 FrameStyle -> Gray]

Mathematica graphics

I have tried all DistanceFunctions while comparing the upper right-hand corner of the first rectangle to the upper left-hand corner of the right-hand rectangle.

Module[{df = #, c},
   c = FindClusters[recs, 
     DistanceFunction -> (df[Last@#1, Flatten[List @@ #2][[{1, 4}]]] &)];
   Labeled[
    Graphics[MapIndexed[{ColorData[109]@*First@#2, #} &, c]],
    df, Top]
   ] & /@ 
 Symbol /@ 
  Select[StringEndsQ["Distance"]]@
   EntityValue[
    EntityList[
     EntityClass["WolframLanguageSymbol", {"FunctionalityAreas" -> "ClusteringSymbols"}]
    ],
   "Name"]//
 Multicolumn[#, 3,
   Frame -> All,
   FrameStyle -> Gray,
   Alignment -> Center] &

Mathematica graphics

However, none are coming close to the desired result.

Any ideas on how the target clustering can be achieved in general? There will be both more and less columns and both more and less sentence type columns.

The goal is to recreate the grid of text in the image as Grid of strings with matching empty and filled cells.

$\endgroup$
  • 1
    $\begingroup$ maybe MorphologicalComponents[Dilation[Image[1 - ImageData[Graphics[recs]]], 2]] // Colorize as a first step? $\endgroup$ – kglr Mar 4 at 2:48
4
$\begingroup$

Update: Using the horizontal dilation idea with RegionIntersection + RelationGraph + ConnectedComponents:

ClearAll[hDilate]
hDilate[d_: 10] := # /. Rectangle[{xmin_, ymin_}, {xmax_, ymax_}] :> 
     Rectangle[{xmin - d, ymin}, {xmax + d, ymax}] &;

cc = ConnectedComponents[
   RelationGraph[RegionIntersection[hDilate[]@#, hDilate[]@#2] =!=  EmptyRegion[2]&, recs]];

Sort[cc] == Sort[recsByCell]

True

A slightly modified version:

rel = UnsameQ[##] && RegionIntersection[hDilate[]@recs[[#]], 
         hDilate[]@recs[[#2]]] =!= EmptyRegion[2] &;

rg = RelationGraph[rel, Range[Length@recs]];

cc2 = recs[[#]] & /@ ConnectedComponents[rg];

cc2 == cc

True

vstyle = Association[Join @@ MapIndexed[Thread[# -> ColorData[109]@*First@#2] &, 
     ConnectedComponents[rg]]];

Graph[rg, PerformanceGoal -> "Quality", 
  VertexCoordinates -> {v_ :> RegionCentroid[recs[[v]]]}, 
  ImageSize -> Large, VertexSize -> Large, 
  EdgeStyle -> {e_ :> Directive[CapForm["Round"], Opacity[.5], vstyle[e[[1]]], 
      AbsoluteThickness[20]]}, VertexStyle -> {v_ :> vstyle[v]}]

enter image description here

Original answer:

Use ComponentMeasurements to

  1. Dilate morphological components horizontally using the kernel ConstantArray[1, {1, 10}],
  2. Find the bounding rectangles
  3. Erode each bounding rectangle horizontally using the same kernel

boundingboxes = Fold[
   Rectangle @@@ 
      ComponentMeasurements[
          #2[Image[1 - ImageData[Graphics[#]]], ConstantArray[1, {1, 10}]], 
          "BoundingBox"][[All, 2]] &, 
   recs, {Dilation, Erosion}];

Find the transformation function to map coordinate bounds of boundingboxes to coordinate bounds of recs:

trF = RescalingTransform @@ (CoordinateBounds[# /. 
        Rectangle[a_, b_] :> {a, b}] & /@ {boundingboxes, recs});

Transform bounding rectangles:

trnsfrmedbb = boundingboxes /. Rectangle[a_, b_] :> (Rectangle @@ trF[{a, b}]);

Show transformed boxes together with recs:

Graphics[{EdgeForm[], MapIndexed[{ColorData[109]@*First@#2, #} &, trnsfrmedbb2], 
  EdgeForm[Black], FaceForm[], recs}, ImageSize -> Large]

enter image description here

Find the box each element of recs belongs to using RegionIntersection:

clusters = recs[[#]] & /@ 
   SparseArray[Outer[Boole[RegionIntersection[##] =!= EmptyRegion[2]] &, 
      trnsfrmedbb, recs]]["AdjacencyLists"];

The result matches OP's manual clusters:

clusters == recsByCell

True

Show clusters using OP's color coding:

Graphics[MapIndexed[{ColorData[109]@*First@#2, #} &, clusters], ImageSize -> Large]

enter image description here

| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ This is interesting. May you give a brief sentence on what each line of code is doing. (+1) $\endgroup$ – Edmund Mar 4 at 12:38
  • 2
    $\begingroup$ @Edmund, added some notes. $\endgroup$ – kglr Mar 4 at 15:12

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.