Best Fit to Image

[jdtrat]

Hello! I'm working on a Shiny app where images will be annotated based on users' input. I need to have the annotation fit within a certain region of the image, and have been unable to figure that out. For example, if the input is someone's name, I would like it to size automatically within a certain border. "Jonathan," for instance, would be smaller than "Hadley." A hard coded example:

library(magick)
frink <- image_read("https://jeroen.github.io/images/frink.png")
image_draw(frink)
rect(20, 20, 200, 100, border = "red", lty = "dashed", lwd = 5)
text(110, 55, "Jonathan", cex = 3.5)
dev.off()

library(magick)
frink <- image_read("https://jeroen.github.io/images/frink.png")
image_draw(frink)
rect(20, 20, 200, 100, border = "red", lty = "dashed", lwd = 5)
text(110, 55, "Hadley", cex = 4.5)
dev.off()

This is possible with the ImageMagick engine (see the Best Fit to Image section) by not specifying a pointsize argument for a label. According to the website, IM would "have the freedom to try and select a font size that best fits the image size requested. That is the drawn text will be adjusted to fit the given size!" The code they provide as an example is seen below:

convert -background lightblue -fill blue  -font Candice \
          -size 165x70  label:Anthony     label_size_fit.gif

The image_draw function does have a pointsize argument, but if I set it to NULL it throws an error and nothing changes (see reprex below). Am I missing something? If there is another way to achieve this, I would greatly appreciate a nudge in the right direction. If there is not a way to do this, would it be possible to add this as a feature?

library(magick)
#> Linking to ImageMagick 6.9.9.39
#> Enabled features: cairo, fontconfig, freetype, lcms, pango, rsvg, webp
#> Disabled features: fftw, ghostscript, x11
# Vectorized example with custom coordinates
earth <- image_read("https://jeroen.github.io/images/earth.gif") 
#pointsize default of 12
img <- image_draw(earth, xlim = c(0,1), ylim = c(0,1), pointsize = 12)
rect(.1, .1, .9, .9, border = "red", lty = "dashed", lwd = 5) 
text(.5, .9, "Our planet", cex = 3, col = "white")
print(img)
#>    format width height colorspace matte filesize density
#> 1     GIF   400    400       sRGB  TRUE        0   72x72
#> 2     GIF   400    400       sRGB  TRUE        0   72x72
#> 3     GIF   400    400       sRGB  TRUE        0   72x72
#> 4     GIF   400    400       sRGB  TRUE        0   72x72
#> 5     GIF   400    400       sRGB  TRUE        0   72x72
#> 6     GIF   400    400       sRGB  TRUE        0   72x72
#> 7     GIF   400    400       sRGB  TRUE        0   72x72
#> 8     GIF   400    400       sRGB  TRUE        0   72x72
#> 9     GIF   400    400       sRGB  TRUE        0   72x72
#> 10    GIF   400    400       sRGB  TRUE        0   72x72
#> 11    GIF   400    400       sRGB  TRUE        0   72x72
#> 12    GIF   400    400       sRGB  TRUE        0   72x72
#> 13    GIF   400    400       sRGB  TRUE        0   72x72
#> 14    GIF   400    400       sRGB  TRUE        0   72x72
#> 15    GIF   400    400       sRGB  TRUE        0   72x72
#> 16    GIF   400    400       sRGB  TRUE        0   72x72
#> 17    GIF   400    400       sRGB  TRUE        0   72x72
#> 18    GIF   400    400       sRGB  TRUE        0   72x72
#> 19    GIF   400    400       sRGB  TRUE        0   72x72
#> 20    GIF   400    400       sRGB  TRUE        0   72x72
#> 21    GIF   400    400       sRGB  TRUE        0   72x72
#> 22    GIF   400    400       sRGB  TRUE        0   72x72
#> 23    GIF   400    400       sRGB  TRUE        0   72x72
#> 24    GIF   400    400       sRGB  TRUE        0   72x72
#> 25    GIF   400    400       sRGB  TRUE        0   72x72
#> 26    GIF   400    400       sRGB  TRUE        0   72x72
#> 27    GIF   400    400       sRGB  TRUE        0   72x72
#> 28    GIF   400    400       sRGB  TRUE        0   72x72
#> 29    GIF   400    400       sRGB  TRUE        0   72x72
#> 30    GIF   400    400       sRGB  TRUE        0   72x72
#> 31    GIF   400    400       sRGB  TRUE        0   72x72
#> 32    GIF   400    400       sRGB  TRUE        0   72x72
#> 33    GIF   400    400       sRGB  TRUE        0   72x72
#> 34    GIF   400    400       sRGB  TRUE        0   72x72
#> 35    GIF   400    400       sRGB  TRUE        0   72x72
#> 36    GIF   400    400       sRGB  TRUE        0   72x72
#> 37    GIF   400    400       sRGB  TRUE        0   72x72
#> 38    GIF   400    400       sRGB  TRUE        0   72x72
#> 39    GIF   400    400       sRGB  TRUE        0   72x72
#> 40    GIF   400    400       sRGB  TRUE        0   72x72
#> 41    GIF   400    400       sRGB  TRUE        0   72x72
#> 42    GIF   400    400       sRGB  TRUE        0   72x72
#> 43    GIF   400    400       sRGB  TRUE        0   72x72
#> 44    GIF   400    400       sRGB  TRUE        0   72x72

