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

来源:互联网 发布:moto 正在检查网络 编辑:程序博客网 时间:2024/04/28 11:19

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

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

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

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



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

# 加载相关包library("httr")#链接APIlibrary("XML")#爬取网页数据library("stringr")#字符串处理library("ggplot2")#绘图使用 # Define image sourceimg.url     = 'https://www.whitehouse.gov/sites/whitehouse.gov/files/images/first-family/44_barack_obama[1].jpg' # Define Microsoft API URL to request dataURL.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 imagemybody = list(url = img.url) # Request data from MicrosoftfaceEMO = 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 analysisObama = httr::content(faceEMO)[[1]]Obama# Define results in data frameo<-as.data.frame(as.matrix(Obama$scores)) # Make some transformationo$V1 <- lapply(strsplit(as.character(o$V1 ), "e"), "[", 1)o$V1<-as.numeric(o$V1)colnames(o)[1] <- "Level" # Define nameso$Emotion<- rownames(o) # Make plotggplot(data=o, aes(x=Emotion, y=Level)) +  geom_bar(stat="identity")
下面就是对这张照片的情感分析图。



#人脸检测###################################################################### Define image sourceimg.url = 'https://www.whitehouse.gov/sites/whitehouse.gov/files/images/first-family/44_barack_obama[1].jpg' # Define Microsoft API URL to request datafaceURL = "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 imagemybody = list(url = img.url) # Request data from MicrosoftfaceResponse = 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 analysisObamaR = httr::content(faceResponse)[[1]] # Define results in data frameOR<-as.data.frame(as.matrix(ObamaR$faceLandmarks)) # Make some transformation to data frameOR$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<-NULLOR
结果如下:

 是他脸部的特征值:

                        X     YpupilLeft           475.4 158.6pupilRight          590.6 157.3noseTip             534.4 227.7mouthLeft           460.8 273.7mouthRight          603.6 268.2eyebrowLeftOuter    425.2 154.8eyebrowLeftInner    508.4 142.3eyeLeftOuter        458.6 162.6eyeLeftTop          473.6 153.8eyeLeftBottom       475.9 164.9eyeLeftInner        492.8 162.0eyebrowRightInner   552.3 141.4eyebrowRightOuter   636.0 156.2eyeRightInner       571.7 159.9eyeRightTop         588.1 152.5eyeRightBottom      587.4 163.9eyeRightOuter       605.5 161.5noseRootLeft        511.2 163.4noseRootRight       551.2 163.0noseLeftAlarTop     503.1 204.6noseRightAlarTop    559.2 201.6noseLeftAlarOutTip  485.3 226.9noseRightAlarOutTip 580.5 224.1upperLipTop         530.9 264.3upperLipBottom      532.1 272.5underLipTop         530.3 305.1underLipBottom      532.5 318.6

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

注转载请注明原文链接:http://blog.csdn.net/wzgl__wh/article/details/52904069

原文链接:点击打开链接

1 0