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

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

PROCEED WITH CAUTION... WORK IN PROGRESS

library(facefuns)
library(ggplot2)

Load and prep 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 asymmetry

Needs tidying up. For now we have:

• calc_as: calculates asymmetry as the Procrustes distance between each original template and its symmetrized counterpart[@komori2009]; does not correct for directional asymmetry (DA)

• calc_fa: calculates fluctuating asymmetry (FA) by correcting asymmetry as calculated above for DA following Klingenberg (2015)[@klingenberg2015]; DA is calculated as the average of original templates minus the average of mirrored templates

• calc_fageo: calculates FA, here using geomorph::bilat.symmetry. I am not entirely sure what bilat.symmetry is doing under the hood and hence whether I'm implementing this correctly. Resulting scores are strongly correlated with the other two, but of course that doesn't mean much

as <- calc_as(shapedata, mirroredlandmarks)
fa <- calc_fa(shapedata, mirroredlandmarks)
fa.geo <- calc_fageo(shapedata, mirroredlandmarks)

compare <- fa %>%
  dplyr::left_join(fa.geo, by="id") %>%
  dplyr::left_join(as, by="id") %>%
  # one picture is very asymmetric (face turned sideways) and was
  # excluded, so as to not inflate correlations between different scores
  dplyr::filter(id != "139") %>%
  dplyr::mutate(fa.geo = fa.geo/2)

as <- compare %>%
  tidyr::pivot_longer(!c(id, asym),
                      names_to = "other_fa_types",
                      values_to = "score") %>%
  ggplot(aes(x = asym, y = score, colour = other_fa_types)) +
  geom_point()

fa <- compare %>%
  tidyr::pivot_longer(!c(id, fa),
                      names_to = "other_fa_types",
                      values_to = "score") %>%
  ggplot(aes(x = fa, y = score, colour = other_fa_types)) +
  geom_point()

cowplot::plot_grid(as, fa, ncol = 2)

References

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