index.qmd

---
title: Process Profile Pictures with magick
author: Garrick Aden-Buie
date: '2022-07-12'
slug: process-profile-picture-magick
categories:
  - R
  - Images
  - Interesting Uses of R
description: |
  Process a directory full of profile pictures, resizing and cropping the images
  to be centered around faces.
image: feature.png
source_link: 'https://github.com/gadenbuie/garrickadenbuie-com/blob/main/content/blog/2022/process-profile-picture-magick/index.Rmarkdown'
keywords: rstats
editor_options:
  chunk_output_type: console
post_data:
  photos:
    - id: DItYlc26zVI
      credit: christian buehner
    - id: bpxgyD4YYt4
      credit: Eunice Lituañas
    - id: 6anudmpILw4
      credit: Foto Sushi
    - id: 3dqSZidOkvs
      credit: Eye for Ebony
resources:
  - profiles
  - profiles_cropped
bump: 2
---

<!-- Links -->

```{r setup, include=FALSE}
knitr::opts_chunk$set(
  echo = FALSE, warning = FALSE, message = FALSE,
  collapse = TRUE,
  fig.width = 9, fig.height = 10
)
options(htmltools.dir.version = TRUE)

photos <- rmarkdown::metadata$post_data$photos

fs::dir_create("profiles")
purrr::walk(photos, function(photo) {
  url <- paste0("https://source.unsplash.com/", photo$id)
  dest <- fs::path("profiles", photo$id, ext = "jpg")
  if (!fs::file_exists(dest)) {
    download.file(url, dest)
  }
})

credit_link <- function(id, credit) {
  htmltools::tags$a(
    href = fs::path("https://unsplash.com/photos", id),
    credit,
    .noWS = "outside"
  )
}

profile_preview <- function(.photo, .alt, .caption) {
  htmltools::withTags(
    figure(
      class = "mx-auto",
      style = "width: 66vw; max-width: 100%",
      img(alt = .alt, src = fs::path("profiles", .photo$id, ext = "jpg")),
      figcaption(
        .caption,
        "Image by ",
        credit_link(.photo$id, .photo$credit),
        "."
      )
    )
  )
}
```

## rstudio::conf(2022) runs on R

