In iholzleitner/facefuns: Convenience Functions Around 2D and 3D Face Shape Analysis

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

WORK IN PROGRESS

This tutorial will explain how to calculate facial (dis)similarity in a set of 2-D faces. We will calculate the Euclidean distance between Procrustes-aligned landmark templates; to calculate it dissimilarity in face space, replace your matrix of landmark coordinates with the matrix of PC scores.

library(facefuns)
library(geomorph)

Read and prepare data

path_to_tem <- system.file("extdata", "tem", package="facefuns")

shapedata <- facefuns(data = read_lmdata(lmdata = path_to_tem,
                                         plot = FALSE),
                      remove_points = "frlgmm",
                      pc_criterion = "broken_stick",
                      plot_sample = FALSE,
                      quiet = TRUE)

Calculate facial similarity

We will use facefuns::calc_ed to calculate similarity. calc_ed requires two arguments:

1. Landmark coordinates (or PC scores) in a matrix format

2. A table specifying for which pairs of faces you would like to calculate similarity

Create landmark matrix

Currently, our landmark templates are stored in a three-dimensional array: a list of n matrices of dimensions p x k

• p The number of landmarks, here 132
• k The number of landmark dimensions, here 2
• n The number of faces, here 102

str(shapedata$aligned)

We will use facefuns::convert_array_to_matrix to convert our array into a matrix with n rows and p x k columns.

data_matrix <- convert_array_to_matrix(shapedata$aligned)
str(data_matrix)

Create list of faces

Most times, you will already have a list of face pairs for which you want to calculate similarity.

For this example, we will calculate the similarity between all possible combinations of face pairs in our data set.

We start by assigning all face IDs in our sample to a variable ...

face_names <- dimnames(shapedata$aligned)[[3]]

... and then create a list of all possible combinations

pairs <- expand.grid(A = face_names,
                     B = face_names)

calc_ed

We now have everything we need to run our function

sim_table <- calc_ed(coords_matrix = data_matrix,
                     pairs_table = pairs)

head(sim_table)

Let's display our data in a wide format and round the values. It is a rather big table, so we will only print a small subset

sim_table %>%
  dplyr::mutate(EuclideanDistance = round(EuclideanDistance, 2)) %>%
  tidyr::spread(B, EuclideanDistance) %>%
  dplyr::select(1:10) %>%
  dplyr::slice(1:9)

Averageness

Averageness can be quantified as distinctiveness from the sample average. For each face, we will calculate the Euclidean distance to the sample average, and then reverse scores, so higher scores mean "more average".

You could use calc_ed, but this will require a wee bit of data wrangling: you will need to attach the average template to the array holding the aligned templates, then convert this new array to a matrix and finally reverse the distinctiveness scores. calc_avg does all of that! It only takes one argument - a facefuns object:

avg <- calc_avg(shapedata)

head(avg)

iholzleitner/facefuns documentation built on March 19, 2021, 2:43 p.m.