使用R语言对照片人物进行情绪分析

人脸提供关于情绪的各种信息。 微软于2015年12月推出免费服务，分析人脸，进行情绪检测。 检测到的情绪是愤怒，蔑视，厌恶，恐惧，幸福，中立，悲伤和惊喜。 这些情绪被理解为与特定的面部表情跨文化和普遍传达。

Emotion API将图像中的面部表情作为输入，并使用Face API返回图像中每个面部的一组情绪的置信度以及面部的边界框。

在R中的实现允许以结构化的方式分析人脸。 注意，必须创建一个帐户来使用Face API。

该示例引用了一个简单的示例：使用的是现任美国总统奥巴马的照片；如下'

需要加载的包有: httr, XML, stringr, ggplot2.

# 加载相关包

library("httr")#链接API

library("XML")#爬取网页数据

library("stringr")#字符串处理

library("ggplot2")#绘图使用

 

# Define image source

img.url     = 'https://www.whitehouse.gov/sites/whitehouse.gov/files/images/first-family/44_barack_obama[1].jpg'

 

# Define Microsoft API URL to request data

URL.emoface = 'https://api.projectoxford.ai/emotion/v1.0/recognize'

 

# Define access key (access key is available via: https://www.microsoft.com/cognitive-services/en-us/emotion-api)

emotionKEY = 'XXXX' # 在此处输入你获取的key

 

# Define image

mybody = list(url = img.url)

 

# Request data from Microsoft

faceEMO = POST(

  url = URL.emoface,

  content_type('application/json'), add_headers(.headers = c('Ocp-Apim-Subscription-Key' = emotionKEY)),

  body = mybody,

  encode = 'json'

)

 

# Show request results (if Status=200, request is okay)

faceEMO

 

# Reuqest results from face analysis

Obama = httr::content(faceEMO)[[1]]

Obama

# Define results in data frame

o<-as.data.frame(as.matrix(Obama$scores))

 

# Make some transformation

o$V1 <- lapply(strsplit(as.character(o$V1 ), "e"), "[", 1)

o$V1<-as.numeric(o$V1)

colnames(o)[1] <- "Level"

 

# Define names

o$Emotion<- rownames(o)

 

# Make plot

ggplot(data=o, aes(x=Emotion, y=Level)) +

  geom_bar(stat="identity")

下面就是对这张照片的情感分析图。

（不过这结果看起来好像不太准确）

#人脸检测

#####################################################################

# Define image source

img.url = 'https://www.whitehouse.gov/sites/whitehouse.gov/files/images/first-family/44_barack_obama[1].jpg'

 

# Define Microsoft API URL to request data

faceURL = "https://api.projectoxford.ai/face/v1.0/detect?returnFaceId=true&returnFaceLandmarks=true&returnFaceAttributes=age"

 

# Define access key (access key is available via: https://www.microsoft.com/cognitive-services/en-us/face-api)

faceKEY = 'a868182e859c4458953f69dab084f5e8'

 

# Define image

mybody = list(url = img.url)

 

# Request data from Microsoft

faceResponse = POST(

  url = faceURL, 

  content_type('application/json'), add_headers(.headers = c('Ocp-Apim-Subscription-Key' = faceKEY)),

  body = mybody,

  encode = 'json'

)

 

# Show request results (if Status=200, request is okay)

faceResponse

 

# Reuqest results from face analysis

ObamaR = httr::content(faceResponse)[[1]]

 

# Define results in data frame

OR<-as.data.frame(as.matrix(ObamaR$faceLandmarks))

 

# Make some transformation to data frame

OR$V2 <- lapply(strsplit(as.character(OR$V1), "\\="), "[", 2)

OR$V2 <- lapply(strsplit(as.character(OR$V2), "\\,"), "[", 1)

colnames(OR)[2] <- "X"

OR$X<-as.numeric(OR$X)

 

OR$V3 <- lapply(strsplit(as.character(OR$V1), "\\y = "), "[", 2)

OR$V3 <- lapply(strsplit(as.character(OR$V3), "\\)"), "[", 1)

colnames(OR)[3] <- "Y"

OR$Y<-as.numeric(OR$Y)

 

OR$V1<-NULL

OR

结果如下：

 是他脸部的特征值：

                        X     Y

pupilLeft           475.4 158.6

pupilRight          590.6 157.3

noseTip             534.4 227.7

mouthLeft           460.8 273.7

mouthRight          603.6 268.2

eyebrowLeftOuter    425.2 154.8

eyebrowLeftInner    508.4 142.3

eyeLeftOuter        458.6 162.6

eyeLeftTop          473.6 153.8

eyeLeftBottom       475.9 164.9

eyeLeftInner        492.8 162.0

eyebrowRightInner   552.3 141.4

eyebrowRightOuter   636.0 156.2

eyeRightInner       571.7 159.9

eyeRightTop         588.1 152.5

eyeRightBottom      587.4 163.9

eyeRightOuter       605.5 161.5

noseRootLeft        511.2 163.4

noseRootRight       551.2 163.0

noseLeftAlarTop     503.1 204.6

noseRightAlarTop    559.2 201.6

noseLeftAlarOutTip  485.3 226.9

noseRightAlarOutTip 580.5 224.1

upperLipTop         530.9 264.3

upperLipBottom      532.1 272.5

underLipTop         530.3 305.1

underLipBottom      532.5 318.6

说明：本人对原博客进行翻译的时候，在某些地方进行了一定修改，与原文并不完全相同。