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

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

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

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

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



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

[plain] view
plain copy

# 加载相关包  

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")  

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



[plain] view
plain copy

#人脸检测  

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

# 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  

结果如下：

 是他脸部的特征值：

[plain] view
plain copy

                        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  

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