# Vectorized example with custom coordinates
#pointsize NULL
img <- image_draw(earth, xlim = c(0,1), ylim = c(0,1), pointsize = NULL)
#> Error in magick_device_internal(bg = "transparent", width = width, height = height, : Expecting a single value: [extent=0].
rect(.1, .1, .9, .9, border = "red", lty = "dashed", lwd = 5) 
text(.5, .9, "Our planet", cex = 3, col = "white")
print(img)
#>    format width height colorspace matte filesize density
#> 1     GIF   400    400       sRGB  TRUE        0   72x72
#> 2     GIF   400    400       sRGB  TRUE        0   72x72
#> 3     GIF   400    400       sRGB  TRUE        0   72x72
#> 4     GIF   400    400       sRGB  TRUE        0   72x72
#> 5     GIF   400    400       sRGB  TRUE        0   72x72
#> 6     GIF   400    400       sRGB  TRUE        0   72x72
#> 7     GIF   400    400       sRGB  TRUE        0   72x72
#> 8     GIF   400    400       sRGB  TRUE        0   72x72
#> 9     GIF   400    400       sRGB  TRUE        0   72x72
#> 10    GIF   400    400       sRGB  TRUE        0   72x72
#> 11    GIF   400    400       sRGB  TRUE        0   72x72
#> 12    GIF   400    400       sRGB  TRUE        0   72x72
#> 13    GIF   400    400       sRGB  TRUE        0   72x72
#> 14    GIF   400    400       sRGB  TRUE        0   72x72
#> 15    GIF   400    400       sRGB  TRUE        0   72x72
#> 16    GIF   400    400       sRGB  TRUE        0   72x72
#> 17    GIF   400    400       sRGB  TRUE        0   72x72
#> 18    GIF   400    400       sRGB  TRUE        0   72x72
#> 19    GIF   400    400       sRGB  TRUE        0   72x72
#> 20    GIF   400    400       sRGB  TRUE        0   72x72
#> 21    GIF   400    400       sRGB  TRUE        0   72x72
#> 22    GIF   400    400       sRGB  TRUE        0   72x72
#> 23    GIF   400    400       sRGB  TRUE        0   72x72
#> 24    GIF   400    400       sRGB  TRUE        0   72x72
#> 25    GIF   400    400       sRGB  TRUE        0   72x72
#> 26    GIF   400    400       sRGB  TRUE        0   72x72
#> 27    GIF   400    400       sRGB  TRUE        0   72x72
#> 28    GIF   400    400       sRGB  TRUE        0   72x72
#> 29    GIF   400    400       sRGB  TRUE        0   72x72
#> 30    GIF   400    400       sRGB  TRUE        0   72x72
#> 31    GIF   400    400       sRGB  TRUE        0   72x72
#> 32    GIF   400    400       sRGB  TRUE        0   72x72
#> 33    GIF   400    400       sRGB  TRUE        0   72x72
#> 34    GIF   400    400       sRGB  TRUE        0   72x72
#> 35    GIF   400    400       sRGB  TRUE        0   72x72
#> 36    GIF   400    400       sRGB  TRUE        0   72x72
#> 37    GIF   400    400       sRGB  TRUE        0   72x72
#> 38    GIF   400    400       sRGB  TRUE        0   72x72
#> 39    GIF   400    400       sRGB  TRUE        0   72x72
#> 40    GIF   400    400       sRGB  TRUE        0   72x72
#> 41    GIF   400    400       sRGB  TRUE        0   72x72
#> 42    GIF   400    400       sRGB  TRUE        0   72x72
#> 43    GIF   400    400       sRGB  TRUE        0   72x72
#> 44    GIF   400    400       sRGB  TRUE        0   72x72

