Find best region to put text onto image

Question

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):

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]

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):

Answer 1

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:

Answer 2

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. 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: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.

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.

Answer 3

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

Answer 4

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]]]

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:

Original examples:

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

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}]]]]]