Análisis de sentimiento facial en R

El pasado fin de semana terminé de leer el artículo “How to apply face recognition API technology to data journalism with R and python“, y se despertó en mí cierta curiosidad sobre el análisis de sentimiento facial (en su faceta aplicada más que teórica, todo sea dicho). Así pues, ¿por qué no intentar replicar alguna de sus partes utilizando también las APIs que Microsoft pone a nuestra disposición?

Trabajar con vídeo, tal y como hacen en el mencionado artículo, me pareció un poco pretencioso para una primera aproximación. Por lo tanto, con la ayuda del artículo “Analyzing ‘Twitter faces’ in R with Microsoft Project Oxford“, me planteé llevar a cabo un análisis de sentimiento facial, utilizando R como lenguaje de programación, a partir de unas cuantas fotos extraídas de la red (que, según Google, están libres de derechos de autor).

Para empezar, necesitamos disponer de una cuenta en Microsoft, para poder tener acceso a las claves de las dos APIs que vamos a utilizar: Face y Emotion (usaremos este enlace). Aunque existen planes de pago para ambas, la opción gratuita nos bastará para experimentar y hacernos una idea del potencial de estas herramientas. De hecho, de las treinta mil peticiones que podría realizar este mes, en el rato que he estado lidiando con ella apenas he usado un centenar.

En cuanto a R, únicamente emplearemos la librería httr, que posee una función que nos va a facilitar enormemente la realización de peticiones a las APIs. De esta forma, el inicio del script podría ser el siguiente:

# Librerías
library(httr) # Para realizar las peticiones a la API.

# Claves para las APIs (https://www.microsoft.com/cognitive-services/en-us/apis)
# - Face
# - Emotion
face.key <- "XXX" # Pon aquí tu clave para la API Face
emot.key <- "XXX" # Pon aquí tu clave para la API Emotion

Al pedir la clave de acceso en cada una de las APIs, tendremos disponibles dos (Key 1 y Key 2). En ambos casos, he copiado y pegado la primera de ellas en mi código, funcionando luego todo correctamente (confieso que desconozco la función que desempeña la segunda).

Ahora bien, como el objetivo es lanzar el mismo análisis de sentimiento facial sobre unas cuantas imágenes, en lugar de tener que reescribir una y otra vez las mismas instrucciones, vamos a implementar una función general que recoja el proceso. Después ya simplemente procederemos a utilizarla cuantas veces queramos sobre las imágenes que nos interesen.

El código de la función es bastante sencillo de seguir y entender, a excepción quizá del uso de la función POST(), en el que únicamente hemos seguido las instrucciones de la documentación de las APIs; y su salida, en la que en lugar de devolver directamente los resultados de interés, los hemos formateado levemente.

# Función para automatizar el proceso
face.analysis <- function(img.url, face.key, emot.key) {

    my.body <- list(url = img.url)

    face.api.url <- "https://api.projectoxford.ai/face/v1.0/detect?returnFaceId=true&returnFaceLandmarks=true&returnFaceAttributes=age,gender,headPose,smile,facialHair,glasses"
    emot.api.url <- "https://api.projectoxford.ai/emotion/v1.0/recognize"

    face.response <- POST(
        url = face.api.url,
        content_type('application/json'),
        add_headers(.headers = c('Ocp-Apim-Subscription-Key' = face.key)),
        body = my.body,
        encode = 'json'
    )

    emot.response <- POST(
        url = emot.api.url,
        content_type('application/json'),
        add_headers(.headers = c('Ocp-Apim-Subscription-Key' = emot.key)),
        body = my.body,
        encode = 'json'
    )

    face <- content(face.response)[[1]]
    emot <- content(emot.response)[[1]]

    return(list(atributos = t(as.data.frame(face$faceAttributes)),
                emociones = t(round(as.data.frame(emot$scores), 3))))
}

Dado todo el revuelo que está levantando el último debate de investidura, lo primero que me ha venido a la cabeza para probar la función es, precisamente, utilizar fotos de políticos. Veamos qué obtenemos con la siguiente imagen de Pablo Iglesias:

pablo_iglesias_ahora_madrid_2015_-_05_cropped

# Pablo Iglesias
img.url <- "https://upload.wikimedia.org/wikipedia/commons/b/b0/Pablo_Iglesias_Ahora_Madrid_2015_-_05_(cropped).jpg"