[jeroen]

Maybe you can do the drawing in a second image, that you can resize before overlaying it? Eg

library(magick)
frink <- image_read("https://jeroen.github.io/images/frink.png")

fig <- image_draw(image_blank(800, 800))
rect(20, 20, 200, 100, border = "red", lty = "dashed", lwd = 5)
text(110, 55, "Jonathan", cex = 3.5)
dev.off()

image_composite(frink, image_trim(fig), operator = 'SrcOver')

[jeroen]

Here is another example, using image_annotate and then rescaling:

library(magick)
frink <- image_read("https://jeroen.github.io/images/frink.png")
width <- image_info(frink)$width

fig <- image_blank(800, 800) %>%
  image_annotate('Jeroen', size = 100) %>%
  image_trim() %>%
  image_border('none') %>%
  image_border('red')  %>%
  image_resize(paste0(width, 'x'))

image_composite(frink, fig, operator = 'SrcOver')

[jdtrat]

Thanks for your help, @jeroen! I ended up using the second method. This allowed me to keep the names within a border on the first image. I've set it up so the relative heights of each name are the same, too. One thing I noticed with this, however, is that the names left-flush. Do you have any suggestions as to how I could make the offset the composite image based on its center? I came across this discussion, but I don't believe there is a geometry argument available for image_composite function. Any advice you can give would be greatly appreciated! Reprex below shows what I'm trying to do.

library(magick)
#> Linking to ImageMagick 6.9.9.39
#> Enabled features: cairo, fontconfig, freetype, lcms, pango, rsvg, webp
#> Disabled features: fftw, ghostscript, x11
frink <- image_read("https://jeroen.github.io/images/frink.png")
# set border width to be 90%
width <- image_info(frink)$width * 0.90

fig <- image_draw(frink)
rect(20, 20, width, 100, border = "red", lty = "dashed", lwd = 5)
dev.off()
#> quartz_off_screen 
#>                 2

name1 <- image_blank(800, 800) %>%
  image_annotate('Jonathan', size = 100) %>%
  image_trim() %>%
  image_resize(paste0(width * 0.9, 'x30'))

name2 <- image_blank(800, 800) %>%
  image_annotate('Jeroen', size = 100) %>%
  image_trim() %>%
  image_resize(paste0(width * 0.9, 'x30'))

fig %>%
  image_composite(name1, offset = paste0("+", 0.1 * width,"+40"), operator = "SrcOver")

fig %>%
  image_composite(name2, offset = paste0("+", 0.1 * width,"+40"), operator = "SrcOver")

# Manually center names
fig %>%
  image_composite(name1, offset = paste0("+", (0.1 * width) + 6,"+40"), operator = "SrcOver")

fig %>%
  image_composite(name2, offset = paste0("+", (0.1 * width) + 30,"+40"), operator = "SrcOver")

