Align X and Y coordinates of face landmarks in R

Question

here is a reprex example (sorry it's a bit long but needed to demonstrate the issue )

reprex<- structure(list(lanmark_id = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 
11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 
27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 
43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 
59, 60, 61, 62, 63, 64, 65, 66, 67), x_new_norm = c(0.0209747069710061, 
0, 0, 0.0203578038247992, 0.0561381863047496, 0.101172115977792, 
0.156076495990129, 0.215299198025911, 0.318322023442319, 0.452190006169031, 
0.594694632942629, 0.735348550277607, 0.850709438618138, 0.924737816162864, 
0.958050586057989, 0.983960518198643, 1, 0.0154225786551511, 
0.0758790869833434, 0.141887723627391, 0.199876619370759, 0.253547193090684, 
0.470080197409007, 0.56323257248612, 0.652683528685996, 0.735965453423813, 
0.809376927822333, 0.338062924120913, 0.308451573103023, 0.278840222085133, 
0.248611967921036, 0.181986428130784, 0.227637260950032, 0.279457125231339, 
0.352251696483652, 0.424429364589759, 0.0703269586674898, 0.119062307217767, 
0.183220234423196, 0.23874151758174, 0.173349784083898, 0.112276372609501, 
0.529919802590994, 0.603331276989513, 0.674892041949415, 0.7347316471314, 
0.671807526218385, 0.6020974706971, 0.125231338679827, 0.163479333744602, 
0.233189389265885, 0.296113510178902, 0.380012338062924, 0.518815545959284, 
0.664404688463912, 0.526218383713757, 0.380012338062924, 0.288093769278224, 
0.217149907464528, 0.156076495990129, 0.154225786551512, 0.233806292412092, 
0.298581122763727, 0.382479950647749, 0.624305983960519, 0.385564466378779, 
0.298581122763727, 0.231955582973473), y_new_norm = c(0.191854233654877, 
0.30064308681672, 0.414255091103966, 0.531082529474812, 0.64898177920686, 
0.762057877813505, 0.866023579849946, 0.959271168274384, 0.997856377277599, 
1, 0.961414790996785, 0.908896034297964, 0.829046087888532, 0.719721329046088, 
0.585209003215434, 0.448017148981779, 0.313504823151125, 0.0337620578778134, 
0, 0.00482315112540196, 0.0209003215434084, 0.0535905680600213, 
0.0669882100750266, 0.0375133976420149, 0.0359056806002145, 0.0514469453376206, 
0.0980707395498391, 0.168810289389067, 0.251339764201501, 0.333333333333333, 
0.418542336548767, 0.460878885316184, 0.486066452304395, 0.508038585209003, 
0.491425509110397, 0.478563772775991, 0.170418006430868, 0.140943193997856, 
0.14898177920686, 0.190782422293676, 0.194533762057878, 0.188102893890675, 
0.213826366559486, 0.179528403001072, 0.183279742765273, 0.217577706323687, 
0.227224008574491, 0.22454448017149, 0.581993569131833, 0.556270096463022, 
0.553590568060021, 0.568595927116827, 0.561629153269025, 0.580385852090032, 
0.619506966773848, 0.709003215434084, 0.746516613076099, 0.7491961414791, 
0.737942122186495, 0.690246516613076, 0.595391211146838, 0.596998928188639, 
0.607181136120043, 0.603429796355841, 0.62593783494105, 0.686495176848875, 
0.688638799571275, 0.676312968917471)), row.names = c(NA, -68L
), class = c("tbl_df", "tbl", "data.frame"))

x_new_norm and y_new_norm are cordinates for points that represent a human face, here is what it looks when plotted

What I want to achieve is that the coordinates are aligned such that the points for eyes (based on points 39 and 42) are always at the same y coordinate, and points 27 and 8 would be in the same x coordinate. This would ensure that I can align multiple faces (taken during movement, or different people and poses).

While I have some intuition on how this can be achieved I cannot work out how to implement it in R

Answer 1

You could do it by following these steps:

First, isolate the points of interest (the subject's left and right eyes)

left_eye  <- reprex[reprex$lanmark_id == 42,]
right_eye <- reprex[reprex$lanmark_id == 39,] 

Now find the difference in the y co-ordinates and x co-ordinates between these two points:

diff_x <- left_eye$x_new_norm - right_eye$x_new_norm
diff_y <- left_eye$y_new_norm - right_eye$y_new_norm

The arctangent of the ratio will be the angle you need to rotate all the points by:

theta  <- atan2(-diff_y, diff_x)

To transform the points, you need to create a rotation matrix, which is a specific two-by-two matrix which you can use to rotate the original points:

mat <- matrix(c(cos(theta), sin(theta), -sin(theta), cos(theta)), 2)

Now we multiply each x, y point by this matrix to get our rotated points, and write it back into our original data frame:

reprex[,2:3] <- t(apply(reprex[,2:3], 1, function(x) mat %*% x))

Our eyes are now at the same level, as we can demonstrate by plotting:

p <- ggplot(reprex, aes(x_new_norm, y_new_norm, label = lanmark_id)) + 
  geom_point(color = 'gray') +
  geom_text() +
  scale_y_reverse() +
  theme_bw()

p

p + geom_hline(yintercept = reprex$y_new_norm[reprex$lanmark_id == 42],
               linetype = 2, color = 'red4', alpha = 0.5)