使用R語言對照片人物進行情緒分析

01-29

人臉提供關於情緒的各種信息。微軟於2015年12月推出免費服務，分析人臉，進行情緒檢測。檢測到的情緒是憤怒，蔑視，厭惡，恐懼，幸福，中立，悲傷和驚喜。這些情緒被理解為與特定的面部表情跨文化和普遍傳達。

Emotion API將圖像中的面部表情作為輸入，並使用Face API返回圖像中每個面部的一組情緒的置信度以及面部的邊界框。

在R中的實現允許以結構化的方式分析人臉。注意，必須創建一個帳戶來使用Face API。

該示例引用了一個簡單的示例：使用的是現任美國總統奧巴馬的照片；如下

需要載入的包有: httr, XML, stringr, ggplot2.

# 載入相關包nlibrary("httr")#鏈接APInlibrary("XML")#爬取網頁數據nlibrary("stringr")#字元串處理nlibrary("ggplot2")#繪圖使用nn# Define image sourcenimg.url = https://www.whitehouse.gov/sites/whitehouse.gov/files/images/first-family/44_barack_obama[1].jpgnn# Define Microsoft API URL to request datanURL.emoface = https://api.projectoxford.ai/emotion/v1.0/recognizenn# Define access key (access key is available via: https://www.microsoft.com/cognitive-services/en-us/emotion-api)nemotionKEY = XXXX # 在此處輸入你獲取的keynn# Define imagenmybody = list(url = img.url)nn# Request data from MicrosoftnfaceEMO = POST(n url = URL.emoface,n content_type(application/json), add_headers(.headers = c(Ocp-Apim-Subscription-Key = emotionKEY)),n body = mybody,n encode = jsonn)nn# Show request results (if Status=200, request is okay)nfaceEMOnn# Reuqest results from face analysisnObama = httr::content(faceEMO)[[1]]nObaman# Define results in data frameno<-as.data.frame(as.matrix(Obama$scores))nn# Make some transformationno$V1 <- lapply(strsplit(as.character(o$V1 ), "e"), "[", 1)no$V1<-as.numeric(o$V1)ncolnames(o)[1] <- "Level"nn# Define namesno$Emotion<- rownames(o)nn# Make plotnggplot(data=o, aes(x=Emotion, y=Level)) +n geom_bar(stat="identity")n

下面就是對這張照片的情感分析圖。

（不過這結果看起來好像不太準確）

#人臉檢測n#####################################################################n# Define image sourcenimg.url = https://www.whitehouse.gov/sites/whitehouse.gov/files/images/first-family/44_barack_obama[1].jpgnn# Define Microsoft API URL to request datanfaceURL = "https://api.projectoxford.ai/face/v1.0/detect?returnFaceId=true&returnFaceLandmarks=true&returnFaceAttributes=age"nn# Define access key (access key is available via: https://www.microsoft.com/cognitive-services/en-us/face-api)nfaceKEY = a868182e859c4458953f69dab084f5e8nn# Define imagenmybody = list(url = img.url)nn# Request data from MicrosoftnfaceResponse = POST(n url = faceURL, n content_type(application/json), add_headers(.headers = c(Ocp-Apim-Subscription-Key = faceKEY)),n body = mybody,n encode = jsonn)nn# Show request results (if Status=200, request is okay)nfaceResponsenn# Reuqest results from face analysisnObamaR = httr::content(faceResponse)[[1]]nn# Define results in data framenOR<-as.data.frame(as.matrix(ObamaR$faceLandmarks))nn# Make some transformation to data framenOR$V2 <- lapply(strsplit(as.character(OR$V1), "="), "[", 2)nOR$V2 <- lapply(strsplit(as.character(OR$V2), ","), "[", 1)ncolnames(OR)[2] <- "X"nOR$X<-as.numeric(OR$X)nnOR$V3 <- lapply(strsplit(as.character(OR$V1), "y = "), "[", 2)nOR$V3 <- lapply(strsplit(as.character(OR$V3), ")"), "[", 1)ncolnames(OR)[3] <- "Y"nOR$Y<-as.numeric(OR$Y)nnOR$V1<-NULLnORn

結果如下：

是他臉部的特徵值：

X YnpupilLeft 475.4 158.6npupilRight 590.6 157.3nnoseTip 534.4 227.7nmouthLeft 460.8 273.7nmouthRight 603.6 268.2neyebrowLeftOuter 425.2 154.8neyebrowLeftInner 508.4 142.3neyeLeftOuter 458.6 162.6neyeLeftTop 473.6 153.8neyeLeftBottom 475.9 164.9neyeLeftInner 492.8 162.0neyebrowRightInner 552.3 141.4neyebrowRightOuter 636.0 156.2neyeRightInner 571.7 159.9neyeRightTop 588.1 152.5neyeRightBottom 587.4 163.9neyeRightOuter 605.5 161.5nnoseRootLeft 511.2 163.4nnoseRootRight 551.2 163.0nnoseLeftAlarTop 503.1 204.6nnoseRightAlarTop 559.2 201.6nnoseLeftAlarOutTip 485.3 226.9nnoseRightAlarOutTip 580.5 224.1nupperLipTop 530.9 264.3nupperLipBottom 532.1 272.5nunderLipTop 530.3 305.1nunderLipBottom 532.5 318.6n

說明：本人對原博客進行翻譯的時候，在某些地方進行了一定修改，與原文並不完全相同。

作者：王亨

出處：王亨的博客專欄

公眾號：跟著菜鳥一起學R語言

大家也可以加小編微信：tswenqu，進R語言中文社區交流群，可以跟各位老師互相交流。