^{Created on 2020-08-26 by the reprex package (v0.3.0)}

[jeroen]

Maybe try gravity = "center" in image_composite ?

[jdtrat]

I thought the same thing, but that places the name in relation to the background picture:

library(magick)
#> Linking to ImageMagick 6.9.9.39
#> Enabled features: cairo, fontconfig, freetype, lcms, pango, rsvg, webp
#> Disabled features: fftw, ghostscript, x11
frink <- image_read("https://jeroen.github.io/images/frink.png")
# set border width to be 90%
width <- image_info(frink)$width * 0.90

fig <- image_draw(frink)
rect(20, 20, width, 100, border = "red", lty = "dashed", lwd = 5)
dev.off()
#> quartz_off_screen 
#>                 2

name <- image_blank(800, 800) %>%
  image_annotate('Jonathan', size = 100) %>%
  image_trim() %>%
  image_resize(paste0(width * 0.9, 'x30'))

fig %>%
  image_composite(name, offset = paste0("+", 0.1 * width,"+40"), operator = "SrcOver", gravity = "center")

^{Created on 2020-08-27 by the reprex package (v0.3.0)}

I ended up creating a blank image with a border and compositing it with the name using the gravity = "center" argument, and then compositing that on top of the background image. That seems to work as I wanted, but I'm having a different issue: I'm unable to place the new border/image over the original border created using the rect function. I attempted to rescale it with the same width/height used, but it doesn't overlap and I'm not sure why. If you have time, I would greatly appreciate your thoughts! If not, no worries. I am very grateful that you helped me solve my problem!

library(magick)
#> Linking to ImageMagick 6.9.9.39
#> Enabled features: cairo, fontconfig, freetype, lcms, pango, rsvg, webp
#> Disabled features: fftw, ghostscript, x11
frink <- image_read("https://jeroen.github.io/images/frink.png")
# set border width to be 90%
width <- image_info(frink)$width * 0.90

fig <- image_draw(frink)
rect(20, 20, width, 100, border = "red", lty = "dashed", lwd = 5)
dev.off()
#> quartz_off_screen 
#>                 2

name <- image_blank(800, 800) %>%
  image_annotate('Jonathan', size = 100) %>%
  image_trim() %>%
  image_resize(paste0(width * 0.9, 'x30'))

rect <- image_blank(width, 100) %>%
  image_border(color = "blue", geometry = "5x5") %>%
  image_resize(width)

# add name to rect
rectName <- rect %>%
  image_composite(name, operator = "SrcOver", gravity = "center") %>%
  image_resize(paste0(width, "x100")) # x100 comes from the original rect function

# add rectName to fig
fig %>% image_composite(rectName,
                        offset = "+20+20", 
                        operator = "SrcOver")

# name 2
name2 <- image_blank(800, 800) %>%
  image_annotate('Jeroen', size = 100) %>%
  image_trim() %>%
  image_resize(paste0(width * 0.9, 'x30'))

rect2 <- image_blank(width, 100) %>%
  image_border(color = "blue", geometry = "5x5") %>%
  image_resize(width)

# add name to rect
rectName2 <- rect2 %>%
  image_composite(name2, operator = "SrcOver", gravity = "center") %>%
  image_resize(paste0(width, "x100")) # x100 comes from the original rect function

# add rectName to fig
fig %>% image_composite(rectName2,
                        offset = "+20+20", 
                        operator = "SrcOver")

^{Created on 2020-08-27 by the reprex package (v0.3.0)}

[dmi3kno]

I wonder if exposing fontTypeMetrics could help (ref #216). Wouldn't it be cool to just

# do not run
image_annotate("Jeroen",.., width=100, height=50)

and have Magick figure out what font size it needs to use (given the font family) to fit the bounding box. It sounds like a reverse problem compared to what fontTypeMetrics does, though (from bbox -> font not font ->bbox). So, never mind.

Printing on arbitrary(blank) raster and then scaling it before image_composite() sounds like a plausible strategy.