集合写真で水中メガネの人に枠を付ける

R

前回の記事の集合写真を拡大すると、さらに細かくメガネの種類を検出できるらしい。
http://uribo.hatenablog.com/entry/2017/04/05/224401

ということでメガネの種類ごとに色分けした顔領域を描画したい。

画像の読み込みと拡大

画像の拡大には今回はmagickパッケージのimage_scale()を用いる。

library("httr")
library("magick")
library("dplyr")
MS_FACE_KEY <- "あなたのスクリプトキー"
url_image <- "https://henningsway.github.io/images/biginjapan_blog/tokyo_r.jpg"
# 画像を読み込んで、顔が検出できるように幅を5000pxに拡大する
pic <- image_read(url_image) %>% image_scale("5000")

ここで画像の情報を確認する。magickパッケージのimage_info()を用いる。
幅5000pxになっていることが確認できる。

# いったん画像の情報を確認する
image_info(pic)
#   format width height colorspace filesize
# 1   JPEG  5000   3328       sRGB        0

APIへのPOST

拡大した画像をファイル出力し、APIにPOSTする。

# APIにPOSTするために一時ファイルに出力する：出力しなくて良い方法があったら教えてください
tmp <- tempfile()
image_write(pic, tmp)

# MS Face APIにPOST
url_base <- "https://westus.api.cognitive.microsoft.com/face/v1.0/detect"
result <- POST(url_base, 
               body = upload_file(tmp), 
               query = list(returnFaceAttributes="age,gender,headPose,smile,facialHair,glasses,emotion", 
                            language="en"), 
               add_headers(.headers = c(`Content-Type`="application/octet-stream", 
                                        `Ocp-Apim-Subscription-Key`=MS_FACE_KEY
                                        )
                           )
               ) %>% content()

POSTした結果から検出されたメガネの種類を確認すると３種類あることがわかる。

# 検出されたメガネの種類を確認
result %>% lapply(function(x)x$faceAttributes$glasses) %>% unlist() %>% table()

# NoGlasses  ReadingGlasses SwimmingGoggles 
# 17              12               3

メガネの種類によって色分けする

結果には検出された顔領域がfaceRectangleとして格納されている。
メガネの種類によって、これを塗り分けることにする。
いったん写真を描画して、rect()を用いて色分けした四角形を描画する。

# 検出された顔領域のデータを抽出
bbox <- lapply(result, function(x)x$faceRectangle)

# メガネの種類によって顔領域を塗り分けるために色分けする
# メガネなし：灰、通常のメガネ：オレンジ、水中メガネ：緑
glass <- result %>% lapply(function(x)x$faceAttributes$glasses) %>% 
  unlist() %>% 
  recode(ReadingGlasses="orange", SwimmingGoggles="green", .default=NA_character_)

# 描画
plot(pic)
for(i in seq(length(bbox))){
  rect(xleft=bbox[[i]]$left,
       ybottom=image_info(pic)$height-bbox[[i]]$top-bbox[[i]]$height,
       xright=bbox[[i]]$left+bbox[[i]]$width,
       ytop=image_info(pic)$height-bbox[[i]]$top, 
       lwd=2,
       border=glass[i]
       )
}

結果はこちら。

Enjoy!