inst/etc/z_legacy_code/python_face_functions_v2.R

In d-bohn/quantIm: Quantitative Assesment of Facial Images

#' Get facial landmarks
#'
#' @param image Path to image
#' @param convert Convert output to be R compatible?
#'
#' @return Dataframe with 68 face points.
#'
#' @importFrom reticulate import source_python
#'
#' @examples
#' img <- system.file("extdata", "obama.png", package = "quantIm")
#' get_landmarks(img)
#'
get_landmarks <- function(image, convert = TRUE) {

  cv <- reticulate::import('cv2', convert = FALSE)

  img <- cv$imread(image)

  py_file <- system.file("python", "get_landmarks.py", package = "quantIm")
  PREDICTOR_PATH = system.file("extdata", "shape_predictor_68_face_landmarks.dat", package = "quantIm")

  if (convert == TRUE){
    reticulate::source_python(py_file)
    x <- get_landmarks(im = img, PREDICTOR_PATH = PREDICTOR_PATH)

    landmarks <- data.frame(image_base = rep(basename(image),68),
                            image_path = rep(image, 68),
                            point = seq(0,67),
                            x = x[,1],
                            y = x[,2])
    return(landmarks)
  }
  if (convert == FALSE){
    reticulate::source_python(py_file, convert = FALSE)
    x <- get_landmarks(im = img, PREDICTOR_PATH = PREDICTOR_PATH)
    return(x)
  }

}

#' Warp (affine transform) an image
#'
#' @param image1 Path to image to warp.
#' @param m Affine matrix.
#' @param convert Convert output to be R compatible?
#'
#' @return Warped image
#'
#' @importFrom reticulate import source_python
#' @importFrom EBImage readImage writeImage
#' @export
#'
#' @examples
#'

warp_image <- function(image, m, width, height, convert = FALSE){
  on.exit(
    unlink(c(temp1, temp2))
  )

  cv <- reticulate::import('cv2', convert = FALSE)

  temp1 <- tempfile(fileext = '.png')
  temp2 <- tempfile(fileext = '.png')

  if (class(image) %in% 'Image'){
    EBImage::writeImage(image, temp1)
    image1 <- temp1
  } else {
    image1 <- image
  }

  py_file <- system.file("python", "warp_image.py", package = "quantIm")

  if (convert == TRUE){
    reticulate::source_python(py_file)
    img <- warp_im(im = image1, M = m, width = width, height = height)
    return(img)
  }
  if (convert == FALSE){
    reticulate::source_python(py_file, convert = FALSE)
    img <- warp_im(im = image1, M = m, width = width, height = height)
    cv$imwrite(temp2, img)
    out_im <- EBImage::readImage(temp2)
    return(out_im)
  }


}

#' Match color between two images
#'
#' @param image1 Reference image
#' @param image2 Image to color correct
#'
#' @return
#'
#' @importFrom reticulate import source_python
#' @importFrom EBImage readImage writeImage
#' @export
#'
#' @examples
#'

color_correction <- function(image1, image2, blur = 0.6){
  on.exit(
    unlink(c(temp1, temp2))
  )

  cv <- reticulate::import('cv2', convert = FALSE)

  temp1 <- tempfile(fileext = '.png')
  temp2 <- tempfile(fileext = '.png')

  if (class(image2) %in% 'Image'){
    EBImage::writeImage(image2, temp1)
    image22 <- temp1
  } else {
    image22 <- image2
  }

  points <- get_landmarks(image22, convert = FALSE)

  py_file <- system.file("python", "color_correct.py", package = "quantIm")
  reticulate::source_python(py_file, convert = FALSE)

  img <- correct_colours(im1 = image1, im2 = image22, landmarks1 = points, blur = blur)

  cv$imwrite(temp2, img)

  out_im <- EBImage::readImage(temp2)

  return(out_im)
}

# NOT WORKING ----

#' Get a face mask
#'
#' @param image
#'
#' @return
#'
#' @importFrom EBImage readImage
#'
#' @examples
#'

get_face_mask <- function(image){
  on.exit(
    unlink(c(temp1, temp2))
  )

  cv <- reticulate::import('cv2', convert = FALSE)

  temp1 <- tempfile(fileext = '.png')
  temp2 <- tempfile(fileext = '.png')

  if (class(image) %in% 'Image'){
    EBImage::writeImage(image, temp1)
    image2 <- temp1
  } else {
    image2 <- image
  }

  lm <- get_landmarks(image2, convert = FALSE)
  im <- cv$imread(image2)

  py_file <- system.file("python", "get_face_mask.py", package = "quantIm")
  reticulate::source_python(py_file, convert = FALSE)

  mask <- get_face_mask(im = im, landmarks = lm)

  cv$imwrite(temp2, mask)

  out_im <- EBImage::readImage(temp2)
  return(out_im)
}

# END NOT WORKING ----