pablo.iglesias <- face.analysis(img.url, face.key, emot.key)

pablo.iglesias$atributos

#                      [,1]
# smile                "0.004"
# headPose.pitch       "0"
# headPose.roll        "2.9"
# headPose.yaw         "17.9"
# gender               "male"
# age                  "39.8"
# facialHair.moustache "0.5"
# facialHair.beard     "0.6"
# facialHair.sideburns "0.2"
# glasses              "NoGlasses"

pablo.iglesias$emociones

#           [,1]
# anger     0.000
# contempt  0.000
# disgust   0.000
# fear      0.000
# happiness 0.994
# neutral   0.006
# sadness   0.000
# surprise  0.000

Por lo que respecta a las emociones, el algoritmo lo tiene bastante claro: Pablo Iglesias es una persona feliz en la foto que hemos escogido. Las puntuaciones asociadas al resto de emociones disponibles en esta API son prácticamente nulas.

En cuanto a los atributos, el algoritmo correctamente identifica al secretario general de Podemos como un hombre, al que le estima una edad que asciende a 39.8 años. Teniendo en cuenta que acaba de cumplir, en realidad, 38 años, el resultado no es en absoluto malo. Por otro lado, detecta correctamente que no utiliza gafas, así como ofrece una orientación acerca del vello facial (y su proporción entre bigote, barba y patillas).

¿Os imagináis un sistema de recomendación que, a partir de características similares, nada más entrar a una tienda, te ofreciese vía móvil ciertos productos enfocados exclusivamente a ti? Recordemos que aunque aquí estemos experimentando con imágenes estáticas, en verdad podríamos implementar un sistema similar utilizando vídeo.

Veamos ahora qué resultados obtenemos al estudiar la siguiente foto de Albert Rivera:

albert_rivera_abril_2016

# Albert Rivera
img.url <- "https://upload.wikimedia.org/wikipedia/commons/3/35/Albert_Rivera_Abril_2016.jpg"

albert.rivera <- face.analysis(img.url, face.key, emot.key)

albert.rivera$atributos

#                      [,1]
# smile                "0.117"
# headPose.pitch       "0"
# headPose.roll        "1.8"
# headPose.yaw         "1.9"
# gender               "male"
# age                  "27.1"
# facialHair.moustache "0"
# facialHair.beard     "0"
# facialHair.sideburns "0"
# glasses              "NoGlasses"

albert.rivera$emociones

#           [,1]
# anger     0.000
# contempt  0.001
# disgust   0.000
# fear      0.000
# happiness 0.323
# neutral   0.675
# sadness   0.000
# surprise  0.000

Espero que en la próxima entrevista al presidente de Ciudadanos alguien le pregunte su secreto para conservarse, según este algoritmo, como un “chaval” de 27 años, cuando, en realidad, tiene a sus espaldas una década más. Por lo demás, acierta completamente sobre el uso de gafas y la total ausencia de vello facial. En cuanto a las emociones se refiere, el algoritmo apuesta por un estado neutral, aunque la opción de la felicidad alcanza una puntuación a tener en consideración.

Siguiendo con las posibilidades de esta tecnología, y dado que la mayoría de nosotros no estamos demasiado entrenados en el control de emociones, se podría estudiar nuestra reacción a ciertos estímulos comparando automáticamente capturas “antes y después”. ¿Se acabó entonces la posibilidad de mentir en cuestionarios de opinión?

Llega el turno ahora de Mariano Rajoy (al PSOE lo dejaremos tranquilo de momento, que con todo lo que arrastra últimamente, no tenía claro a quién colocar como representante):

mariano_rajoy_2015_cropped

# Mariano Rajoy
img.url <- "https://upload.wikimedia.org/wikipedia/commons/e/eb/Mariano_Rajoy_2015_(cropped).jpg"

mariano.rajoy <- face.analysis(img.url, face.key, emot.key)

mariano.rajoy$atributos

#                      [,1]
# smile                "0.004"
# headPose.pitch       "0"
# headPose.roll        "-2.5"
# headPose.yaw         "-28"
# gender               "male"
# age                  "60.7"
# facialHair.moustache "0.6"
# facialHair.beard     "0.3"
# facialHair.sideburns "0.4"
# glasses              "ReadingGlasses"

