Rで表情解析

 Rで表情解析をします。

Microsoft の Emotion API をRから動かす形になります。

azure.microsoft.com

Emotion API は画像の中の人物の表情を入力として取り、Face API を使って画像の中の顔それぞれについて一連の感情の信頼度と、顔の境界ボックスを返します。ユーザーがすでに Face API を呼び出している場合は、オプション入力として顔矩形を指定することができます。
検出される感情は、怒り、軽蔑、嫌悪感、恐怖、喜び、中立、悲しみ、驚きです。これらの感情は、文化が異なっても特定の表情を伴って広く交わされると理解されています。

ということで、画像から人物の顔を抽出して、その表情を8つの指標で評価してくれます。
対応している画像は、4MB未満のJPEGPNG、GIF、BMPとのこと。
Emotion API を利用するにはAPIキーが必要になるので、前掲のページから取得しておいてください。

ではやってみましょう。

# 必要なライブラリを読み込む
library(tidyverse)
library(httr)
library(EBImage)
library(grid)

# Microsoft's Azure Emotion API を使う準備
API_url <- "https://westus.api.cognitive.microsoft.com/emotion/v1.0/recognize"
KEY <- "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" #ここに各自のAPIキーを入力

最初のモデルはモナ・リザさん。
モナ・リザ - Wikipedia

f:id:bob3:20171217124134j:plain

res <- POST(url = API_url,
            add_headers(.headers = c("Ocp-Apim-Subscription-Key" = KEY)),
            body = '{"url":"https://upload.wikimedia.org/wikipedia/commons/thumb/6/6a/Mona_Lisa.jpg/317px-Mona_Lisa.jpg"}', #ここに画像のURL
            query = list(returnFaceAttributes = "emotion"),
            accept_json())
raw <- res %>%
       content()

ここで抽出されるのは検出された顔の領域と八つの表情の指標です。
これをもとにまずは顔を抜き出します。

# 顔の領域抽出と切り出し
faceRect <- raw %>%
            pluck(1, "faceRectangle")
Left      <- faceRect$left
LeftWidth <- faceRect$left + faceRect$width
Top       <- faceRect$top
TopHeight <- faceRect$top + faceRect$height

pic <- readImage("https://upload.wikimedia.org/wikipedia/commons/thumb/6/6a/Mona_Lisa.jpg/317px-Mona_Lisa.jpg") #ここも画像のURL
pic_face <- pic[Left:LeftWidth, Top:TopHeight,]
plot(pic_face)

抜き出された顔がこちら。
f:id:bob3:20171217125109j:plain:medium
顔ですね。

では、モナ・リザさんのご機嫌は?

# 感情指標抽出
scores <- raw %>%
          pluck(1, "scores") %>%   
          as.tibble() %>%
          t() %>%
          round(4)
scores <- tibble(emotion=c("怒り","侮蔑","嫌悪","恐れ","幸せ","普通","悲しみ","驚き"),
                 scores=scores[,1])

# 感情のチャート化
g <- ggplot(scores, aes(x=emotion, y=scores, fill=emotion)) +
     geom_bar(stat = "identity") +
     ylim(0, 1) +
     annotation_raster(pic_face, 4, 5, 0.875, 1,interpolate=TRUE)
plot(g)

f:id:bob3:20171217130257p:plain
普通に幸せってことでまさに「微笑」ですね。

続けてほかの画像の結果も。

マリリンモンローのびっくり顔。
File:Gentlemen Prefer Blondes Movie Trailer Screenshot (16-2).jpg - Wikimedia Commons
f:id:bob3:20171217141521j:plain:medium
f:id:bob3:20171217141555p:plain
びっくりしてますね。

映画『ベン・ハー』より。
File:Jack Hawkins in Ben Hur trailer.jpg - Wikimedia Commons
f:id:bob3:20160910132332j:plain:medium
f:id:bob3:20171217142759p:plain
複雑な表情です。

映画『風と共に去りぬ』より
File:De Havilland-Melanie.jpg - Wikimedia Commons
f:id:bob3:20171217144029j:plain:medium
f:id:bob3:20171217144303p:plain
幸せそうです。

同上。
File:Clark Gable as Rhett Butler in Gone With the Wind trailer.jpg - Wikimedia Commons
f:id:bob3:20170705140520j:plain:medium
f:id:bob3:20171217145625p:plain
ちょっとスケベっぽいけど。

以上です。

enjoy!