案例 | 通过R对照片进行情绪分析

      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

提示：点击“阅读原文”查看作者原文！