ラブライブ!というアニメを観ていて

MikuHatsune2013-01-15

ラブライブ!というアニメがある。
内容は廃校寸前の学園からアイドル活動を通じて学園を立て直そう的なものなのだが、出ている声優が初めて聞く人が多くて注目している。
そのなかでメインとなる9人のメンバーがいるのだが

身長やスリーサイズといったプロフィールが公式設定で存在している。
ラブライブ!はユーザー参加型企画らしいのだが、どのキャラが好きかどうか決めないと先に進まないだろうから、彼女らをどうにか特徴付けようと思って、前回やった主成分分析をやってみる。
(実はとある人にこのアニメを勧めたはいいが、自分はまったく知らないのでキャラを覚える意味でやるという…)

data0 <- read.csv("loverive.txt", header=TRUE)
data1 <- data0[,-which(colnames(data0)=="name")] #PCA用に数値だけにする
   B  W  H height age        name
1 90 60 82    156  17     東條 希
2 88 60 84    162  17   絢瀬 絵里
3 82 60 83    156  15   小泉 花陽
4 80 58 80    159  16   南 ことり
5 78 56 83    161  15 西木野 真姫
6 78 58 82    157  16 高坂 穂乃果
7 76 58 80    159  16   園田 海未
8 75 59 80    155  15     星空 凛
9 74 57 79    154  17   矢澤 にこ
plot(data1, cex=1)

cors <- cor(data1)
library(gplots)
colors <- greenred(20)
image(seq(nrow(cors)), seq(ncol(cors)), cors, xlab="", ylab="", axes=FALSE, col=colors, zlim=c(-1, 1))
axis(1, at=seq(nrow(cors)), label=rownames(cors), las=2)
axis(2, at=seq(ncol(cors)), label=rownames(cors), las=2)
           B      W      H height    age
B      1.000  0.696  0.672  0.319  0.436
W      0.696  1.000  0.364 -0.118  0.203
H      0.672  0.364  1.000  0.560 -0.083
height 0.319 -0.118  0.560  1.000  0.000
age    0.436  0.203 -0.083  0.000  1.000

respca <- prcomp(data0[, -which(colnames(data0)=="name")], scale=TRUE)
respca$rotation
cols <- c("black", topo.colors(ncol(data0[, -which(colnames(data0)=="name")]) - 2), "red")
barplot(t(respca$rotation[, 1:2]), beside=TRUE, las=1, col=1:2, ylim=c(-1, 1))

summary(prcomp(data0[, -which(colnames(data0)=="name")]))
Importance of components:
                          PC1    PC2     PC3     PC4     PC5
Standard deviation     5.9287 2.7019 1.20465 0.85421 0.53456
Proportion of Variance 0.7825 0.1625 0.03231 0.01625 0.00636
Cumulative Proportion  0.7825 0.9451 0.97739 0.99364 1.00000

第2主成分までで95%近く説明できるようだ。

pca_score <- scale(data1) %*% eigen(cor(data1))$vectors *sqrt(nrow(data1)/(nrow(data1) - 1))

plot(pca_score[, 1:2], type="n", xlab="PC1", ylab="PC2", xlim=c(-1, 1)*4, ylim=c(-1, 1)*4)
text(pca_score[,1:2], as.character(data0$name))


第1主成分は、スリーサイズに対する影響が一目瞭然だろう。
絢瀬絵里東條希が負に突出、矢澤にこが正に突出している点からもそうだろう。
第2主成分はちょっとよくわからないが、東條希矢澤にこが高学年の割に背が小さい。一方で、西木野真姫は最年少ではあるが、背は大きい方だ。
ということで、年下のくせに大きな娘か、年上のくせに小さい、みたいな?
ちなみにこれは性格を一切反映していないので実際のところよくわからない。
 
ここで、せっかく彼女らのイラストがあるのだから、Rのプロット上に写真を出したくなった。
ちょっと前biOpsというパッケージを聞いたのでやってみたが、プロットした点に対応して画像を貼り付ける、というのがうまくいかない。
というのでこんな感じにした。
画像を貼り付ける座標を四方四ヶ所指定すればいい感じにプロットしたように見える。
pngでしかうまくいかなかった。jpgは違う方式でデータ格納されているのでやる気があればやる。
これもうまくいかなかった。

#上の画像をpng保存してちまちまやる。
library(png)
picnames <- c("tojo", "ayase", "koizumi", "minami", "nishikino", "kosaka", "sonoda", "hoshizora", "yazawa")
pics <- vector("list", length(picnames))
for(i in seq(picnames)){
	pics[[i]] <- readPNG(paste("path", picnames[i], ".png", sep=""))
}

ra <- 1 #原点に近いところが潰れるので拡大したかったけど、等倍でやった。
xyl<- 4 #プロット領域
xy0 <- sapply(pics, dim)[1:2, ] #pixel
rownames(xy0) <- c("height", "width")
s0 <- 0.01 #拡大縮小率
plot(pca_score[, 1:2], type="n", xlim=c(-1, 1)*xyl, ylim=c(-1, 1)*xyl,
	xlab="←グラマラス ロリ→", ylab="←大きい妹キャラ 小さなお姉さんキャラ→")
	title("身体的特徴プロフィールを用いた主成分分析")
for(j in seq(pics)){
	rasterImage(image=pics[[j]], xleft=pca_score[j, 1]*ra - xy0[2, j]/2*s0, ybottom=pca_score[j, 2]*ra - xy0[1, j]/2*s0,
		xright=pca_score[j, 1]*ra + xy0[2, j]/2*s0, ytop=pca_score[j, 2]*ra + xy0[1, j]/2*s0)
}


南ことりが下敷きになってしまったがしょうがない…
ことり厨が発狂しないようにことりが前面バージョンも作った。

 
今回は9人だけだったが、もっと人数の多いTHE IDOLM@STER (HP)や、もっともっと人の多いTHE IDOLM@STER CINDERELLA GIRLS (HP)もあるので、データベースがあればやってみないこともない…