19
$\begingroup$

Given an image upon which you want to inset text, the question arises:

  • What is the best sub-region to place text?

For example, given a background image I want to find the rectangle in the image (left), so that we can inset textual content to make a readable overlay (right):

enter image description here

In other words, I want to find the largest sub-rectangle such that inset text (which could be any constant font color) stands-out will and is clearly readable.

Here are additional examples to try with:

moreExamples = CloudGet["https://www.wolframcloud.com/obj/a1f146e3-59d9-45ca-b4c7-1ffcd4a9f17b"]

What I've tried:

Using built-in methods of GradientFilter and ImageMeasurements for finding the largest rectangular region of the lowest contrast?

img = CloudGet["https://www.wolframcloud.com/obj/62fecb26-7525-493c-af93-96ee18e8d9b9"]
g = GradientFilter[ColorConvert[img, "Grayscale"], 10, Method->{"NonMaxSuppression"->False, "DerivativeKernel"->"ShenCastan"}] // ImageAdjust
p = ImagePartition[g, Round[ImageDimensions[g][[1]] / 30]];
ArrayPlot[Rescale @ Map[Plus @@ ImageMeasurements[#, {"Entropy", "TotalIntensity"}]&, p, {2}], 
  ColorFunction->"ThermometerColors", ColorFunctionScaling->False]

enter image description here

In this approach, the last step (which I'm not quite sure how to do) is to find the largest rectangles with minimal entropy. Here's what that might look like (using drawing tools):

enter image description here

$\endgroup$
16
  • 1
    $\begingroup$ I think they are trying to find a good rectangle to put the text, there’s no textbook detect in the given image at first... $\endgroup$ – user5601 Apr 29 '20 at 18:55
  • 1
    $\begingroup$ Thank so I did understand it right, this is an interesting problem... imaging experts on this site probably have a solution $\endgroup$ – user5601 Apr 30 '20 at 0:12
  • 1
    $\begingroup$ Finding a good region for writing text on an image is not only a matter of uniformity in the picture. For the picture of the question I would prefer to put the text in a layer in front of the carpet and therefore add some extra pixels of the carpet color and choose a high contrast text color to that. And use the dark shadow of the couch on the left side for the call-to-action-button. The whiting fog in front of the flowers and plants is not the best choice. $\endgroup$ – Steffen Jaeschke Apr 30 '20 at 16:53
  • 1
    $\begingroup$ @user2432923 thank for your comment, you sound like you have experience in design... $\endgroup$ – M.R. Apr 30 '20 at 22:09
  • 1
    $\begingroup$ This problem is just like region proposals in an object detection network $\endgroup$ – M.R. May 3 '20 at 21:19
11
+250
$\begingroup$

Edited again: Very much faster!

I am using EdgeDetect and create a monochrome image.

ImagePartition then breaks down this image and I put the small images in a Grid. All these images are are then converted to 1 or 0, according to the presence or not of edges.

Thousands of random rectangles are then created on the grid, and tested for including areas with 1 or 0. This decides if a rectangle is discarded or accepted.

Accepted rectangles are converted to normal coordinates (instead of grid coord) and ordered by size. Overlapping rectangles of a smaller size are discarded. You can show as many rectangles as you wish by adjusting the settings. Note that the number maxRandomRectangles is very rarely reached,as maxAccepted is normally reached much earlier (in most images) and breaks the loop.

img = CloudGet["https://www.wolframcloud.com/obj/62fecb26-7525-493c-af93-96ee18e8d9b9"];
edge = EdgeDetect[ColorConvert[img, "Grayscale"], 1]
data = ImageData[edge];

(* Settings *)
minXlength = 50;
minYlength = 50;
maxRectanglesDisplayed = 2;
maxRandomRectangles = 50000;
maxAccepted = 400;

(* Partition the image and create a grid *)
divisor = minXlength/2;
pData = ImagePartition[edge, {minXlength/2}];
nRows = Ceiling[ImageDimensions[edge][[1]]/divisor];
nColumns =  Ceiling[ImageDimensions[edge][[2]]/divisor];
grid = Grid[pData];

(* Replace images in the grid with 1 if contains non-edge; 0 \
otherwise *)
col = 1;
While[col <= nColumns,
 row = 1;
 While[row <= nRows,
  gridImage = grid[[1, col, row]];
  gridImageData = ImageData[gridImage];
  flatImageData = Flatten[gridImageData];
  blackList = Cases[flatImageData, 0];
  If[blackList == flatImageData, grid[[1, col, row]] = 1, 
   grid[[1, col, row]] = 0];
  row++;
  ];
 col++;
 ]

(* Create a loop to create random rectangles. Break out of the loop \
if maxAccepted rectangles reached before.*) 
possibleRect = {};
rejectedRect = 0;
acceptedRect = 0;
j = 1;
While[j <= maxRandomRectangles, j++;

 (* Select random coordinates for our rectangle *)

 xvalue1 = RandomInteger[{1, nRows}];
 xvalue2 = RandomInteger[{1, nRows}];
 yvalue1 = RandomInteger[{1, nColumns}];
 yvalue2 = RandomInteger[{1, nColumns}];

 (* Reject rectangles with sides too small *)

 If[Abs[xvalue1 - xvalue2] < 2, rejectedRect++; Continue[]];
 If[Abs[yvalue1 - yvalue2] < 2, rejectedRect++; Continue[]];

 (* Arrange coordinates from smaller to higher *)

 minCoordX = Min[xvalue1, xvalue2];
 minCoordY = Min[yvalue1, yvalue2];
 maxCoordX = Max[xvalue1, xvalue2];
 maxCoordY = Max[yvalue1, yvalue2];

 (* Scan edge data to see if our rectangle contains edges 
 - if so, discard rectangle 
 - if not, keep as a possible candidate *)
 breakDetected = False;
 For[col = minCoordY, col <= maxCoordY, col++,

  For[row = minCoordX, row <= maxCoordX, row++,
   If[grid[[1, col, row]] == 1, Continue[], breakDetected = True; 
    rejectedRect++; Break[];]
   ];
  If[breakDetected, Break[]];
  ];
 If[breakDetected, breakDetected = False; Continue[]];

 (* Create the rectangle with proper coordinates *)

 rect = Rectangle[{(minCoordX - 1)*divisor, (minCoordY - 1)*
     divisor}, {(maxCoordX - 1)*divisor, (maxCoordY - 1)*divisor}];
 possibleRect = Append[possibleRect, rect];
 acceptedRect++;
 If[acceptedRect >= maxAccepted, Break[]]
 ]

(* Simple function to determine if we have an empty region *)

IsEmptyRegion2D[x_] := False;
IsEmptyRegion2D[EmptyRegion[2]] := True;

(* Sort the possible rectangles with larger ones first *)

sortedRect = Sort[possibleRect, Area[#1] > Area[#2] &];

(* Starting with the larger rectangles, keep only the ones non \
overlapping with previous ones in the list, up to the number of \
rectangles we want to display *)
nonoverlapping = {};
For[k = 1, k <= Length[sortedRect], k++,
  If[Length[nonoverlapping] == 0, 
   nonoverlapping = Append[nonoverlapping, sortedRect[[k]]]; 
   Continue[]];
  keep = True;
  For[n = 1, n <= Length[nonoverlapping], n++,
   intersection = 
    RegionIntersection[nonoverlapping[[n]], sortedRect[[k]]];
   If[IsEmptyRegion2D[intersection], keep = True, keep = False; 
    Break[]];
   ];
  If[keep, nonoverlapping = Append[nonoverlapping, sortedRect[[k]]]];
  If[Length[nonoverlapping] == maxRectanglesDisplayed, Break[]]
  ];


(* Accepted and Rejected rect*)
Print[Style["Accepted:", Bold]];
Print[acceptedRect];
Print[Style["Rejected:", Bold]];
Print[rejectedRect];

(* Print rectangles data *)

Print[Style["List of non overlapping rectangles:", Bold]];
Print[nonoverlapping];

(* Show rectangles in image *)

over = Graphics[{EdgeForm[{Thick, Green}], 
    FaceForm[Opacity[0.1], Gray], nonoverlapping}];
final = ImageReflect[Show[ImageReflect[img], over]]

Here are some results:

Edge detection

5 best non overlapping rectangles

Edge detection[![][3]

Boxed

Edge detection

$\endgroup$
2
  • 1
    $\begingroup$ Thanks for posting an answer! Do you think you speed this up by (1) assuming a min/max aspect ratio and area or (2) sampling more rectangles near the non-Edgy regions? $\endgroup$ – M.R. May 6 '20 at 0:50
  • 1
    $\begingroup$ Yes, aspect ratio would help. Also setting higher minimum length for a rectangle side (set to 50 pixels above). As for the rectangles, what take a while is removing partly overlapping rectangles. If you don't do that (at first, I was not doing it), all the non-edgy regions get covered with rectangles, which is interesting to watch, and really highligths where to focus. Finally, the code itself was not optimized at all. Certainly speed to gain there. $\endgroup$ – Jean-Pierre May 6 '20 at 1:13
8
$\begingroup$

Masks are created that focus on regions which are structureless or are backgrounds. Later the region is searched for rectangles

(*ver2.01*)
imgs = CloudGet[
  "https://www.wolframcloud.com/obj/a1f146e3-59d9-45ca-b4c7-\
1ffcd4a9f17b"]

getMasks[img_, edR_: 6, clR_: 30.1, dilR_: 12.5, gauR_: 5] := Module[
  {mask, comps},
  mask = ColorNegate@Closing[Dilation[EdgeDetect[GaussianFilter[img, gauR], edR],dilR], clR];
  comps = DeleteSmallComponents@Colorize@MorphologicalComponents[mask]
  ]

masks = getMasks /@ imgs;
MapThread[HighlightImage[#1, #2] &, {imgs, masks}]

The parameters used as defaults were found using Manipulate

Manipulate[(MapThread[{#1, #2} &, {imgs, masks}]) // Grid,
 {{edR, 6}, 0.1, 10}, {{clR, 30.1}, 0.1, 100}, {{dilR, 12.5}, 1, 100}, {{gauR, 5}, 1, 100}]

fig1: the masks
fig1: The masks. Note that disjoint masks, though highlighted the same, are separately accessible. Also note the lack of a good spot in the top right corner of the top right image.

Some comments on the mask creation

  1. Params which have most effect are dilation and closing.
  2. DeleteSmallComponents also has a drastic effect on removing perfectly good placements: one may implement an area based filter here instead.
  3. The regions may be further filtered using a quality metric which may be a weighted function of
    1. overlap with regions from FeatureDetect
    2. area and contrast
    3. convexity and rectangularity

Even though a mask is highly useful during image compositing, an inscribed oriented rectangle would be great, as asks the OP. For this sub problem, solutions exist here and here. Nevertheless, an in-house and simple approach is implemented below with plenty of scope for optimization.

toArray = Range[Length[#1]] /. #1 & 

comps = toArray@
     ComponentMeasurements[#, {"Shape", "BoundingBox"}, All, 
      "ComponentPropertyAssociation"] & /@ masks;


getRect[comp_] :=
 Module[
  {reg, center, perimeter, pts, box, translatedBox},
  (*the region of interest*)
  reg = comp["Shape"];
  (*region center*)
  center = RegionCentroid@ImageMesh@reg;
  (*region perimeter*)
  perimeter = First[1 /. ComponentMeasurements[reg, "Contours"]];
  (*
  points of intersection b/w horizontal/vertical rays emanating
  from centroid and the perimeter
  *)
  pts =
   (RegionNearest[#1, 
       center] &) /@ (RegionIntersection[HalfLine[center, #1], 
        perimeter] &) /@ AngleVector /@ ( Range[0, 3] \[Pi]/2);
  (*the resuting box*)
  box = BoundingRegion@pts;
  (*the same box in image's frame*)
  translatedBox = Translate[box, First@comp[["BoundingBox"]]]
  ]

rects = Map[getRect, comps, {2}]

MapThread[HighlightImage[#1, #2] &, {imgs, rects}]

fig2 fig2:The rects. Note the largeness of some rects compared to those from stochastic methods: this is one benefit of contiguous masks.

Some comments on rectangle creation

  1. A chief source of overhead is from use of Region_ core methods. They are convenient but quite general and slow.
  2. Instead of centroid, a weighted point may be used. Weights can be say from DistanceTransform.
  3. A simple approach was used to determine the rectangle: a horizontal line and a vertical line from the centroid was drawn. Closest points of intersection with the mask boundary determined the rectangle. Needless to say, better techniques may be developed: for e.g growing a convex hull around the centroid.
  4. The mask isn't very convex to begin with and this leads to smaller rects. Chunks of viable areas get wasted in buds and branches. Though this may be adjusted for during mask creation itself, a created mask can be turned even more convex by Pruning@SkeletonTransform. Another technique would be to implement a Ricci flow like transform.

For comparison, here's an image showing the mask (red) and the derived rect (green) over the prelaid design.

enter image description here

Finding great visual real-estate in an image has more to it than segmenting low entropy regions. To account for all that are considered good qualities would be highly subjective and difficult to model. An ANN trained on a good dataset would be a neat choice for this.

$\endgroup$
6
$\begingroup$

I played with this task for some time and even though I did not come up with a good solution, I would still like to share some of the code I wrote. I tried to use your results as the base of my solution, because I assumed that is what you wanted. Maybe you can reuse some ideas.

example = 
 CloudGet["https://www.wolframcloud.com/obj/62fecb26-7525-493c-af93-\
96ee18e8d9b9"]

filter[image_Image] := 
 GradientFilter[ColorConvert[image, "Grayscale"], 10, 
   Method -> {"NonMaxSuppression" -> False, 
     "DerivativeKernel" -> "ShenCastan"}] // ImageAdjust

filtered = filter[example]

partitioned = 
  ImagePartition[filtered, Round[ImageDimensions[filtered][[1]]/30]];

contentIntensity[image_Image] := 
 Plus @@ ImageMeasurements[
    image, {"Entropy", "TotalIntensity"}]/(Times @@ 
     ImageDimensions[image])^1.001

content = Rescale@Map[contentIntensity, partitioned, {2}];

ArrayPlot[content, ColorFunction -> "ThermometerColors", 
 ColorFunctionScaling -> False]

contentIntensity[image_Image, 
  Rectangle[{xmin_Integer, ymin_Integer}, {xmax_Integer, 
    ymax_Integer}]] := 
 contentIntensity[ImageTrim[image, {xmin, ymin}, {xmax, ymax}]]

candidateRegions[image_Image, nOfSplits_Integer: 8] := Module[{
   width,
   height,
   step
   },
  {width, height} = ImageDimensions@image;
  step = Max@Round[ImageDimensions@image/nOfSplits];
  Flatten@
   Table[Rectangle[{xmin, ymin}, {xmax, ymax}], {xmin, 1, 
     width - step, step}, {xmax, xmin + step, width, step}, {ymin, 1, 
     height - step, step}, {ymax, ymin + step, height, step}]
  ]

subRectangleQ[
  Rectangle[{xmin_Integer, ymin_Integer}, {xmax_Integer, 
    ymax_Integer}], 
  Rectangle[{subxmin_Integer, subymin_Integer}, {subxmax_Integer, 
    subymax_Integer}]] := 
 xmin <= subxmin <= subxmax <= xmax && 
  ymin <= subymin <= subymax <= ymax

memberQBySubRectangleQ[rectangles_List, rectangle_Rectangle] := 
 MemberQ[Map[subRectangleQ[#, rectangle] &, rectangles], True]

removeWorseSubregions[regions_List] := Module[{
   results = {First@regions}
   },
  Map[If[! memberQBySubRectangleQ[results, #], 
     AppendTo[results, #]] &, Rest@regions];
  results
  ]

findRegions[image_Image, nOfSplits_Integer: 8, nOfResults_: 5] := 
 Module[{
   rectangles = candidateRegions[image, nOfSplits],
   intensities,
   filtered = filter[image]
   },
  intensities = 
   ParallelMap[contentIntensity[filtered, #] &, rectangles];
  removeWorseSubregions[
    SortBy[Transpose[{rectangles, intensities}], Last][[;; , 1]]][[;; 
     nOfResults]]
  ]

regions = findRegions[example];

HighlightImage[example, regions]

HighlightImage[example, #] & /@ regions

moreExamples = 
 CloudGet["https://www.wolframcloud.com/obj/a1f146e3-59d9-45ca-b4c7-\
1ffcd4a9f17b"]

HighlightImage[#, findRegions[#]] & /@ moreExamples

Sample output with the original filtered image More examples

$\endgroup$
2
  • 1
    $\begingroup$ Could you add some sample output? $\endgroup$ – Chris K May 7 '20 at 1:26
  • 1
    $\begingroup$ You can just copy paste and run the code as it is, but I added the important parts of output to the answer. $\endgroup$ – Jan Hubik May 7 '20 at 9:31
4
$\begingroup$

After spending significant time on playing with this idea I decided to share it, although it is not necessarily fast nor fancy. It effectively performs exhaustive search of (possibly overlapping) rectangular regions composed of zeroes on an operated and downscaled image. Quality depends a lot on preprocessing:

ClearAll@findLargestZeroRectangles;
findLargestZeroRectangles[img_Image, count_ : UpTo@Infinity, 
   op_ : EdgeDetect, downscale_ : 8] :=
  With[{scaled = ImageResize[img, Scaled[1/downscale]]},
   With[{data = ImageData[op[scaled]],
      xdim = ImageDimensions[scaled][[1]] - 1,
      ydim = ImageDimensions[scaled][[2]] - 1}, 
     Table[With[{x = pos[[1]], y = pos[[2]]},
       ({#1, ydim + 1 - #2} & @@@
           {{x, y}, (# + {0, 1})}) & /@
        DeleteCases[{v_, _} /; v <= x]@
         Rest@
          NestWhileList[
           Apply[{x + 
               First@FirstPosition[data[[#2 + 2, x + 1 ;; #1]], 
                 1, {#1 - x + 1}] - 1, #2 + 1} &],
           {xdim + 1, y - 1}, Apply[#1 > x && #2 < ydim &]]],
      {pos, Position[data, 0, {2}] - 1}]] // 
    downscale TakeLargestBy[Flatten[#, 1], Area@*Apply[Rectangle], count] &];

With[{img = ResourceFunction["RandomPhoto"][640, 480]}, 
 HighlightImage[img, Rectangle @@@ findLargestZeroRectangles[img, UpTo@1]]]

enter image description here

I admit that + 1s, - 1s and even a + 2 in this code makes it look pretty hackish. Unfortunately they're to an extent necessary to make this work properly on ConstantImages and to provide rectangles that logically enclose all zero pixels at specified level of downscaling (this might not be precisely what you want).

There's a good chance the NestWhileList portion where the code spends most of its time could be sped up significantly (like 10-fold?) by rewriting it for FunctionCompile. Current version spends about four seconds on average on each of these example images (640x480, 8-fold downscaling) on my laptop.

Couple more "RandomPhoto" examples with plain EdgeDetect:

enter image description here

enter image description here

enter image description here

Original examples:

Table[HighlightImage[img, 
  Rectangle @@@ findLargestZeroRectangles[img, UpTo@1]], {img, 
  CloudGet["https://www.wolframcloud.com/obj/a1f146e3-59d9-45ca-b4c7-\
1ffcd4a9f17b"]}]

enter image description here

enter image description here

enter image description here

enter image description here

Multiple alternatives can be also found (here eliminating rectangles which are completely inside other rectangles):

With[{img = 
   Last@CloudGet[
     "https://www.wolframcloud.com/obj/a1f146e3-59d9-45ca-b4c7-1ffcd4a9f17b"]},
 With[{rects = Rectangle @@@ findLargestZeroRectangles[img, UpTo@500]},
  HighlightImage[img,
   Complement[rects,
    If[RegionWithin[#1, #2], #2, 
       If[RegionWithin[#2, #1], #1, Nothing]] & @@@
     Subsets[rects, {2}]]]]]

enter image description here

$\endgroup$
2
  • $\begingroup$ can you please share the images? $\endgroup$ – lineage May 11 '20 at 10:39
  • $\begingroup$ Do you mean those I used with "RandomPhoto"? I fear not, they were fetched and used directly using the ResourceFunctionand not saved anywhere, I fear. Assuming you have recent version of Mathematica you can get similar test images quite easily the same way. $\endgroup$ – kirma May 11 '20 at 10:45

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.