GF(仮)のキャラがニーソなのかどうなのかを Deep learning を使ってなんとか知りたい

MikuHatsune2014-11-18

GF(仮)を見てる。

クロエ・ルメールのようなニーソキャラが好きなのだが、これをどうにかキャラプロフィールから推定できないか…と思っていたら
MNIST手書き文字データをdeep learnignで分類するっていう、あの有名なやつを、Rパッケージであるh2oでやる、という話があったわけで
　
GFのプロフィール画像からニーソキャラかどうか推定しよう!!
　
ってたぶん誰でも思いつくわけですよ。
というわけでやってみた。ちなみにdeep learning の勉強は1秒も進んでいない。
キャラがニーソであるかどうかは、おそらく髪が長くて金髪、つまりクロエ・ルメール的なキャラだとニーソ率が高いということがいままでのアニメ経験上分かっている感じ。
(だったら画像上、長髪キャラかどうかを判別するほうがたぶんdeep learning の本当の使い方なんだろうけど完全無視!!というかニーソ推定やってから気づいた)
ubuntuのRでRCurlが入らなくて困ったら

sudo apt-get install libcurl4-gnutls-dev

でたぶん解決する。
　
画像データはここを参考に取ってくる。112人分の150*150ピクセルの画像があるので、1人あたり22500の長さのデータベクトルが得られる。これが入力になる。データ量削減のために、RBG、つまり色はもう白黒ベースにしてしまう。データはpngを読み込むと行列で得られるが、ベクトルにしておく。
とすると白い部分が多いとスパースになるから、LASSOでいいのではと思ったけどまったく分類できなかった。
　
キャラページを開いて地道にニーソ判定する。キャラID順に1がニーソのフラグがこちら。

dat <- read.delim("GF_deep.csv")
knee <- dat$knee
dat1 <- as.matrix(dat[, -c(1:2)]) # IDとニーソのラベルを削除

tate <- 8
yoko <- nrow(dat1) / tate
col <- grey(seq(0, 1, length=100))
pix <- sqrt(ncol(dat1))
#png("20141119.png", 150*yoko*0.6, 150*tate*0.6)
par(mfrow=c(tate, yoko), mar=rep(0, 4))
for(i in seq(nrow(dat1))){
	mat <- matrix(as.integer(dat1[i, ]), nr=pix)[, pix:1]
	image(mat, col=col, axes=FALSE)
	if(knee[i] == 1){
		p <- par()$usr
		polygon(p[c(1,2,2,1)], p[c(1,1,2,2)], border="red", lwd=7)
	}
}

赤で囲ったのがニーソキャラ。クロエ・ルメールは真ん中になった(偶然

　
Deep learningで分類器を作る。推定精度として交差検証を行うが、one leave out は回数が多くなりすぎるので14で割った数にしたが、これでもPCが落ちまくるのでその都度計算を記録して1日がかりでなんとかやった。
パラメータの詳細はここにあるけど適当。

library(h2o)
# deep learning のための接続
localH2O <- h2o.init(ip = "localhost", port = 54321, startH2O = TRUE, nthreads=-1)
# dat_tr は1列目がラベル、2列目以降が入力ベクトルのひらすらでかいデータ
# 読み込み
h2o_tr <- h2o.importFile(localH2O, path = "dat_tr.csv")
df_tr <- as.data.frame(h2o_tr)
# CV用のグループ
# 本当は one leave out でしたかったけど
cv_group <- matrix(sample(seq(nrow(df_tr))), 8)
vec <- rep(-1, nrow(df_tr)) # 推定したラベルを収めるベクトル

# はじめる
for(j in seq(ncol(cv_group))){
	# deep learning
	dl <- h2o.deeplearning(x = 2:ncol(df_tr), y = 1, data = h2o_tr[-cv_group[, j], ], activation = "Tanh", hidden=rep(20, 5), epochs = 20)
	# テストデータの推定
	pred.dl <- h2o.predict(object=dl, newdata=h2o_tr[cv_group[, j], -1])
	p <- as.data.frame(pred.dl)$predict
	# write.csv(cbind(cv_group[, j], p), paste("OLOCV", j, ".csv", sep="")) # その都度出力して記録する用
	vec[cv_group[, j]] <- p
	print(j) # タイマー
}

交差検証をしたので、性能を評価してみる。

stats <- function(mat){
	recall <- mat[2,2]/sum(mat[2,])
	precision <- mat[2,2]/sum(mat[,2])
	F <- (2*recall*precision)/(recall+precision)
	MMC <- (prod(diag(mat))-mat[1,2]*mat[2,1])/sqrt(prod(rowSums(mat), colSums(mat)))
	ret <- list(recall=recall, precisiion=precision, F=F, MMC=MMC)
	return(ret)
}

# 正誤
s <- table(df_tr[, 1], vec)
stats(s)

$recall
[1] 0.173913

$precisiion
[1] 0.1666667

$F
[1] 0.1702128

$MMC
[1] -0.05001813

というわけでF値 0.17程度の素晴らしい()分類器ができたよ(ﾆｺｯ
　
この結果を真に分類できたか、または間違ったかでプロットし直すと

# 推定結果
p2 <- cbind(df_tr, vec)
par(mfrow=c(tate, yoko), mar=rep(0, 4))
for(i in seq(nrow(dat1))){
	mat <- matrix(as.integer(dat1[i, ]), nr=pix)[, pix:1]
	image(mat, col=col, axes=FALSE)
	p <- par()$usr
	# 真陰性、偽陰性、偽陽性、真陽性
	bcol <- switch(sum(p2[i,]*(1:2))+1, NA, "red", "yellow", "green")
	polygon(p[c(1,2,2,1)], p[c(1,1,2,2)], border=bcol, lwd=7)
}

クロエ・ルメールがニーソキャラと分類できたよ!!

　
推定結果