[rstudio::conf(2022)](https://rstudio.com/conference) is just around the corner!
This year,
I've been fortunate to be part of the conference program committee,
the small group of RStudio people who gather and evaluate talk submissions,
make the tough scheduling decisions about the sessions and talks in the conference program,
and generally wrangle and herd all the speaker and talk information into the final schedule.

My favorite part of the process —
apart from seeing all of the wonderful and creative ways
our community approaches data science with R (okay, and Python too) —
is finding out how many creative ways **we** use R
to manage the conference.
Let's just say Jenny Bryan is a literal Google Forms/Sheets/Drive wizard.

One of the things I love about R
is the cycle of starting a task wondering
_Can I do this with R?_
and ending with
_Wow, I can do this with R!_
I've been using R for a while and I'm still occasionally surprised
when I find myself on this virtuous loop.

This post is about an otherwise mundane conference admin task
that would have involved a lot of manual labor
(in the form of clicks and mouse movements)
that I automated with the help of a few R packages.
Maybe in future posts I'll share
more cool things that we did with R
in the making of rstudio::conf.

Oh and I hope to see you there,
either in person, online or on Twitter at
[#RStudioConf2022](https://twitter.com/search?q=%23RStudioConf2022)!
Learn more at [rstd.io/conf](https://rstudio.com/conference).

## Send me your profile picture, please

Suppose you've asked 100-ish people to send you a profile picture
and to your surprise they all followed through and sent you an actual image.

But, of course, you now have a new problem.
Each of those 100-ish people has used slightly different sizes for their profile picture.
They're all sorts of different shapes, sizes, and resolutions.

Some people's profile images feature their faces, centered and tightly cropped.
Others are photographed at a distance or off-center.

```{r echo=FALSE}
profile_preview(
  photos[[1]],
  "A profile picture of a man, early 30s and smiling, against a soft gray background.",
  "An example profile picture you received."
)
```

In their final placement,
you want all of the profile images to be circular images
centered on the person's face as much as possible.
If we took the image above and simply centered it inside a circle,
we would get something like this:

<div class="p-3 text-center rounded-circle mx-auto shadow-lg" style="background-size: cover; background-image: url(profiles/`r photos[[1]]$id`.jpg); width: 200px; height: 200px">
<div class="visually-hidden">The example profile image clipped to fit a circular avatar image. The subject appears at the right edge of the circle. About 40% of their face is clipped.</div>
</div>

Obviously, we'd rather not clip half of the person out of their profile image,
so we'll need to edit this photo.
But there are hundreds of them and most of them will need _some_ adjustment.

Good news! You have access to R,
where we can use tools like magick to read and process the images,
or face detection with neural networks.
So with a few hours of work you can save yourself
[an hour of mindless clicking](https://xkcd.com/1319).
Let's do this!

## Collect the Profile Pictures

To see how this all works,
I've downloaded four example profile pictures from [unsplash](https://unsplash.com)[^1].

```{r include=FALSE}
ids <- photos |> purrr::map_chr("id")
ids <- paste0('"', ids, '"', collapse = ", ")
```

```r
dir.create("profiles")
photo_ids <- c(`r ids`)

for (id in photo_ids) {
  download.file(
    sprintf("https://source.unsplash.com/%s", id),
    sprintf("profiles/%s.jpg", id)
  )
}
```

I've put the photos in a `profiles/` directory
so that I can list the them all at once:

```{r fs-dir-ls-profiles, echo = TRUE}
fs::dir_ls("profiles")
```

## Magick with R

The first step is to use the magick package to read in our profile pictures.

```{r echo=TRUE}
library(magick)
library(purrr)

profiles <-
  fs::dir_ls("profiles") |>
  map(image_read)

profiles
```

Here are the four profiles.
As you can see, they come in a variety of sizes
and the person in the frame is rarely centered.

::: text-center
```{r}
#| fig.alt: |
#|   Four profile pictures of irregular sizes in a 2 by 2 grid. None of the
#|   subjects are perfectly centered in the images. Clockwise: a late 20s
#|   black woman against a green, natural background; a mid-50s white male on a
#|   gray background; a mid-20s woman in a blue shirt against a tan background;
#|   an early-30s male with curly hair and a floral print shirt on a light gray
#|   background.
all_profiles <-
  profiles |>
  map(image_border, geometry = "10x10", color = "transparent") |>
  reduce(c) |>
  image_montage(
    tile = "2x2",
    geometry = geometry_area(width = 250),
    bg = "transparent"
  )

all_profiles
```
:::

## Finding Faces

Now for the most fun of this entire post.
After a quick search on [r-pkg.org](https://r-pkg.org),
I found a few packages that provide methods for
[facial detection](https://r-pkg.org/search.html?q=face+detect);
I tried [image.libfacedetection](https://github.com/bnosac/image) first
and it worked out so well that I didn't have to look any further on the list.

As it says on the CRAN page, image.libfacedetection is

> An open source library for face detection in images.
> Provides a pretrained convolutional neural network based on
> <https://github.com/ShiqiYu/libfacedetection> which can be used
> to detect faces which have size greater than 10x10 pixels.

The best feature — apart from reliably detecting faces —
is that it works really well with magick.
The core functionality is all wrapped up in a single function,
`image.libfacedetection::image_detect_faces()`,
and the example in the
[README](https://cran.rstudio.com/web/packages/image.libfacedetection/readme/README.html)
tells you just about everything you need to know.

In short, after reading the image into R with `magick::image_read()`,
you can call `image_detect_faces()` to find faces in the image.
`image_detect_faces()` returns data about the detected faces,
and you can use its `plot()` method to overlay boxes over the found faces
in the image.

```{r libfacedetection-example, echo = TRUE, eval = FALSE}
library(image.libfacedetection)
faces <- all_profiles |> image_detect_faces()
plot(faces, all_profiles, only_box = TRUE)
```
```{r}
#| ref.label: libfacedetection-example
#| class.chunk: tc
#| fig.alt: |
#|   The four profile images from the previous example. A red square outline
#|   marking the detected face regions has been overlaid over each face in the
#|   examples profile images.
```

`image_detect_faces()` returns some interesting data about the detected faces:

> The data frame detections indicates the locations of these.
> This data.frame has columns `x`, `y`, `width` and `height`
> as well as a column called `confidence`.
> The values of `x` and `y` are the top left of the start of the box.

```{r libfacedetection-example-2, echo = TRUE}
faces
```

Since we asked for a profile picture,
we can reasonably expect that there's only one person in the image.
So we'll take the detection with the highest confidence
(in case something else registers as a face),
and find the center of the detected region.

```{r find-face-center, echo = TRUE}
find_face_center <- function(image) {
  detections <- image.libfacedetection::image_detect_faces(image)$detections
  best_face <- which(detections$confidence == max(detections$confidence))
  dims <- as.list(detections[best_face[[1]], ])
  list(
    x = dims$x + dims$width / 2,
    y = dims$y + dims$height / 2
  )
}
```

```{r find-face-center-example, echo = FALSE, include = FALSE}
face_center <- find_face_center(profiles[[3]])
str(face_center)
```

So when applied to our example profile image,
we find that our subject's face is centered at
(`r face_center$x |> round(2)`, `r face_center$y |> round(2)`).

```{r ref.label="find-face-center-example", echo = TRUE}
```

```{r find-face-center-image, echo = FALSE}
#| message: false
#| out.width: 75%
#| class.chunk: text-center
#| fig.alt: |
#|   The primary example profile image, with a medium yellow dot placed on the
#|   man's nose marking the center of his face as detected by the algorithm.
profile_center <- image_draw(profiles[[3]])
symbols(
  x = face_center$x,
  y = face_center$y,
  circles = 15,
  fg = "yellow",
  bg = "yellow",
  add = TRUE,
  inches = FALSE
)
# width <- 718
# offset_y <- 70
# rect(
#   xleft = face_center$x - width / 2,
#   xright = face_center$x + width / 2,
#   ybottom = face_center$y - width / 2 + offset_y,
#   ytop = face_center$y + width / 2 + offset_y,
#   border = "black",
#   lty = "dashed",
#   lwd = 5
# )
null <- dev.off()
profile_center
```

In the next steps, we'll resize and crop the photo
so that it's centered, as much as possible, on this point.

## Resize

Our goal is to resize and crop the photo into an 600px square image.
If we start with an image smaller than 600px in either dimension,
then we won't scale up.
We also take another shortcut:
since most people will provide a profile image
that prominently features their face,
we can start by shrinking the smaller side of the image
down to match the desired image size.

This shortcut keeps us from perfectly framing the person's face.
Sometimes their face is too close to the edge of the picture,
and in other cases there may be negative space around their head
that will end up in the cropped profile image.
I'd argue that this is okay.
It keeps our cropping from being _too perfect_
and the final images still retain some of the character of the original photo.

Our example profile image is
`r image_info(profiles[[3]])$width`px wide and
`r image_info(profiles[[3]])$height`px tall,
so we'll resize the image proportionally down to an image
with height 600px.

```{r resize-fit, echo = TRUE}
resize_fit <- function(image, size = 600) {
  info <- image_info(image)
  size <- min(size, info$width, info$height)
  image_resize(
    image,
    geometry_size_pixels(
      height = if (info$width >= info$height) size,
      width = if (info$height > info$width) size
    )
  )
}
```

When applied to our example profile image,
we end up with a 900px &times; 600px image.

```{r echo = TRUE}
resized_profile <-
  profiles[[3]] |>
  resize_fit()

resized_profile |> image_info()
```

In the next step,
we'll figure out which 600px horizontal region
best covers the person's face.

## Find Resized Faces

Wait.
I showed the face-center discovery step above
because it's the coolest part of this pipeline,
but we don't actually perform the facial detection first.
We need to know where the person's face is located
**after** we scale down their profile image.

```{r echo=TRUE}
resized_profile |>
  find_face_center()
```

## Cropping

Now that we know where the center `point` of the person's face is located in the image,
and also because we've already resized the image so we don't have to worry about
its height,
we only need to crop the image in one direction.
The problem now is that
we need to pick a 600px `width` region within the full 900px `range`.


```
           point
|------[=====*=====]---|
       ^~~ width ~~^
^......................^ range
```

This isn't too complicated.
There are three cases:

1. The `point` is so close to the start of the `range`
   that it we can't center the point in our `width`
   and instead have to start at 0.
1. Similarly, the `point` might be so close to the end of the `range`
   that our crop `width` lines up with the end. Or, in other words,
   the crop width starts at `range - width`.
1. Or finally, we can center the `point` in our crop `width`,
   so it should start at `point - width/2`.
1. Oh, and there's an edge case: if the `width` is greater than or equal to
   the full `range`, then the offset is 0, too.

This logic gives us the following `crop_offset()` function:

```{r crop-offset, echo = TRUE}
crop_offset <- function(point, range, width) {
  # 4. Catch the edge case first
  if (width >= range) return(0)

  if ((point - width / 2) < 0) {
    # 1. must start at left edge
    return(0)
  }
  if ((point + width / 2) > range) {
    # 2. must start at right edge
    return(range - width)
  }
  # 3. enough space on both sides to center width in range
  point - width / 2
}
```

Which in our example case tells us that we could crop our resized profile image
to a 600px square,
offset by the following amount in the `x` direction:

```{r echo = TRUE}
offset <- crop_offset(
  point = 579,
  range = 900,
  width = 600
)
offset
```

We can use `magick::image_crop()` with the `magick::geometry_area()` helper function:

```{r resized-cropped, echo = TRUE, include = FALSE}
image_crop(
  resized_profile,
  geometry_area(
    width = 600,
    height = 600,
    x_off = offset
  )
)
```

::: text-center
```{r out.width="50%"}
#| fig.alt: |
#|   The example profile image, cropped to a square
#|   and centered on the man's face.
knitr::include_graphics(knitr::fig_chunk("resized-cropped", "png"))
```
:::

When this image is used as a profile or avatar picture,
it ends up looking much better than the uncropped and uncentered version!

<div class="p-4 text-center rounded-circle mx-auto shadow-lg" style="background-size: cover; background-image: url(`r knitr::fig_chunk("resized-cropped", "png")`); width: 200px; height: 200px">
<div class="visually-hidden">The example profile image cropped and centered to fit a circular avatar image. The subject appears directly in the middle of the circle.</div>
</div>

## Put it all together

The last step is to put everything we've sketched out above
into a single function that takes a [magick]{.pkg} image
and returns a new cropped and centered version.
And here's that function.

```{r resize_crop_to_face, echo = TRUE}
resize_crop_to_face <- function(image, size = 600) {
  image <- resize_fit(image, size)
  info <- image_info(image)

  # size may have changed after refit
  size <- min(info$height, info$width)

  is_image_square <- info$width == info$height
  if (is_image_square) {
    return(image)
  }

  face <- find_face_center(image)

  image_crop(
    image,
    geometry = geometry_area(
      width = size,
      height = size,
      x_off = crop_offset(face$x, info$width, size),
      y_off = crop_offset(face$y, info$height, size)
    )
  )
}
```

Starting over from the beginning,
we can read all of the profile images
and resize and crop them around the subject's face
in just a few lines

```{r final, echo = TRUE}
profiles <-
  fs::dir_ls("profiles") |>
  map(image_read) |>
  map(resize_crop_to_face)
```

and then we can write them back into the profiles directory.

```{r write-back, echo = TRUE}
fs::dir_create("profiles_cropped")

profiles |>
  iwalk(function(image, path) {
    new_path <- fs::path("profiles_cropped", fs::path_file(path))
    image_write(image, new_path)
  })
```

The end result is four perfect profile pictures!

```{r}
profile_circle_preview <- '
<div class="p-3 text-center rounded-circle m-3 shadow-lg" style="background-size: cover; background-image: url({image}); width: 250px; height: 250px">
<div class="visually-hidden">{alt}</div>
</div>'


profiles_cropped <- list(
  image = sub("profiles/", "profiles_cropped/", names(profiles)),
  alt = c(
    "A young black woman, centered in the image, against a green background.",
    "An older white man on a gray background, centered in the image.",
    "The example profile: a young white male centered in the image.",
    "A young woman against a tan background, centered in the image."
  )
)

profiles_cropped_html <- glue::glue_data(profiles_cropped, profile_circle_preview)
profiles_cropped_html <- htmltools::HTML(profiles_cropped_html)
```

::: {.d-flex .flex-row .flex-wrap}
`r profiles_cropped_html`
:::

[^1]: Images by `r photos |> purrr::map(~ credit_link(.$id, .$credit)) |> purrr::map_chr(format) |> knitr::combine_words()`.