mariano.rajoy$emociones

#           [,1]
# anger     0.070
# contempt  0.018
# disgust   0.020
# fear      0.001
# happiness 0.002
# neutral   0.846
# sadness   0.039
# surprise  0.004

Para el presidente del Partido Popular, la estimación de edad vuelve a arrojar un resultado certero, ya que en realidad tiene algo más de 61 años. La detección del vello facial y la presencia de gafas (incluso es capaz de decirnos de qué tipo son) vuelve a ser muy buena. En cuanto a las emociones respecta, el algoritmo clasifica la imagen como caracterizada por un estado neutral.

En resumen, es una tecnología interesante, que todavía acepta margen de mejora, pero con tantas posibilidades como creativos seamos imaginando aplicaciones. Además, si el algoritmo escala adecuadamente, de manera que podamos estar en condiciones de crear sistemas capaces de realizar en tiempo real análisis de sentimiento facial, ¿no sería una herramienta maravillosa? ¿O acaso estaríamos cruzando ciertas barreras éticas con el uso de este tipo de prácticas?

Para finalizar el texto, añado tres ejemplos, correspondientes a imágenes que he seleccionado al azar al buscar “funny faces” entre las que estaban libres de derechos de autor. Queda como ejercicio examinar los resultados y comprobar el grado de precisión del algoritmo en cada caso.

1-12431680347qay

# Funny faces
img.url <- "http://www.publicdomainpictures.net/pictures/10000/velka/1-12431680347QAy.jpg"

ff.1 <- face.analysis(img.url, face.key, emot.key)

ff.1$atributos

#                      [,1]
# smile                "0.003"
# headPose.pitch       "0"
# headPose.roll        "-18.6"
# headPose.yaw         "-2.7"
# gender               "male"
# age                  "24.9"
# facialHair.moustache "0.2"
# facialHair.beard     "0.3"
# facialHair.sideburns "0.3"
# glasses              "NoGlasses"

ff.1$emociones

#           [,1]
# anger     0.013
# contempt  0.004
# disgust   0.001
# fear      0.004
# happiness 0.023
# neutral   0.902
# sadness   0.023
# surprise  0.029

6601077523_3db80a6fcc_b

img.url <- "https://c2.staticflickr.com/8/7156/6601077523_3db80a6fcc_b.jpg"

ff.2 <- face.analysis(img.url, face.key, emot.key)

ff.2$atributos

#                      [,1]
# smile                "0.55"
# headPose.pitch       "0"
# headPose.roll        "-5.5"
# headPose.yaw         "-1.2"
# gender               "female"
# age                  "6"
# facialHair.moustache "0"
# facialHair.beard     "0"
# facialHair.sideburns "0"
# glasses              "NoGlasses"

ff.2$emociones

#           [,1]
# anger     0.004
# contempt  0.005
# disgust   0.002
# fear      0.054
# happiness 0.566
# neutral   0.073
# sadness   0.006
# surprise  0.288

person-1111703_960_720

img.url <- "https://pixabay.com/static/uploads/photo/2015/12/28/17/41/person-1111703_960_720.jpg"

ff.3 <- face.analysis(img.url, face.key, emot.key)

ff.3$atributos

#                      [,1]
# smile                "0.765"
# headPose.pitch       "0"
# headPose.roll        "5"
# headPose.yaw         "-8.3"
# gender               "male"
# age                  "59.2"
# facialHair.moustache "0.2"
# facialHair.beard     "0"
# facialHair.sideburns "0.1"
# glasses              "NoGlasses"

ff.3$emociones

#           [,1]
# anger     0.000
# contempt  0.000
# disgust   0.001
# fear      0.009
# happiness 0.452
# neutral   0.000
# sadness   0.000
# surprise  0.538

Fuentes:

Anuncios

Responder

Introduce tus datos o haz clic en un icono para iniciar sesión:

Logo de WordPress.com

Estás comentando usando tu cuenta de WordPress.com. Cerrar sesión / Cambiar )

Imagen de Twitter

Estás comentando usando tu cuenta de Twitter. Cerrar sesión / Cambiar )

Foto de Facebook

Estás comentando usando tu cuenta de Facebook. Cerrar sesión / Cambiar )

Google+ photo

Estás comentando usando tu cuenta de Google+. Cerrar sesión / Cambiar )

Conectando a %s